From f808d59eae2123cdc69d400a4f8de2eacb1cd722 Mon Sep 17 00:00:00 2001 From: Jesse Capecelatro <> Date: Mon, 7 Nov 2022 12:59:02 +0100 Subject: [PATCH 001/152] Olivier's changes from develop. Also updated LPT class to include energy source, temperature, etc. Still need to add heat transfer between phases. MAST now gets source from particles. Need to check energy equation. --- src/constant_density/incomp_class.f90 | 101 +- src/constant_density/scalar_class.f90 | 271 ++-- src/grid/iterator_class.f90 | 33 +- src/grid/pgrid_class.f90 | 104 +- src/particles/lpt_class.f90 | 34 +- src/two_phase/mast_class.f90 | 1505 ++++++++++++++++++----- src/two_phase/matm_class.f90 | 437 ++++++- src/two_phase/tpns_class.f90 | 6 +- src/two_phase/vfs_class.f90 | 45 +- src/variable_density/lowmach_class.f90 | 6 +- src/variable_density/vdscalar_class.f90 | 2 +- 11 files changed, 2105 insertions(+), 439 deletions(-) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index a2fd775c2..92d24c76f 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -114,7 +114,8 @@ module incomp_class procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values procedure :: interp_vel !< Calculate interpolated velocity - procedure :: get_strainrate !< Calculate strain rate tensor + procedure :: get_strainrate !< Calculate strain rate tensor (naive implementation based on Ui/Vi/Wi) + procedure :: get_gradu !< Calculate velocity gradient tensor (optimal implementation based on U/V/W) procedure :: get_mfr !< Calculate outgoing MFR through each bcond procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation procedure :: shift_p !< Shift pressure to have zero average @@ -1242,9 +1243,9 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uxp-Uxm); dUdx(1,3)=this%cfg%dzi(k)*(Uxp-Uxm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vxp-Vxm); dUdx(2,3)=this%cfg%dzi(k)*(Vxp-Vxm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wxp-Wxm); dUdx(3,3)=this%cfg%dzi(k)*(Wxp-Wxm) + dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) + dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) + dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) ! Assemble the strain rate SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP @@ -1285,6 +1286,98 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end subroutine get_strainrate + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(incomp), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + !> Calculate the CFL subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index cd46fcdea..484f033e7 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -18,7 +18,9 @@ module scalar_class integer, parameter, public :: neumann=3 !< Zero normal gradient ! List of available advection schemes for scalar transport + integer, parameter, public :: upwind=0 !< First order upwind scheme integer, parameter, public :: quick=1 !< Quick scheme + integer, parameter, public :: bquick=2 !< BQuick scheme !> Boundary conditions for the incompressible solver @@ -65,12 +67,16 @@ module scalar_class integer :: nst !< Scheme order (and elemental stencil size) integer :: stp1,stp2 !< Plus interpolation stencil extent for scalar advection integer :: stm1,stm2 !< Minus interpolation stencil extent for scalar advection - real(WP), dimension(:,:,:,:), allocatable :: itpsc_xp,itpsc_yp,itpsc_zp !< Plus interpolation for SC - real(WP), dimension(:,:,:,:), allocatable :: itpsc_xm,itpsc_ym,itpsc_zm !< Minus interpolation for SC - real(WP), dimension(:,:,:,:), allocatable :: divsc_x ,divsc_y ,divsc_z !< Divergence for SC - real(WP), dimension(:,:,:,:), allocatable :: grdsc_x ,grdsc_y ,grdsc_z !< Scalar gradient for SC - real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity - + real(WP), dimension(:,:,:,:), allocatable :: itp_xp,itp_yp,itp_zp !< Plus interpolation for SC + real(WP), dimension(:,:,:,:), allocatable :: itp_xm,itp_ym,itp_zm !< Minus interpolation for SC + real(WP), dimension(:,:,:,:), allocatable :: div_x ,div_y ,div_z !< Divergence for SC + real(WP), dimension(:,:,:,:), allocatable :: grd_x ,grd_y ,grd_z !< Scalar gradient for SC + real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity + + ! Bquick requires additional storage + real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup + real(WP), dimension(:,:,:,:), allocatable :: bitp_xm,bitp_ym,bitp_zm !< Minus interpolation for SC - backup + ! Masking info for metric modification integer, dimension(:,:,:), allocatable :: mask !< Integer array used for modifying SC metrics @@ -85,6 +91,8 @@ module scalar_class procedure :: apply_bcond !< Apply all boundary conditions procedure :: init_metrics !< Initialize metrics procedure :: adjust_metrics !< Adjust metrics + procedure :: metric_reset !< Reset adaptive metrics like bquick + procedure :: metric_adjust !< Adjust adaptive metrics like bquick procedure :: get_drhoSCdt !< Calculate drhoSC/dt procedure :: get_max !< Calculate maximum field values procedure :: get_int !< Calculate integral field values @@ -128,6 +136,13 @@ function constructor(cfg,scheme,name) result(self) ! Prepare advection scheme self%scheme=scheme select case (self%scheme) + case (upwind) + ! Check current overlap + if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=1 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (quick) ! Check current overlap if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') @@ -135,6 +150,13 @@ function constructor(cfg,scheme,name) result(self) self%nst=3 self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (bquick) + ! Check current overlap + if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=3 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case default call die('[scalar constructor] Unknown scalar transport scheme selected') end select @@ -194,58 +216,62 @@ subroutine init_metrics(this) end do ! Allocate finite difference scalar interpolation coefficients - allocate(this%itpsc_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%itpsc_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%itpsc_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%itpsc_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%itpsc_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered - allocate(this%itpsc_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + allocate(this%itp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%itp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%itp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%itp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%itp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + allocate(this%itp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered ! Create scalar interpolation coefficients to cell faces select case (this%scheme) - case (quick) + case (upwind) + this%itp_xp=1.0_WP; this%itp_xm=1.0_WP + this%itp_yp=1.0_WP; this%itp_ym=1.0_WP + this%itp_zp=1.0_WP; this%itp_zm=1.0_WP + case (quick,bquick) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 ! Interpolation to x-face - call fv_itp_build(n=3,x=this%cfg%x(i+this%stp1:i+this%stp2+1),xp=this%cfg%x(i),coeff=this%itpsc_xp(:,i,j,k)) - call fv_itp_build(n=3,x=this%cfg%x(i+this%stm1:i+this%stm2+1),xp=this%cfg%x(i),coeff=this%itpsc_xm(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%x(i+this%stp1:i+this%stp2+1),xp=this%cfg%x(i),coeff=this%itp_xp(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%x(i+this%stm1:i+this%stm2+1),xp=this%cfg%x(i),coeff=this%itp_xm(:,i,j,k)) ! Interpolation to y-face - call fv_itp_build(n=3,x=this%cfg%y(j+this%stp1:j+this%stp2+1),xp=this%cfg%y(j),coeff=this%itpsc_yp(:,i,j,k)) - call fv_itp_build(n=3,x=this%cfg%y(j+this%stm1:j+this%stm2+1),xp=this%cfg%y(j),coeff=this%itpsc_ym(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%y(j+this%stp1:j+this%stp2+1),xp=this%cfg%y(j),coeff=this%itp_yp(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%y(j+this%stm1:j+this%stm2+1),xp=this%cfg%y(j),coeff=this%itp_ym(:,i,j,k)) ! Interpolation to z-face - call fv_itp_build(n=3,x=this%cfg%z(k+this%stp1:k+this%stp2+1),xp=this%cfg%z(k),coeff=this%itpsc_zp(:,i,j,k)) - call fv_itp_build(n=3,x=this%cfg%z(k+this%stm1:k+this%stm2+1),xp=this%cfg%z(k),coeff=this%itpsc_zm(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%z(k+this%stp1:k+this%stp2+1),xp=this%cfg%z(k),coeff=this%itp_zp(:,i,j,k)) + call fv_itp_build(n=3,x=this%cfg%z(k+this%stm1:k+this%stm2+1),xp=this%cfg%z(k),coeff=this%itp_zm(:,i,j,k)) end do end do end do end select ! Allocate finite volume divergence operators - allocate(this%divsc_x(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered - allocate(this%divsc_y(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered - allocate(this%divsc_z(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered + allocate(this%div_x(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered + allocate(this%div_y(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered + allocate(this%div_z(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered ! Create divergence operator to cell center [xm,ym,zm] do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - this%divsc_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,zm] - this%divsc_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,zm] - this%divsc_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,z ] + this%div_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,zm] + this%div_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,zm] + this%div_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,z ] end do end do end do ! Allocate finite difference velocity gradient operators - allocate(this%grdsc_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%grdsc_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%grdsc_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + allocate(this%grd_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%grd_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%grd_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered ! Create gradient coefficients to cell faces do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%grdsc_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in x from [xm,ym,zm] to [x,ym,zm] - this%grdsc_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in y from [xm,ym,zm] to [xm,y,zm] - this%grdsc_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in z from [xm,ym,zm] to [xm,ym,z] + this%grd_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in x from [xm,ym,zm] to [x,ym,zm] + this%grd_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in y from [xm,ym,zm] to [xm,y,zm] + this%grd_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient of SC in z from [xm,ym,zm] to [xm,ym,z] end do end do end do @@ -285,30 +311,30 @@ subroutine adjust_metrics(this) do i=this%cfg%imin_,this%cfg%imax_+1 ! X face if (this%mask(i-1,j,k).eq.2) then - this%itpsc_xm(:,i,j,k)=0.0_WP; this%itpsc_xm(-1,i,j,k)=1.0_WP - this%itpsc_xp(:,i,j,k)=0.0_WP; this%itpsc_xp(-1,i,j,k)=1.0_WP + this%itp_xm(:,i,j,k)=0.0_WP; this%itp_xm(-1,i,j,k)=1.0_WP + this%itp_xp(:,i,j,k)=0.0_WP; this%itp_xp(-1,i,j,k)=1.0_WP end if if (this%mask(i ,j,k).eq.2) then - this%itpsc_xm(:,i,j,k)=0.0_WP; this%itpsc_xm( 0,i,j,k)=1.0_WP - this%itpsc_xp(:,i,j,k)=0.0_WP; this%itpsc_xp( 0,i,j,k)=1.0_WP + this%itp_xm(:,i,j,k)=0.0_WP; this%itp_xm( 0,i,j,k)=1.0_WP + this%itp_xp(:,i,j,k)=0.0_WP; this%itp_xp( 0,i,j,k)=1.0_WP end if ! Y face if (this%mask(i,j-1,k).eq.2) then - this%itpsc_ym(:,i,j,k)=0.0_WP; this%itpsc_ym(-1,i,j,k)=1.0_WP - this%itpsc_yp(:,i,j,k)=0.0_WP; this%itpsc_yp(-1,i,j,k)=1.0_WP + this%itp_ym(:,i,j,k)=0.0_WP; this%itp_ym(-1,i,j,k)=1.0_WP + this%itp_yp(:,i,j,k)=0.0_WP; this%itp_yp(-1,i,j,k)=1.0_WP end if if (this%mask(i,j ,k).eq.2) then - this%itpsc_ym(:,i,j,k)=0.0_WP; this%itpsc_ym( 0,i,j,k)=1.0_WP - this%itpsc_yp(:,i,j,k)=0.0_WP; this%itpsc_yp( 0,i,j,k)=1.0_WP + this%itp_ym(:,i,j,k)=0.0_WP; this%itp_ym( 0,i,j,k)=1.0_WP + this%itp_yp(:,i,j,k)=0.0_WP; this%itp_yp( 0,i,j,k)=1.0_WP end if ! Z face if (this%mask(i,j,k-1).eq.2) then - this%itpsc_zm(:,i,j,k)=0.0_WP; this%itpsc_zm(-1,i,j,k)=1.0_WP - this%itpsc_zp(:,i,j,k)=0.0_WP; this%itpsc_zp(-1,i,j,k)=1.0_WP + this%itp_zm(:,i,j,k)=0.0_WP; this%itp_zm(-1,i,j,k)=1.0_WP + this%itp_zp(:,i,j,k)=0.0_WP; this%itp_zp(-1,i,j,k)=1.0_WP end if if (this%mask(i,j,k ).eq.2) then - this%itpsc_zm(:,i,j,k)=0.0_WP; this%itpsc_zm( 0,i,j,k)=1.0_WP - this%itpsc_zp(:,i,j,k)=0.0_WP; this%itpsc_zp( 0,i,j,k)=1.0_WP + this%itp_zm(:,i,j,k)=0.0_WP; this%itp_zm( 0,i,j,k)=1.0_WP + this%itp_zp(:,i,j,k)=0.0_WP; this%itp_zp( 0,i,j,k)=1.0_WP end if end do end do @@ -319,9 +345,9 @@ subroutine adjust_metrics(this) do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ if (this%mask(i,j,k).gt.0) then - this%divsc_x(:,i,j,k)=0.0_WP - this%divsc_y(:,i,j,k)=0.0_WP - this%divsc_z(:,i,j,k)=0.0_WP + this%div_x(:,i,j,k)=0.0_WP + this%div_y(:,i,j,k)=0.0_WP + this%div_z(:,i,j,k)=0.0_WP end if end do end do @@ -331,25 +357,25 @@ subroutine adjust_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - if (this%mask(i,j,k).eq.1.or.this%mask(i-1,j,k).eq.1) this%grdsc_x(:,i,j,k)=0.0_WP !< FD gradient in x of SC - if (this%mask(i,j,k).eq.1.or.this%mask(i,j-1,k).eq.1) this%grdsc_y(:,i,j,k)=0.0_WP !< FD gradient in y of SC - if (this%mask(i,j,k).eq.1.or.this%mask(i,j,k-1).eq.1) this%grdsc_z(:,i,j,k)=0.0_WP !< FD gradient in z of SC + if (this%mask(i,j,k).eq.1.or.this%mask(i-1,j,k).eq.1) this%grd_x(:,i,j,k)=0.0_WP !< FD gradient in x of SC + if (this%mask(i,j,k).eq.1.or.this%mask(i,j-1,k).eq.1) this%grd_y(:,i,j,k)=0.0_WP !< FD gradient in y of SC + if (this%mask(i,j,k).eq.1.or.this%mask(i,j,k-1).eq.1) this%grd_z(:,i,j,k)=0.0_WP !< FD gradient in z of SC end do end do end do ! Adjust metrics to account for lower dimensionality if (this%cfg%nx.eq.1) then - this%divsc_x=0.0_WP - this%grdsc_x=0.0_WP + this%div_x=0.0_WP + this%grd_x=0.0_WP end if if (this%cfg%ny.eq.1) then - this%divsc_y=0.0_WP - this%grdsc_y=0.0_WP + this%div_y=0.0_WP + this%grd_y=0.0_WP end if if (this%cfg%nz.eq.1) then - this%divsc_z=0.0_WP - this%grdsc_z=0.0_WP + this%div_z=0.0_WP + this%grd_z=0.0_WP end if end subroutine adjust_metrics @@ -365,6 +391,17 @@ subroutine setup(this,implicit_ils) ! Adjust metrics based on mask array call this%adjust_metrics() + ! Bquick needs to remember the quick coefficients + select case (this%scheme) + case (bquick) + allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp + allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm + allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp + allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym + allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp + allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm + end select + ! Set dynamic stencil map for the scalar solver count=1; this%implicit%stc(count,:)=[0,0,0] do st=1,abs(this%stp1) @@ -423,7 +460,7 @@ end function locator if (new_bc%type.eq.neumann) call die('[scalar apply_bcond] Neumann requires a direction') new_bc%dir=0 end if - new_bc%itr=iterator(this%cfg,new_bc%name,locator) + new_bc%itr=iterator(this%cfg,new_bc%name,locator,'c') ! Insert it up front new_bc%next=>this%first_bc @@ -534,17 +571,17 @@ subroutine get_drhoSCdt(this,drhoSCdt,rhoU,rhoV,rhoW) do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 ! Fluxes on x-face - FX(i,j,k)=-0.5_WP*(rhoU(i,j,k)+abs(rhoU(i,j,k)))*sum(this%itpsc_xp(:,i,j,k)*this%SC(i+this%stp1:i+this%stp2,j,k)) & - & -0.5_WP*(rhoU(i,j,k)-abs(rhoU(i,j,k)))*sum(this%itpsc_xm(:,i,j,k)*this%SC(i+this%stm1:i+this%stm2,j,k)) & - & +sum(this%itp_x(:,i,j,k)*this%diff(i-1:i,j,k))*sum(this%grdsc_x(:,i,j,k)*this%SC(i-1:i,j,k)) + FX(i,j,k)=-0.5_WP*(rhoU(i,j,k)+abs(rhoU(i,j,k)))*sum(this%itp_xp(:,i,j,k)*this%SC(i+this%stp1:i+this%stp2,j,k)) & + & -0.5_WP*(rhoU(i,j,k)-abs(rhoU(i,j,k)))*sum(this%itp_xm(:,i,j,k)*this%SC(i+this%stm1:i+this%stm2,j,k)) & + & +sum(this%itp_x(:,i,j,k)*this%diff(i-1:i,j,k))*sum(this%grd_x(:,i,j,k)*this%SC(i-1:i,j,k)) ! Fluxes on y-face - FY(i,j,k)=-0.5_WP*(rhoV(i,j,k)+abs(rhoV(i,j,k)))*sum(this%itpsc_yp(:,i,j,k)*this%SC(i,j+this%stp1:j+this%stp2,k)) & - & -0.5_WP*(rhoV(i,j,k)-abs(rhoV(i,j,k)))*sum(this%itpsc_ym(:,i,j,k)*this%SC(i,j+this%stm1:j+this%stm2,k)) & - & +sum(this%itp_y(:,i,j,k)*this%diff(i,j-1:j,k))*sum(this%grdsc_y(:,i,j,k)*this%SC(i,j-1:j,k)) + FY(i,j,k)=-0.5_WP*(rhoV(i,j,k)+abs(rhoV(i,j,k)))*sum(this%itp_yp(:,i,j,k)*this%SC(i,j+this%stp1:j+this%stp2,k)) & + & -0.5_WP*(rhoV(i,j,k)-abs(rhoV(i,j,k)))*sum(this%itp_ym(:,i,j,k)*this%SC(i,j+this%stm1:j+this%stm2,k)) & + & +sum(this%itp_y(:,i,j,k)*this%diff(i,j-1:j,k))*sum(this%grd_y(:,i,j,k)*this%SC(i,j-1:j,k)) ! Fluxes on z-face - FZ(i,j,k)=-0.5_WP*(rhoW(i,j,k)+abs(rhoW(i,j,k)))*sum(this%itpsc_zp(:,i,j,k)*this%SC(i,j,k+this%stp1:k+this%stp2)) & - & -0.5_WP*(rhoW(i,j,k)-abs(rhoW(i,j,k)))*sum(this%itpsc_zm(:,i,j,k)*this%SC(i,j,k+this%stm1:k+this%stm2)) & - & +sum(this%itp_z(:,i,j,k)*this%diff(i,j,k-1:k))*sum(this%grdsc_z(:,i,j,k)*this%SC(i,j,k-1:k)) + FZ(i,j,k)=-0.5_WP*(rhoW(i,j,k)+abs(rhoW(i,j,k)))*sum(this%itp_zp(:,i,j,k)*this%SC(i,j,k+this%stp1:k+this%stp2)) & + & -0.5_WP*(rhoW(i,j,k)-abs(rhoW(i,j,k)))*sum(this%itp_zm(:,i,j,k)*this%SC(i,j,k+this%stm1:k+this%stm2)) & + & +sum(this%itp_z(:,i,j,k)*this%diff(i,j,k-1:k))*sum(this%grd_z(:,i,j,k)*this%SC(i,j,k-1:k)) end do end do end do @@ -552,9 +589,9 @@ subroutine get_drhoSCdt(this,drhoSCdt,rhoU,rhoV,rhoW) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - drhoSCdt(i,j,k)=sum(this%divsc_x(:,i,j,k)*FX(i:i+1,j,k))+& - & sum(this%divsc_y(:,i,j,k)*FY(i,j:j+1,k))+& - & sum(this%divsc_z(:,i,j,k)*FZ(i,j,k:k+1)) + drhoSCdt(i,j,k)=sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) end do end do end do @@ -606,15 +643,15 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) do std=0,1 ! Loop over plus interpolation stencil do sti=this%stp1,this%stp2 - this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)=this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)+0.5_WP*dt*this%divsc_x(std,i,j,k)*0.5_WP*(rhoU(i+std,j,k)+abs(rhoU(i+std,j,k)))*this%itpsc_xp(sti,i+std,j,k) - this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)=this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)+0.5_WP*dt*this%divsc_y(std,i,j,k)*0.5_WP*(rhoV(i,j+std,k)+abs(rhoV(i,j+std,k)))*this%itpsc_yp(sti,i,j+std,k) - this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)=this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)+0.5_WP*dt*this%divsc_z(std,i,j,k)*0.5_WP*(rhoW(i,j,k+std)+abs(rhoW(i,j,k+std)))*this%itpsc_zp(sti,i,j,k+std) + this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)=this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)+0.5_WP*dt*this%div_x(std,i,j,k)*0.5_WP*(rhoU(i+std,j,k)+abs(rhoU(i+std,j,k)))*this%itp_xp(sti,i+std,j,k) + this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)=this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)+0.5_WP*dt*this%div_y(std,i,j,k)*0.5_WP*(rhoV(i,j+std,k)+abs(rhoV(i,j+std,k)))*this%itp_yp(sti,i,j+std,k) + this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)=this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)+0.5_WP*dt*this%div_z(std,i,j,k)*0.5_WP*(rhoW(i,j,k+std)+abs(rhoW(i,j,k+std)))*this%itp_zp(sti,i,j,k+std) end do ! Loop over minus interpolation stencil do sti=this%stm1,this%stm2 - this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)=this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)+0.5_WP*dt*this%divsc_x(std,i,j,k)*0.5_WP*(rhoU(i+std,j,k)-abs(rhoU(i+std,j,k)))*this%itpsc_xm(sti,i+std,j,k) - this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)=this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)+0.5_WP*dt*this%divsc_y(std,i,j,k)*0.5_WP*(rhoV(i,j+std,k)-abs(rhoV(i,j+std,k)))*this%itpsc_ym(sti,i,j+std,k) - this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)=this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)+0.5_WP*dt*this%divsc_z(std,i,j,k)*0.5_WP*(rhoW(i,j,k+std)-abs(rhoW(i,j,k+std)))*this%itpsc_zm(sti,i,j,k+std) + this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)=this%implicit%opr(this%implicit%stmap(sti+std,0,0),i,j,k)+0.5_WP*dt*this%div_x(std,i,j,k)*0.5_WP*(rhoU(i+std,j,k)-abs(rhoU(i+std,j,k)))*this%itp_xm(sti,i+std,j,k) + this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)=this%implicit%opr(this%implicit%stmap(0,sti+std,0),i,j,k)+0.5_WP*dt*this%div_y(std,i,j,k)*0.5_WP*(rhoV(i,j+std,k)-abs(rhoV(i,j+std,k)))*this%itp_ym(sti,i,j+std,k) + this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)=this%implicit%opr(this%implicit%stmap(0,0,sti+std),i,j,k)+0.5_WP*dt*this%div_z(std,i,j,k)*0.5_WP*(rhoW(i,j,k+std)-abs(rhoW(i,j,k+std)))*this%itp_zm(sti,i,j,k+std) end do end do end do @@ -625,18 +662,18 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divsc_x(+1,i,j,k)*sum(this%itp_x(:,i+1,j,k)*this%diff(i :i+1,j,k))*this%grdsc_x(-1,i+1,j,k)+& - & this%divsc_x( 0,i,j,k)*sum(this%itp_x(:,i ,j,k)*this%diff(i-1:i ,j,k))*this%grdsc_x( 0,i ,j,k)+& - & this%divsc_y(+1,i,j,k)*sum(this%itp_y(:,i,j+1,k)*this%diff(i,j :j+1,k))*this%grdsc_y(-1,i,j+1,k)+& - & this%divsc_y( 0,i,j,k)*sum(this%itp_y(:,i,j ,k)*this%diff(i,j-1:j ,k))*this%grdsc_y( 0,i,j ,k)+& - & this%divsc_z(+1,i,j,k)*sum(this%itp_z(:,i,j,k+1)*this%diff(i,j,k :k+1))*this%grdsc_z(-1,i,j,k+1)+& - & this%divsc_z( 0,i,j,k)*sum(this%itp_z(:,i,j,k )*this%diff(i,j,k-1:k ))*this%grdsc_z( 0,i,j,k )) - this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divsc_x(+1,i,j,k)*sum(this%itp_x(:,i+1,j,k)*this%diff(i :i+1,j,k))*this%grdsc_x( 0,i+1,j,k)) - this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divsc_x( 0,i,j,k)*sum(this%itp_x(:,i ,j,k)*this%diff(i-1:i ,j,k))*this%grdsc_x(-1,i ,j,k)) - this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divsc_y(+1,i,j,k)*sum(this%itp_y(:,i,j+1,k)*this%diff(i,j :j+1,k))*this%grdsc_y( 0,i,j+1,k)) - this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divsc_y( 0,i,j,k)*sum(this%itp_y(:,i,j ,k)*this%diff(i,j-1:j ,k))*this%grdsc_y(-1,i,j ,k)) - this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divsc_z(+1,i,j,k)*sum(this%itp_z(:,i,j,k+1)*this%diff(i,j,k :k+1))*this%grdsc_z( 0,i,j,k+1)) - this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divsc_z( 0,i,j,k)*sum(this%itp_z(:,i,j,k )*this%diff(i,j,k-1:k ))*this%grdsc_z(-1,i,j,k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%div_x(+1,i,j,k)*sum(this%itp_x(:,i+1,j,k)*this%diff(i :i+1,j,k))*this%grd_x(-1,i+1,j,k)+& + & this%div_x( 0,i,j,k)*sum(this%itp_x(:,i ,j,k)*this%diff(i-1:i ,j,k))*this%grd_x( 0,i ,j,k)+& + & this%div_y(+1,i,j,k)*sum(this%itp_y(:,i,j+1,k)*this%diff(i,j :j+1,k))*this%grd_y(-1,i,j+1,k)+& + & this%div_y( 0,i,j,k)*sum(this%itp_y(:,i,j ,k)*this%diff(i,j-1:j ,k))*this%grd_y( 0,i,j ,k)+& + & this%div_z(+1,i,j,k)*sum(this%itp_z(:,i,j,k+1)*this%diff(i,j,k :k+1))*this%grd_z(-1,i,j,k+1)+& + & this%div_z( 0,i,j,k)*sum(this%itp_z(:,i,j,k )*this%diff(i,j,k-1:k ))*this%grd_z( 0,i,j,k )) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%div_x(+1,i,j,k)*sum(this%itp_x(:,i+1,j,k)*this%diff(i :i+1,j,k))*this%grd_x( 0,i+1,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%div_x( 0,i,j,k)*sum(this%itp_x(:,i ,j,k)*this%diff(i-1:i ,j,k))*this%grd_x(-1,i ,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%div_y(+1,i,j,k)*sum(this%itp_y(:,i,j+1,k)*this%diff(i,j :j+1,k))*this%grd_y( 0,i,j+1,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%div_y( 0,i,j,k)*sum(this%itp_y(:,i,j ,k)*this%diff(i,j-1:j ,k))*this%grd_y(-1,i,j ,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%div_z(+1,i,j,k)*sum(this%itp_z(:,i,j,k+1)*this%diff(i,j,k :k+1))*this%grd_z( 0,i,j,k+1)) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%div_z( 0,i,j,k)*sum(this%itp_z(:,i,j,k )*this%diff(i,j,k-1:k ))*this%grd_z(-1,i,j,k )) end do end do end do @@ -654,6 +691,68 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) end subroutine solve_implicit + !> Metric resetting for adaptive discretization like bquick + subroutine metric_reset(this) + implicit none + class(scalar), intent(inout) :: this + select case (this%scheme) + case (bquick) + this%itp_xp=this%bitp_xp + this%itp_xm=this%bitp_xm + this%itp_yp=this%bitp_yp + this%itp_ym=this%bitp_ym + this%itp_zp=this%bitp_zp + this%itp_zm=this%bitp_zm + end select + end subroutine metric_reset + + + !> Adjust adaptive metrics like bquick + subroutine metric_adjust(this,SC,SCmin,SCmax) + implicit none + class(scalar), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SC !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), optional :: SCmin + real(WP), optional :: SCmax + integer :: i,j,k + select case (this%scheme) + case (bquick) + if (present(SCmin)) then + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).lt.SCmin) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if + end do + end do + end do + end if + if (present(SCmax)) then + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).gt.SCmax) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if + end do + end do + end do + end if + end select + end subroutine metric_adjust + + !> Print out info for scalar solver subroutine scalar_print(this) use, intrinsic :: iso_fortran_env, only: output_unit diff --git a/src/grid/iterator_class.f90 b/src/grid/iterator_class.f90 index 40d0f012d..988c2ddf8 100644 --- a/src/grid/iterator_class.f90 +++ b/src/grid/iterator_class.f90 @@ -62,6 +62,7 @@ end function locator integer :: i,j,k,cnt integer :: color,key,ierr integer :: f_imax_,f_jmax_,f_kmax_ + integer :: f_imin_,f_jmin_,f_kmin_ ! Set the name for the iterator self%name=trim(adjustl(name)) @@ -76,14 +77,20 @@ end function locator case('x'); self%face='x' case('y'); self%face='y' case('z'); self%face='z' + case('c'); self%face='c' ! for cell-centered boundary conditions case default; call die('[iterator constructor] Unknown face value - if provided, expecting x, y, or z') end select end if - ! Modify iteration upper bounds to handle face-specific limits -> this considers more faces to be *inside* our domain - f_imax_=self%pg%imax_; if (.not.self%pg%xper.and.self%pg%iproc.eq.self%pg%npx.and.self%face.eq.'x') f_imax_=f_imax_+1 - f_jmax_=self%pg%jmax_; if (.not.self%pg%yper.and.self%pg%jproc.eq.self%pg%npy.and.self%face.eq.'y') f_jmax_=f_jmax_+1 - f_kmax_=self%pg%kmax_; if (.not.self%pg%zper.and.self%pg%kproc.eq.self%pg%npz.and.self%face.eq.'z') f_kmax_=f_kmax_+1 + ! Modify iteration upper bounds to include faces at boundary and cells just past boundary + f_imax_=self%pg%imax_; if (.not.self%pg%xper.and.self%pg%iproc.eq.self%pg%npx.and.(self%face.eq.'c'.or.self%face.eq.'x')) f_imax_=f_imax_+1 + f_jmax_=self%pg%jmax_; if (.not.self%pg%yper.and.self%pg%jproc.eq.self%pg%npy.and.(self%face.eq.'c'.or.self%face.eq.'y')) f_jmax_=f_jmax_+1 + f_kmax_=self%pg%kmax_; if (.not.self%pg%zper.and.self%pg%kproc.eq.self%pg%npz.and.(self%face.eq.'c'.or.self%face.eq.'z')) f_kmax_=f_kmax_+1 + + ! Modify iteration lower bounds to include cells just past boundary, faces remain at boundary + f_imin_=self%pg%imin_; if (.not.self%pg%xper.and.self%pg%iproc.eq.1.and.self%face.eq.'c') f_imin_=f_imin_-1 + f_jmin_=self%pg%jmin_; if (.not.self%pg%yper.and.self%pg%jproc.eq.1.and.self%face.eq.'c') f_jmin_=f_jmin_-1 + f_kmin_=self%pg%kmin_; if (.not.self%pg%zper.and.self%pg%kproc.eq.1.and.self%face.eq.'c') f_kmin_=f_kmin_-1 ! Loop over local domain with overlap to count iterator cells self%n_=0; self%no_=0 @@ -92,9 +99,9 @@ end function locator do i=self%pg%imino_,self%pg%imaxo_ if (locator(self%pg,i,j,k)) then self%no_=self%no_+1 - if (i.ge.self%pg%imin_.and.i.le.f_imax_.and.& - & j.ge.self%pg%jmin_.and.j.le.f_jmax_.and.& - & k.ge.self%pg%kmin_.and.k.le.f_kmax_) self%n_=self%n_+1 + if (i.ge.f_imin_.and.i.le.f_imax_.and.& + & j.ge.f_jmin_.and.j.le.f_jmax_.and.& + & k.ge.f_kmin_.and.k.le.f_kmax_) self%n_=self%n_+1 end if end do end do @@ -128,9 +135,9 @@ end function locator ! Create unstructured mapping to iterator cells - first inside cells then overlap allocate(self%map(1:3,1:self%no_)) cnt=0 - do k=self%pg%kmin_,f_kmax_ - do j=self%pg%jmin_,f_jmax_ - do i=self%pg%imin_,f_imax_ + do k=f_kmin_,f_kmax_ + do j=f_jmin_,f_jmax_ + do i=f_imin_,f_imax_ if (locator(self%pg,i,j,k)) then cnt=cnt+1 self%map(1:3,cnt)=[i,j,k] @@ -142,9 +149,9 @@ end function locator do j=self%pg%jmino_,self%pg%jmaxo_ do i=self%pg%imino_,self%pg%imaxo_ ! Skip inside cells - if (i.ge.self%pg%imin_.and.i.le.f_imax_.and. & - & j.ge.self%pg%jmin_.and.j.le.f_jmax_.and. & - & k.ge.self%pg%kmin_.and.k.le.f_kmax_) cycle + if (i.ge.f_imin_.and.i.le.f_imax_.and. & + & j.ge.f_jmin_.and.j.le.f_jmax_.and. & + & k.ge.f_kmin_.and.k.le.f_kmax_) cycle ! Only consider overlap cells if (locator(self%pg,i,j,k)) then cnt=cnt+1 diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 89ede4bef..f0ba13b90 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -88,10 +88,11 @@ module pgrid_class procedure :: allprint=>pgrid_allprint !< Output grid to screen - blocking and requires all procs... procedure :: print =>pgrid_print !< Output grid to screen procedure :: log =>pgrid_log !< Output grid info to log - generic :: sync=>pgrid_rsync,pgrid_rsync_array,pgrid_rsync_no,pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries - generic + generic :: sync=>pgrid_rsync,pgrid_rsync_array,pgrid_rsync_tensor,pgrid_rsync_no,pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries - generic procedure, private :: pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries for integer procedure, private :: pgrid_rsync,pgrid_rsync_no !< Commmunicate inner and periodic boundaries for real(WP) procedure, private :: pgrid_rsync_array !< Commmunicate inner and periodic boundaries for arrays of real(WP) of the form (:,i,j,k) + procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) generic :: syncsum=>pgrid_rsyncsum !< Summation across inner and periodic boundaries - generic procedure, private :: pgrid_rsyncsum !< Summation inner and periodic boundaries for real(WP) procedure :: get_rank !< Function that returns rank of processor that contains provided indices @@ -703,7 +704,7 @@ subroutine pgrid_rsync_array(this,A) use parallel, only: MPI_REAL_WP implicit none class(pgrid), intent(in) :: this - real(WP), dimension(1:,this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (imin_-no:imax_+no,jmin_-no:jmax_+no,kmin_-no:kmax_+no) + real(WP), dimension(1:,this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (:,imin_-no:imax_+no,jmin_-no:jmax_+no,kmin_-no:kmax_+no) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k,dim real(WP), dimension(:,:,:,:), allocatable :: buf1,buf2 @@ -793,6 +794,105 @@ subroutine pgrid_rsync_array(this,A) end if end subroutine pgrid_rsync_array + + + !> Synchronization of overlap cells + !> This version is capable of handling a tensor of the shape (:,:,i,j,k) + subroutine pgrid_rsync_tensor(this,A) + use parallel, only: MPI_REAL_WP + implicit none + class(pgrid), intent(in) :: this + real(WP), dimension(1:,1:,this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (:,:,imin_-no:imax_+no,jmin_-no:jmax_+no,kmin_-no:kmax_+no) + type(MPI_Status) :: status + integer :: isrc,idst,ierr,isize,i,j,k,dim1,dim2 + real(WP), dimension(:,:,:,:,:), allocatable :: buf1,buf2 + + ! Get first two dimensions + dim1=size(A,DIM=1) + dim2=size(A,DIM=2) + + ! Work in x - is it 2D or 3D? + if (this%nx.eq.1) then + ! Direct copy if 2D + do i=this%imax_+1,this%imaxo_ + A(:,:,i,:,:)=A(:,:,this%imin_,:,:) + end do + do i=this%imino_,this%imin_-1 + A(:,:,i,:,:)=A(:,:,this%imin_,:,:) + end do + else + isize=dim1*dim2*(this%no)*(this%nyo_)*(this%nzo_) + allocate(buf1(dim1,dim2,this%no,this%nyo_,this%nzo_)) + allocate(buf2(dim1,dim2,this%no,this%nyo_,this%nzo_)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,0,-1,isrc,idst,ierr) + buf1=A(:,:,this%imin_:this%imin_+this%no-1,:,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imax_+1:this%imaxo_,:,:)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,0,+1,isrc,idst,ierr) + buf1=A(:,:,this%imax_-this%no+1:this%imax_,:,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imino_:this%imin_-1,:,:)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + + ! Work in y - is it 2D or 3D? + if (this%ny.eq.1) then + ! Direct copy if 2D + do j=this%jmax_+1,this%jmaxo_ + A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) + end do + do j=this%jmino_,this%jmin_-1 + A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) + end do + else + isize=dim1*dim2*(this%nxo_)*(this%no)*(this%nzo_) + allocate(buf1(dim1,dim2,this%nxo_,this%no,this%nzo_)) + allocate(buf2(dim1,dim2,this%nxo_,this%no,this%nzo_)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,1,-1,isrc,idst,ierr) + buf1=A(:,:,:,this%jmin_:this%jmin_+this%no-1,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmax_+1:this%jmaxo_,:)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,1,+1,isrc,idst,ierr) + buf1=A(:,:,:,this%jmax_-this%no+1:this%jmax_,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmino_:this%jmin_-1,:)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + + ! Work in z - is it 2D or 3D? + if (this%nz.eq.1) then + ! Direct copy if 2D + do k=this%kmax_+1,this%kmaxo_ + A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) + end do + do k=this%kmino_,this%kmin_-1 + A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) + end do + else + isize=dim1*dim2*(this%nxo_)*(this%nyo_)*(this%no) + allocate(buf1(dim1,dim2,this%nxo_,this%nyo_,this%no)) + allocate(buf2(dim1,dim2,this%nxo_,this%nyo_,this%no)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,2,-1,isrc,idst,ierr) + buf1=A(:,:,:,:,this%kmin_:this%kmin_+this%no-1) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmax_+1:this%kmaxo_)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,2,+1,isrc,idst,ierr) + buf1=A(:,:,:,:,this%kmax_-this%no+1:this%kmax_) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmino_:this%kmin_-1)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + + end subroutine pgrid_rsync_tensor !> Synchronization of overlap cells for integer diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index e10d77558..331b40c70 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -19,7 +19,9 @@ module lpt_class !> I/O chunk size to read at a time integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - + + ! Drag model + character(len=str_medium) :: drag_model !> Basic particle object definition type :: part @@ -30,6 +32,7 @@ module lpt_class real(WP), dimension(3) :: pos !< Particle center coordinates real(WP), dimension(3) :: vel !< Velocity of particle real(WP), dimension(3) :: col !< Collision force + real(WP) :: T !< Temperature real(WP) :: dt !< Time step size for the particle !> MPI_INTEGER data integer , dimension(3) :: ind !< Index of cell containing particle center @@ -37,7 +40,7 @@ module lpt_class end type part !> Number of blocks, block length, and block types in a particle integer, parameter :: part_nblock=3 - integer , dimension(part_nblock) :: part_lblock=[1,11,4] + integer , dimension(part_nblock) :: part_lblock=[1,12,4] type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] !> MPI_PART derived datatype and size type(MPI_Datatype) :: MPI_PART @@ -93,6 +96,7 @@ module lpt_class real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered ! Filtering operation real(WP) :: filter_width !< Characteristic filter width @@ -152,6 +156,7 @@ function constructor(cfg,name) result(self) allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP ! Set default filter width to zero by default self%filter_width=0.0_WP @@ -489,7 +494,7 @@ subroutine advance(this,dt,U,V,W,rho,visc) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i - real(WP) :: mydt,dt_done + real(WP) :: mydt,dt_done,deng real(WP), dimension(3) :: acc,dmom type(part) :: pold @@ -497,6 +502,7 @@ subroutine advance(this,dt,U,V,W,rho,visc) this%srcU=0.0_WP this%srcV=0.0_WP this%srcW=0.0_WP + this%srcE=0.0_WP ! Advance the equations do i=1,this%np_ @@ -519,9 +525,11 @@ subroutine advance(this,dt,U,V,W,rho,visc) this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) ! Send source term back to the mesh dmom=mydt*acc*this%rho*Pi/6.0_WP*this%p(i)%d**3 + deng=sum(dmom*this%p(i)%vel) if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcU,bc='n') if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcV,bc='n') if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcW,bc='n') + call this%cfg%set_scalar(Sp=-deng ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcE,bc='n') ! Increment dt_done=dt_done+mydt end do @@ -544,6 +552,7 @@ subroutine advance(this,dt,U,V,W,rho,visc) this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) + this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) ! Recompute volume fraction call this%update_VF() @@ -605,11 +614,24 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) ! Return acceleration and optimal timestep size acc=fVF*(fvel-p%vel)/tau opt_dt=tau/real(this%nstep,WP) - end subroutine get_rhs + + contains + + function drag(Rep,Map,VFp,Knp) result(Fd) + real(WP) :: Fd + real(WP) :: Rep,Map,VFp,Knp + + select case(trim(drag_model)) + case ('Tenneti') + case ('KC') + end select + + end function drag + end subroutine get_rhs - !> Update particle volume fraction using our current particles - subroutine update_VF(this) + !> Update particle volume fraction using our current particles + subroutine update_VF(this) use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 0dfd24187..b911ce848 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -19,9 +19,16 @@ module mast_class integer, parameter, public :: neumann=3 !< Zero normal gradient !integer, parameter, public :: convective=4 !< Convective outflow condition integer, parameter, public :: clipped_neumann=5 !< Clipped Neumann condition (outflow only) + !integer, parameter, public :: adiabatic=6 + !integer, parameter, public :: pressure_dirichlet=7 ! List of available contact line models for this solver integer, parameter, public :: static_contact=1 !< Static contact line model + + ! List of available pressure relaxation implementations + integer, parameter, public :: mech_egy_mech_hhz=1 !< Mechanical for energy, mechanical for helmholtz + integer, parameter, public :: thermmech_egy_mech_hhz=2 !< Thermo-mechanical for energy, mechanical for helmholtz + !integer, parameter, public :: thermmech_egy_therm_hhz=3 !< Thermo-mechanical for energy, thermal for helmholtz ! Buffer for labeling BCs character(len=str_medium), public :: bc_scope @@ -33,12 +40,13 @@ module mast_class integer :: type !< Bcond type type(iterator) :: itr !< This is the iterator for the bcond - this identifies the (i,j,k) character(len=1) :: face !< Bcond face (x/y/z) - integer :: dir !< Bcond direction (+1,-1,0 for interior) - real(WP) :: rdir !< Bcond direction (real variable) + integer :: dir_rhs,dir_lhs,fdir_rhs,fdir_lhs !< Bcond key for shift array based on direction and face + character(len=2) :: celldir !< Bcond cell and direction (e.g. x+ or xp) + integer :: dir !< Bcond direction (-1 or +1) end type bcond !> Bcond shift value - integer, dimension(3,6), parameter :: shift=reshape([+1,0,0,-1,0,0,0,+1,0,0,-1,0,0,0,+1,0,0,-1],shape(shift)) + integer, dimension(3,10), parameter :: shift=reshape([+1,0,0,-1,0,0,0,+1,0,0,-1,0,0,0,+1,0,0,-1,-2,0,0,0,-2,0,0,0,-2,0,0,0],shape(shift)) !> Two-phase compressible solver object definition ([M]ultiphase [A]ll-Mach [S]emi-Lagrangian [T]ransport) type :: mast @@ -56,11 +64,6 @@ module mast_class real(WP) :: contact_angle !< This is our static contact angle real(WP) :: sigma !< This is our constant surface tension coefficient - ! Variable or constant fluid properties - real(WP) :: visc_l0,visc_g0 !< These are our constant/initial dynamic viscosities in liquid and gas - real(WP) :: cv_l0,cv_g0 !< These are our constant/initial specific heats (constant volume) in liquid and gas - real(WP) :: kappa_l0,kappa_g0 !< These are our constant/initial thermal conductivities in liquid and gas - ! Gravitational acceleration real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity @@ -84,11 +87,12 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: P_V !< Pressure field array on V-cell real(WP), dimension(:,:,:), allocatable :: P_W !< Pressure field array on W-cell - ! Viscosity fields + ! Viscosity real(WP), dimension(:,:,:), allocatable :: visc !< Viscosity field on P-cell - real(WP), dimension(:,:,:), allocatable :: visc_xy !< Viscosity field on U-cell - real(WP), dimension(:,:,:), allocatable :: visc_yz !< Viscosity field on V-cell - real(WP), dimension(:,:,:), allocatable :: visc_zx !< Viscosity field on W-cell + ! Thermal conductivity + real(WP), dimension(:,:,:), allocatable :: therm_cond !< Viscosity field on P-cell + + ! Note: conserved variables are rhoUi, rhoVi, rhoWi, Grho, GrhoE, Lrho, LrhoE ! Flow variables - harmonized/mixture real(WP), dimension(:,:,:), allocatable :: RHO !< density array @@ -110,6 +114,8 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjx !< dPressure jump to add to -ddP/dx real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz + real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture + real(WP), dimension(:,:,:), allocatable :: divU !< Dilatation ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays @@ -130,6 +136,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: F_GrhoE,F_LrhoE !< Energy fluxes real(WP), dimension(:,:,:), allocatable :: F_GP, F_LP !< Pressure fluxes real(WP), dimension(:,:,:), allocatable :: F_VOL, F_VF !< Volume fluxes + real(WP), dimension(:,:,:,:), allocatable :: F_Gbary, F_Lbary !< Barycenter fluxes ! Density flux arrays real(WP), dimension(:,:,:,:), allocatable :: GrhoFf !< Gas density flux (used for SC advection) @@ -142,7 +149,7 @@ module mast_class real(WP), dimension(:,:,:,:), allocatable :: gradLrhoU,gradLrhoV,gradLrhoW !< Gradients: Liquid momentum ! Hybrid advection - integer, dimension(:,:,:,:), allocatable :: sl_face ! < Flag for flux method switching + integer, dimension(:,:,:), allocatable :: sl_x,sl_y,sl_z ! < Flag for flux method switching ! Terms needed for pressure relaxation real(WP), dimension(:,:,:), allocatable :: srcVF ! < Predicted volume exchange during advection real(WP), dimension(:,:,:), allocatable :: Hpjump ! < Helmholtz pressure jump @@ -151,11 +158,17 @@ module mast_class ! Temporary arrays for a few things real(WP), dimension(:,:,:), pointer :: tmp1,tmp2,tmp3 + ! Temporary arrays for viscous routine (may be used for more in the future) + real(WP), dimension(:,:,:), pointer :: tmp4,tmp5,tmp6,tmp7,tmp8,tmp9,tmp10 + ! Pressure solver type(ils) :: psolv !< Iterative linear solver object for the pressure Helmholtz equation ! Implicit momentum solver type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the advection residual + ! Variables to save information for monitor + integer :: impl_it_x, impl_it_y + real(WP) :: impl_rerr_x, impl_rerr_y ! Metrics real(WP), dimension(:,:,:,:), allocatable :: itpi_x,itpi_y,itpi_z !< Interpolation fom cell center to face (for scalars, e.g. pressure) @@ -177,12 +190,14 @@ module mast_class real(WP) :: CFLv_x,CFLv_y,CFLv_z !< Viscous CFL numbers ! Monitoring quantities - real(WP) :: Umax,Vmax,Wmax,Pmax,RHOmax !< Maximum velocity, pressure, density + real(WP) :: RHOmin,RHOmax,Umax,Vmax,Wmax,Pmax,Tmax !< Minimum density; Maximum density, velocity, pressure, density, temperature contains procedure :: print=>mast_print !< Output solver to the screen procedure :: get_bcond !< Get a boundary condition procedure :: apply_bcond !< Apply boundary conditions as specified + procedure :: apply_bcond_vf !< Apply boundary conditions for VF field + procedure :: apply_bcond_facepressure !< Apply boundary conditions to face pressure field procedure :: add_static_contact !< Add static contact line model to surface tension jump ! For initialization of simulation @@ -200,7 +215,9 @@ module mast_class procedure :: advection_step !< Full, hybrid advection step ! For convenience in advection routines procedure :: GKEold, LKEold !< Calculate kinetic energy at timestep 'n' - ! For viscous/dissipative/body forces (will address later) + ! For viscous/dissipative/body forces + procedure :: diffusion_src_explicit_step !< Explicit approach to incorporating body forces and diffusion + procedure :: get_viscosity !< Calculates diffusive terms at required locations ! For setting up pressure solve procedure :: pressureproj_prepare !< Overall subroutine for pressure solve setup procedure :: interp_pressure_density !< Calculate pressure and density interpolated to face @@ -216,6 +233,7 @@ module mast_class ! For pressure relaxation procedure :: pressure_relax !< Loop to relax pressure, change VF and phase values, at end of timetep procedure :: pressure_relax_one !< Routine to perform mechanical relaxation for an individual cell + procedure :: pressure_thermal_relax_one !< Routine to perform thermo-mechanical relaxation for an individual cell ! Miscellaneous procedure :: get_cfl !< Calculate maximum CFL @@ -275,6 +293,8 @@ function constructor(cfg,name,vf) result(self) allocate(self%dPjx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjx=0.0_WP allocate(self%dPjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjy=0.0_WP allocate(self%dPjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjz=0.0_WP + allocate(self%Tmptr(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Tmptr=25.0_WP + allocate(self%divU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%divU=5.0_WP allocate(self%rho_U(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_U=0.0_WP allocate(self%rho_V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_V=0.0_WP allocate(self%rho_W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_W=0.0_WP @@ -282,9 +302,7 @@ function constructor(cfg,name,vf) result(self) allocate(self%P_V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%P_V=0.0_WP allocate(self%P_W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%P_W=0.0_WP allocate(self%visc (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc =0.0_WP - allocate(self%visc_xy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_xy=0.0_WP - allocate(self%visc_yz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_yz=0.0_WP - allocate(self%visc_zx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_zx=0.0_WP + allocate(self%therm_cond(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%therm_cond=0.0_WP ! Two-phase allocate(self%Grho (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Grho =0.0_WP allocate(self%Lrho (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Lrho =0.0_WP @@ -322,6 +340,10 @@ function constructor(cfg,name,vf) result(self) allocate(self%F_GP (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%F_GP =0.0_WP allocate(self%F_LP (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%F_LP =0.0_WP + ! Flux sum arrays for barycenters + allocate(self%F_Gbary(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%F_Gbary=0.0_WP + allocate(self%F_Lbary(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%F_Lbary=0.0_WP + ! Density flux arrays allocate(self%GrhoFf (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_,3)); self%GrhoFf =0.0_WP allocate(self%LrhoFf (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_,3)); self%LrhoFf =0.0_WP @@ -343,16 +365,25 @@ function constructor(cfg,name,vf) result(self) allocate(self%gradLrhoW(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%gradLrhoW=0.0_WP ! Hybrid advection - allocate(self%sl_face(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_,3)); self%sl_face=0 + allocate(self%sl_x(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sl_x=0 + allocate(self%sl_y(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sl_y=0 + allocate(self%sl_z(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sl_z=0 ! Pressure relaxation allocate(self%srcVF(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcVF=0.0_WP allocate(self%Hpjump(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Hpjump=0.0_WP allocate(self%dHpjump(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dHpjump=0.0_WP ! Arrays employed temporarily in a few places - allocate(self%tmp1(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp1 =0.0_WP - allocate(self%tmp2(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp2 =0.0_WP - allocate(self%tmp3(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp3 =0.0_WP + allocate(self%tmp1 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp1 =0.0_WP + allocate(self%tmp2 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp2 =0.0_WP + allocate(self%tmp3 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp3 =0.0_WP + allocate(self%tmp4 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp4 =0.0_WP + allocate(self%tmp5 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp5 =0.0_WP + allocate(self%tmp6 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp6 =0.0_WP + allocate(self%tmp7 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp7 =0.0_WP + allocate(self%tmp8 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp8 =0.0_WP + allocate(self%tmp9 (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp9 =0.0_WP + allocate(self%tmp10(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%tmp10 =0.0_WP ! Allocate vfs objects that are required for the MAST solver call vf%allocate_supplement() @@ -444,8 +475,7 @@ end function constructor subroutine init_metrics(this) implicit none class(mast), intent(inout) :: this - integer :: i,j,k,st1,st2 - real(WP), dimension(-1:0) :: itpx,itpy,itpz + integer :: i,j,k ! Allocate interpolation coefficients for center to cell face allocate(this%itpi_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered @@ -513,8 +543,7 @@ end subroutine init_metrics subroutine adjust_metrics(this) implicit none class(mast), intent(inout) :: this - integer :: i,j,k,st1,st2 - real(WP) :: delta,mysum + integer :: i,j,k ! Sync up u/v/wmasks call this%cfg%sync(this%umask) @@ -648,7 +677,7 @@ end subroutine setup !> Add a boundary condition - subroutine add_bcond(this,name,type,locator,face,dir) + subroutine add_bcond(this,name,type,locator,face,dir,celldir) use string, only: lowercase use messager, only: die implicit none @@ -663,29 +692,84 @@ logical function locator(pargrid,ind1,ind2,ind3) integer, intent(in) :: ind1,ind2,ind3 end function locator end interface - character(len=1), intent(in) :: face - integer, intent(in) :: dir + character(len=1), intent(in), optional :: face + integer, intent(in), optional :: dir + character(len=2), intent(in), optional :: celldir type(bcond), pointer :: new_bc integer :: i,j,k,n - ! Prepare new bcond - allocate(new_bc) - new_bc%name=trim(adjustl(name)) - new_bc%type=type - select case (lowercase(face)) - case ('x'); new_bc%face='x' - case ('y'); new_bc%face='y' - case ('z'); new_bc%face='z' - case default; call die('[mast add_bcond] Unknown bcond face - expecting x, y, or z') - end select - new_bc%itr=iterator(pg=this%cfg,name=new_bc%name,locator=locator,face=new_bc%face) - select case (dir) ! Outward-oriented - case (+1); new_bc%dir=+1 - case (-1); new_bc%dir=-1 - case ( 0); new_bc%dir= 0 - case default; call die('[mast add_bcond] Unknown bcond dir - expecting -1, +1, or 0') - end select - new_bc%rdir=real(new_bc%dir,WP) + ! Check face or cell specification + if (present(face).and.present(celldir)) call die('[mast add_bcond] Specification of bcond must be by face or cell, not both') + if ((.not.present(face)).and.(.not.present(celldir))) call die('[mast add_bcond] Specification of bcond must be by face or cell') + + ! BC specified using face locator; cell BC is implied + if (present(face)) then + ! Check presence of dir + if (.not.present(dir)) call die('[mast add_bcond] Specification of bcond by face must include dir') + ! Check direction parameter + select case (dir) ! Outward-oriented + case (+1,-1) + case default; call die('[mast add_bcond] Unknown bcond dir - expecting -1 or +1') + end select + ! Create BC + allocate(new_bc) + new_bc%name=trim(adjustl(name)) + new_bc%type=type + ! Check face parameter + select case (lowercase(face)) + case ('x') + new_bc%fdir_rhs=1+max(0,-dir) ! 1 and 2 + new_bc%dir_lhs=(1-max(0,-dir))*10 + max(0,-dir)*1 ! 10 and 1 + new_bc%dir_rhs=(1-max(0,-dir))*1 + max(0,-dir)*10 ! 1 and 10 + case ('y') + new_bc%fdir_rhs=3+max(0,-dir) ! 3 and 4 + new_bc%dir_lhs=(1-max(0,-dir))*10 + max(0,-dir)*3 ! 10 and 3 + new_bc%dir_rhs=(1-max(0,-dir))*3 + max(0,-dir)*10 ! 3 and 10 + case ('z') + new_bc%fdir_rhs=5+max(0,-dir) ! 5 and 6 + new_bc%dir_lhs=(1-max(0,-dir))*10 + max(0,-dir)*5 ! 10 and 5 + new_bc%dir_rhs=(1-max(0,-dir))*5 + max(0,-dir)*10 ! 5 and 10 + case default + call die('[mast add_bcond] Unknown bcond face - expecting x, y, or z') + end select + ! Prepare new bcond + new_bc%fdir_lhs=10 ! no shifts for face lhs + new_bc%face=face + new_bc%itr=iterator(pg=this%cfg,name=new_bc%name,locator=locator,face=face) + new_bc%dir=dir + end if + ! BC specified using cell locator; face BC is implied + if (present(celldir)) then + ! Create BC + allocate(new_bc) + new_bc%name=trim(adjustl(name)) + new_bc%type=type + ! Check celldir string; direction tells which face is included + select case (lowercase(celldir)) + case ('+x','x+','xp','px') + new_bc%dir_rhs =1; new_bc%dir=+1; new_bc%face='x' + new_bc%fdir_lhs=10; new_bc%fdir_rhs=1 + case ('-x','x-','xm','mx') + new_bc%dir_rhs =2; new_bc%dir=-1; new_bc%face='x' + new_bc%fdir_lhs=2; new_bc%fdir_rhs=7 + case ('+y','y+','yp','py') + new_bc%dir_rhs =3; new_bc%dir=+1; new_bc%face='y' + new_bc%fdir_lhs=10; new_bc%fdir_rhs=3 + case ('-y','y-','ym','my') + new_bc%dir_rhs =4; new_bc%dir=-1; new_bc%face='y' + new_bc%fdir_lhs=4; new_bc%fdir_rhs=8 + case ('+z','z+','zp','pz') + new_bc%dir_rhs =5; new_bc%dir=+1; new_bc%face='z' + new_bc%fdir_lhs=10; new_bc%fdir_rhs=5 + case ('-z','z-','zm','mz') + new_bc%dir_rhs =6; new_bc%dir=-1; new_bc%face='z' + new_bc%fdir_lhs=6; new_bc%fdir_rhs=9 + case default; call die('[vfs add_bcond] Unknown bcond celldir') + end select + ! Prepare new bcond + new_bc%dir_lhs=10 ! no shifts for cell lhs + new_bc%itr=iterator(pg=this%cfg,name=new_bc%name,locator=locator,face='c') + end if ! Insert it up front new_bc%next=>this%first_bc @@ -696,39 +780,78 @@ end function locator ! For this collocated solver, BCs specify cell-centered values and behavior, ! and the behavior of the face-centered values depends on the type of BC. - ! (For now, dirichlet BCs always enforce the flowrate, i.e., mask face velocities, - ! and clipped neumann BCs modify the sl_face flags to what works best at the outlet.) - ! To work properly with n_ and locators, dirichlets work by specifying the face that is - ! a part of the dirichlet, and the cell behind it (determined by the direction) is included. + ! BC locators can be specified using faces or cells, and this is interpreted by + ! which parameters are used when add_bcond is called. For pure neumann conditions, + ! face velocities are untouched, but for clipped neumann conditions, face quantities + ! are modified to limit reflection from the boundary. For dirichlet conditions, + ! the cell and corresponding face values are masked, and the user must be aware of + ! which indices are being used in the locator in order to set the values within + ! the simulation file. ! Now adjust the metrics accordingly select case (new_bc%type) case (dirichlet) do n=1,new_bc%itr%n_ i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) - select case(face) - case('x') - ! Mask face - this%umask(i,j,k)=2 - ! Mask cell - this%mask(i+min(0,dir),j,k)=2 - case('y') - ! Mask face - this%vmask(i,j,k)=2 - ! Mask cell - this%mask(i,j+min(0,dir),k)=2 - case('z') - ! Mask face - this%wmask(i,j,k)=2 - ! Mask cell - this%mask(i,j,k+min(0,dir))=2 - end select + if (present(face)) then + select case(face) + case('x') + ! Mask face + this%umask(i,j,k)=2 + ! Mask cell + this%mask(i+min(0,dir),j,k)=2 + case('y') + ! Mask face + this%vmask(i,j,k)=2 + ! Mask cell + this%mask(i,j+min(0,dir),k)=2 + case('z') + ! Mask face + this%wmask(i,j,k)=2 + ! Mask cell + this%mask(i,j,k+min(0,dir))=2 + end select + else + select case(celldir) + case('+x','x+','xp','px') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%umask(i,j,k)=2 + case('-x','x-','xm','mx') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%umask(i+1,j,k)=2 + case('+y','y+','yp','py') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%vmask(i,j,k)=2 + case('-y','y-','ym','my') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%vmask(i,j+1,k)=2 + case('+z','z+','zp','pz') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%wmask(i,j,k)=2 + case('-z','z-','zm','mz') + ! Mask cell + this%mask(i,j,k)=2 + ! Mask face + this%wmask(i,j,k+1)=2 + end select + end if end do case (neumann) !< Neumann has to be at existing wall or at domain boundary! case (clipped_neumann) !case (convective) + !case (adiabatic) case default call die('[mast add_bcond] Unknown bcond type') end select @@ -758,7 +881,7 @@ subroutine apply_bcond(this,dt,scope) implicit none class(mast), intent(inout) :: this real(WP), intent(in) :: dt - integer :: i,j,k,n,stag,ii + integer :: i,j,k,n,ii,factor type(bcond), pointer :: my_bc character(len=str_medium) :: scope @@ -779,74 +902,111 @@ subroutine apply_bcond(this,dt,scope) ! This is done by the user directly for conseerved quantities and face velocity - ! Condition is necessary for sl_face + ! Condition is necessary for sl_ flags if (trim(adjustl(scope)).eq.'flag') then - ! Usage of SL scheme is same for dirichlet and neumann do n=1,my_bc%itr%n_ i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) select case (my_bc%face) case ('x') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i-ii*my_bc%dir,j,k,1) = 1 - end do + this%sl_x(i-shift(1,my_bc%fdir_lhs),j,k)=1 case ('y') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i,j+ii*my_bc%dir,k,2) = 1 - end do + this%sl_y(i,j-shift(2,my_bc%fdir_lhs),k)=1 case ('z') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i,j,k-ii*my_bc%dir,3) = 1 - end do + this%sl_z(i,j,k-shift(3,my_bc%fdir_lhs))=1 end select end do end if case (neumann,clipped_neumann) !< Apply Neumann condition to all 3 components - ! Handle index shift due to staggering - stag=min(my_bc%dir,0) ! Implement based on bcond direction do n=1,my_bc%itr%n_ i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) select case (trim(adjustl(scope))) case('density') - this%Grho(i,j,k)=this%Grho(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) - this%Lrho(i,j,k)=this%Lrho(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) + this%Grho (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%Grho(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) + this%Lrho (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%Lrho(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) case('momentum') - this%rhoUi(i,j,k)=this%rhoUi(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) - this%rhoVi(i,j,k)=this%rhoVi(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) - this%rhoWi(i,j,k)=this%rhoWi(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) + this%rhoUi (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%rhoUi(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) + this%rhoVi (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%rhoVi(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) + this%rhoWi (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%rhoWi(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) case('energy') - this%GrhoE(i,j,k)=this%GrhoE(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) - this%LrhoE(i,j,k)=this%LrhoE(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) + this%GrhoE (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%GrhoE(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) + this%LrhoE (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =this%LrhoE(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) case('velocity') - select case (my_bc%face) - case ('x') - this%U(i ,j ,k )=this%U(i-my_bc%dir ,j ,k ) - this%V(i+stag,j:j+1,k )=this%V(i-my_bc%dir+stag,j:j+1,k ) - this%W(i+stag,j ,k:k+1)=this%W(i-my_bc%dir+stag,j ,k:k+1) - case ('y') - this%U(i:i+1,j+stag,k )=this%U(i:i+1,j-my_bc%dir+stag,k ) - this%V(i ,j ,k )=this%V(i ,j-my_bc%dir ,k ) - this%W(i ,j+stag,k:k+1)=this%W(i ,j-my_bc%dir+stag,k:k+1) - case ('z') - this%U(i:i+1,j ,k+stag)=this%U(i:i+1,j ,k-my_bc%dir+stag) - this%V(i ,j:j+1,k+stag)=this%V(i ,j:j+1,k-my_bc%dir+stag) - this%W(i ,j ,k )=this%W(i ,j ,k-my_bc%dir ) - end select + ! Neumann only applied to face velocity for clipped_neumann, + ! otherwise the value comes from the cell-centered velocity + if (my_bc%type.eq.clipped_neumann) then + select case (my_bc%face) + case ('x') + this%U (i-shift(1,my_bc%fdir_lhs),j,k) & + =this%U(i-shift(1,my_bc%fdir_rhs),j,k) + this%V (i-shift(1,my_bc%dir_lhs),j:j+1,k) & + =this%V(i-shift(1,my_bc%dir_rhs),j:j+1,k) + this%W (i-shift(1,my_bc%dir_lhs),j,k:k+1) & + =this%W(i-shift(1,my_bc%dir_rhs),j,k:k+1) + case ('y') + this%U (i:i+1,j-shift(2,my_bc%dir_lhs),k) & + =this%U(i:i+1,j-shift(2,my_bc%dir_rhs),k) + this%V (i,j-shift(2,my_bc%fdir_lhs),k) & + =this%V(i,j-shift(2,my_bc%fdir_rhs),k) + this%W (i,j-shift(2,my_bc%dir_lhs),k:k+1) & + =this%W(i,j-shift(2,my_bc%dir_rhs),k:k+1) + case ('z') + this%U (i:i+1,j,k-shift(3,my_bc%dir_lhs)) & + =this%U(i:i+1,j,k-shift(3,my_bc%dir_rhs)) + this%V (i,j:j+1,k-shift(3,my_bc%dir_lhs)) & + =this%V(i,j:j+1,k-shift(3,my_bc%dir_rhs)) + this%W (i,j,k-shift(3,my_bc%fdir_lhs)) & + =this%W(i,j,k-shift(3,my_bc%fdir_rhs)) + end select + else + select case (my_bc%face) + case ('x') + this%U (i-shift(1,my_bc%fdir_lhs),j,k) & + =this%Ui(i-shift(1,my_bc%dir_rhs),j,k) + this%V (i-shift(1,my_bc%dir_lhs),j:j+1,k) & + =this%V(i-shift(1,my_bc%dir_rhs),j:j+1,k) + this%W (i-shift(1,my_bc%dir_lhs),j,k:k+1) & + =this%W(i-shift(1,my_bc%dir_rhs),j,k:k+1) + case ('y') + this%U (i:i+1,j-shift(2,my_bc%dir_lhs),k) & + =this%U(i:i+1,j-shift(2,my_bc%dir_rhs),k) + this%V (i,j-shift(2,my_bc%fdir_lhs),k) & + =this%Vi(i,j-shift(2,my_bc%dir_rhs),k) + this%W (i,j-shift(2,my_bc%dir_lhs),k:k+1) & + =this%W(i,j-shift(2,my_bc%dir_rhs),k:k+1) + case ('z') + this%U (i:i+1,j,k-shift(3,my_bc%dir_lhs)) & + =this%U(i:i+1,j,k-shift(3,my_bc%dir_rhs)) + this%V (i,j:j+1,k-shift(3,my_bc%dir_lhs)) & + =this%V(i,j:j+1,k-shift(3,my_bc%dir_rhs)) + this%W (i,j,k-shift(3,my_bc%fdir_lhs)) & + =this%Wi(i,j,k-shift(3,my_bc%dir_rhs)) + end select + end if case('flag') - ! Extend + ! Extend if clipped neumann + factor = 0 + if (my_bc%type.eq.clipped_neumann) factor = 2 select case (my_bc%face) case ('x') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i-ii*my_bc%dir ,j ,k ,1 ) = 1 + do ii = 0,abs(factor*my_bc%dir) + this%sl_x(i-shift(1,my_bc%fdir_lhs)-ii*my_bc%dir,j,k)=1 end do case ('y') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i ,j-ii*my_bc%dir ,k ,2 ) = 1 + do ii = 0,abs(factor*my_bc%dir) + this%sl_y(i,j-shift(2,my_bc%fdir_lhs)-ii*my_bc%dir,k)=1 end do case ('z') - do ii = 0,abs(2*my_bc%dir) - this%sl_face(i ,j ,k-ii*my_bc%dir ,3 ) = 1 + do ii = 0,abs(factor*my_bc%dir) + this%sl_z(i,j,k-shift(3,my_bc%fdir_lhs)-ii*my_bc%dir)=1 end do end select end select @@ -855,15 +1015,20 @@ subroutine apply_bcond(this,dt,scope) if (my_bc%type.eq.clipped_neumann.and.trim(adjustl(scope)).eq.'velocity') then select case (my_bc%face) case ('x') - if (this%U(i,j,k)*my_bc%rdir.lt.0.0_WP) this%U(i,j,k)=0.0_WP + if (this%U(i-shift(1,my_bc%fdir_lhs),j,k)*real(my_bc%dir,WP).lt.0.0_WP) & + this%U(i-shift(1,my_bc%fdir_lhs),j,k)=0.0_WP case ('y') - if (this%V(i,j,k)*my_bc%rdir.lt.0.0_WP) this%V(i,j,k)=0.0_WP + if (this%V(i,j-shift(2,my_bc%fdir_lhs),k)*real(my_bc%dir,WP).lt.0.0_WP) & + this%V(i,j-shift(2,my_bc%fdir_lhs),k)=0.0_WP case ('z') - if (this%W(i,j,k)*my_bc%rdir.lt.0.0_WP) this%W(i,j,k)=0.0_WP + if (this%W(i,j,k-shift(3,my_bc%fdir_lhs))*real(my_bc%dir,WP).lt.0.0_WP) & + this%W(i,j,k-shift(3,my_bc%fdir_lhs))=0.0_WP end select end if !case (convective) ! Not implemented yet! + + !case (adiabatic) ! Not implemented yet! case default call die('[mast apply_bcond] Unknown bcond type') @@ -871,34 +1036,123 @@ subroutine apply_bcond(this,dt,scope) end if - ! Sync full fields after each bcond (Needs to be done anyways) - select case(trim(adjustl(scope))) - case('density') - call this%cfg%sync(this%Grho) - call this%cfg%sync(this%Lrho) - case('momentum') - call this%cfg%sync(this%rhoUi) - call this%cfg%sync(this%rhoVi) - call this%cfg%sync(this%rhoWi) - case('energy') - call this%cfg%sync(this%GrhoE) - call this%cfg%sync(this%LrhoE) - case('velocity') - call this%cfg%sync(this%U) - call this%cfg%sync(this%V) - call this%cfg%sync(this%W) - case('flag') - call this%cfg%sync(this%sl_face(:,:,:,1)) - call this%cfg%sync(this%sl_face(:,:,:,2)) - call this%cfg%sync(this%sl_face(:,:,:,3)) - end select - ! Move on to the next bcond my_bc=>my_bc%next end do + ! Sync full fields after all bconds + select case(trim(adjustl(scope))) + case('density') + call this%cfg%sync(this%Grho) + call this%cfg%sync(this%Lrho) + case('momentum') + call this%cfg%sync(this%rhoUi) + call this%cfg%sync(this%rhoVi) + call this%cfg%sync(this%rhoWi) + case('energy') + call this%cfg%sync(this%GrhoE) + call this%cfg%sync(this%LrhoE) + case('velocity') + call this%cfg%sync(this%U) + call this%cfg%sync(this%V) + call this%cfg%sync(this%W) + case('flag') + call this%cfg%sync(this%sl_x) + call this%cfg%sync(this%sl_y) + call this%cfg%sync(this%sl_z) + end select + end subroutine apply_bcond + + !> Enforce boundary condition on vf%VF + subroutine apply_bcond_vf(this,vf) + use messager, only: die + use vfs_class, only: vfs + implicit none + class(mast), intent(inout) :: this + class(vfs), intent(inout) :: vf + integer :: i,j,k,n + type(bcond), pointer :: my_bc + + ! Traverse bcond list + my_bc=>this%first_bc + do while (associated(my_bc)) + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + ! Select appropriate action based on the bcond type + select case (my_bc%type) + case (dirichlet) !< Apply Dirichlet conditions (nothing to do here) + case (neumann,clipped_neumann) !< Apply Neumann condition + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + vf%VF (i-shift(1,my_bc%dir_lhs),j-shift(2,my_bc%dir_lhs),k-shift(3,my_bc%dir_lhs)) & + =vf%VF(i-shift(1,my_bc%dir_rhs),j-shift(2,my_bc%dir_rhs),k-shift(3,my_bc%dir_rhs)) + end do + !case (convective) ! Not implemented yet! + !case (adiabatic) ! Not implemented yet! + case default + call die('[mast apply_bcond_vf] Unknown bcond type') + end select + end if + ! Move on to the next bcond + my_bc=>my_bc%next + end do + + ! Sync field + call this%cfg%sync(vf%VF) + + end subroutine apply_bcond_vf + + !> Enforce boundary conditions face pressure, if specified + subroutine apply_bcond_facepressure(this,Px,Py,Pz) + use messager, only: die + implicit none + class(mast), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Px,Py,Pz + integer :: i,j,k,n + type(bcond), pointer :: my_bc + + ! Traverse bcond list + my_bc=>this%first_bc + do while (associated(my_bc)) + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + ! Select appropriate action based on the bcond type + select case (my_bc%type) + case (dirichlet) !< Apply Dirichlet conditions (nothing to do here) + case (neumann) !< no treatment of face pressure with neumann + case (clipped_neumann) !< Apply clipped Neumann condition + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + select case (my_bc%face) + case ('x') + Px (i-shift(1,my_bc%fdir_lhs),j,k) & + =Px(i-shift(1,my_bc%fdir_rhs),j,k) + case ('y') + Py (i,j-shift(2,my_bc%fdir_lhs),k) & + =Py(i,j-shift(2,my_bc%fdir_rhs),k) + case ('z') + Pz (i,j,k-shift(3,my_bc%fdir_lhs)) & + =Pz(i,j,k-shift(3,my_bc%fdir_rhs)) + end select + end do + !case (convective) ! Not implemented yet! + !case (adiabatic) ! Not implemented yet! + case default + call die('[mast apply_bcond_facepressure] Unknown bcond type') + end select + end if + ! Move on to the next bcond + my_bc=>my_bc%next + end do + + ! Sync fields + call this%cfg%sync(Px) + call this%cfg%sync(Py) + call this%cfg%sync(Pz) + + end subroutine apply_bcond_facepressure ! Function to more easily calculate gas kinetic energy function GKEold(this,i,j,k) result(val) @@ -932,7 +1186,7 @@ subroutine flag_sl(this,dt,vf) n_band = 1 !ceiling(max_CFL) - this%sl_face = 0 + this%sl_x = 0; this%sl_y = 0; this%sl_z = 0 ! 1 is for semi-Lagrangian, 0 is for centered scheme ! Loop over the domain and determine multiphase locations within band and shock locations @@ -960,13 +1214,11 @@ subroutine flag_sl(this,dt,vf) ! If change of phase is not found in band, check shock sensor if (shock_sensor(i,j,k).gt.0) then ! If shock is indicated, set values to negative, band will be extended around these cells - this%sl_face(i,j,k,1:3)=-1 - this%sl_face(i+1,j,k,1)=-1; this%sl_face(i,j+1,k,2)=-1; this%sl_face(i,j,k+1,3)=-1; + this%sl_x(i:i+1,j,k)=-1; this%sl_y(i,j:j+1,k)=-1; this%sl_z(i,j,k:k+1)=-1 end if else ! If change of phase is found in band, turn on SL fluxing - this%sl_face(i,j,k,1:3)=1 - this%sl_face(i+1,j,k,1)=1; this%sl_face(i,j+1,k,2)=1; this%sl_face(i,j,k+1,3)=1; + this%sl_x(i:i+1,j,k)=1; this%sl_y(i,j:j+1,k)=1; this%sl_z(i,j,k:k+1)=1 end if elseif (vf%VFold(i,j,k).gt.VFhi) then ! In fully liquid cells, check in band for change in phase @@ -989,18 +1241,15 @@ subroutine flag_sl(this,dt,vf) ! If change of phase is not found in band, check shock sensor if (shock_sensor(i,j,k).gt.0.0_WP) then ! If shock is indicated, set values to negative, band will be extended around these cells - this%sl_face(i,j,k,1:3)=-1 - this%sl_face(i+1,j,k,1)=-1; this%sl_face(i,j+1,k,2)=-1; this%sl_face(i,j,k+1,3)=-1; + this%sl_x(i:i+1,j,k)=-1; this%sl_y(i,j:j+1,k)=-1; this%sl_z(i,j,k:k+1)=-1 end if else ! If change of phase is found in band, turn on SL fluxing - this%sl_face(i,j,k,1:3)=1 - this%sl_face(i+1,j,k,1)=1; this%sl_face(i,j+1,k,2)=1; this%sl_face(i,j,k+1,3)=1; + this%sl_x(i:i+1,j,k)=1; this%sl_y(i,j:j+1,k)=1; this%sl_z(i,j,k:k+1)=1 end if else ! If cell is multiphase, turn on SL fluxing - this%sl_face(i,j,k,1:3)=1 - this%sl_face(i+1,j,k,1)=1; this%sl_face(i,j+1,k,2)=1; this%sl_face(i,j,k+1,3)=1; + this%sl_x(i:i+1,j,k)=1; this%sl_y(i,j:j+1,k)=1; this%sl_z(i,j,k:k+1)=1 end if end do end do @@ -1014,14 +1263,22 @@ subroutine flag_sl(this,dt,vf) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - if (this%sl_face(i,j,k,1).eq.0.or.this%sl_face(i,j,k,2).eq.0.or.this%sl_face(i,j,k,3).eq.0) then + if (minval(this%sl_x(i:i+1,j,k)).eq.0.or. & + minval(this%sl_y(i,j:j+1,k)).eq.0.or. & + minval(this%sl_z(i,j,k:k+1)).eq.0) then shock_check = 0 do ni=-n_band,n_band do nj=-n_band,n_band - do nk=-n_band,n_band - if (minval(this%sl_face(max(this%cfg%imino_,min(i+ni,this%cfg%imaxo_)), & - max(this%cfg%jmino_,min(j+nj,this%cfg%jmaxo_)), & - max(this%cfg%kmino_,min(k+nk,this%cfg%kmaxo_)),:)).eq.-1) then + do nk=-n_band,n_band + if (min(this%sl_x(max(this%cfg%imino_,min(i+ni,this%cfg%imaxo_)), & + max(this%cfg%jmino_,min(j+nj,this%cfg%jmaxo_)), & + max(this%cfg%kmino_,min(k+nk,this%cfg%kmaxo_))), & + this%sl_y(max(this%cfg%imino_,min(i+ni,this%cfg%imaxo_)), & + max(this%cfg%jmino_,min(j+nj,this%cfg%jmaxo_)), & + max(this%cfg%kmino_,min(k+nk,this%cfg%kmaxo_))), & + this%sl_z(max(this%cfg%imino_,min(i+ni,this%cfg%imaxo_)), & + max(this%cfg%jmino_,min(j+nj,this%cfg%jmaxo_)), & + max(this%cfg%kmino_,min(k+nk,this%cfg%kmaxo_)))).eq.-1) then shock_check = 1 end if end do @@ -1030,12 +1287,12 @@ subroutine flag_sl(this,dt,vf) if (shock_check.eq.1) then ! If shock is found in band, turn on SL fluxing, but only in faces where shock is not indicated ! I want 0 to go to 1, 1 to stay at 1, and -1 to stay at -1 - this%sl_face(i ,j,k,1)=min(1,2*this%sl_face(i ,j,k,1)+1) - this%sl_face(i+1,j,k,1)=min(1,2*this%sl_face(i+1,j,k,1)+1) - this%sl_face(i,j ,k,2)=min(1,2*this%sl_face(i,j ,k,2)+1) - this%sl_face(i,j+1,k,2)=min(1,2*this%sl_face(i,j+1,k,2)+1) - this%sl_face(i,j,k ,3)=min(1,2*this%sl_face(i,j,k ,3)+1) - this%sl_face(i,j,k+1,3)=min(1,2*this%sl_face(i,j,k+1,3)+1) + this%sl_x(i ,j,k)=min(1,2*this%sl_x(i ,j,k)+1) + this%sl_x(i+1,j,k)=min(1,2*this%sl_x(i+1,j,k)+1) + this%sl_y(i,j ,k)=min(1,2*this%sl_y(i,j ,k)+1) + this%sl_y(i,j+1,k)=min(1,2*this%sl_y(i,j+1,k)+1) + this%sl_z(i,j,k )=min(1,2*this%sl_z(i,j,k )+1) + this%sl_z(i,j,k+1)=min(1,2*this%sl_z(i,j,k+1)+1) end if end if end do @@ -1043,7 +1300,7 @@ subroutine flag_sl(this,dt,vf) end do ! Make all the negatives positive - this%sl_face = abs(this%sl_face) + this%sl_x = abs(this%sl_x); this%sl_y = abs(this%sl_y); this%sl_z = abs(this%sl_z) ! BCs again bc_scope = 'flag' @@ -1059,9 +1316,9 @@ function shock_sensor(i,j,k) result(cb) ! wt weights how important the acoustic scale is cb=abs(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k)) & + sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k)) & - + sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) & - )-min(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k)) & - / sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)) / this%shs_wt + + sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))& + - min(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k)) & + * sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)) / this%shs_wt end function shock_sensor @@ -1098,9 +1355,9 @@ subroutine flow_reconstruct(this,vf) this%gradLP =0.0_WP ! Gradients for linear reconstruction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ + do k=this%cfg%kmino_+1,this%cfg%kmaxo_-1 + do j=this%cfg%jmino_+1,this%cfg%jmaxo_-1 + do i=this%cfg%imino_+1,this%cfg%imaxo_-1 ! No need to calculate gradient inside of wall cell if (this%mask(i,j,k).eq.1) cycle ! Cycle through directions @@ -1219,6 +1476,7 @@ subroutine advection_step(this,dt,vf,matmod) class(matm), intent(inout) :: matmod !< The material models for this solver real(WP), intent(inout) :: dt !< Timestep size over which to advance real(WP), dimension(14) :: flux !< Passes flux to and from routines + real(WP), dimension(3,2) :: b_flux !< Passes barycenter fluxes real(WP), dimension(:,:,:), pointer :: PgradX,PgradY,PgradZ type(CapDod_type) :: fp !< Object for flux polyhedron type(TagAccVM_SepVM_type) :: ffm !< Object for flux moments @@ -1242,6 +1500,13 @@ subroutine advection_step(this,dt,vf,matmod) this%F_LrhoV=this%Lrhoold*this%Viold*(( vf%VFold)*this%cfg%vol) this%F_LrhoW=this%Lrhoold*this%Wiold*(( vf%VFold)*this%cfg%vol) this%F_LP =this%LPold *(( vf%VFold)*this%cfg%vol) + + this%F_Gbary(1,:,:,:)= vf%Gbaryold(1,:,:,:)*((1.0_WP-vf%VFold)*this%cfg%vol) + this%F_Gbary(2,:,:,:)= vf%Gbaryold(2,:,:,:)*((1.0_WP-vf%VFold)*this%cfg%vol) + this%F_Gbary(3,:,:,:)= vf%Gbaryold(3,:,:,:)*((1.0_WP-vf%VFold)*this%cfg%vol) + this%F_Lbary(1,:,:,:)= vf%Lbaryold(1,:,:,:)* vf%VFold *this%cfg%vol + this%F_Lbary(2,:,:,:)= vf%Lbaryold(2,:,:,:)* vf%VFold *this%cfg%vol + this%F_Lbary(3,:,:,:)= vf%Lbaryold(3,:,:,:)* vf%VFold *this%cfg%vol ! Allocate flux_polyhedron that will be used for fluxes call new(fp) @@ -1251,7 +1516,11 @@ subroutine advection_step(this,dt,vf,matmod) ! Designate the use of temporary arrays for pressure gradients PgradX => this%tmp1; PgradY => this%tmp2; PgradZ =>this%tmp3 PgradX = 0.0_WP; PgradY = 0.0_WP; PgradZ = 0.0_WP - + + ! New barycenters are old by default, will be changed in multiphase cells + ! (necessary for any iteration beyond the first) + vf%Gbary = vf%Gbaryold + vf%Lbary = vf%Lbaryold !! ---------------------------------------!! !! 1. SL and TTSL flux calculations !! @@ -1261,25 +1530,25 @@ subroutine advection_step(this,dt,vf,matmod) do i=this%cfg%imin_,this%cfg%imax_+1 !! ---- LEFT X(I) FACE ---- !! - select case(this%sl_face(i,j,k,1)) - case(1); call SL_advect (flux,fp,ffm ,i,j,k,'x') - case(0); call TTSL_advect(flux,[this%cfg%x (i),this%cfg%ym(j),this%cfg%zm(k)],i,j,k,'x') + select case(this%sl_x(i,j,k)) + case(1); call SL_advect (flux,b_flux,fp,ffm ,i,j,k,'x') + case(0); call TTSL_advect(flux,b_flux,[this%cfg%x (i),this%cfg%ym(j),this%cfg%zm(k)],i,j,k,'x') end select - call add_fluxes(flux,i,j,k,'x') + call add_fluxes(flux,b_flux,i,j,k,'x') !! ---- BOTTOM Y(J) FACE ---- !! - select case(this%sl_face(i,j,k,2)) - case(1); call SL_advect (flux,fp,ffm ,i,j,k,'y') - case(0); call TTSL_advect(flux,[this%cfg%xm(i),this%cfg%y (j),this%cfg%zm(k)],i,j,k,'y') + select case(this%sl_y(i,j,k)) + case(1); call SL_advect (flux,b_flux,fp,ffm ,i,j,k,'y') + case(0); call TTSL_advect(flux,b_flux,[this%cfg%xm(i),this%cfg%y (j),this%cfg%zm(k)],i,j,k,'y') end select - call add_fluxes(flux,i,j,k,'y') + call add_fluxes(flux,b_flux,i,j,k,'y') !! ---- BACK Z(K) FACE ---- !! - select case(this%sl_face(i,j,k,3)) - case(1); call SL_advect (flux,fp,ffm ,i,j,k,'z') - case(0); call TTSL_advect(flux,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%z (k)],i,j,k,'z') + select case(this%sl_z(i,j,k)) + case(1); call SL_advect (flux,b_flux,fp,ffm ,i,j,k,'z') + case(0); call TTSL_advect(flux,b_flux,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%z (k)],i,j,k,'z') end select - call add_fluxes(flux,i,j,k,'z') + call add_fluxes(flux,b_flux,i,j,k,'z') end do end do @@ -1364,6 +1633,13 @@ subroutine advection_step(this,dt,vf,matmod) ! Calculate density, incorporating volume change this%Grho (i,j,k) = this%F_Grho (i,j,k)/((1.0_WP-vf%VF(i,j,k))*this%cfg%vol(i,j,k)) this%Lrho (i,j,k) = this%F_Lrho (i,j,k)/( vf%VF(i,j,k) *this%cfg%vol(i,j,k)) + ! Calculate barycenters from source + vf%Gbary(:,i,j,k) = this%F_Gbary(:,i,j,k)/(this%F_VOL(i,j,k)-this%F_VF(i,j,k)) + vf%Lbary(:,i,j,k) = this%F_Lbary(:,i,j,k)/( this%F_VF(i,j,k)) + ! Project forward in time + vf%Gbary(:,i,j,k)=vf%project(vf%Gbary(:,i,j,k),i,j,k,dt,this%U,this%V,this%W) + vf%Lbary(:,i,j,k)=vf%project(vf%Lbary(:,i,j,k),i,j,k,dt,this%U,this%V,this%W) + end if end if @@ -1371,8 +1647,8 @@ subroutine advection_step(this,dt,vf,matmod) end do end do - ! Boundaries for VF, phase density, phase pressure - call vf%cfg%sync(vf%VF) + ! Boundaries for VF + call this%apply_bcond_vf(vf) ! Update phase interface to match VF field, etc. ! (Mimics the end of vf%advance()) @@ -1386,6 +1662,7 @@ subroutine advection_step(this,dt,vf,matmod) !call vf%distance_from_polygon() call vf%subcell_vol() call vf%get_curvature() + call vf%reset_moments() ! Band and distance information should not be needed ! Boundary conditions density @@ -1412,7 +1689,7 @@ subroutine advection_step(this,dt,vf,matmod) !! ---- LEFT X(I) FACE ---- !! ! Advection term - if (this%sl_face(i,j,k,1).eq.0) then + if (this%sl_x(i,j,k).eq.0) then call SubCan_mom_RHS_flux(i,j,k,'x') ! Calculate coefficients to go into alap array @@ -1434,7 +1711,7 @@ subroutine advection_step(this,dt,vf,matmod) !! ---- BOTTOM Y(J) FACE ---- !! ! Advection term - if (this%sl_face(i,j,k,2).eq.0) then + if (this%sl_y(i,j,k).eq.0) then call SubCan_mom_RHS_flux(i,j,k,'y') ! Calculate coefficients to go into alap array @@ -1454,7 +1731,7 @@ subroutine advection_step(this,dt,vf,matmod) !! ---- BACK Z(K) FACE ---- !! ! Advection term - if (this%sl_face(i,j,k,3).eq.0) then + if (this%sl_z(i,j,k).eq.0) then call SubCan_mom_RHS_flux(i,j,k,'z') ! Calculate coefficients to go into alap array @@ -1465,7 +1742,7 @@ subroutine advection_step(this,dt,vf,matmod) else ! Current cell (in front of face) this%implicit%opr(1,i,j,k ) = this%implicit%opr(1,i,j,k ) + (1.0_WP-vf%VF(i,j,k ))*Ga_i + vf%VF(i,j,k )*La_i - this%implicit%opr(7,i,j,k ) = this%implicit%opr(5,i,j,k ) + (1.0_WP-vf%VF(i,j,k ))*Ga_nb+ vf%VF(i,j,k )*La_nb + this%implicit%opr(7,i,j,k ) = this%implicit%opr(7,i,j,k ) + (1.0_WP-vf%VF(i,j,k ))*Ga_nb+ vf%VF(i,j,k )*La_nb ! Left cell (behind face) this%implicit%opr(1,i,j,k-1) = this%implicit%opr(1,i,j,k-1) - (1.0_WP-vf%VF(i,j,k-1))*Ga_nb- vf%VF(i,j,k-1)*La_nb this%implicit%opr(6,i,j,k-1) = this%implicit%opr(6,i,j,k-1) - (1.0_WP-vf%VF(i,j,k-1))*Ga_i - vf%VF(i,j,k-1)*La_i @@ -1480,6 +1757,9 @@ subroutine advection_step(this,dt,vf,matmod) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ + PgradX(i,j,k)=0.0_WP; PgradY(i,j,k)=0.0_WP; PgradZ(i,j,k)=0.0_WP + ! Skip wall cells and masked BC cells + if (this%mask(i,j,k).gt.0) cycle ! Pressure jump, gradient for x rho_l=sum(vf%Gvol(0,:,:,i,j,k))*this%Grho(i,j,k)+sum(vf%Lvol(0,:,:,i,j,k))*this%Lrho(i,j,k) rho_r=sum(vf%Gvol(1,:,:,i,j,k))*this%Grho(i,j,k)+sum(vf%Lvol(1,:,:,i,j,k))*this%Lrho(i,j,k) @@ -1509,18 +1789,21 @@ subroutine advection_step(this,dt,vf,matmod) this%implicit%sol=this%rhoUi call this%implicit%solve() this%rhoUi=this%implicit%sol + this%impl_it_x = this%implicit%it; this%impl_rerr_x=this%implicit%rerr ! monitor info ! Solve for y-momentum call this%implicit%setup() this%implicit%rhs=this%F_GrhoV+this%F_LrhoV-dt*this%cfg%vol*PgradY this%implicit%sol=this%rhoVi call this%implicit%solve() this%rhoVi=this%implicit%sol + this%impl_it_y = this%implicit%it; this%impl_rerr_y=this%implicit%rerr ! monitor info ! Solve for z-momentum call this%implicit%setup() this%implicit%rhs=this%F_GrhoW+this%F_LrhoW-dt*this%cfg%vol*PgradZ this%implicit%sol=this%rhoWi call this%implicit%solve() this%rhoWi=this%implicit%sol + ! monitor info retained by solver ! Nullify pointers nullify(PgradX,PgradY,PgradZ) @@ -1542,17 +1825,17 @@ subroutine advection_step(this,dt,vf,matmod) do i=this%cfg%imin_,this%cfg%imax_+1 !! ---- LEFT X(I) FACE ---- !! - if (this%sl_face(i,j,k,1).eq.0) then + if (this%sl_x(i,j,k).eq.0) then call SubCan_KE_RHS_flux(i,j,k,'x') end if !! ---- BOTTOM Y(J) FACE ---- !! - if (this%sl_face(i,j,k,2).eq.0) then + if (this%sl_y(i,j,k).eq.0) then call SubCan_KE_RHS_flux(i,j,k,'y') end if !! ---- BACK Z(K) FACE ---- !! - if (this%sl_face(i,j,k,3).eq.0) then + if (this%sl_z(i,j,k).eq.0) then call SubCan_KE_RHS_flux(i,j,k,'z') end if @@ -1585,7 +1868,7 @@ subroutine advection_step(this,dt,vf,matmod) ( this%P(i,j,k)*(1.0_WP-this%Grho(i,j,k)/this%RHO(i,j,k)) & - this%Hpjump(i,j,k)*( vf%VF(i,j,k))) ) - this%F_LrhoE(i,j,k) = this%F_LrhoE(i,j,k) & + this%F_LrhoE(i,j,k) = this%F_LrhoE(i,j,k) & - dt*this%cfg%vol(i,j,k)*( vf%VF(i,j,k))*(this%Lrho(i,j,k)/this%RHO(i,j,k)*& ( sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k)*this%P_U(i:i+1,j,k)) & + sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k)*this%P_V(i,j:j+1,k)) & @@ -1624,10 +1907,11 @@ subroutine advection_step(this,dt,vf,matmod) ! ================================================================= ! ! Construct flux hexahedron, perform cutting, call flux calculation ! ! ================================================================= ! - subroutine SL_advect(flux,a_flux_polyhedron,some_face_flux_moments,i,j,k,dir) + subroutine SL_advect(flux,b_flux,a_flux_polyhedron,some_face_flux_moments,i,j,k,dir) character(len=1) :: dir integer :: i,j,k,idir - real(WP), dimension(14) :: flux + real(WP), dimension(14) :: flux + real(WP), dimension(3,2) :: b_flux type(CapDod_type) :: a_flux_polyhedron type(TagAccVM_SepVM_type) :: some_face_flux_moments @@ -1645,7 +1929,7 @@ subroutine SL_advect(flux,a_flux_polyhedron,some_face_flux_moments,i,j,k,dir) call vf%fluxpoly_project_getmoments(i,j,k,dt,dir,this%U,this%V,this%W,& a_flux_polyhedron,vf%localized_separator_linkold(i,j,k),some_face_flux_moments) ! Calculate fluxes from volume moments - call SL_getFaceFlux(some_face_flux_moments, flux) + call SL_getFaceFlux(some_face_flux_moments, flux, b_flux) ! Store face density terms this%GrhoFf(i,j,k,idir) = flux(3) this%LrhoFf(i,j,k,idir) = flux(8) @@ -1656,20 +1940,21 @@ end subroutine SL_advect ! ====================================================== ! ! Given a flux hexahedron, calculate and return the flux ! ! ====================================================== ! - subroutine SL_getFaceFlux(f_moments, flux) + subroutine SL_getFaceFlux(f_moments, flux, b_flux) use irl_fortran_interface, only: getSize integer :: ii,jj,kk,n - integer :: list_size,uniq_id - integer, dimension(3) :: ind + integer :: list_size real(WP) :: my_Gvol,my_Lvol real(WP), dimension(3) :: my_Gbary,my_Lbary real(WP), dimension(14) :: flux + real(WP), dimension(3,2) :: b_flux type(TagAccVM_SepVM_type) :: f_moments logical :: skip_flag !..... Using geometry, calculate fluxes .....! ! Initialize at zero flux = 0.0_WP + b_flux = 0.0_WP ! Get number of tags (elements) in the f_moments list_size = getSize(f_moments) ! Loop through tags in the list @@ -1682,8 +1967,8 @@ subroutine SL_getFaceFlux(f_moments, flux) if (skip_flag) cycle ! Store barycenter fluxes - !b_flux(:,1) = b_flux(:,1) + my_Gvol*my_Gbary - !b_flux(:,2) = b_flux(:,2) + my_Lvol*my_Lbary + b_flux(:,1) = b_flux(:,1) + my_Gvol*my_Gbary + b_flux(:,2) = b_flux(:,2) + my_Lvol*my_Lbary ! Bound barycenters by the cell dimensions my_Lbary(1) = max(this%cfg%x(ii),min(this%cfg%x(ii+1),my_Lbary(1))) @@ -1724,25 +2009,27 @@ end subroutine SL_getFaceFlux ! ===================================================== ! ! Project the center of the face, call flux calculation ! ! ===================================================== ! - subroutine TTSL_advect(flux,pt_f,i,j,k,dir) + subroutine TTSL_advect(flux,b_flux,pt_f,i,j,k,dir) implicit none - real(WP), dimension(3) :: pt_f,pt_p - real(WP), dimension(14):: flux - integer, dimension(3) :: ind_p + real(WP), dimension(3) :: pt_f,pt_p + real(WP), dimension(14) :: flux + real(WP), dimension(3,2) :: b_flux + integer, dimension(3) :: ind_p real(WP) :: vol_f,vol_check character(len=1) :: dir - integer :: n,i,j,k,idir + integer :: i,j,k,idir ! Trajectory-Tracing Semi-Lagrangian scheme - ! Initialize flux at 0 + ! Initialize fluxes at 0 flux = 0.0_WP + b_flux = 0.0_WP ! Get projected point pt_p = vf%project(pt_f,i,j,k,-dt,this%U,this%V,this%W) ! Get approximate barycenter of flux volume, assign to one phase - ! b_flux(:,ceiling(oldVOF(i,j,k))+1) = 0.5_WP*(pt_p+pt_f) + b_flux(:,ceiling(vf%VFold(i,j,k))+1) = 0.5_WP*(pt_p+pt_f) select case (trim(dir)) case('x') @@ -1765,8 +2052,8 @@ subroutine TTSL_advect(flux,pt_f,i,j,k,dir) vol_check = abs(dt*this%W(i,j,k)*this%cfg%dzi(k)) end select - ! Calculate barycenter fluxes - !b_flux = b_flux*vol_f + ! Calculate barycenter fluxes by multiplying integration volume + b_flux = b_flux*vol_f ! Calculate fluxes (if there is any flux to calculate) if (vol_check.gt.epsilon(1.0_WP)) then @@ -1786,7 +2073,7 @@ end subroutine TTSL_advect ! ===================================================== ! subroutine TTSL_getFaceFlux(pt_p,pt_f,ind_p,vol_f, flux) implicit none - real(WP), dimension(3) :: pt_f,pt_p,pt_c,dx_f + real(WP), dimension(3) :: pt_f,pt_p,pt_c real(WP), dimension(14):: flux integer, dimension(3) :: ind_p,ind_c real(WP) :: vol_f,l_f,l_c,l_d,l_s @@ -1857,13 +2144,12 @@ end function TTSL_getval ! Routine to find intesections with mesh and calculate distances subroutine mesh_intersect(pt_p,pt_f,ind_p, pt_c,ind_c) - integer :: i,j,k,min_d + integer :: min_d real(WP) :: slope_factor real(WP), dimension(3) :: pt_p,pt_f,pt_c,vec integer, dimension(3) :: ind_p,ind_c,ind_m real(WP), dimension(3) :: xint,yint,zint real(WP), dimension(4) :: dint - logical :: p_flag ! Direction of intersection vec = pt_f - pt_p @@ -1935,9 +2221,10 @@ function VF_src_quad(gss2,lss2,fvf,fvl,vl) result(volfrac) end if end function VF_src_quad - subroutine add_fluxes(flux,i,j,k,dir) + subroutine add_fluxes(flux,b_flux,i,j,k,dir) implicit none - real(WP), dimension(14) :: flux + real(WP), dimension(14) :: flux + real(WP), dimension(3,2) :: b_flux character(len=1) :: dir integer :: i,j,k,st_i,st_j,st_k @@ -1949,6 +2236,12 @@ subroutine add_fluxes(flux,i,j,k,dir) case('z') st_i = 0; st_j = 0; st_k =-1 end select + + ! Barycenter fluxes + this%F_Gbary(:,i,j,k)=this%F_Gbary(:,i,j,k) +b_flux(:,1) + this%F_Lbary(:,i,j,k)=this%F_Lbary(:,i,j,k) +b_flux(:,2) + this%F_Gbary(:,i+st_i,j+st_j,k+st_k)=this%F_Gbary(:,i+st_i,j+st_j,k+st_k) -b_flux(:,1) + this%F_Lbary(:,i+st_i,j+st_j,k+st_k)=this%F_Lbary(:,i+st_i,j+st_j,k+st_k) -b_flux(:,2) ! Store update for right cell from face this%F_VOL (i,j,k)=this%F_VOL (i,j,k) +flux( 1) @@ -2226,6 +2519,310 @@ subroutine calculate_ustar(i,j,k,star_vel) end subroutine calculate_ustar end subroutine advection_step + + subroutine diffusion_src_explicit_step(this,dt,vf,matmod,sgs_visc,srcU,srcV,srcW,srcE) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + use vfs_class, only: vfs + use matm_class, only: matm + implicit none + class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver + class(vfs), intent(inout) :: vf !< The volume fraction solver + class(matm), intent(inout) :: matmod !< The material models for this solver + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep + real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces + integer :: i,j,k,n,nCFL,ierr + real(WP) :: buf,myCFL,mydt,spec_heat + + ! Set up intermediate divergence + div =>this%tmp1 + ! Set up temporary face velocity + Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 + Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 + ! Set up face viscosities + visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 + + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Viscosity and thermal conductivity updated using new temperature and VOF + call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + + ! Estimate CFL from explicit diffusive and source terms + buf=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Viscous CFL + buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) + spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & + +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) + buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) + ! Gravity CFL (check this) + buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & + dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & + dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) + end do + end do + end do + call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Calculate sub-step for viscous solver + nCFL=ceiling(myCFL) + mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon + + ! Sub-step for stability + do n=1,nCFL + ! Perform viscous step + call diffusion_src_explicit_substep() + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Calculate viscosity + if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + end do + + ! Store dilatation + this%divU=div + + ! Nullify... + + contains + + subroutine diffusion_src_explicit_substep() + implicit none + + real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX + real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy + real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz + real(WP) :: dMUdx,dMUdy,dMUdz + real(WP) :: div2U,div2V,div2W + real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + + integer :: i,j,k,n + + ! Viscous routine operates on face velocities, need to be updated each time + ! Update traditional face velocity (just interpolated) + call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) + ! Apply boundary condtions + bc_scope = 'velocity' + call this%apply_bcond(dt,bc_scope) + ! Calculate other interpolated face velocities (ignore masks) + call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) + call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) + ! BCs not needed, masks are already addressed, nothing used from within boundary + + ! Compute divergence and SGS isotropic tensor in each cell + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + div(i,j,k)=( sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k)) & + + sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k)) & + + sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) ) + !tau_kk(i,j,k) = 2.0_WP*CI_visc(i,j,k)*RHO(i,j,k)*(delta_3D(i,j,k)*S(i,j,k))**2 + ! Zero values near wall cells + !if (minval(vol(i-3:i+3,j-3:j+3,k-3:k+3)).eq.0.0_WP) then + !eddyVISC(i,j,k) = 0.0_WP + ! tau_kk (i,j,k) = 0.0_WP + !end if + end do + end do + end do + ! Communicate + call this%cfg%sync(div) + !call compressible_boundary_update(tau_kk) + + ! Perform viscous update over substep + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + dMUdx= sum(this%divp_x(:,i,j,k)*visc_x(i:i+1,j,k)) + dMUdy= sum(this%divp_y(:,i,j,k)*visc_y(i,j:j+1,k)) + dMUdz= sum(this%divp_z(:,i,j,k)*visc_z(i,j,k:k+1)) + + dUdx = sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k)) + dVdx = sum(this%divp_x(:,i,j,k)*Vf_x (i:i+1,j,k)) + dWdx = sum(this%divp_x(:,i,j,k)*Wf_x (i:i+1,j,k)) + + dUdy = sum(this%divp_y(:,i,j,k)*Uf_y (i,j:j+1,k)) + dVdy = sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k)) + dWdy = sum(this%divp_y(:,i,j,k)*Wf_y (i,j:j+1,k)) + + dUdz = sum(this%divp_z(:,i,j,k)*Uf_z (i,j,k:k+1)) + dVdz = sum(this%divp_z(:,i,j,k)*Vf_z (i,j,k:k+1)) + dWdz = sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) + + div2U = 2.0_WP*( & + this%divp_x(1,i,j,k)*(this%divp_x(1,i,j,k)*this%U (i+1,j,k) + this%divp_x(0,i,j,k)*this%Ui(i,j,k)) +& + this%divp_x(0,i,j,k)*(this%divp_x(1,i,j,k)*this%Ui(i,j,k) + this%divp_x(0,i,j,k)*this%U (i,j,k)) +& + this%divp_x(1,i,j,k)*(this%divp_y(1,i,j,k)*Uf_y (i,j+1,k) + this%divp_y(0,i,j,k)*this%Ui(i,j,k)) +& + this%divp_y(0,i,j,k)*(this%divp_y(1,i,j,k)*this%Ui(i,j,k) + this%divp_y(0,i,j,k)*Uf_y (i,j,k)) +& + this%divp_z(1,i,j,k)*(this%divp_z(1,i,j,k)*Uf_z (i,j,k+1) + this%divp_z(0,i,j,k)*this%Ui(i,j,k)) +& + this%divp_z(0,i,j,k)*(this%divp_z(1,i,j,k)*this%Ui(i,j,k) + this%divp_z(0,i,j,k)*Uf_z (i,j,k)) ) + div2V = 2.0_WP*( & + this%divp_x(1,i,j,k)*(this%divp_x(1,i,j,k)*Vf_x (i+1,j,k) + this%divp_x(0,i,j,k)*this%Vi(i,j,k)) +& + this%divp_x(0,i,j,k)*(this%divp_x(1,i,j,k)*this%Vi(i,j,k) + this%divp_x(0,i,j,k)*Vf_x (i,j,k)) +& + this%divp_x(1,i,j,k)*(this%divp_y(1,i,j,k)*this%V (i,j+1,k) + this%divp_y(0,i,j,k)*this%Vi(i,j,k)) +& + this%divp_y(0,i,j,k)*(this%divp_y(1,i,j,k)*this%Vi(i,j,k) + this%divp_y(0,i,j,k)*this%V (i,j,k)) +& + this%divp_z(1,i,j,k)*(this%divp_z(1,i,j,k)*Vf_z (i,j,k+1) + this%divp_z(0,i,j,k)*this%Vi(i,j,k)) +& + this%divp_z(0,i,j,k)*(this%divp_z(1,i,j,k)*this%Vi(i,j,k) + this%divp_z(0,i,j,k)*Vf_z (i,j,k)) ) + div2W = 2.0_WP*( & + this%divp_x(1,i,j,k)*(this%divp_x(1,i,j,k)*Wf_x (i+1,j,k) + this%divp_x(0,i,j,k)*this%Wi(i,j,k)) +& + this%divp_x(0,i,j,k)*(this%divp_x(1,i,j,k)*this%Wi(i,j,k) + this%divp_x(0,i,j,k)*Wf_x (i,j,k)) +& + this%divp_x(1,i,j,k)*(this%divp_y(1,i,j,k)*Wf_y (i,j+1,k) + this%divp_y(0,i,j,k)*this%Wi(i,j,k)) +& + this%divp_y(0,i,j,k)*(this%divp_y(1,i,j,k)*this%Wi(i,j,k) + this%divp_y(0,i,j,k)*Wf_y (i,j,k)) +& + this%divp_z(1,i,j,k)*(this%divp_z(1,i,j,k)*this%W (i,j,k+1) + this%divp_z(0,i,j,k)*this%Wi(i,j,k)) +& + this%divp_z(0,i,j,k)*(this%divp_z(1,i,j,k)*this%Wi(i,j,k) + this%divp_z(0,i,j,k)*this%W (i,j,k)) ) + + ddilatationdx = this%divp_x(0,i,j,k)*sum(this%itpi_x(:,i ,j,k)*div(i-1:i,j,k)) & + +this%divp_x(1,i,j,k)*sum(this%itpi_x(:,i+1,j,k)*div(i:i+1,j,k)) + ddilatationdy = this%divp_y(0,i,j,k)*sum(this%itpi_y(:,i,j ,k)*div(i,j-1:j,k)) & + +this%divp_y(1,i,j,k)*sum(this%itpi_y(:,i,j+1,k)*div(i,j:j+1,k)) + ddilatationdz = this%divp_z(0,i,j,k)*sum(this%itpi_z(:,i,j,k )*div(i,j,k-1:k)) & + +this%divp_z(1,i,j,k)*sum(this%itpi_z(:,i,j,k+1)*div(i,j,k:k+1)) + + ! Compute d/dx_j (tau_ij) for i = 1 + ! (x-direction) + VISCforceX=dMUdx*(dUdx+dUdx) & ! j = 1 + +dMUdy*(dUdy+dVdx) & ! j = 2 + +dMUdz*(dUdz+dWdx) & ! j = 3 + +this%visc(i,j,k)*div2U & + -(2.0_WP/3.0_WP)*dMUdx*div(i,j,k) & + +(1.0_WP/3.0_WP)*this%visc(i,j,k)*ddilatationdx + + ! Compute d/dx_j (tau_ij) for i = 2 + ! (y-direction) + VISCforceY=dMUdx*(dVdx+dUdy) & ! j = 1 + +dMUdy*(dVdy+dVdy) & ! j = 2 + +dMUdz*(dVdz+dWdy) & ! j = 3 + +this%visc(i,j,k)*div2V & + -(2.0_WP/3.0_WP)*dMUdy*div(i,j,k) & + +(1.0_WP/3.0_WP)*this%visc(i,j,k)*ddilatationdy + + ! Compute d/dx_j (tau_ij) for i = 3 + ! (z-direction) + VISCforceZ=dMUdx*(dWdx+dUdz) & ! j = 1 + +dMUdy*(dWdy+dVdz) & ! j = 2 + +dMUdz*(dWdz+dWdz) & ! j = 3 + +this%visc(i,j,k)*div2W & + -(2.0_WP/3.0_WP)*dMUdz*div(i,j,k) & + +(1.0_WP/3.0_WP)*this%visc(i,j,k)*ddilatationdz + + ! Compute the energy source/sink due to viscous effects + ! d/dx_j (tau_ij u_i) = tau_ij d/dx_i u_j + u_i d/dx_j (tau_ij) + ! ^{internal energy} ^{kinetic energy} + VISCKinEnergy=this%Ui(i,j,k)*VISCforceX+this%Vi(i,j,k)*VISCforceY+this%Wi(i,j,k)*VISCforceZ + ! ^ needs to be multiplied by density ratio + VISCIntEnergy= this%visc(i,j,k)*(& + (dUdx*(dUdx+dUdx)+dUdy*(dVdx+dUdy)+dUdz*(dWdx+dUdz) & + +dVdx*(dUdy+dVdx)+dVdy*(dVdy+dVdy)+dVdz*(dWdy+dVdz) & + +dWdx*(dUdz+dWdx)+dWdy*(dVdz+dWdy)+dWdz*(dWdz+dWdz))& + -(2.0_WP/3.0_WP)*div(i,j,k)**2) + HEATIntEnergy=therm_diffterm(i,j,k) + ! ^ phase-specific terms are included + + ! Add sponge + !spongeX=(RHO(i,j,k)*sp_vel-rhoU(i,j,k))*sp_coeff*0.5_WP*(tanh((xm(i)-sp_loc)/(2.0_WP*min_meshsize))+1.0_WP) + ! Perform update from viscous forces + this%rhoUi(i,j,k)=this%rhoUi(i,j,k)+mydt*VISCforceX!+mydt*eddyVISCforceX+mydt*spongeX!+mydt*STforceX + this%rhoVi(i,j,k)=this%rhoVi(i,j,k)+mydt*VISCforceY!+mydt*eddyVISCforceY!+mydt*STforceY + this%rhoWi(i,j,k)=this%rhoWi(i,j,k)+mydt*VISCforceZ!+mydt*eddyVISCforceZ!+mydt*STforceZ + this%GrhoE(i,j,k)=this%GrhoE(i,j,k) & + +mydt*this%Grho(i,j,k)/this%RHO(i,j,k)*VISCKinEnergy & + +mydt*(VISCIntEnergy+HEATIntEnergy)*real(ceiling(1.0_WP-vf%VF(i,j,k)),WP) + this%LrhoE(i,j,k)=this%LrhoE(i,j,k) & + +mydt*this%Lrho(i,j,k)/this%RHO(i,j,k)*VISCKinEnergy & + +mydt*(VISCIntEnergy+HEATIntEnergy)*real(ceiling( vf%VF(i,j,k)),WP) + this%GP (i,j,k)=this%GP (i,j,k)+mydt*matmod%EOS_gas (i,j,k,'v')* & + (VISCIntEnergy + HEATIntEnergy)*real(ceiling(1.0_WP-vf%VF(i,j,k)),WP) + this%LP (i,j,k)=this%LP (i,j,k)+mydt*matmod%EOS_liquid(i,j,k,'v')* & + (VISCIntEnergy + HEATIntEnergy)*real(ceiling( vf%VF(i,j,k)),WP) + + ! Update with gravity + this%rhoUi(i,j,k)=this%rhoUi(i,j,k)+mydt*this%RHO (i,j,k)*this%gravity(1) + this%rhoVi(i,j,k)=this%rhoVi(i,j,k)+mydt*this%RHO (i,j,k)*this%gravity(2) + this%rhoWi(i,j,k)=this%rhoWi(i,j,k)+mydt*this%RHO (i,j,k)*this%gravity(3) + this%GrhoE(i,j,k)=this%GrhoE(i,j,k)+mydt*this%Grho(i,j,k)* & + (this%gravity(1)*(this%Ui(i,j,k)+0.5_WP*mydt*this%gravity(1)) & + +this%gravity(2)*(this%Vi(i,j,k)+0.5_WP*mydt*this%gravity(2)) & + +this%gravity(3)*(this%Wi(i,j,k)+0.5_WP*mydt*this%gravity(3))) + this%LrhoE(i,j,k)=this%LrhoE(i,j,k)+mydt*this%Lrho(i,j,k)* & + (this%gravity(1)*(this%Ui(i,j,k)+0.5_WP*mydt*this%gravity(1)) & + +this%gravity(2)*(this%Vi(i,j,k)+0.5_WP*mydt*this%gravity(2)) & + +this%gravity(3)*(this%Wi(i,j,k)+0.5_WP*mydt*this%gravity(3))) + ! Include source terms from LPT + if (present(srcU)) this%rhoUi(i,j,k)=this%rhoUi(i,j,k) + srcU(i,j,k)/real(nCFL,WP) + if (present(srcV)) this%rhoVi(i,j,k)=this%rhoVi(i,j,k) + srcV(i,j,k)/real(nCFL,WP) + if (present(srcW)) this%rhoWi(i,j,k)=this%rhoWi(i,j,k) + srcW(i,j,k)/real(nCFL,WP) + if (present(srcE)) this%GrhoE(i,j,k)=this%GrhoE(i,j,k) + srcE(i,j,k)/real(nCFL,WP) + ! LPT are liquid droplets, only get energy from gas phase + + end do + end do + end do + + ! BCs and communication for updated variables + bc_scope = 'momentum' + call this%apply_bcond(dt,bc_scope) + bc_scope = 'energy' + call this%apply_bcond(dt,bc_scope) + call this%cfg%sync(this%GP) + call this%cfg%sync(this%LP) + + ! Synchronize velocity with momeentum + this%Ui=this%rhoUi/this%RHO + this%Vi=this%rhoVi/this%RHO + this%Wi=this%rhoWi/this%RHO + + return + end subroutine diffusion_src_explicit_substep + + function therm_diffterm(i,j,k) result(heat_term) + implicit none + integer :: i,j,k + real(WP) :: heat_term + real(WP) :: div2T,dTdx,dTdy,dTdz + real(WP) :: dkdx,dkdy,dkdz + + ! Calculate finite difference derivatives + + div2T = this%divp_x(0,i,j,k)*sum(this%divu_x(:,i ,j,k)*this%Tmptr(i-1:i,j,k)) & + +this%divp_x(1,i,j,k)*sum(this%divu_x(:,i+1,j,k)*this%Tmptr(i:i+1,j,k)) & + +this%divp_y(0,i,j,k)*sum(this%divv_y(:,i,j ,k)*this%Tmptr(i,j-1:j,k)) & + +this%divp_y(1,i,j,k)*sum(this%divv_y(:,i,j+1,k)*this%Tmptr(i,j:j+1,k)) & + +this%divp_z(0,i,j,k)*sum(this%divw_z(:,i,j,k )*this%Tmptr(i,j,k-1:k)) & + +this%divp_z(1,i,j,k)*sum(this%divw_z(:,i,j,k+1)*this%Tmptr(i,j,k:k+1)) + + dTdx = this%divp_x(0,i,j,k)*sum(this%itpi_x(:,i ,j,k)*this%Tmptr(i-1:i,j,k)) & + +this%divp_x(1,i,j,k)*sum(this%itpi_x(:,i+1,j,k)*this%Tmptr(i:i+1,j,k)) + dTdy = this%divp_y(0,i,j,k)*sum(this%itpi_y(:,i,j ,k)*this%Tmptr(i,j-1:j,k)) & + +this%divp_y(1,i,j,k)*sum(this%itpi_y(:,i,j+1,k)*this%Tmptr(i,j:j+1,k)) + dTdz = this%divp_z(0,i,j,k)*sum(this%itpi_z(:,i,j,k )*this%Tmptr(i,j,k-1:k)) & + +this%divp_z(1,i,j,k)*sum(this%itpi_z(:,i,j,k+1)*this%Tmptr(i,j,k:k+1)) + + dkdx = this%divp_x(0,i,j,k)*sum(this%itpi_x(:,i ,j,k)*this%therm_cond(i-1:i,j,k)) & + +this%divp_x(1,i,j,k)*sum(this%itpi_x(:,i+1,j,k)*this%therm_cond(i:i+1,j,k)) + dkdy = this%divp_y(0,i,j,k)*sum(this%itpi_y(:,i,j ,k)*this%therm_cond(i,j-1:j,k)) & + +this%divp_y(1,i,j,k)*sum(this%itpi_y(:,i,j+1,k)*this%therm_cond(i,j:j+1,k)) + dkdz = this%divp_z(0,i,j,k)*sum(this%itpi_z(:,i,j,k )*this%therm_cond(i,j,k-1:k)) & + +this%divp_z(1,i,j,k)*sum(this%itpi_z(:,i,j,k+1)*this%therm_cond(i,j,k:k+1)) + + ! Calculate heat conduction term + heat_term = dkdx*dTdx+dkdy*dTdy+dkdz*dTdz+this%therm_cond(i,j,k)*div2T + + return + end function therm_diffterm + + + end subroutine diffusion_src_explicit_step subroutine pressureproj_prepare(this,dt,vf,matmod,contact_model) use vfs_class, only : vfs @@ -2339,6 +2936,7 @@ subroutine pressureproj_correct(this,dt,vf,DP) ! BCs bc_scope = 'velocity' call this%apply_bcond(dt,bc_scope) + call this%apply_bcond_facepressure(DP_U,DP_V,DP_W) ! Correct cell-centered quantities do k=this%cfg%kmin_,this%cfg%kmax_ @@ -2419,15 +3017,16 @@ subroutine pressureproj_correct(this,dt,vf,DP) end subroutine pressureproj_correct - subroutine pressure_relax(this,vf,matmod) + subroutine pressure_relax(this,vf,matmod,relax_model) use vfs_class, only: vfs, VFlo, VFhi use matm_class, only: matm implicit none class(mast), intent(inout) :: this class(vfs), intent(inout) :: vf class(matm), intent(inout) :: matmod + integer, intent(in) :: relax_model real(WP) :: KE - logical :: Gflag, Lflag + logical :: Gflag, Lflag, Gf, Lf integer :: i,j,k ! Loop through domain and relax multiphase cells @@ -2438,16 +3037,17 @@ subroutine pressure_relax(this,vf,matmod) if (this%mask(i,j,k).gt.0) cycle ! Determine if multiphase cell if ((vf%VF(i,j,k).ge.VFlo).and.(vf%VF(i,j,k).le.VFhi)) then - if (.true.) then !(mult_iso) then - ! Mechanical relaxation - call this%pressure_relax_one(vf,matmod,i,j,k) - else - ! Thermal relaxation - ! call pressure_thermal_relax_one(i,j,k) - end if - ! Refresh temperature and temperature-dependent variables - ! call therm_refresh_one(i,j,k) + select case (relax_model) + case (mech_egy_mech_hhz) + ! Mechanical relaxation + call this%pressure_relax_one(vf,matmod,i,j,k) + case (thermmech_egy_mech_hhz) !,thermmech_egy_therm_hhz + ! Thermo-mechanical relaxation + call this%pressure_thermal_relax_one(vf,matmod,i,j,k) + end select end if + ! Update temperature globally, having changed during prior iteration and relaxation + this%Tmptr(i,j,k)=matmod%get_local_temperature(vf,i,j,k,this%Tmptr(i,j,k)) end do end do end do @@ -2463,6 +3063,7 @@ subroutine pressure_relax(this,vf,matmod) !call vf%distance_from_polygon() call vf%subcell_vol() call vf%get_curvature() + call vf%reset_moments() ! * Band and distance information should not be needed ! * Interface information won't be used before interface changes ! Just VOF and barycenter values @@ -2479,7 +3080,12 @@ subroutine pressure_relax(this,vf,matmod) ! Calculate kinematic KE KE = 0.5_WP*(this%Ui(i,j,k)**2+this%Vi(i,j,k)**2+this%Wi(i,j,k)**2) ! Alter energy if needed + Gf = .false.; Lf = .false. call matmod%fix_energy(vf%VF(i,j,k),KE,this%P(i,j,k),this%sigma*vf%curv(i,j,k),i,j,k,Gflag,Lflag) + ! If energy has been altered, update temperature + if (Gf.or.Lf) this%Tmptr(i,j,k) = matmod%get_local_temperature(vf,i,j,k,this%Tmptr(i,j,k)) + ! Update flags + Gflag = (Gflag.or.Gf); Lflag = (Lflag.or.Lf) end do end do end do @@ -2528,7 +3134,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'Ptherm relax could not be performed',i,j,k,'oVF',oVF, & + print*,'Ptherm relax could not be performed(1)',i,j,k,'oVF',oVF, & 'detmnt',detmnt,'Pliq',matmod%EOS_liquid(i,j,k,'p'),'Pgas',matmod%EOS_gas(i,j,k,'p') end if return @@ -2546,7 +3152,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'P relax could not be performed',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'P relax could not be performed(2)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq',Peq,'Pliq',matmod%EOS_liquid(i,j,k,'p'),'Pgas',matmod%EOS_gas(i,j,k,'p') end if return @@ -2559,7 +3165,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) ! Use the VF increment and Pint to calculate the change of the internal energy ! Store "relaxed" values with prefix r if (buf_VF.le.VFhi.and.buf_VF.ge.VFlo) then - ! Calculate future energy unless VF is out of bounds + ! Calculate total energy rLrhoE = (oVF*this%LrhoE(i,j,k) - Pint*dVF)/buf_VF rGrhoE = ((1.0_WP-oVF)*this%GrhoE(i,j,k) + Pint*dVF)/(1.0_WP-buf_VF) ! Adjust phase quantities now that the volume fraction has changed @@ -2573,7 +3179,212 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) ! Go through cases according to the values found ! Check for VF bounds, then for bad values if (buf_VF.gt.VFhi) then - ! If equilibrium pressure or relaxed energy is negative, let liquid phase take gas energy + vf%VF(i,j,k) = 1.0_WP + this%LrhoE(i,j,k) = oVF*this%LrhoE(i,j,k) + (1.0_WP-oVF)*this%GrhoE(i,j,k) + this%GrhoE(i,j,k) = 0.0_WP + this%Lrho (i,j,k) = oVF*this%Lrho(i,j,k) + this%Grho (i,j,k) = 0.0_WP + else if (buf_VF.lt.VFlo) then + vf%VF(i,j,k) = 0.0_WP + this%GrhoE(i,j,k) = (1.0_WP-oVF)*this%GrhoE(i,j,k) + oVF*this%LrhoE(i,j,k) + this%LrhoE(i,j,k) = 0.0_WP + this%Grho (i,j,k) = (1.0_WP-oVF)*this%Grho(i,j,k) + this%Lrho (i,j,k) = 0.0_WP + else if (rGIE.lt.Plo.and.oVF.gt.gelim) then + ! If equilibrium gas energy is negative, leave other values unchanged + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'Gas phase eliminated in P relax(3)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq-pjump',Peq-my_pjump,'Pliq',matmod%EOS_liquid(i,j,k,'p'), & + 'Grhoe0',this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE,'Grho0',this%Grho(i,j,k) + end if + vf%VF(i,j,k) = 1.0_WP + this%LrhoE(i,j,k) = this%LrhoE(i,j,k) + this%GrhoE(i,j,k) = 0.0_WP + this%Lrho (i,j,k) = this%Lrho(i,j,k) + this%Grho (i,j,k) = 0.0_WP + else if (rLIE.lt.Plo.and.oVF.lt.lelim) then + ! If equilibrium liquid energy is negative, leave other values unchanged + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'Liq phase eliminated in P relax(4)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq',Peq,'Pgas',matmod%EOS_gas(i,j,k,'p'), & + 'Lrhoe0',this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE,'Lrho0',this%Lrho(i,j,k) + end if + vf%VF(i,j,k) = 0.0_WP + this%GrhoE(i,j,k) = this%GrhoE(i,j,k) + this%LrhoE(i,j,k) = 0.0_WP + this%Grho (i,j,k) = this%Grho(i,j,k) + this%Lrho (i,j,k) = 0.0_WP + else if (Peq+matmod%Pref_g-my_pjump.lt.Plo.and.oVF.gt.gelim) then + ! If equilibrium pressure is negative, let liquid phase take the energy + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'Gas phase eliminated in P relax(5)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq-pjump',Peq-my_pjump,'Pliq',matmod%EOS_liquid(i,j,k,'p'), & + 'Grhoe0',this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE,'Grho0',this%Grho(i,j,k) + end if + vf%VF(i,j,k) = 1.0_WP + this%LrhoE(i,j,k) = oVF*this%LrhoE(i,j,k) + max((1.0_WP-oVF)*this%GrhoE(i,j,k),0.0_WP) + this%GrhoE(i,j,k) = 0.0_WP + this%Lrho (i,j,k) = oVF*this%Lrho(i,j,k) ! + (1.0_WP-oVF)*Grho(i,j,k) + this%Grho (i,j,k) = 0.0_WP + else if (Peq+matmod%Pref_l.lt.Plo.and.oVF.lt.lelim) then + ! If equilibrium pressure is negative, let gas phase take energy + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'Liq phase eliminated in P relax(6)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq',Peq,'Pgas',matmod%EOS_gas(i,j,k,'p'), & + 'Lrhoe0',this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE,'Lrho0',this%Lrho(i,j,k) + end if + vf%VF(i,j,k) = 0.0_WP + this%GrhoE(i,j,k) = (1.0_WP-oVF)*this%GrhoE(i,j,k) + max(oVF*this%LrhoE(i,j,k),0.0_WP) + this%LrhoE(i,j,k) = 0.0_WP + this%Grho (i,j,k) = (1.0_WP-oVF)*this%Grho(i,j,k) ! + oVF*Lrho(i,j,k) + this%Lrho (i,j,k) = 0.0_WP + else + ! Check for errant energy values + if (min(rGIE,rLIE,Peq+matmod%Pref_g-my_pjump,Peq+matmod%Pref_l).lt.Plo) then + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'P relax could not be performed(7)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq+Pref_l',Peq+matmod%Pref_l,'Peq+Pref_g-pjump',Peq+matmod%Pref_g-my_pjump, & + 'rGrhoe',rGIE,'rLrhoe',rLIE + end if + return + end if + + ! Set VF, rhoE, rho to relaxed values (made it past all the conditionals) + vf%VF(i,j,k) = buf_VF + this%LrhoE(i,j,k) = rLrhoE + this%GrhoE(i,j,k) = rGrhoE + this%Lrho (i,j,k) = rLrho + this%Grho (i,j,k) = rGrho + end if + + return + end subroutine pressure_relax_one + + subroutine pressure_thermal_relax_one(this,vf,matmod,i,j,k) + use vfs_class, only: vfs, VFlo, VFhi + use matm_class, only: matm, constant + implicit none + class(mast), intent(inout) :: this + class(vfs), intent(inout) :: vf + class(matm), intent(inout) :: matmod + integer, intent(in) :: i,j,k + integer :: n + real(WP) :: KE,buf_VF,detmnt,cvg_p,re1,re2,T1,T2 + real(WP) :: Peq,Pold,Pnorm,oVF,my_pjump + real(WP) :: rGrhoE,rLrhoE,rGrho,rLrho,rGIE,rLIE,D_rhoe + real(WP), dimension(4) :: VF_terms + real(WP), dimension(3) :: quad_terms + integer , parameter :: n_loop = 10 + real(WP), parameter :: tol_p = 1e-5 + real(WP), parameter :: lelim = 0.1_WP + real(WP), parameter :: gelim = 1.0_WP-lelim + real(WP), parameter :: Plo = 1e-8_WP + + ! Calculate kinetic energy without the density + KE = 0.5_WP*(this%Ui(i,j,k)**2+this%Vi(i,j,k)**2+this%Wi(i,j,k)**2) + + ! Store old VF value + oVF = vf%VF(i,j,k) + ! Store pressure jump + my_pjump = this%sigma*vf%curv(i,j,k) + ! Set initial guesses and loop quantities + this%Tmptr(i,j,k) = matmod%get_local_temperature(vf,i,j,k,this%Tmptr(i,j,k)) + T1 = this%Tmptr(i,j,k); T2 = this%Tmptr(i,j,k) + Pnorm = abs(oVF*matmod%EOS_liquid(i,j,k,'p') + (1.0_WP-oVF)*matmod%EOS_gas(i,j,k,'p')) + n = 0; cvg_p = 1.0_WP; Pold = Pnorm + + ! Begin loop (for temperature-dependent cv) + do while (cvg_p.gt.tol_p.and.n.lt.n_loop) + + ! Get coefficients for quadratic equation + call matmod%EOS_thermal_relax_quad(i,j,k,oVF,my_pjump, & + matmod%spec_heat_liquid(T1),matmod%spec_heat_gas(T2), & + VF_terms,quad_terms) + + ! Check if solution can exist + detmnt = quad_terms(2)**2-4.0_WP*quad_terms(1)*quad_terms(3) + if (detmnt.lt.0.0_WP) then + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'Ptherm relax could not be performed(1)',i,j,k,'oVF',oVF, & + 'detmnt',detmnt,'Pliq',matmod%EOS_liquid(i,j,k,'p'),'Pgas',matmod%EOS_gas(i,j,k,'p') + end if + return + end if + + ! Solve quadratic equation for equilibrium pressure + Peq = (-quad_terms(2) + sqrt(detmnt))/(2.0_WP*quad_terms(1)) + ! Use equilibrium pressure to calculate the new VF + buf_VF = (VF_terms(1)*Peq+VF_terms(2))/(VF_terms(3)*Peq+VF_terms(4)) + + ! Check if new VF not NaN. Let bounds be handled later. + if (buf_VF.ne.buf_VF.or.& + (Peq+matmod%Pref_g-my_pjump.lt.Plo.and.oVF.le.gelim).or.& + (Peq+matmod%Pref_l.lt.Plo.and.oVF.ge.lelim)) then + if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & + j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & + k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then + print*,'P relax could not be performed(2)',i,j,k,'oVF',oVF,'VF*',buf_VF, & + 'Peq',Peq,'Pliq',matmod%EOS_liquid(i,j,k,'p'),'Pgas',matmod%EOS_gas(i,j,k,'p') + end if + return + end if + + ! If cell becomes single-phase, exit + if ((buf_VF.gt.VFhi).or.(buf_VF.lt.VFlo)) exit + + ! Calculate relaxed phase densities + rLrho = ( oVF)*this%Lrho(i,j,k)/( buf_VF) + rGrho = (1.0_WP-oVF)*this%Grho(i,j,k)/(1.0_WP-buf_VF) + ! Update temperature of each phase according to equilibrium pressure + T1 = matmod%EOS_temp(Peq ,rLrho,matmod%spec_heat_liquid(T1),'liquid') + T2 = matmod%EOS_temp(Peq-my_pjump,rGrho,matmod%spec_heat_gas(T2), 'gas') + + ! If properties are constant, exit after one iteration + if ((matmod%M_cv_l.eq.constant).and.(matmod%M_cv_g.eq.constant)) exit + + ! Prepare for next iteration and calculate loop criteria + n = n + 1 + cvg_p = abs(Peq-Pold)/Pnorm + Pold = Peq + + end do + + ! Store "relaxed" values with prefix r + if (buf_VF.le.VFhi.and.buf_VF.ge.VFlo) then + ! Use the new VOF and the EOS to calculate the energy exchange + ! If statement is to reduce the likelihood of round-off error + re1 = ( oVF)*(this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE) + re2 = (1.0_WP-oVF)*(this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE) + if (abs(re1).gt.abs(re2)) then + D_rhoe = -(1.0_WP-buf_VF)*matmod%EOS_energy(Peq-my_pjump,rGrho, & + 0.0_WP,0.0_WP,0.0_WP,'gas' ) + re2 + else + D_rhoe = +( buf_VF)*matmod%EOS_energy(Peq ,rLrho, & + 0.0_WP,0.0_WP,0.0_WP,'liquid') - re1 + end if + ! Calculate relaxed energy + rLrhoE = (( oVF)*this%LrhoE(i,j,k) + D_rhoe)/( buf_VF) + rGrhoE = ((1.0_WP-oVF)*this%GrhoE(i,j,k) - D_rhoe)/(1.0_WP-buf_VF) + ! Calculate relaxed internal energy of each phase + rLIE = rLrhoE-rLrho*KE + rGIE = rGrhoE-rGrho*KE + end if + + ! Go through cases according to the values found + ! Check for VF bounds, then for bad values + if (buf_VF.gt.VFhi) then vf%VF(i,j,k) = 1.0_WP this%LrhoE(i,j,k) = oVF*this%LrhoE(i,j,k) + (1.0_WP-oVF)*this%GrhoE(i,j,k) this%GrhoE(i,j,k) = 0.0_WP @@ -2590,7 +3401,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'Gas phase eliminated in P relax',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'Gas phase eliminated in P relax(3)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq-pjump',Peq-my_pjump,'Pliq',matmod%EOS_liquid(i,j,k,'p'), & 'Grhoe0',this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE,'Grho0',this%Grho(i,j,k) end if @@ -2604,7 +3415,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'Liq phase eliminated in P relax',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'Liq phase eliminated in P relax(4)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq',Peq,'Pgas',matmod%EOS_gas(i,j,k,'p'), & 'Lrhoe0',this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE,'Lrho0',this%Lrho(i,j,k) end if @@ -2618,7 +3429,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'Gas phase eliminated in P relax',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'Gas phase eliminated in P relax(5)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq-pjump',Peq-my_pjump,'Pliq',matmod%EOS_liquid(i,j,k,'p'), & 'Grhoe0',this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE,'Grho0',this%Grho(i,j,k) end if @@ -2632,7 +3443,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'Liq phase eliminated in P relax',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'Liq phase eliminated in P relax(6)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq',Peq,'Pgas',matmod%EOS_gas(i,j,k,'p'), & 'Lrhoe0',this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE,'Lrho0',this%Lrho(i,j,k) end if @@ -2647,7 +3458,7 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) if (i.ge.this%cfg%imin_.and.i.le.this%cfg%imax_.and. & j.ge.this%cfg%jmin_.and.j.le.this%cfg%jmax_.and. & k.ge.this%cfg%kmin_.and.k.le.this%cfg%kmax_) then - print*,'P relax could not be performed',i,j,k,'oVF',oVF,'VF*',buf_VF, & + print*,'P relax could not be performed(7)',i,j,k,'oVF',oVF,'VF*',buf_VF, & 'Peq+Pref_l',Peq+matmod%Pref_l,'Peq+Pref_g-pjump',Peq+matmod%Pref_g-my_pjump, & 'rGrhoe',rGIE,'rLrhoe',rLIE end if @@ -2660,10 +3471,11 @@ subroutine pressure_relax_one(this,vf,matmod,i,j,k) this%GrhoE(i,j,k) = rGrhoE this%Lrho (i,j,k) = rLrho this%Grho (i,j,k) = rGrho + this%Tmptr(i,j,k) = T1 ! = T2 end if return - end subroutine pressure_relax_one + end subroutine pressure_thermal_relax_one !> Combine phase pressures and bulk moduli according to mixture rules, add additional terms to PA subroutine harmonize_advpressure_bulkmod(this,vf,matmod) @@ -2676,9 +3488,9 @@ subroutine harmonize_advpressure_bulkmod(this,vf,matmod) real(WP) :: rhoc2_lI,rhoc2_gI,denom integer :: i,j,k - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ ! Intermediate variables for mechanical equilibrium projection rhoc2_lI = this%LrhoSS2(i,j,k); rhoc2_gI = this%GrhoSS2(i,j,k) if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) call matmod%bulkmod_intf(i,j,k,rhoc2_lI,rhoc2_gI) @@ -2696,6 +3508,8 @@ subroutine harmonize_advpressure_bulkmod(this,vf,matmod) end do end do end do + + call this%cfg%sync(this%RHOSS2) end subroutine harmonize_advpressure_bulkmod @@ -2829,11 +3643,14 @@ subroutine interp_pressure_density(this,vf) end do end do end do + + ! Boundary conditions for pressure at faces (helps outflow) + call this%apply_bcond_facepressure(this%P_U,this%P_V,this%P_W) end subroutine interp_pressure_density !> Calculate the interpolated velocity, which is the velocity at the face - subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W) + subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W,use_masks) use vfs_class, only : vfs implicit none class(mast), intent(in) :: this @@ -2844,9 +3661,17 @@ subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: U real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: V real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: W + logical, intent(in), optional :: use_masks integer :: i,j,k real(WP) :: vol_r,vol_l,rho_r,rho_l + logical :: flag + ! Determine whether masks should matter or use global interpolation + if (present(use_masks)) then + flag = .not.use_masks + else + flag = .false. + end if do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -2857,7 +3682,7 @@ subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W) rho_r=sum(vf%Gvol(0,:,:,i ,j,k))*this%Grho(i ,j,k)+sum(vf%Lvol(0,:,:,i ,j,k))*this%Lrho(i ,j,k) rho_l=sum(vf%Gvol(1,:,:,i-1,j,k))*this%Grho(i-1,j,k)+sum(vf%Lvol(1,:,:,i-1,j,k))*this%Lrho(i-1,j,k) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%umask(i,j,k).ne.2) U(i,j,k)=(rho_l*Ui(i-1,j,k)+rho_r*Ui(i,j,k))/(rho_l+rho_r) + if (this%umask(i,j,k).ne.2.or.flag) U(i,j,k)=(rho_l*Ui(i-1,j,k)+rho_r*Ui(i,j,k))/(rho_l+rho_r) else U(i,j,k)=0.0_WP end if @@ -2867,7 +3692,7 @@ subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W) rho_r=sum(vf%Gvol(:,0,:,i,j ,k))*this%Grho(i,j ,k)+sum(vf%Lvol(:,0,:,i,j ,k))*this%Lrho(i,j ,k) rho_l=sum(vf%Gvol(:,1,:,i,j-1,k))*this%Grho(i,j-1,k)+sum(vf%Lvol(:,1,:,i,j-1,k))*this%Lrho(i,j-1,k) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%vmask(i,j,k).ne.2) V(i,j,k)=(rho_l*Vi(i,j-1,k)+rho_r*Vi(i,j,k))/(rho_l+rho_r) + if (this%vmask(i,j,k).ne.2.or.flag) V(i,j,k)=(rho_l*Vi(i,j-1,k)+rho_r*Vi(i,j,k))/(rho_l+rho_r) else V(i,j,k)=0.0_WP end if @@ -2877,7 +3702,7 @@ subroutine interp_vel_basic(this,vf,Ui,Vi,Wi,U,V,W) rho_r=sum(vf%Gvol(:,:,0,i,j,k ))*this%Grho(i,j,k )+sum(vf%Lvol(:,:,0,i,j,k ))*this%Lrho(i,j,k ) rho_l=sum(vf%Gvol(:,:,1,i,j,k-1))*this%Grho(i,j,k-1)+sum(vf%Lvol(:,:,1,i,j,k-1))*this%Lrho(i,j,k-1) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%wmask(i,j,k).ne.2) W(i,j,k)=(rho_l*Wi(i,j,k-1)+rho_r*Wi(i,j,k))/(rho_l+rho_r) + if (this%wmask(i,j,k).ne.2.or.flag) W(i,j,k)=(rho_l*Wi(i,j,k-1)+rho_r*Wi(i,j,k))/(rho_l+rho_r) else W(i,j,k)=0.0_WP end if @@ -2920,7 +3745,7 @@ subroutine interp_vel_full(this,vf,dt,Ui,Vi,Wi,termU,termV,termW,U,V,W) rho_r=sum(vf%Gvol(0,:,:,i ,j,k))*this%Grho(i ,j,k)+sum(vf%Lvol(0,:,:,i ,j,k))*this%Lrho(i ,j,k) rho_l=sum(vf%Gvol(1,:,:,i-1,j,k))*this%Grho(i-1,j,k)+sum(vf%Lvol(1,:,:,i-1,j,k))*this%Lrho(i-1,j,k) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%sl_face(i,j,k,1).eq.1) then + if (this%sl_x(i,j,k).eq.1) then subtract_l = dt*termU(i-1,j,k) subtract_r = dt*termU(i ,j,k) add = -dt*sum(this%divu_x(:,i,j,k)*this%P(i-1:i,j,k))/this%rho_U(i,j,k)& @@ -2939,7 +3764,7 @@ subroutine interp_vel_full(this,vf,dt,Ui,Vi,Wi,termU,termV,termW,U,V,W) rho_r=sum(vf%Gvol(:,0,:,i,j ,k))*this%Grho(i,j ,k)+sum(vf%Lvol(:,0,:,i,j ,k))*this%Lrho(i,j ,k) rho_l=sum(vf%Gvol(:,1,:,i,j-1,k))*this%Grho(i,j-1,k)+sum(vf%Lvol(:,1,:,i,j-1,k))*this%Lrho(i,j-1,k) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%sl_face(i,j,k,2).eq.1) then + if (this%sl_y(i,j,k).eq.1) then subtract_l = dt*termV(i,j-1,k) subtract_r = dt*termV(i,j ,k) add = -dt*sum(this%divv_y(:,i,j,k)*this%P(i,j-1:j,k))/this%rho_V(i,j,k)& @@ -2958,7 +3783,7 @@ subroutine interp_vel_full(this,vf,dt,Ui,Vi,Wi,termU,termV,termW,U,V,W) rho_r=sum(vf%Gvol(:,:,0,i,j,k ))*this%Grho(i,j,k )+sum(vf%Lvol(:,:,0,i,j,k ))*this%Lrho(i,j,k ) rho_l=sum(vf%Gvol(:,:,1,i,j,k-1))*this%Grho(i,j,k-1)+sum(vf%Lvol(:,:,1,i,j,k-1))*this%Lrho(i,j,k-1) if (min(vol_l,vol_r).gt.0.0_WP) then - if (this%sl_face(i,j,k,3).eq.1) then + if (this%sl_z(i,j,k).eq.1) then subtract_l = dt*termW(i,j,k-1) subtract_r = dt*termW(i,j,k ) add = -dt*sum(this%divw_z(:,i,j,k)*this%P(i,j,k-1:k))/this%rho_W(i,j,k)& @@ -2989,7 +3814,7 @@ subroutine terms_modified_face_velocity(this,vf,termU,termV,termW) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: termV real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: termW integer :: i,j,k - real(WP) :: vol_r,vol_l,rho_r,rho_l + real(WP) :: rho_r,rho_l real(WP), dimension(0:1) :: jumpx,jumpy,jumpz ! Begin at zero every time @@ -3139,12 +3964,14 @@ subroutine update_Helmholtz_RHS(this,dt) end subroutine update_Helmholtz_RHS !> Calculate the CFL - subroutine get_cfl(this,dt,cflc,cfl) + subroutine get_cfl(this,dt,cflc,cfl,matmod) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN use parallel, only: MPI_REAL_WP use mathtools, only: Pi + use matm_class, only: matm implicit none class(mast), intent(inout) :: this + class(matm), intent(inout), optional :: matmod real(WP), intent(in) :: dt real(WP), intent(out) :: cflc real(WP), optional :: cfl @@ -3167,9 +3994,6 @@ subroutine get_cfl(this,dt,cflc,cfl) call MPI_ALLREDUCE(my_CFLst,this%CFLst,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) this%CFLst=dt/this%CFLst - ! Get largest kinematic viscosity - !max_nu=max(this%visc_l/this%rho_l,this%visc_g/this%rho_g) - max_nu = 0.0 ! for now ! Set the CFLs to zero my_CFLc_x=0.0_WP; my_CFLc_y=0.0_WP; my_CFLc_z=0.0_WP my_CFLv_x=0.0_WP; my_CFLv_y=0.0_WP; my_CFLv_z=0.0_WP @@ -3183,6 +4007,16 @@ subroutine get_cfl(this,dt,cflc,cfl) my_CFLa_x=max(my_CFLa_x,abs(this%U(i,j,k)+sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)))*this%cfg%dxmi(i)) my_CFLa_y=max(my_CFLa_y,abs(this%V(i,j,k)+sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)))*this%cfg%dymi(j)) my_CFLa_z=max(my_CFLa_z,abs(this%W(i,j,k)+sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)))*this%cfg%dzmi(k)) + + max_nu = this%VISC(i,j,k)/this%RHO(i,j,k) + if (present(matmod)) then + if (this%Lrho(i,j,k).gt.0.0_WP) then + max_nu = max(max_nu,matmod%viscosity_liquid(this%Tmptr(i,j,k))/this%Lrho(i,j,k)) + end if + if (this%Grho(i,j,k).gt.0.0_WP) then + max_nu = max(max_nu,matmod%viscosity_gas (this%Tmptr(i,j,k))/this%Grho(i,j,k)) + end if + end if my_CFLv_x=max(my_CFLv_x,4.0_WP*max_nu*this%cfg%dxi(i)**2) my_CFLv_y=max(my_CFLv_y,4.0_WP*max_nu*this%cfg%dyi(j)**2) my_CFLv_z=max(my_CFLv_z,4.0_WP*max_nu*this%cfg%dzi(k)**2) @@ -3193,7 +4027,7 @@ subroutine get_cfl(this,dt,cflc,cfl) my_CFLa_x=my_CFLa_x*dt; my_CFLa_y=my_CFLa_y*dt; my_CFLa_z=my_CFLa_z*dt my_CFLv_x=my_CFLv_x*dt; my_CFLv_y=my_CFLv_y*dt; my_CFLv_z=my_CFLv_z*dt - ! Get the parallel max + ! Get the parallel min, max call MPI_ALLREDUCE(my_CFLc_x,this%CFLc_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_CFLc_y,this%CFLc_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_CFLc_z,this%CFLc_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) @@ -3216,82 +4050,151 @@ end subroutine get_cfl !> Calculate the max of our fields subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN use parallel, only: MPI_REAL_WP implicit none class(mast), intent(inout) :: this integer :: i,j,k,ierr - real(WP) :: my_Umax,my_Vmax,my_Wmax,my_Pmax,my_divmax + real(WP) :: my_RHOmin,my_RHOmax,my_Umax,my_Vmax,my_Wmax,my_Pmax,my_Tmax ! Set all to zero - my_Umax=0.0_WP; my_Vmax=0.0_WP; my_Wmax=0.0_WP; my_Pmax=0.0_WP; my_divmax=0.0_WP + my_RHOmin=huge(1.0_WP); my_RHOmax = 0.0_WP + my_Umax=0.0_WP; my_Vmax=0.0_WP; my_Wmax=0.0_WP; my_Pmax=0.0_WP; my_Tmax=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ my_Umax=max(my_Umax,abs(this%U(i,j,k))) my_Vmax=max(my_Vmax,abs(this%V(i,j,k))) my_Wmax=max(my_Wmax,abs(this%W(i,j,k))) - if (this%cfg%VF(i,j,k).gt.0.0_WP) my_Pmax =max(my_Pmax ,abs(this%P(i,j,k) )) - !if (this%cfg%VF(i,j,k).gt.0.0_WP) my_divmax=max(my_divmax,abs(this%div(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_RHOmin=min(my_RHOmin,abs(this%RHO(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_RHOmax=max(my_RHOmax,abs(this%RHO(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_Pmax=max(my_Pmax,abs(this%P(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_Tmax=max(my_Tmax,abs(this%Tmptr(i,j,k))) end do end do end do ! Get the parallel max - call MPI_ALLREDUCE(my_Umax ,this%Umax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_Vmax ,this%Vmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_Wmax ,this%Wmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_Pmax ,this%Pmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - !call MPI_ALLREDUCE(my_divmax,this%divmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_RHOmin,this%RHOmin,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_RHOmax,this%RHOmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Umax,this%Umax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Vmax,this%Vmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Wmax,this%Wmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Pmax,this%Pmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Tmax,this%Tmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) end subroutine get_max - !> Prepare viscosity arrays from vfs object - subroutine get_viscosity(this,vf) - use vfs_class, only: vfs - implicit none - class(mast), intent(inout) :: this - class(vfs), intent(in) :: vf - integer :: i,j,k - real(WP) :: liq_vol,gas_vol,tot_vol - ! ! Compute harmonically-averaged staggered viscosities using subcell phasic volumes - ! do k=this%cfg%kmino_+1,this%cfg%kmaxo_ - ! do j=this%cfg%jmino_+1,this%cfg%jmaxo_ - ! do i=this%cfg%imino_+1,this%cfg%imaxo_ - ! ! VISC at [xm,ym,zm] - direct sum in x/y/z - ! liq_vol=sum(vf%Lvol(:,:,:,i,j,k)) - ! gas_vol=sum(vf%Gvol(:,:,:,i,j,k)) - ! tot_vol=gas_vol+liq_vol - ! this%visc(i,j,k)=0.0_WP - ! if (tot_vol.gt.0.0_WP) this%visc(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) - ! ! VISC_xy at [x,y,zm] - direct sum in z, staggered sum in x/y - ! liq_vol=sum(vf%Lvol(0,0,:,i,j,k))+sum(vf%Lvol(1,0,:,i-1,j,k))+sum(vf%Lvol(0,1,:,i,j-1,k))+sum(vf%Lvol(1,1,:,i-1,j-1,k)) - ! gas_vol=sum(vf%Gvol(0,0,:,i,j,k))+sum(vf%Gvol(1,0,:,i-1,j,k))+sum(vf%Gvol(0,1,:,i,j-1,k))+sum(vf%Gvol(1,1,:,i-1,j-1,k)) - ! tot_vol=gas_vol+liq_vol - ! this%visc_xy(i,j,k)=0.0_WP - ! if (tot_vol.gt.0.0_WP) this%visc_xy(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) - ! ! VISC_yz at [xm,y,z] - direct sum in x, staggered sum in y/z - ! liq_vol=sum(vf%Lvol(:,0,0,i,j,k))+sum(vf%Lvol(:,1,0,i,j-1,k))+sum(vf%Lvol(:,0,1,i,j,k-1))+sum(vf%Lvol(:,1,1,i,j-1,k-1)) - ! gas_vol=sum(vf%Gvol(:,0,0,i,j,k))+sum(vf%Gvol(:,1,0,i,j-1,k))+sum(vf%Gvol(:,0,1,i,j,k-1))+sum(vf%Gvol(:,1,1,i,j-1,k-1)) - ! tot_vol=gas_vol+liq_vol - ! this%visc_yz(i,j,k)=0.0_WP - ! if (tot_vol.gt.0.0_WP) this%visc_yz(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) - ! ! VISC_zx at [x,ym,z] - direct sum in y, staggered sum in z/x - ! liq_vol=sum(vf%Lvol(0,:,0,i,j,k))+sum(vf%Lvol(0,:,1,i,j,k-1))+sum(vf%Lvol(1,:,0,i-1,j,k))+sum(vf%Lvol(1,:,1,i-1,j,k-1)) - ! gas_vol=sum(vf%Gvol(0,:,0,i,j,k))+sum(vf%Gvol(0,:,1,i,j,k-1))+sum(vf%Gvol(1,:,0,i-1,j,k))+sum(vf%Gvol(1,:,1,i-1,j,k-1)) - ! tot_vol=gas_vol+liq_vol - ! this%visc_zx(i,j,k)=0.0_WP - ! if (tot_vol.gt.0.0_WP) this%visc_zx(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) - ! end do - ! end do - ! end do - ! ! Synchronize boundaries - not really needed... - ! call this%cfg%sync(this%visc) - ! call this%cfg%sync(this%visc_xy) - ! call this%cfg%sync(this%visc_yz) - ! call this%cfg%sync(this%visc_zx) + !> Prepare viscosity arrays from vfs, matm, and sgsmodel objects + subroutine get_viscosity(this,vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + use vfs_class, only: vfs, VFhi, VFlo + use matm_class, only: matm + implicit none + class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver + class(vfs), intent(inout) :: vf !< The volume fraction solver + class(matm), intent(inout) :: matmod !< The material models for this solver + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc_x + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc_y + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc_z + real(WP) :: visc_g,visc_l,kappa_g,kappa_l + real(WP) :: liq_vol,gas_vol,tot_vol + integer :: i,j,k + + ! Initialize face viscosities + visc_x = 0.0_WP; visc_y = 0.0_WP; visc_z = 0.0_WP + ! Initialize cell-centered diffusion parameters + this%visc = 0.0_WP; + this%therm_cond = 0.0_WP; + + do k=this%cfg%kmin_-1,this%cfg%kmax_+2 + do j=this%cfg%jmin_-1,this%cfg%jmax_+2 + do i=this%cfg%imin_-1,this%cfg%imax_+2 + + ! Update thermal conductivity and viscosity of each phase + ! Set to unity if phase not present for sake of harmonic average + if (vf%VF(i,j,k).ge.VFlo) then + kappa_l = matmod%therm_cond_liquid(this%Tmptr(i,j,k)) + visc_l = matmod%viscosity_liquid(this%Tmptr(i,j,k)) + else + kappa_l = 1.0_WP; visc_l = 1.0_WP + end if + if (vf%VF(i,j,k).le.VFhi) then + kappa_g = matmod%therm_cond_gas(this%Tmptr(i,j,k)) + visc_g = matmod%viscosity_gas(this%Tmptr(i,j,k)) + else + kappa_g = 1.0_WP; visc_g = 1.0_WP + end if + + ! Contribute eddy viscosity to each phase viscosity + if (present(sgs_visc)) then + visc_g = visc_g + this%Grho(i,j,k)*sgs_visc(i,j,k) + visc_l = visc_l + this%Lrho(i,j,k)*sgs_visc(i,j,k) + end if + + !! -- CELL CENTER -- !! + liq_vol=sum(vf%Lvol(:,:,:,i,j,k)) + gas_vol=sum(vf%Gvol(:,:,:,i,j,k)) + tot_vol=gas_vol+liq_vol + if (tot_vol.gt.0.0_WP) then + this%therm_cond(i,j,k)=kappa_g*kappa_l/(kappa_l*gas_vol/tot_vol+kappa_g*liq_vol/tot_vol+epsilon(1.0_WP)) + this%visc(i,j,k)=visc_g*visc_l/(visc_l*gas_vol/tot_vol+visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + end if + + ! Skip if inviscid + if (.not.(visc_g.gt.0.0_WP .and. visc_l.gt.0.0_WP)) cycle + + !! -- X FACE -- !! + ! Left half contribution + liq_vol=sum(vf%Lvol(1,:,:,i,j,k)) + gas_vol=sum(vf%Gvol(1,:,:,i,j,k)) + visc_x(i+1,j,k) = visc_x(i+1,j,k) + gas_vol/visc_g + liq_vol/visc_l + ! Right half contribution + liq_vol=sum(vf%Lvol(0,:,:,i,j,k)) + gas_vol=sum(vf%Gvol(0,:,:,i,j,k)) + visc_x(i ,j,k) = visc_x(i ,j,k) + gas_vol/visc_g + liq_vol/visc_l + ! Perform harmonic average (reciprocal) + tot_vol = sum(vf%Gvol(0,:,:,i,j,k)) + sum(vf%Lvol(0,:,:,i,j,k)) + sum(vf%Gvol(1,:,:,i-1,j,k)) + sum(vf%Lvol(1,:,:,i-1,j,k)) + if (tot_vol.gt.0.0_WP) visc_x(i,j,k) = tot_vol / visc_x(i,j,k); + + !! -- Y FACE -- !! + ! Left half contribution + liq_vol=sum(vf%Lvol(:,1,:,i,j,k)) + gas_vol=sum(vf%Gvol(:,1,:,i,j,k)) + visc_y(i,j+1,k) = visc_y(i,j+1,k) + gas_vol/visc_g + liq_vol/visc_l + ! Right half contribution + liq_vol=sum(vf%Lvol(:,0,:,i,j,k)) + gas_vol=sum(vf%Gvol(:,0,:,i,j,k)) + visc_y(i,j ,k) = visc_y(i,j ,k) + gas_vol/visc_g + liq_vol/visc_l + ! Perform harmonic average (reciprocal) + tot_vol = sum(vf%Gvol(:,0,:,i,j,k)) + sum(vf%Lvol(:,0,:,i,j,k)) + sum(vf%Gvol(:,1,:,i,j-1,k)) + sum(vf%Lvol(:,1,:,i,j-1,k)) + if (tot_vol.gt.0.0_WP) visc_y(i,j,k) = tot_vol / visc_y(i,j,k); + + !! -- Z FACE -- !! + ! Left half contribution + liq_vol=sum(vf%Lvol(:,:,1,i,j,k)) + gas_vol=sum(vf%Gvol(:,:,1,i,j,k)) + visc_z(i,j,k+1) = visc_z(i,j,k+1) + gas_vol/visc_g + liq_vol/visc_l + ! Right half contribution + liq_vol=sum(vf%Lvol(:,:,0,i,j,k)) + gas_vol=sum(vf%Gvol(:,:,0,i,j,k)) + visc_z(i,j,k ) = visc_z(i,j,k ) + gas_vol/visc_g + liq_vol/visc_l + ! Perform harmonic average (reciprocal) + tot_vol = sum(vf%Gvol(:,:,0,i,j,k)) + sum(vf%Lvol(:,:,0,i,j,k)) + sum(vf%Gvol(:,:,1,i,j,k-1)) + sum(vf%Lvol(:,:,1,i,j,k-1)) + if (tot_vol.gt.0.0_WP) visc_z(i,j,k) = tot_vol / visc_z(i,j,k); + + end do + end do + end do + + !call this%cfg%sync(this%therm_cond) + !call this%cfg%sync(this%visc) + !call this%cfg%sync(visc_x) + !call this%cfg%sync(visc_y) + !call this%cfg%sync(visc_z) + + return end subroutine get_viscosity - ! !> Add gravity source term - assumes that rho_[UVW] have been generated before ! subroutine addsrc_gravity(this,resU,resV,resW) diff --git a/src/two_phase/matm_class.f90 b/src/two_phase/matm_class.f90 index 8a7d8aa85..e5a28a67d 100644 --- a/src/two_phase/matm_class.f90 +++ b/src/two_phase/matm_class.f90 @@ -10,6 +10,13 @@ module matm_class ! Expose type/constructor/methods public :: matm + ! Parameters for viscosity, and heat diffusion models + integer, parameter, public :: none =0 !< Sets the constant to 0 (for inviscid, isothermal, etc.). Careful, overwrites input values + integer, parameter, public :: constant =1 !< Assumes default value, available for all types, overwritten by input + integer, parameter, public :: water =2 !< Empirical models for water (mu, kappa, cv) + integer, parameter, public :: air =3 !< Empirical models for air (mu, kappa, cv) + ! More can be added for other materials, alongside functions that feature models + !> Material modeling type intended for two-phase, liquid-gas flows type :: matm @@ -29,33 +36,61 @@ module matm_class ! Gas properties real(WP) :: gamm_g,Pref_g,q_g,b_g - ! Specific heat coefficients - real(WP), dimension(:,:,:), allocatable :: cv_l, cv_g - ! Pointers for local thermodynamic or flow variables real(WP), dimension(:,:,:), pointer :: Grho,GU,GV,GW,GrhoE,GP real(WP), dimension(:,:,:), pointer :: Lrho,LU,LV,LW,LrhoE,LP + + ! Variables to store chosen diffusion & thermo models (defaults to constant model, M references "model") + integer :: M_mu_l = 1 + integer :: M_kappa_l = 1 + integer :: M_cv_l = 1 + integer :: M_mu_g = 1 + integer :: M_kappa_g = 1 + integer :: M_cv_g = 1 + + ! Defaults for constant diffusion & thermo parameters + real(WP) :: mu_l0 = 8.9e-4_WP + real(WP) :: mu_g0 = 1.81e-5_WP + real(WP) :: kappa_l0 = 0.610_WP + real(WP) :: kappa_g0 = 0.026_WP + real(WP) :: cv_l0 = 4130.2_WP + real(WP) :: cv_g0 = 717.6_WP + + ! Default temperature guess (for the sake of variable cv) upon initialization, can be overwritten + ! Also used by EOS_gas and EOS_liquid functions if temperature guess is not directly supplied + real(WP) :: Tdefault = 25.0_WP + 273.15_WP contains procedure :: EOS_gas, EOS_liquid !< Output solver to the screen procedure :: EOS_energy !< Calculates phase total energy from pressure and kinetic energy procedure :: EOS_temp !< Calculates phase temperature from pressure directly + procedure :: EOS_density !< Calculates phase density from pressure and temperature directly + procedure :: EOS_pressure !< Calculates phase pressure from density and temperature directly procedure :: EOS_all !< Calculates vol-avg pressure for entire domain from conserved variables procedure :: register_idealgas !< EOS available for gas-like fluids procedure :: register_stiffenedgas !< EOS for liquid-like fluids procedure :: register_NobleAbelstiffenedgas !< EOS for liquid-like fluids + + procedure :: register_diffusion_thermo_models !< Choose models or set parameters for viscosity, thermal conductivity, and specific heat procedure :: register_thermoflow_variables !< Creates pointers from material models to flow solver variables procedure :: EOS_relax_quad !< Outputs terms for mechanical pressure relaxation step + procedure :: EOS_thermal_relax_quad !< Outputs terms for thermo-mechanical pressure relaxation step procedure :: bulkmod_intf !< Calculate the bulk modulus at liquid-gas interface procedure :: fix_energy !< Can correct erroneous energy values + + procedure :: update_temperature !< Updates entire array of mixture temperature as passed in + procedure :: get_local_temperature !< Calculates local mixture temperature procedure :: viscosity_water, viscosity_air !< Empirical models for temperature dependence of dynamic viscosity procedure :: spec_heat_water, spec_heat_air !< Empirical models for temperature dependence of specific heat (cv) procedure :: therm_cond_water, therm_cond_air !< Empirical models for temperature dependence of thermal conductivity + procedure :: viscosity_gas, spec_heat_gas, therm_cond_gas !< Provide diffusive/thermal parameters according to registered model + procedure :: viscosity_liquid, spec_heat_liquid, therm_cond_liquid + end type matm @@ -84,10 +119,6 @@ function constructor(cfg,name) result(self) self%gamm_l = 0.0_WP; self%Pref_l = 0.0_WP; self%q_l = 0.0_WP; self%b_l = 0.0_WP self%gamm_g = 0.0_WP; self%Pref_g = 0.0_WP; self%q_g = 0.0_WP; self%b_g = 0.0_WP - ! Allocate specific heat - allocate(self%cv_l(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%cv_l=0.0_WP - allocate(self%cv_g(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%cv_g=0.0_WP - end function constructor subroutine register_idealgas(this,phase,gamm) @@ -143,6 +174,91 @@ subroutine register_NobleAbelstiffenedgas(this,phase,gamm,Pref,q,b) end subroutine register_NobleAbelstiffenedgas + subroutine register_diffusion_thermo_models(this,viscmodel_liquid,hdffmodel_liquid,sphtmodel_liquid,viscmodel_gas,hdffmodel_gas,sphtmodel_gas,viscconst_liquid,hdffconst_liquid,sphtconst_liquid,viscconst_gas,hdffconst_gas,sphtconst_gas) + use messager, only: die + implicit none + class(matm), intent(inout) :: this + integer , intent(in), optional :: viscmodel_liquid,hdffmodel_liquid,sphtmodel_liquid,viscmodel_gas,hdffmodel_gas,sphtmodel_gas + real(WP), intent(in), optional :: viscconst_liquid,hdffconst_liquid,sphtconst_liquid,viscconst_gas,hdffconst_gas,sphtconst_gas + + ! If constants are supplied, replace default constants with provided constants + if (present(viscconst_liquid)) then + this%mu_l0 = viscconst_liquid + end if + if (present(viscconst_gas)) then + this%mu_g0 = viscconst_gas + end if + if (present(hdffconst_liquid)) then + this%kappa_l0 = hdffconst_liquid + end if + if (present(hdffconst_gas)) then + this%kappa_g0 = hdffconst_gas + end if + if (present(sphtconst_liquid)) then + this%cv_l0 = sphtconst_liquid + end if + if (present(sphtconst_gas)) then + this%cv_g0 = sphtconst_gas + end if + + ! If models are supplied, replace default models (constant) with specified models + ! Specifying a non-constant model will override specifying a constant parameter above + if (present(viscmodel_liquid)) then + this%M_mu_l = viscmodel_liquid + ! Check allowed values + select case (this%M_mu_l) + case (none,constant,water); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown liquid viscosity model') + end select + end if + if (present(viscmodel_gas)) then + this%M_mu_g = viscmodel_gas + ! Check allowed values + select case (this%M_mu_g) + case (none,constant,air); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown gas viscosity model') + end select + end if + if (present(hdffmodel_liquid)) then + this%M_kappa_l = hdffmodel_liquid + ! Check allowed values + select case (this%M_kappa_l) + case (none,constant,water); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown liquid heat diffusivity model') + end select + end if + if (present(hdffmodel_gas)) then + this%M_kappa_g = hdffmodel_gas + ! Check allowed values + select case (this%M_kappa_g) + case (none,constant,air); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown gas heat diffusivity model') + end select + end if + if (present(sphtmodel_liquid)) then + this%M_cv_l = sphtmodel_liquid + ! Check allowed values + select case (this%M_cv_l) + case (constant,water); ! do nothing - never zero, so none is not allowed + case default; call die('[matm register_diffusion_thermo_models] Unknown liquid specific heat model') + end select + end if + if (present(sphtmodel_gas)) then + this%M_cv_g = sphtmodel_gas + ! Check allowed values + select case (this%M_cv_g) + case (constant,air); ! do nothing - never zero, so none is not allowed + case default; call die('[matm register_diffusion_thermo_models] Unknown gas specific heat model') + end select + end if + + ! Set parameter values to zero if prescribed + if (this%M_mu_l .eq.none) this%mu_l0 = 0.0_WP + if (this%M_kappa_l.eq.none) this%kappa_l0 = 0.0_WP + if (this%M_mu_g .eq.none) this%mu_g0 = 0.0_WP + if (this%M_kappa_g.eq.none) this%kappa_g0 = 0.0_WP + + end subroutine register_diffusion_thermo_models subroutine register_thermoflow_variables(this,phase,rho,u,v,w,rhoe,p) implicit none @@ -168,13 +284,199 @@ subroutine register_thermoflow_variables(this,phase,rho,u,v,w,rhoe,p) end select end subroutine register_thermoflow_variables + + + function viscosity_liquid(this,T) result(mu) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: mu + + select case(this%M_mu_l) + case(none,constant) + mu = this%mu_l0 + case(water) + mu = this%viscosity_water(T) + end select + + return + end function viscosity_liquid + + function viscosity_gas(this,T) result(mu) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: mu + + select case(this%M_mu_g) + case(none,constant) + mu = this%mu_g0 + case(air) + mu = this%viscosity_air(T) + end select + + return + end function viscosity_gas + + function therm_cond_liquid(this,T) result(kappa) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: kappa + + select case(this%M_kappa_l) + case(none,constant) + kappa = this%kappa_l0 + case(water) + kappa = this%therm_cond_water(T) + end select + + return + end function therm_cond_liquid + + function therm_cond_gas(this,T) result(kappa) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: kappa + + select case(this%M_kappa_g) + case(none,constant) + kappa = this%kappa_g0 + case(air) + kappa = this%therm_cond_air(T) + end select + + return + end function therm_cond_gas + + function spec_heat_liquid(this,T) result(cv) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: cv + + select case(this%M_cv_l) + case(constant) + cv = this%cv_l0 + case(water) + cv = this%spec_heat_water(T) + end select + + return + end function spec_heat_liquid + + function spec_heat_gas(this,T) result(cv) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: cv + + select case(this%M_cv_g) + case(constant) + cv = this%cv_g0 + case(air) + cv = this%spec_heat_air(T) + end select + + return + end function spec_heat_gas + + subroutine update_temperature(this,vf,Temperature) + use vfs_class, only : vfs + implicit none + class(matm), intent(inout) :: this + class(vfs), intent(inout) :: vf + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: Temperature + integer :: i,j,k + + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Get local temperature, use current temperature as first guess for cv + Temperature(i,j,k) = this%get_local_temperature(vf,i,j,k,Temperature(i,j,k)) + end do + end do + end do + + end subroutine update_temperature + + function get_local_temperature(this,vf,i,j,k,Tguess) result(T) + use vfs_class, only : vfs, VFhi, VFlo + implicit none + class(matm), intent(inout) :: this + class(vfs), intent(inout) :: vf + integer, intent(in) :: i,j,k + real(WP), intent(in) :: Tguess + real(WP) :: Tlast,delta_T,Gtemp,Ltemp,T + real(WP) :: cv_g = 0.0_WP + real(WP) :: cv_l = 0.0_WP + integer :: n + real(WP), parameter :: T_cvg = 1e-1_WP + integer, parameter :: n_loop = 10 + ! Initialize guesses + Gtemp = Tguess; Ltemp = Tguess + ! Gas temperature + if (vf%VF(i,j,k).le.VFhi) then + n = 0; delta_T = 1.0_WP + T_cvg + do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) + Tlast = Gtemp + ! Calculate temperature with latest temperature in cv_g calculation + Gtemp = this%EOS_gas(i,j,k,'T',Gtemp) + ! Increment interation number + n = n+1 + ! Convergence residual + delta_T = abs(Gtemp-Tlast) + ! Exit loop if constant model + if (this%M_cv_g.eq.constant) n = n_loop + ! Exit loop if not converging + if (Gtemp.le.0.0_WP) then + n = n_loop + Gtemp = Tlast ! hopefully last iteration had better value + end if + end do + ! Update cv value using current temperature value + cv_g = this%spec_heat_gas(Gtemp) + end if + ! Liquid temperature + if (vf%VF(i,j,k).ge.VFlo) then + n = 0; delta_T = 1.0_WP + T_cvg + do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) + Tlast = Ltemp + ! Calculate temperature with latest temperature in cv_l calculation + Ltemp = this%EOS_liquid(i,j,k,'T',Ltemp) + ! Increment interation number + n = n+1 + ! Convergence residual + delta_T = abs(Ltemp-Tlast) + ! Exit loop if constant model + if (this%M_cv_l.eq.constant) n = n_loop + ! Exit loop if not converging + if (Ltemp.le.0.0_WP) then + n = n_loop + Ltemp = Tlast ! hopefully last iteration had better value + end if + end do + ! Update cv value using current temperature value + cv_l = this%spec_heat_liquid(Ltemp) + end if + + ! Mixture temperature + T = ((1.0_WP-vf%VF(i,j,k))*cv_g*this%Grho(i,j,k)*Gtemp & + +( vf%VF(i,j,k))*cv_l*this%Lrho(i,j,k)*Ltemp)& + /((1.0_WP-vf%VF(i,j,k))*cv_g*this%Grho(i,j,k) & + +( vf%VF(i,j,k))*cv_l*this%Lrho(i,j,k) ) + + return + end function get_local_temperature - function EOS_liquid(this,i,j,k,flag) result(property) + function EOS_liquid(this,i,j,k,flag,Ltemp) result(property) implicit none class(matm), intent(inout) :: this integer,intent(in) :: i,j,k character(len=1),intent(in) :: flag + real(WP), intent(in), optional :: Ltemp ! Just for getting cv real(WP) :: property select case(flag) @@ -187,9 +489,10 @@ function EOS_liquid(this,i,j,k,flag) result(property) property = this%LP(i,j,k)+this%Pref_l property = this%gamm_l/(1.0_WP-this%Lrho(i,j,k)*this%b_l)*property case('T') ! Temperature + if (present(Ltemp)) then; property = Ltemp; else; property = this%Tdefault; end if property = (-(1.0_WP-this%Lrho(i,j,k)*this%b_l)*this%Pref_l+this%LrhoE(i,j,k) & -0.5_WP*this%Lrho(i,j,k)*(this%LU(i,j,k)**2+this%LV(i,j,k)**2+this%LW(i,j,k)**2) & - -this%Lrho(i,j,k)*this%q_l) / (this%Lrho(i,j,k)*this%cv_l(i,j,k)) + -this%Lrho(i,j,k)*this%q_l) / (this%Lrho(i,j,k)*this%spec_heat_liquid(property)) case('v') ! (1/rho)(dp/de), for viscous pressure term property = (this%gamm_l-1.0_WP)/(1.0_WP-this%Lrho(i,j,k)*this%b_l) case('M') ! Bulk modulus calculated from conserved variables @@ -202,11 +505,12 @@ function EOS_liquid(this,i,j,k,flag) result(property) return end function EOS_liquid - function EOS_gas(this,i,j,k,flag) result(property) + function EOS_gas(this,i,j,k,flag,Gtemp) result(property) implicit none class(matm), intent(inout) :: this integer,intent(in) :: i,j,k character(len=1),intent(in) :: flag + real(WP), intent(in), optional :: Gtemp ! Just for getting cv real(WP) :: property select case(flag) @@ -219,9 +523,10 @@ function EOS_gas(this,i,j,k,flag) result(property) property = this%GP(i,j,k)+this%Pref_g property = this%gamm_g/(1.0_WP-this%Grho(i,j,k)*this%b_g)*property case('T') ! Temperature + if (present(Gtemp)) then; property = Gtemp; else; property = this%Tdefault; end if property = (-(1.0_WP-this%Grho(i,j,k)*this%b_g)*this%Pref_g+this%GrhoE(i,j,k) & -0.5_WP*this%Grho(i,j,k)*(this%GU(i,j,k)**2+this%GV(i,j,k)**2+this%GW(i,j,k)**2) & - -this%Grho(i,j,k)*this%q_g) / (this%Grho(i,j,k)*this%cv_g(i,j,k)) + -this%Grho(i,j,k)*this%q_g) / (this%Grho(i,j,k)*this%spec_heat_gas(property)) case('v') ! (1/rho)(dp/de), for viscous pressure term property = (this%gamm_g-1.0_WP)/(1.0_WP-this%Grho(i,j,k)*this%b_g) case('M') ! Bulk modulus calculated from conserved variables @@ -269,17 +574,51 @@ function EOS_temp(this,pres,dens,cv,phase) result(temp) return end function EOS_temp + + function EOS_pressure(this,temp,dens,cv,phase) result(pres) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: temp,dens,cv + character(len=*),intent(in) :: phase + real(WP) :: pres - function EOS_all(this,vf,buf_GrhoE,buf_LrhoE) result(buf_P) + select case(trim(adjustl(phase))) + case('liquid') + pres = temp*(dens*cv)*(this%gamm_l-1.0_WP)/(1.0_WP-dens*this%b_l)-this%Pref_l + case('gas') + pres = temp*(dens*cv)*(this%gamm_g-1.0_WP)/(1.0_WP-dens*this%b_g)-this%Pref_g + end select + + return + end function EOS_pressure + + function EOS_density(this,pres,temp,cv,phase) result(dens) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: pres,temp,cv + character(len=*),intent(in) :: phase + real(WP) :: dens + + select case(trim(adjustl(phase))) + case('liquid') + dens = (pres+this%Pref_l)/(cv*(this%gamm_l-1.0_WP)*temp+this%b_l*(pres+this%Pref_l)) + case('gas') + dens = (pres+this%Pref_g)/(cv*(this%gamm_g-1.0_WP)*temp+this%b_g*(pres+this%Pref_g)) + end select + + return + end function EOS_density + + function EOS_all(this,vf) result(buf_P) use vfs_class, only : vfs implicit none class(matm), intent(inout) :: this class(vfs), intent(inout) :: vf - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: buf_GrhoE,buf_LrhoE,buf_P + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: buf_P - buf_P = (1.0_WP-vf%VF)*((this%gamm_g-1.0_WP)/(1.0_WP-this%Grho*this%b_g)*(buf_GrhoE-0.5_WP* & + buf_P = (1.0_WP-vf%VF)*((this%gamm_g-1.0_WP)/(1.0_WP-this%Grho*this%b_g)*(this%GrhoE-0.5_WP* & this%Grho*(this%GU**2+this%GV**2+this%GW**2)-this%Grho*this%q_g)-this%gamm_g*this%Pref_g) + & - ( vf%VF)*((this%gamm_l-1.0_WP)/(1.0_WP-this%Lrho*this%b_l)*(buf_LrhoE-0.5_WP* & + ( vf%VF)*((this%gamm_l-1.0_WP)/(1.0_WP-this%Lrho*this%b_l)*(this%LrhoE-0.5_WP* & this%Lrho*(this%LU**2+this%LV**2+this%LW**2)-this%Lrho*this%q_l)-this%gamm_l*this%Pref_l) return @@ -385,6 +724,70 @@ subroutine EOS_relax_quad(this,i,j,k,myVF,srcVF,my_pjump,lbm,gbm,VF_terms,quad_t return end subroutine EOS_relax_quad + + subroutine EOS_thermal_relax_quad(this,i,j,k,myVF,my_pjump,cv_l,cv_g,VF_terms,quad_terms) + implicit none + class(matm), intent(inout) :: this + integer, intent(in) :: i,j,k + real(WP), intent(in) :: my_pjump,myVF,cv_l,cv_g + real(WP) :: KE + real(WP) :: n1,n0,d1,d0 + real(WP) :: re1,r1,cv1,b1,q1,g1,pr1,temp1 + real(WP) :: re2,r2,cv2,b2,q2,g2,pr2,temp2 + real(WP) :: a,b,c + real(WP), parameter :: phist = 1.0_WP + real(WP), parameter :: phi0 = 1.0_WP-phist + real(WP), dimension(4) :: VF_terms + real(WP), dimension(3) :: quad_terms + real(WP), dimension(2) :: Pint_terms + + ! Incoming quantities + ! myVF : local value of volume fraction + ! my_pjump: pressure jump from phase 1 to 2, i.e. liquid to gas + ! cv_l : specific heat of liquid phase + ! cv_g : specific heat of gas phase + + ! Outputs + ! a,b,c : coefficients for quadratic equation of phase 1 eq. pressure (quad_terms) + ! n1,n0,d1,d0 : coefficients for rational equation of phase 1 vol. frac. (VF_terms) + + ! Calculate kinetic energy without the density (assuming single velocity) + KE = 0.5_WP*(this%LU(i,j,k)**2+this%LV(i,j,k)**2+this%LW(i,j,k)**2) + + ! Liquid is fluid 1, Gas is fluid 2 + re1 = ( myVF)*(this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE) + re2 = (1.0_WP-myVF)*(this%GrhoE(i,j,k)-this%Grho(i,j,k)*KE) + r1 = ( myVF)*this%Lrho (i,j,k) + r2 = (1.0_WP-myVF)*this%Grho (i,j,k) + ! Rename property variables for brevity + b1 = this%b_l; b2 = this%b_g; g1 = this%gamm_l; g2 = this%gamm_g + q1 = this%q_l; q2 = this%q_g; pr1 = this%Pref_l; pr2 = this%Pref_g + cv1 = cv_l; cv2 = cv_g; + ! Intermediate terms + temp1 = (g1-1.0_WP)*r1*cv1 + temp2 = (g2-1.0_WP)*r2*cv2 + n1 = r1*b1*temp2 + (1.0_WP-r2*b2)*temp1 + n0 = pr1*r1*b1*temp2 + (pr2-my_pjump)*(1.0_WP-r2*b2)*temp1 + d1 = temp2 + temp1 + d0 = pr1*temp2 + (pr2-my_pjump)*temp1 + ! Terms in quadratic equation + a = n1*(1.0_WP/(g1-1.0_WP) - 1.0_WP/(g2-1.0_WP)) + & + d1*(-r1*b1/(g1-1.0_WP) + (1.0_WP-r2*b2)/(g2-1.0_WP)) + b = n1*(g1*pr1/(g1-1.0_WP) - (g2*pr2-my_pjump)/(g2-1.0_WP)) + & + d1*(-g1*pr1*r1*b1/(g1-1.0_WP) + (g2*pr2-my_pjump)*(1.0_WP-r2*b2)/(g2-1.0_WP) & + + r1*q1 + r2*q2 - re1 - re2) + & + n0*(1.0_WP/(g1-1.0_WP) - 1.0_WP/(g2-1.0_WP)) + & + d0*(-r1*b1/(g1-1.0_WP) + (1.0_WP-r2*b2)/(g2-1.0_WP)) + c = n0*(g1*pr1/(g1-1.0_WP) - (g2*pr2-my_pjump)/(g2-1.0_WP)) + & + d0*(-g1*pr1*r1*b1/(g1-1.0_WP) + (g2*pr2-my_pjump)*(1.0_WP-r2*b2)/(g2-1.0_WP) & + + r1*q1 + r2*q2 - re1 - re2) + ! Put into vector -> for result of Peq + quad_terms = (/a,b,c/) + ! Terms in new volume fraction equations -> for VF=(n1*Peq+n0)/(d1*Peq+d0) + VF_terms = (/n1,n0,d1,d0/) + + return + end subroutine EOS_thermal_relax_quad subroutine bulkmod_intf(this,i,j,k,rc2_l,rc2_g) implicit none @@ -498,8 +901,6 @@ subroutine fix_energy(this,vf,KE,PresH,my_pjump,i,j,k,Gflag,Lflag) PresH-( vf)*my_pjump & ), this%Grho(i,j,k),sqrt(2.0_WP*KE),0.0_WP,0.0_WP,'gas')) Gflag = .true. - ! Update temperature - !call compressible_therm_refresh_one(i,j,k) end if if (vf.gt.VFlo.and. & min(this%EOS_liquid(i,j,k,'p')+this%Pref_l,this%LrhoE(i,j,k)-this%Lrho(i,j,k)*KE).le.0.0_WP) then @@ -508,8 +909,6 @@ subroutine fix_energy(this,vf,KE,PresH,my_pjump,i,j,k,Gflag,Lflag) PresH+(1.0_WP-vf)*my_pjump & ), this%Lrho(i,j,k),sqrt(2.0_WP*KE),0.0_WP,0.0_WP,'liquid')) Lflag = .true. - ! Update temperature - !call compressible_therm_refresh_one(i,j,k) end if return diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 3ec928dd0..92f53a5f8 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -1760,9 +1760,9 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uxp-Uxm); dUdx(1,3)=this%cfg%dzi(k)*(Uxp-Uxm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vxp-Vxm); dUdx(2,3)=this%cfg%dzi(k)*(Vxp-Vxm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wxp-Wxm); dUdx(3,3)=this%cfg%dzi(k)*(Wxp-Wxm) + dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) + dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) + dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) ! Assemble the strain rate SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP diff --git a/src/two_phase/vfs_class.f90 b/src/two_phase/vfs_class.f90 index a92add3f8..ac2fee604 100644 --- a/src/two_phase/vfs_class.f90 +++ b/src/two_phase/vfs_class.f90 @@ -175,6 +175,7 @@ module vfs_class procedure :: distance_from_polygon !< Build a signed distance field from the polygonalized interface procedure :: subcell_vol !< Build subcell phasic volumes from reconstructed interface procedure :: reset_volume_moments !< Reconstruct volume moments from IRL interfaces + procedure :: reset_moments !< Reconstruct first-order moments from IRL interfaces procedure :: update_surfmesh !< Update a surfmesh object using current polygons procedure :: get_curvature !< Compute curvature from IRL surface polygons procedure :: paraboloid_fit !< Perform local paraboloid fit of IRL surface using IRL barycenter data @@ -604,7 +605,7 @@ end function locator if (new_bc%type.eq.neumann) call die('[vfs apply_bcond] Neumann requires a direction') new_bc%dir=0 end if - new_bc%itr=iterator(this%cfg,new_bc%name,locator) + new_bc%itr=iterator(this%cfg,new_bc%name,locator,'c') ! Insert it up front new_bc%next=>this%first_bc @@ -2510,6 +2511,48 @@ subroutine reset_volume_moments(this) end subroutine reset_volume_moments + ! Reset only moments, leave VF unchanged + subroutine reset_moments(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + type(RectCub_type) :: cell + type(SepVM_type) :: separated_volume_moments + + ! Calculate volume moments and store + call new(cell) + call new(separated_volume_moments) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Handle pure wall cells + if (this%mask(i,j,k).eq.1) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + cycle + end if + ! Form the grid cell + call construct_2pt(cell,[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + ! Cut it by the current interface(s) + call getNormMoments(cell,this%liquid_gas_interface(i,j,k),separated_volume_moments) + ! Recover relevant moments + this%Lbary(:,i,j,k)=getCentroid(separated_volume_moments,0) + this%Gbary(:,i,j,k)=getCentroid(separated_volume_moments,1) + ! Clean up + if (this%VF(i,j,k).lt.VFlo) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + if (this%VF(i,j,k).gt.VFhi) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + end do + end do + end do + + end subroutine reset_moments + !> Compute curvature from a least squares fit of the IRL surface subroutine get_curvature(this) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 72bf0c8a8..b6653a3c5 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -1355,9 +1355,9 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uxp-Uxm); dUdx(1,3)=this%cfg%dzi(k)*(Uxp-Uxm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vxp-Vxm); dUdx(2,3)=this%cfg%dzi(k)*(Vxp-Vxm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wxp-Wxm); dUdx(3,3)=this%cfg%dzi(k)*(Wxp-Wxm) + dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) + dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) + dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) ! Assemble the strain rate SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 46e5995b4..105e30b51 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -435,7 +435,7 @@ end function locator if (new_bc%type.eq.neumann) call die('[vdscalar apply_bcond] Neumann requires a direction') new_bc%dir=0 end if - new_bc%itr=iterator(this%cfg,new_bc%name,locator) + new_bc%itr=iterator(this%cfg,new_bc%name,locator,'c') ! Insert it up front new_bc%next=>this%first_bc From 6aed7dbaa1a38179363504d59fbffe40803794de Mon Sep 17 00:00:00 2001 From: Jesse Capecelatro <> Date: Mon, 7 Nov 2022 12:59:20 +0100 Subject: [PATCH 002/152] Shock-particle example case --- examples/shock_particle/GNUmakefile | 49 ++ examples/shock_particle/README | 1 + examples/shock_particle/input | 43 ++ examples/shock_particle/src/Make.package | 2 + examples/shock_particle/src/geometry.f90 | 81 +++ examples/shock_particle/src/simulation.f90 | 589 +++++++++++++++++++++ 6 files changed, 765 insertions(+) create mode 100644 examples/shock_particle/GNUmakefile create mode 100644 examples/shock_particle/README create mode 100644 examples/shock_particle/input create mode 100644 examples/shock_particle/src/Make.package create mode 100644 examples/shock_particle/src/geometry.f90 create mode 100644 examples/shock_particle/src/simulation.f90 diff --git a/examples/shock_particle/GNUmakefile b/examples/shock_particle/GNUmakefile new file mode 100644 index 000000000..676358efc --- /dev/null +++ b/examples/shock_particle/GNUmakefile @@ -0,0 +1,49 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre +IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase particles data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/shock_particle/README b/examples/shock_particle/README new file mode 100644 index 000000000..098c2471d --- /dev/null +++ b/examples/shock_particle/README @@ -0,0 +1 @@ +This is a test case for a shock wave interacting with Lagrangian particles. Uses multiphase solver and hard-codes VF to 0 or 1 based on chosen phase. diff --git a/examples/shock_particle/input b/examples/shock_particle/input new file mode 100644 index 000000000..84d7a4c90 --- /dev/null +++ b/examples/shock_particle/input @@ -0,0 +1,43 @@ +# Parallelization +Partition : 3 1 1 + +# Mesh definition +Lx : 0.2048 +nx : 512 +Ly : 0.0256 +ny : 64 + +# Flow setup +Shock location : 0.08 +Mach number of shock : 1.47 +Pre-shock density : 1.204 +Pre-shock pressure : 1.01325e5 +Particle volume fraction : 0.2 +Particle curtain width : 0.0034 + +# Fluid properties +Phase : gas +Dynamic viscosity : 1.8e-5 +Thermal conductivity : 0 +Gamma : 1.4 + +# Particle parameters +Particle density : 1000 +Particle diameter : 200e-6 + +# Time integration +Max timestep size : 8e-7 +Max cfl number : 0.9 +Max time : 100000 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 10e-6 diff --git a/examples/shock_particle/src/Make.package b/examples/shock_particle/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/shock_particle/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/shock_particle/src/geometry.f90 b/examples/shock_particle/src/geometry.f90 new file mode 100644 index 000000000..736845194 --- /dev/null +++ b/examples/shock_particle/src/geometry.f90 @@ -0,0 +1,81 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read, param_exists + use parallel, only: amRoot + use messager, only: die + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + dx = Lx/nx + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nz',nz,default=1); allocate(z(nz+1)) + + if (nz.eq.1) then + Lz = dx + else + call param_read('Lz',Lz) + end if + + ! Uniform grid + do i=1,nx+1 + x(i) = real(i-1,WP)*dx + end do + do j=1,ny+1 + y(j) = real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + + ! z is always uniform + do k=1,nz+1 + z(k) = real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='ShockTube') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 new file mode 100644 index 000000000..b9863098e --- /dev/null +++ b/examples/shock_particle/src/simulation.f90 @@ -0,0 +1,589 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use mast_class, only: mast + use vfs_class, only: vfs + use matm_class, only: matm + use lpt_class, only: lpt + use partmesh_class, only: partmesh + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Single two-phase flow solver, volume fraction solver, material model, and LPT solver set + !> With corresponding time tracker + type(mast), public :: fs + type(vfs), public :: vf + type(matm), public :: matmod + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,cvgfile + type(monitor) :: lptfile + + public :: simulation_init,simulation_run,simulation_final + + !> Problem definition + character(len=str_medium) :: phase + integer :: relax_model + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resE + real(WP), dimension(:,:,:), allocatable :: dRHOdt + + contains + + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_of_domain + + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + call param_read('Max steps',time%nmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resE (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT + initialize_lpt: block + use random, only: random_uniform + use mathtools, only: Pi + use parallel, only: amRoot + real(WP) :: dp,VFp,L,x0,vol,volp + integer :: i,np + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Get particle diameter from the input + call param_read('Particle diameter',dp) + ! Get particle volume fraction from the input + call param_read('Particle volume fraction',VFp) + ! Get curtain width from the input + call param_read('Particle curtain width',L) + ! Get starting position + x0=0.5_WP*(lp%cfg%x(lp%cfg%imax+1)-lp%cfg%x(lp%cfg%imin)-L) + ! Get number of particles + vol=L*lp%cfg%yL*lp%cfg%zL + volp=Pi*dp**3/6.0_WP + np=int(VFp * vol / volp) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Root process initializes np particles randomly + if (lp%cfg%amRoot) then + call lp%resize(np) + do i=1,np + ! Give id + lp%p(i)%id=int(i,8) + ! Set the diameter + lp%p(i)%d=dp + ! Assign random position in the domain + lp%p(i)%pos=[random_uniform(x0,x0+L),& + & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& + & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] + if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin) + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%col=0.0_WP + ! Give it temperature + lp%p(i)%T=293.15_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Locate the particle on the mesh + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + ! Activate the particle + lp%p(i)%flag=0 + end do + end if + ! Distribute particles + call lp%sync() + ! Get initial particle volume fraction + call lp%update_VF() + ! Set collision timescale + lp%Tcol=5.0_WP*time%dt + if (amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', np + print*,'Mean volume fraction',vfp + end if + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + pmesh=partmesh(nvar=0,name='lpt') + call lp%update_partmesh(pmesh) + end block create_pmesh + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver with lvira reconstruction + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') + call param_read('Phase',phase) + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + select case(trim(phase)) + case('gas') + vf%VF(i,j,k)=0.0_WP + case('liquid') + vf%VF(i,j,k)=1.0_WP + case default + end select + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end do + end do + end do + ! Boundary conditions on VF are built into the mast solver + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Set initial interface at the boundaries + call vf%set_full_bcond() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a compressible two-phase flow solver + create_and_initialize_flow_solver: block + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz + use matm_class, only : air + use ils_class, only: pcg_bbox,gmres_smg + use mathtools, only: Pi + use parallel, only: amRoot + integer :: i,j,k,n + real(WP), dimension(3) :: xyz + real(WP) :: gamm,Pref,visc,hdff + real(WP) :: xshock,vshock,relshockvel + real(WP) :: rho0, P0, rho1, P1, Ma1, Ma, rho, P, U + type(bcond), pointer :: mybc + ! Create material model class + matmod=matm(cfg=cfg,name='Liquid-gas models') + ! Get EOS parameters from input + call param_read('Gamma',gamm) + ! Register equations of state + select case(trim(phase)) + case('gas') + call matmod%register_idealgas('gas',gamm) + case('liquid') + call param_read('Liquid Pref', Pref) + call matmod%register_stiffenedgas('liquid',gamm,Pref) + end select + ! Create flow solver + fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) + ! Register flow solver variables with material models + call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) + call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) + ! Assign constant viscosity, also heat diffusion + call param_read('Dynamic viscosity',visc) + call param_read('Thermal conductivity',hdff) + select case(trim(phase)) + case('gas') + call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscconst_gas=visc, & + viscconst_liquid=0.0_WP, hdffconst_gas=hdff, hdffconst_liquid=0.0_WP) + fs%Lrho = 0.0_WP + fs%LrhoE= 0.0_WP + case('liquid') + call matmod%register_diffusion_thermo_models(viscconst_gas=0.0_WP, viscconst_liquid=visc, & + hdffconst_gas=0.0_WP, hdffconst_liquid=hdff) + fs%Grho = 0.0_WP + end select + ! Read in surface tension coefficient + fs%sigma=0.0_WP + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit momentum solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) + ! Initially 0 velocity in y and z + fs%Vi = 0.0_WP; fs%Wi = 0.0_WP + ! Zero face velocities as well for the sake of dirichlet boundaries + fs%V = 0.0_WP; fs%W = 0.0_WP + ! Set up initial thermo properties (0) + ! Default is from Meng & Colonius (2015), + ! which is basically the same as Igra & Takayama and Terashima & Tryggvason + call param_read('Pre-shock density',rho0,default=1.204_WP) + call param_read('Pre-shock pressure',P0,default=1.01325e5_WP) + call param_read('Mach number of shock',Ma,default=1.47_WP) + call param_read('Shock location',xshock) + ! Use shock relations to get post-shock numbers (1) + P1 = P0 * (2.0_WP*gamm*Ma**2 - (gamm-1.0_WP)) / (gamm+1.0_WP) + rho1 = rho0 * (Ma**2 * (gamm+1.0_WP) / ((gamm-1.0_WP)*Ma**2 + 2.0_WP)) + ! Calculate post-shock Mach number + Ma1 = sqrt(((gamm-1.0_WP)*(Ma**2)+2.0_WP)/(2.0_WP*gamm*(Ma**2)-(gamm-1.0_WP))) + ! Calculate post-shock velocity + vshock = -Ma1 * sqrt(gamm*P1/rho1) + Ma*sqrt(gamm*P0/rho0) + ! Velocity at which shock moves + relshockvel = -rho1*vshock/(rho0-rho1) + + if (amRoot) then + print*,"===== Fluid Setup Description =====" + print*,'Mach number', Ma + print*,'Pre-shock: Density',rho0,'Pressure',P0 + print*,'Post-shock: Density',rho1,'Pressure',P1,'Velocity',vshock + print*,'Shock velocity', relshockvel + end if + + ! Initialize gas phase quantities + do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! pressure, velocity, use matmod for energy + if (fs%cfg%x(i).lt.xshock) then + rho = rho1 + U = vshock + P = P1 + else + rho = rho0 + U = 0.0_WP + P = P0 + end if + select case(trim(phase)) + case('gas') + fs%Grho(i,:,:) = rho + fs%Ui(i,:,:) = U + fs%GrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'gas') + case('liquid') + fs%Lrho(i,:,:) = rho + fs%Ui(i,:,:) = U + fs%LrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'liquid') + end select + end do + + ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers + call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1) + call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1) + + ! Calculate face velocities + call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) + ! Apply face BC - inflow + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%n_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=vshock + end do + ! Apply face BC - outflow + bc_scope = 'velocity' + call fs%apply_bcond(time%dt,bc_scope) + + ! Calculate mixture density and momenta + fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho + fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi + ! Perform initial pressure relax + relax_model = mech_egy_mech_hhz + call fs%pressure_relax(vf,matmod,relax_model) + ! Calculate initial phase and bulk moduli + call fs%init_phase_bulkmod(vf,matmod) + call fs%reinit_phase_pressure(vf,matmod) + call fs%harmonize_advpressure_bulkmod(vf,matmod) + ! Set initial pressure to harmonized field based on internal energy + fs%P = fs%PA + + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ShockTube') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) + call ens_out%add_scalar('T',fs%Tmptr) + call ens_out%add_scalar('P',fs%P) + call ens_out%add_scalar('PA',fs%PA) + call ens_out%add_scalar('Density',fs%RHO) + call ens_out%add_scalar('Bulkmod',fs%RHOSS2) + call ens_out%add_scalar('divU',fs%divU) + call ens_out%add_scalar('Viscosity',fs%visc) + call ens_out%add_scalar('Sensor',fs%sl_x) + call ens_out%add_particle('particles',pmesh) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%RHOmin,'RHOmin') + call mfile%add_column(fs%RHOmax,'RHOmax') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%Tmax,'Tmax') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLa_x,'Acoustic xCFL') + call cflfile%add_column(fs%CFLa_y,'Acoustic yCFL') + call cflfile%add_column(fs%CFLa_z,'Acoustic zCFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%VFmean,'VFp_mean') + call lptfile%add_column(lp%VFmax,'VFp_max') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + use messager, only: die + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Reinitialize phase pressure by syncing it with conserved phase energy + call fs%reinit_phase_pressure(vf,matmod) + fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi + fs%RHOold = fs%RHO + ! Remember old flow variables (phase) + fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho + fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE + fs%GPold = fs%GP; fs%LPold = fs%LP + + ! Remember old interface, including VF and barycenters + call vf%copy_interface_to_old() + + ! Create in-cell reconstruction + call fs%flow_reconstruct(vf) + + ! Zero variables that will change during subiterations + fs%P = 0.0_WP + fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP + fs%Hpjump = 0.0_WP + + ! Determine semi-Lagrangian advection flag + call fs%flag_sl(time%dt,vf) + + ! Collide and advance particles + call lp%collide(dt=time%dtmid) + resU=fs%rho + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) + + ! Update density based on particle volume fraction + fs%rho=resU*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Add momentum source term from lpt (cell-centered) + add_lpt_src: block + integer :: i,j,k + resU=0.0_WP; resV=0.0_WP; resW=0.0_WP; resE=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+lp%srcU(i,j,k) + resV(i,j,k)=resV(i,j,k)+lp%srcV(i,j,k) + resW(i,j,k)=resW(i,j,k)+lp%srcW(i,j,k) + resE(i,j,k)=resE(i,j,k)+lp%srcE(i,j,k) + end do + end do + end do + end block add_lpt_src + + ! Predictor step, involving advection and pressure terms + call fs%advection_step(time%dt,vf,matmod) + + ! Viscous step + call fs%diffusion_src_explicit_step(time%dt,vf,matmod,srcU=resU,srcV=resV,srcW=resW,srcE=resE) + + ! Prepare pressure projection + call fs%pressureproj_prepare(time%dt,vf,matmod) + ! Initialize and solve Helmholtz equation + call fs%psolv%setup() + fs%psolv%sol=fs%PA-fs%P + call fs%psolv%solve() + call fs%cfg%sync(fs%psolv%sol) + ! Perform corrector step using solution + fs%P=fs%P+fs%psolv%sol + call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + + ! Record convergence monitor + call cvgfile%write() + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Pressure relaxation + call fs%pressure_relax(vf,matmod,relax_model) + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=0.5_WP*lp%p(i)%d + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,resE,dRHOdt) + + end subroutine simulation_final + +end module simulation From ecbfe6209c7a4273277ec713508a1378c6afc423 Mon Sep 17 00:00:00 2001 From: Jesse Capecelatro <> Date: Mon, 7 Nov 2022 13:14:47 +0100 Subject: [PATCH 003/152] Some updates to Makefiles --- .gitignore | 3 +- tools/GNUMake/Make.defs | 6 +-- tools/GNUMake/Make.local | 71 ++++++++++++++++++++++++++++++ tools/GNUMake/packages/Make.irl | 2 +- tools/GNUMake/packages/Make.lapack | 6 ++- 5 files changed, 82 insertions(+), 6 deletions(-) create mode 100644 tools/GNUMake/Make.local diff --git a/.gitignore b/.gitignore index 75378f498..31ec775b7 100644 --- a/.gitignore +++ b/.gitignore @@ -40,7 +40,8 @@ stat/ # Ignore all content of examples examples/*/* !examples/*/GNUmakefile -!examples/*/input +!examples/*/input* +examples/*/input*~ !examples/*/README !examples/*/src !examples/*/*.py diff --git a/tools/GNUMake/Make.defs b/tools/GNUMake/Make.defs index d7880f522..2ff6b8a48 100644 --- a/tools/GNUMake/Make.defs +++ b/tools/GNUMake/Make.defs @@ -72,10 +72,10 @@ FORTLINK = UNDERSCORE # Fortran preprocessor FORT_CPP = cpp -E -traditional-cpp -P # Scripts for building dependencies -MKDEP = perl $(NGA_HOME)/tools/scripts/mkdep.pl -MODDEP = $(NGA_HOME)/tools/scripts/dep.py +MKDEP = perl $(NGA_HOME)/tools/scripts/mkdep.pl +MODDEP = $(NGA_HOME)/tools/scripts/dep.py FORTPREP = perl $(NGA_HOME)/Tools/scripts/strip72 -c -F90PREP = cat # a placeholder in case we have to write something later +F90PREP = cat # a placeholder in case we have to write something later CPP_PREFIX = CHECKFORT = $(NGA_HOME)/tools/typechecker/typechecker.py MKCONFIG = $(NGA_HOME)/tools/libamrex/mkconfig.py diff --git a/tools/GNUMake/Make.local b/tools/GNUMake/Make.local new file mode 100644 index 000000000..e0b436202 --- /dev/null +++ b/tools/GNUMake/Make.local @@ -0,0 +1,71 @@ +# +# Template for your own Make.local. +# +# If it exists, the Make.local file is included at the end of +# Make.defs. Thus one can override various variables here. +# +# Do not check this file into git repo. This is supposed to be purely local. +# +# Here are some examples. +# + +# Maybe AMReX fails to configure makefile for MPI on your machine. You could set MPI stuff here, +# and then compile with NO_MPI_CHECKING=TRUE to tell AMReX not to check MPI stuff. +# +# Wrappers for C++, C and Fortran compilers. +CXX := mpicxx +CC := mpicc +FC := mpifort +F90 := mpifort +# AMReX uses MPI in both C++ and Fortran. Because CXX is used for linking, you MAY need to +# provide path to MPI Fortran library. +#LIBRARIES += -lmpif90 + + +# Always have verbosity on even if GNUmakefile set it to FALSE. +VERBOSE=TRUE + + +# By default ccache is not used unless USE_CCACHE is TRUE. +# But I want the opposite. That is ccache is used by default unless +# USE_CCACHE is FALSE. But if I am using UPC++, I would like to turn +# ccache off. +ifeq ($(USE_CCACHE),FALSE) + CCACHE = +else ifeq ($(USE_UPCXX),TRUE) + CCACHE = +else + CCACHE = ccache +endif + + +# When I run on my local desktop, I like to add this gfortran flag. +FFLAGS += -fcheck=array-temps +F90FLAGS += -fcheck=array-temps + + +# Instead of linking to static gfortran library, I like to use shared libraries. +gfortran_libso_dir := $(dir $(shell $(F90) -print-file-name=libgfortran.so)) +LIBRARY_LOCATIONS += $(gfortran_libso_dir) +gfortran_lib = -lgfortran +quadmath_lib = -lquadmath + + +# `make print-CXXFLAGS` shows "-O0" is used. I would like to replace it with "-O2". +# Note that `:=` is needed to avoid recursive references. +CXXFLAGS := $(subst -O0,-O2,$(CXXFLAGS)) + + +# I don't like the CFLAGS shown by `print-CFLAGS`. So I am going to +# completely replace it with my own flags. +CFLAGS = MY_AWESOME_CFLAGS + + +# This compiler has a bug. I have to remove an option from CXXFLAGS. +# The variable lowercase_comp is defined in Make.defs and it's the +# lower case version of $COMP. Note that we are moving toward +# C++11/14. So disabling C++11 is not an option. This is just an +# example. +ifeq ($(lowercase_comp),pg?compiler) + CXXFLAGS := $(filter-out --c++11,$(CXXFLAGS)) +endif diff --git a/tools/GNUMake/packages/Make.irl b/tools/GNUMake/packages/Make.irl index 45f700a8c..0e7a9278d 100644 --- a/tools/GNUMake/packages/Make.irl +++ b/tools/GNUMake/packages/Make.irl @@ -2,7 +2,7 @@ ifdef IRL_DIR INCLUDE_LOCATIONS += $(IRL_DIR)/include/irl_fortran LIBRARY_LOCATIONS += $(IRL_DIR)/lib - LIBRARIES += -lirl_fortran -lirl_c -lirl -labsl_all -lstdc++ + LIBRARIES += -lirl_fortran -lirl_c -lirl -labsl_all -lc++ ifeq ($(os_name), Darwin) LIBRARIES += -framework CoreFoundation endif diff --git a/tools/GNUMake/packages/Make.lapack b/tools/GNUMake/packages/Make.lapack index c4e8a941f..af9eb6a02 100644 --- a/tools/GNUMake/packages/Make.lapack +++ b/tools/GNUMake/packages/Make.lapack @@ -3,5 +3,9 @@ ifdef LAPACK_DIR LIBRARY_LOCATIONS += $(LAPACK_DIR)/lib LIBRARIES += -llapack -lblas else - $(error LAPACK_DIR not defined, but it is currently required by NGA2) + ifeq ($(os_name), Darwin) + LIBRARIES += -framework Accelerate + else + $(error LAPACK_DIR not defined, but it is currently required by NGA2) + endif endif From 23fd21b42e46b071f0f8abc677d41d8bffb26d86 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 7 Nov 2022 14:10:18 +0100 Subject: [PATCH 004/152] Example MAST cases from Olivier's develop branch Example MAST cases from Olivier's develop branch --- examples/MAST_drop/GNUmakefile | 49 ++ examples/MAST_drop/README | 1 + examples/MAST_drop/input_gravity | 43 ++ examples/MAST_drop/input_inertial | 44 ++ examples/MAST_drop/input_spcurr | 39 ++ examples/MAST_drop/input_thermcyl | 53 ++ examples/MAST_drop/src/Make.package | 2 + examples/MAST_drop/src/geometry.f90 | 76 +++ examples/MAST_drop/src/simulation.f90 | 746 ++++++++++++++++++++++++++ 9 files changed, 1053 insertions(+) create mode 100644 examples/MAST_drop/GNUmakefile create mode 100644 examples/MAST_drop/README create mode 100644 examples/MAST_drop/input_gravity create mode 100644 examples/MAST_drop/input_inertial create mode 100644 examples/MAST_drop/input_spcurr create mode 100644 examples/MAST_drop/input_thermcyl create mode 100644 examples/MAST_drop/src/Make.package create mode 100644 examples/MAST_drop/src/geometry.f90 create mode 100644 examples/MAST_drop/src/simulation.f90 diff --git a/examples/MAST_drop/GNUmakefile b/examples/MAST_drop/GNUmakefile new file mode 100644 index 000000000..bbd127241 --- /dev/null +++ b/examples/MAST_drop/GNUmakefile @@ -0,0 +1,49 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HYPRE_DIR = /Users/mbk225/NGA_libs/hypre +LAPACK_DIR= /Users/mbk225/NGA_libs/lapack +IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/MAST_drop/README b/examples/MAST_drop/README new file mode 100644 index 000000000..326623053 --- /dev/null +++ b/examples/MAST_drop/README @@ -0,0 +1 @@ +This is a versatile test case intended for verifying and quantifying simple aspects of the MAST solver: thermal diffusion, gravity, advection, and surface tension (spurious currents). \ No newline at end of file diff --git a/examples/MAST_drop/input_gravity b/examples/MAST_drop/input_gravity new file mode 100644 index 000000000..340899ec7 --- /dev/null +++ b/examples/MAST_drop/input_gravity @@ -0,0 +1,43 @@ +# Parallelization +Partition : 1 1 1 + +# Mesh definition +Lx : 1 +Ly : 1 +nx : 32 +ny : 32 + +# Flow setup +Droplet diameter : 0.4 +Background pressure : 1.01325e5 +Gravity : 0 -9.81 0 + +# Fluid properties +Liquid dynamic viscosity : 0 +Gas dynamic viscosity : 0 +Liquid gamma : 4.4 +Liquid Pref : 6e8 +Gas gamma : 1.4 + +# Initial conditions +Liquid density : 1000 +Gas density : 1.2 +Surface tension coefficient : 0 + +# Time integration +Max timestep size : 1e-2 +Max cfl number : 0.9 +Max time : 1 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 +Implicit solver : blackbox + +# Ensight output +Ensight output period : 1e-1 diff --git a/examples/MAST_drop/input_inertial b/examples/MAST_drop/input_inertial new file mode 100644 index 000000000..d2b54926d --- /dev/null +++ b/examples/MAST_drop/input_inertial @@ -0,0 +1,44 @@ +# Case is intended as a useful sanity check, can also +# be used as a verification test when density ratio is >= 10^6 +Gas velocity : 0.0 0 0 +Liquid velocity : 1.0 0 0 +Gas density : 1.0 +Liquid density : 1000.0 +Surface tension coefficient : 0 + +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 1 +Ly : 1 +nx : 64 +ny : 64 + +# Flow setup +Droplet diameter : 0.2 +Background pressure : 1.01325e5 + +# Fluid properties +Liquid dynamic viscosity : 0 +Gas dynamic viscosity : 0 +Liquid gamma : 4.4 +Liquid Pref : 6e8 +Gas gamma : 1.4 + +# Time integration +Max timestep size : 5e-3 +Max cfl number : 0.9 +Max time : 1 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-10 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-10 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 5e-2 diff --git a/examples/MAST_drop/input_spcurr b/examples/MAST_drop/input_spcurr new file mode 100644 index 000000000..11240c526 --- /dev/null +++ b/examples/MAST_drop/input_spcurr @@ -0,0 +1,39 @@ +# Parallelization +Partition : 1 1 1 + +# Mesh definition +Lx : 2 +Ly : 2 +nx : 20 +ny : 20 + +# Flow setup and initial conditions +Droplet diameter : 1 +Gas sound speed : 1e2 +Liquid density : 1000 +Gas density : 1 +Surface tension coefficient : 1e4 + +# Fluid properties +Liquid dynamic viscosity : 1 +Gas dynamic viscosity : 1 +Liquid gamma : 4.4 +Liquid Pref : 6e8 +Gas gamma : 1.4 + +# Time integration +Max timestep size : 3.7e-5 +Max cfl number : 0.9 +Max time : 2.5e-1 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-3 diff --git a/examples/MAST_drop/input_thermcyl b/examples/MAST_drop/input_thermcyl new file mode 100644 index 000000000..b6cf35d95 --- /dev/null +++ b/examples/MAST_drop/input_thermcyl @@ -0,0 +1,53 @@ +# From Kuhn & Desjardins JCP (2021) +# Case 1 is with uniform velocity of 0.2, inviscid, no surface tension, dt=2.5e-2 (paper has typo) +# Case 2 is quiescent, viscosity of 0.1 in both phases, surface tension of 1000, dt=5e-4 +Gas velocity : 0.2 0 0 +Liquid velocity : 0.2 0 0 +Liquid dynamic viscosity : 0 !0.1 +Gas dynamic viscosity : 0 !0.1 +Surface tension coefficient : 0 !1000 +Max timestep size : 2.5e-2 !5e-4 + +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 2 +Ly : 2 +nx : 200 +ny : 200 + +# Flow setup +Droplet diameter : 0.4 + +# Fluid properties +Liquid gamma : 1.19 +Liquid Pref : 7.028e8 +Liquid b : 6.61e-4 +Liquid q : -1.178e6 +Liquid spec heat : 4130 +Liquid therm cond : 1 +Gas gamma : 1.4 +Gas spec heat : 718 +Gas therm cond : 0.5 + +# Initial conditions +Background pressure: 1e5 +Gas temperature: 300 +Liquid temperature: 350 + +# Time integration +Max cfl number : 0.9 +Max time : 49.99999 +Max steps : 10000000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 0.9999999 diff --git a/examples/MAST_drop/src/Make.package b/examples/MAST_drop/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/MAST_drop/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/MAST_drop/src/geometry.f90 b/examples/MAST_drop/src/geometry.f90 new file mode 100644 index 000000000..6b9d5b9d3 --- /dev/null +++ b/examples/MAST_drop/src/geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read,param_exists + use mathtools, only: pi + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + + ! Read in grid definition: can be 2D or 3D + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + if (param_exists('nz')) then + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + else + Lz = Lx/nx; nz = 1; allocate(z(nz+1)) + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='MASTdrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/MAST_drop/src/simulation.f90 b/examples/MAST_drop/src/simulation.f90 new file mode 100644 index 000000000..ecd371d3d --- /dev/null +++ b/examples/MAST_drop/src/simulation.f90 @@ -0,0 +1,746 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use mast_class, only: mast + use vfs_class, only: vfs + use matm_class, only: matm + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver, volume fraction solver, and material model set + !> With corresponding time tracker + type(mast), public :: fs + type(vfs), public :: vf + type(matm), public :: matmod + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,dfile,cflfile,consfile,cvgfile + + public :: simulation_init,simulation_run,simulation_final + + !> Choice of relaxation model + integer :: relax_model + !> Problem definition + real(WP) :: ddrop + logical :: yes_Temp + + !> Monitor output variables + real(WP) :: xd,yd,zd, vmag2, vmaginf + real(WP) :: LV0,mass0,mom0_x,mom0_y,mom0_z,totegy0 + real(WP) :: LVdiff,massdiff,momdiff_x,momdiff_y,momdiff_z,totegydiff + +contains + + !> Updates quantities specific to the monitor of this case + subroutine mast_drop_update() + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + real(WP) :: md, vol_tot, buf + integer :: ierr,i,j,k + + ! Initialize + vol_tot = 0.0_WP + md = 0.0_WP + xd = 0.0_WP; yd = 0.0_WP; zd = 0.0_WP + vmag2 = 0.0_WP; vmaginf = 0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + ! Volume (for normalizing) + vol_tot = vol_tot + fs%cfg%vol(i,j,k) + ! Mass (for normalizing) + md = md + fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*fs%Lrho(i,j,k) + ! Position of liquid (multiplied by mass) + xd = xd + vf%Lbary(1,i,j,k)*fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*fs%Lrho(i,j,k) + yd = yd + vf%Lbary(2,i,j,k)*fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*fs%Lrho(i,j,k) + zd = zd + vf%Lbary(3,i,j,k)*fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*fs%Lrho(i,j,k) + ! Velocity norms + vmag2 = vmag2 + fs%cfg%vol(i,j,k)*(fs%Ui(i,j,k)**2+fs%Vi(i,j,k)**2+fs%Wi(i,j,k)**2) + vmaginf = max(vmaginf,sqrt(fs%Ui(i,j,k)**2+fs%Vi(i,j,k)**2+fs%Wi(i,j,k)**2)) + end do + end do + end do + ! Normalizing quantities + call MPI_ALLREDUCE(vol_tot,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); vol_tot = buf; + call MPI_ALLREDUCE(md,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); md = buf; + ! Droplet position + call MPI_ALLREDUCE(xd,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); xd = buf/md; + call MPI_ALLREDUCE(yd,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); yd = buf/md; + call MPI_ALLREDUCE(zd,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); zd = buf/md; + ! Velocity norms + call MPI_ALLREDUCE(vmag2,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); vmag2 = sqrt(buf/vol_tot); + call MPI_ALLREDUCE(vmaginf,buf,1,MPI_REAL_WP,MPI_MAX,fs%cfg%comm,ierr); vmaginf = buf; + + end subroutine mast_drop_update + + !> Updates quantities specific to the monitor of this case + subroutine conservation_update() + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + real(WP) :: vol_tot, buf + integer :: ierr,i,j,k + + ! Initialize + vol_tot = 0.0_WP + LVdiff = 0.0_WP; massdiff = 0.0_WP; totegydiff = 0.0_WP + momdiff_x = 0.0_WP; momdiff_y = 0.0_WP; momdiff_z = 0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + ! Volume (for normalizing) + vol_tot = vol_tot + fs%cfg%vol(i,j,k) + ! Liquid volume + LVdiff = LVdiff + fs%cfg%vol(i,j,k)*vf%VF(i,j,k) + ! Mass + massdiff = massdiff + fs%cfg%vol(i,j,k)*fs%RHO(i,j,k) + ! Momentum + momdiff_x = momdiff_x + fs%cfg%vol(i,j,k)*fs%rhoUi(i,j,k) + momdiff_y = momdiff_y + fs%cfg%vol(i,j,k)*fs%rhoVi(i,j,k) + momdiff_z = momdiff_z + fs%cfg%vol(i,j,k)*fs%rhoWi(i,j,k) + ! Total energy + totegydiff = totegydiff + fs%cfg%vol(i,j,k)*(vf%VF(i,j,k)*fs%LrhoE(i,j,k)+(1.0-vf%VF(i,j,k))*fs%GrhoE(i,j,k)) + end do + end do + end do + + ! Parallel sums + call MPI_ALLREDUCE(vol_tot,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); vol_tot = buf; + ! Normalizing quantities is not necessary, but makes things more understandable + call MPI_ALLREDUCE(LVdiff,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); LVdiff = buf/vol_tot; + call MPI_ALLREDUCE(massdiff,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); massdiff = buf/vol_tot; + call MPI_ALLREDUCE(momdiff_x,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); momdiff_x = buf/vol_tot; + call MPI_ALLREDUCE(momdiff_y,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); momdiff_y = buf/vol_tot; + call MPI_ALLREDUCE(momdiff_z,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); momdiff_z = buf/vol_tot; + call MPI_ALLREDUCE(totegydiff,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); totegydiff = buf/vol_tot; + ! Subtract for differences + LVdiff = LVdiff - LV0 + massdiff = massdiff - mass0 + momdiff_x = momdiff_x - mom0_x; momdiff_y = momdiff_y - mom0_y; momdiff_z = momdiff_z - mom0_z + totegydiff = totegydiff - totegy0 + + end subroutine conservation_update + + !> Function that defines a level set function for a spherical droplet at center + function levelset_drop_center(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=1.0_WP-sqrt(xyz(1)**2+xyz(2)**2+xyz(3)**2)/(ddrop/2.0) + end function levelset_drop_center + + function levelset_cyl_center(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=1.0_WP-sqrt((xyz(1)/ddrop*2.0_WP)**2+(xyz(2)/ddrop*2.0_WP)**2) + end function levelset_cyl_center + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read,param_exists + implicit none + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + call param_read('Max steps',time%nmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver with lvira reconstruction + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') + ! Initialize liquid at left + call param_read('Droplet diameter',ddrop) + ! Droplet always initialized at center + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + if (vf%cfg%nz.eq.1) then + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_cyl_center,0.0_WP,amr_ref_lvl) + else + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_drop_center,0.0_WP,amr_ref_lvl) + end if + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + if (vf%cfg%nz.eq.1) vf%Gbary(3,i,j,k)=v_cent(3); + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Set interface at the boundaries + call vf%set_full_bcond() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a compressible two-phase flow solver + create_and_initialize_flow_solver: block + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz,thermmech_egy_mech_hhz + use ils_class, only: pcg_bbox,pcg_amg + use mathtools, only: Pi + use parallel, only: amRoot + use string, only: str_medium + integer :: i,j,k,impl_option + real(WP) :: gamm_l,Pref_l,gamm_g,visc_l,visc_g,hdff_l,hdff_g,cv_l,cv_g,b_l,q_l + real(WP) :: GSS, GP0, LP0, Grho0, Lrho0, GTemp0, LTemp0 + real(WP), dimension(3) :: u_g,u_l,u_mix + character(len=str_medium) :: impl_str + ! Create material model class + matmod=matm(cfg=cfg,name='Liquid-gas models') + ! Get EOS parameters from input + call param_read('Liquid gamma',gamm_l) + call param_read('Liquid Pref', Pref_l) + call param_read('Gas gamma',gamm_g) + ! Check if NASG EOS is being used + b_l = 0.0_WP + if (param_exists('Liquid b')) then + call param_read('Liquid b', b_l) + call param_read('Liquid q', q_l) + end if + ! Register equations of state + if (b_l .eq. 0.0_WP) then + call matmod%register_stiffenedgas('liquid',gamm_l,Pref_l) + else + call matmod%register_NobleAbelstiffenedgas('liquid',gamm_l,Pref_l,q_l,b_l) + end if + call matmod%register_idealgas('gas',gamm_g) + ! Create flow solver + fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) + ! Register flow solver variables with material models + call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) + call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',visc_l) + call param_read('Gas dynamic viscosity',visc_g) + ! Set heat diffusion to 0 unless specified + hdff_l = 0.0_WP; hdff_g = 0.0_WP + if (param_exists('Liquid therm cond')) then + call param_read('Liquid therm cond', hdff_l) + call param_read('Gas therm cond', hdff_g) + end if + ! Set specific heat to default unless specified + cv_l = matmod%cv_l0; cv_g = matmod%cv_g0 + if (param_exists('Liquid spec heat')) then + call param_read('Liquid spec heat', cv_l) + call param_read('Gas spec heat', cv_g) + end if + call matmod%register_diffusion_thermo_models(viscconst_gas=visc_g,& + viscconst_liquid=visc_l, hdffconst_gas=hdff_g, hdffconst_liquid=hdff_l, & + sphtconst_gas=cv_g, sphtconst_liquid=cv_l) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit momentum solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver, default is amg + impl_option = pcg_amg + if (param_exists('Implicit solver')) call param_read('Implicit solver',impl_str) + if (trim(impl_str).eq.'blackbox') impl_option = pcg_bbox + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=impl_option) + + ! Set up problem: velocity, density, pressure + ! Velocity is quiescent unless specified + u_g = 0.0_WP; u_l = 0.0_WP + yes_Temp = .false. + if (param_exists('Liquid velocity')) then + call param_read('Liquid velocity',u_l) + end if + if (param_exists('Gas velocity')) then + call param_read('Gas velocity',u_g) + end if + if (param_exists('Background pressure')) then + ! Set background pressure if specified + call param_read('Background pressure',GP0) + ! Calculate liquid pressure + if (fs%cfg%nz.eq.1) then + ! Cylinder configuration, curv = 1/r + LP0 = GP0 + 2.0/ddrop*fs%sigma + else + ! Sphere configuration, curv = 1/r + 1/r + LP0 = GP0 + 4.0/ddrop*fs%sigma + end if + if (param_exists('Liquid density')) then + ! Set phase density if specified + call param_read('Liquid density',Lrho0) + call param_read('Gas density',Grho0) + else + ! Calculate phase density from specified temperature + yes_Temp = .true. + call param_read('Liquid temperature',LTemp0) + call param_read('Gas temperature',GTemp0) + Lrho0 = matmod%EOS_density(LP0,LTemp0,cv_l,'liquid') + Grho0 = matmod%EOS_density(GP0,GTemp0,cv_g,'gas') + end if + else + ! Get specified sound speed in gas + call param_read('Gas sound speed',GSS) + ! Get phase density + call param_read('Liquid density',Lrho0) + call param_read('Gas density',Grho0) + ! Calculate background pressure + GP0 = Grho0*GSS**2/gamm_g + ! Calculate liquid pressure + if (fs%cfg%nz.eq.1) then + ! Cylinder configuration, curv = 1/r + LP0 = GP0 + 2.0/ddrop*fs%sigma + else + ! Sphere configuration, curv = 1/r + 1/r + LP0 = GP0 + 4.0/ddrop*fs%sigma + end if + end if + ! Get gravity if specified + if (param_exists('Gravity')) then + call param_read('Gravity',fs%gravity) + end if + if (amRoot) then + print*,"===== Problem Setup Non-dimensional Numbers =====" + if (visc_g.ne.0.0_WP) then + print*,'Reynolds (gas) = ', Grho0*sqrt(u_g(1)**2+u_g(2)**2+u_g(3)**2)*ddrop/visc_g + print*,'Reynolds (liquid) = ', Lrho0*sqrt(u_l(1)**2+u_l(2)**2+u_l(3)**2)*ddrop/visc_l + print*,'Acoustic Reynolds = ', Grho0*sqrt(gamm_g*GP0/Grho0)*ddrop/visc_g + print*,'Laplace = ', fs%sigma*Lrho0*ddrop/visc_l**2 + else + print*,'Reynolds (gas) = Infinity' + print*,'Reynolds (liquid) = Infinity' + print*,'Acoustic Reynolds = Infinity' + if (fs%sigma.ne.0.0_WP) then + print*,'Laplace = Infinity' + else + print*,'Laplace = Undefined' + end if + end if + if (hdff_g.ne.0.0_WP) then + print*,'Prandtl (gas) = ', visc_g*gamm_g*cv_g/hdff_g + print*,'Prandtl (liquid) = ', visc_l*gamm_l*cv_l/hdff_l + else + if (visc_g.ne.0.0_WP) then + print*,'Prandtl (gas) = Infinity' + print*,'Prandtl (liquid) = Infinity' + else + print*,'Prandtl (gas) = Undefined' + print*,'Prandtl (liquid) = Undefined' + end if + end if + if (fs%sigma.ne.0.0_WP) then + print*,'Weber = ', Grho0*((u_g(1)-u_l(1))**2+(u_g(2)-u_l(2))**2+(u_g(3)-u_l(3))**2)*ddrop/fs%sigma + print*,'Acoustic Weber = ', gamm_g*GP0*ddrop/fs%sigma + else + print*,'Weber = Infinity' + print*,'Acoustic Weber = Infinity' + end if + if (sum(abs(fs%gravity)).ne.0.0_WP) then + print*,'Froude = ', sqrt(u_l(1)**2+u_l(2)**2+u_l(3)**2)/(fs%gravity(1)**2+fs%gravity(2)**2+fs%gravity(3)**2)/sqrt(ddrop) + else if (sqrt(u_l(1)**2+u_l(2)**2+u_l(3)**2).ne.0.0_WP) then + print*,'Froude = Infinity' + else + print*,'Froude = Undefined' + end if + end if + + ! Initialize flow variables + fs%Lrho = Lrho0 + fs%Grho = Grho0 + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Get local velocity based on mixture momentum, density + u_mix = ((vf%VF(i,j,k))*Lrho0*u_l+(1.0-vf%VF(i,j,k))*Grho0*u_g) / & + ((vf%VF(i,j,k))*Lrho0+(1.0-vf%VF(i,j,k))*Grho0) + ! Set velocity and energy + fs%Ui(i,j,k) = u_mix(1) + fs%Vi(i,j,k) = u_mix(2) + fs%Wi(i,j,k) = u_mix(3) + fs%GrhoE(i,j,k) = matmod%EOS_energy(GP0,Grho0,u_mix(1),u_mix(2),u_mix(3),'gas') + fs%LrhoE(i,j,k) = matmod%EOS_energy(LP0,Lrho0,u_mix(1),u_mix(2),u_mix(3),'liquid') + end do + end do + end do + + ! Calculate face velocities + call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) + ! Need to fill ghost cells + bc_scope='velocity' + call fs%apply_bcond(time%dt,bc_scope) + + ! Choose relaxation model + if (abs(cv_l)+abs(cv_g).gt.0.0_WP) then + ! Use thermo-mechanical if heat conduction is considered + relax_model = thermmech_egy_mech_hhz + else + ! Use mechanical otherwise + relax_model = mech_egy_mech_hhz + end if + + ! Calculate mixture density and momenta + fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho + fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi + ! Perform initial pressure relax + call fs%pressure_relax(vf,matmod,relax_model) + ! Calculate initial phase and bulk moduli + call fs%init_phase_bulkmod(vf,matmod) + call fs%reinit_phase_pressure(vf,matmod) + call fs%harmonize_advpressure_bulkmod(vf,matmod) + ! Set initial pressure to harmonized field based on internal energy + fs%P = fs%PA + ! Calculate initial temperature + call matmod%update_temperature(vf,fs%Tmptr) + ! Initialize first guess for pressure (0 works best) + fs%psolv%sol=0.0_WP + + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='MASTdrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) + call ens_out%add_scalar('P',fs%P) + call ens_out%add_scalar('Peos',fs%PA) + call ens_out%add_scalar('Grho',fs%Grho) + call ens_out%add_scalar('Lrho',fs%Lrho) + call ens_out%add_scalar('Density',fs%RHO) + call ens_out%add_scalar('Temperature',fs%Tmptr) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%Tmax,'Tmax') + call mfile%write() + ! Create drop monitor + dfile=monitor(fs%cfg%amRoot,'drop') + call dfile%add_column(time%n,'Timestep number') + call dfile%add_column(time%t,'Time') + call dfile%add_column(xd,'xdrop') + call dfile%add_column(yd,'ydrop') + call dfile%add_column(zd,'zdrop') + call dfile%add_column(vmag2,'Vmag2Norm') + call dfile%add_column(vmaginf,'VmagInfNorm') + call mast_drop_update() + call dfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') + + ! Create conservation monitor + consfile=monitor(fs%cfg%amRoot,'conservation') + call consfile%add_column(time%n,'Timestep number') + call consfile%add_column(time%t,'Time') + call consfile%add_column(LVdiff,'D_LiqVol') + call consfile%add_column(massdiff,'D_Mass') + call consfile%add_column(momdiff_x,'D_XMomentum') + call consfile%add_column(momdiff_y,'D_YMomentum') + call consfile%add_column(momdiff_z,'D_ZMomentum') + call consfile%add_column(totegydiff,'D_TotEnergy') + ! Set initial quantities to zero + LV0 = 0.0_WP; mass0 = 0.0_WP; totegy0 = 0.0_WP + mom0_x = 0.0_WP; mom0_y = 0.0_WP; mom0_z = 0.0_WP + call conservation_update() + ! Copy current quantities to initial + LV0 = LVdiff; mass0 = massdiff; totegy0 = totegydiff + mom0_x = momdiff_x; mom0_y = momdiff_y; mom0_z = momdiff_z + ! Reset differences to zero, by definition + LVdiff = 0.0_WP; massdiff = 0.0_WP; totegydiff = 0.0_WP + momdiff_x = 0.0_WP; momdiff_y = 0.0_WP; momdiff_z = 0.0_WP + call consfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Reinitialize phase pressure by syncing it with conserved phase energy + call fs%reinit_phase_pressure(vf,matmod) + fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi + fs%RHOold = fs%RHO + ! Remember old flow variables (phase) + fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho + fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE + fs%GPold = fs%GP; fs%LPold = fs%LP + + ! Remember old interface, including VF and barycenters + call vf%copy_interface_to_old() + + ! Create in-cell reconstruction + call fs%flow_reconstruct(vf) + + ! Zero variables that will change during subiterations + fs%P = 0.0_WP + fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP + fs%Hpjump = 0.0_WP + + ! Determine semi-Lagrangian advection flag + call fs%flag_sl(time%dt,vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Predictor step, involving advection and pressure terms + call fs%advection_step(time%dt,vf,matmod) + + ! Diffusion and source term step + call fs%diffusion_src_explicit_step(time%dt,vf,matmod) + + ! Prepare pressure projection + call fs%pressureproj_prepare(time%dt,vf,matmod) + ! Initialize and solve Helmholtz equation + call fs%psolv%setup() + call fs%psolv%solve() + call fs%cfg%sync(fs%psolv%sol) + ! Perform corrector step using solution + fs%P=fs%P+fs%psolv%sol + call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + + ! Record convergence monitor + call cvgfile%write() + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Pressure relaxation + call fs%pressure_relax(vf,matmod,relax_model) + + ! Output to ensight + fs%PA = matmod%EOS_all(vf); + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call mast_drop_update() + call dfile%write() + call cflfile%write() + call conservation_update() + call consfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + use string, only: str_long + implicit none + integer, parameter :: col_len=14 + character(len=*), parameter :: aformat='(a12)' + character(len=*), parameter :: rformat='(es12.5)' + integer :: i,j,k,n,ierr,iunit + real(WP) :: dxr, r, buf0, buf1, l_left, l_right + real(WP), dimension(:), allocatable :: Tprof, RHOprof, normprof, xmprof + character(len=str_long) :: line, header + + ! Output temperature and density profiles + if (yes_Temp) then + + ! Resolution of final profile + dxr = (2.0_WP/real(fs%cfg%nx,WP)) + ! Allocate and zero profile arrays + allocate(Tprof(fs%cfg%nx/2),RHOprof(fs%cfg%nx/2),normprof(fs%cfg%nx/2),xmprof(fs%cfg%nx/2)) + Tprof = 0.0_WP; RHOprof = 0.0_WP; normprof = 0.0_WP + ! Populate the x profile + do i=1,fs%cfg%nx/2 + xmprof(i) = 0.5_WP*dxr + real(i-1,WP)*dxr + end do + + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + ! Calculate current radius + r = sqrt(fs%cfg%xm(i)**2+fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + + !! == For plotting profile == !! + ! Determine which increment of the domain this belongs to + n = 1+floor((r-0.5_WP*dxr)/dxr) + ! Contribute to the left + if (n.le.fs%cfg%nx/2) then + l_left = real(n,WP)*dxr-(r-0.5_WP*dxr) + Tprof(n) = Tprof(n) + l_left*fs%Tmptr(i,j,k) + RHOprof(n) = RHOprof(n) + l_left*fs%RHO(i,j,k) + normprof(n) = normprof(n) + l_left + end if + ! Contribute to the right + if (n+1.le.fs%cfg%nx/2) then + l_right = (r+0.5_WP*dxr)-real(n,WP)*dxr + Tprof(n+1) = Tprof(n+1) + l_right*fs%Tmptr(i,j,k) + RHOprof(n+1) = RHOprof(n+1) + l_right*fs%RHO(i,j,k) + normprof(n+1) = normprof(n+1) + l_right + end if + + end do + end do + end do + ! Create final profile array using info from every proc + do n=1,fs%cfg%nx/2 + ! Sum normalization at current location + call MPI_ALLREDUCE(normprof(n),buf0,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); + ! Sum temperature + call MPI_ALLREDUCE(Tprof(n),buf1,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); + ! Update temperature + Tprof(n) = buf1/buf0 + ! Sum density + call MPI_ALLREDUCE(RHOprof(n),buf1,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); + ! Update density + RHOprof(n) = buf1/buf0 + end do + ! Write profile to file + if (fs%cfg%amRoot) then + ! Open file + if (fs%sigma.eq.0.0_WP) then + open(newunit=iunit,file='profile_noST.txt',form="formatted",iostat=ierr,status="REPLACE") + else + open(newunit=iunit,file='profile_ST.txt',form="formatted",iostat=ierr,status="REPLACE") + end if + ! Write header + write (header(1+0*col_len:),aformat) 'xm' + write (header(1+1*col_len:),aformat) 'T' + write (header(1+2*col_len:),aformat) 'RHO' + write(iunit,'(a)') trim(header) + ! Write data + do n=1,fs%cfg%nx/2 + ! Create the line to dump + write (line(1+0*col_len:),rformat) xmprof(n) + write (line(1+1*col_len:),rformat) Tprof(n) + write (line(1+2*col_len:),rformat) RHOprof(n) + ! Dump the line + write(iunit,'(a)') trim(line) + end do + ! Close file + close(iunit) + end if + end if + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays - none + + end subroutine simulation_final + +end module simulation From 714298cfb383ed6b0dc2797de4fe7e462b30bc6a Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 7 Nov 2022 15:17:08 +0100 Subject: [PATCH 005/152] Update to MAST Compute various terms that are useful for visualization --- src/two_phase/mast_class.f90 | 82 ++++++++++++++++++++++++------------ 1 file changed, 54 insertions(+), 28 deletions(-) diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index b911ce848..4078eaea2 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -116,6 +116,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture real(WP), dimension(:,:,:), allocatable :: divU !< Dilatation + real(WP), dimension(:,:,:), allocatable :: Mach !< Mach number ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays @@ -238,6 +239,7 @@ module mast_class ! Miscellaneous procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values + procedure :: get_viz !< Calculate various quantities for visualization end type mast @@ -294,7 +296,8 @@ function constructor(cfg,name,vf) result(self) allocate(self%dPjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjy=0.0_WP allocate(self%dPjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjz=0.0_WP allocate(self%Tmptr(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Tmptr=25.0_WP - allocate(self%divU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%divU=5.0_WP + allocate(self%divU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%divU=0.0_WP + allocate(self%Mach(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Mach=0.0_WP allocate(self%rho_U(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_U=0.0_WP allocate(self%rho_V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_V=0.0_WP allocate(self%rho_W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_W=0.0_WP @@ -2589,32 +2592,29 @@ subroutine diffusion_src_explicit_step(this,dt,vf,matmod,sgs_visc,srcU,srcV,srcW if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) end do - ! Store dilatation - this%divU=div - - ! Nullify... - - contains - - subroutine diffusion_src_explicit_substep() - implicit none - - real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX - real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy - real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz - real(WP) :: dMUdx,dMUdy,dMUdz - real(WP) :: div2U,div2V,div2W - real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz - - integer :: i,j,k,n - - ! Viscous routine operates on face velocities, need to be updated each time - ! Update traditional face velocity (just interpolated) - call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) - ! Apply boundary condtions - bc_scope = 'velocity' - call this%apply_bcond(dt,bc_scope) - ! Calculate other interpolated face velocities (ignore masks) + ! Nullify... + + contains + + subroutine diffusion_src_explicit_substep() + implicit none + + real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX + real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy + real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz + real(WP) :: dMUdx,dMUdy,dMUdz + real(WP) :: div2U,div2V,div2W + real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + + integer :: i,j,k,n + + ! Viscous routine operates on face velocities, need to be updated each time + ! Update traditional face velocity (just interpolated) + call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) + ! Apply boundary condtions + bc_scope = 'velocity' + call this%apply_bcond(dt,bc_scope) + ! Calculate other interpolated face velocities (ignore masks) call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) ! BCs not needed, masks are already addressed, nothing used from within boundary @@ -4083,7 +4083,33 @@ subroutine get_max(this) call MPI_ALLREDUCE(my_Pmax,this%Pmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_Tmax,this%Tmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - end subroutine get_max + end subroutine get_max + + + !> Calculate various quantities for visualization purposes + subroutine get_viz(this) + implicit none + class(mast), intent(inout) :: this + integer :: i,j,k + + do k=this%cfg%kmino_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Dilatation + this%divU(i,j,k)=( sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k)) & + + sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k)) & + + sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) ) + ! Mach number + this%Mach(i,j,k)=sqrt(this%Ui(i,j,k)**2+this%Vi(i,j,k)**2+this%Wi(i,j,k)**2)& + /sqrt(this%RHOSS2(i,j,k)/this%RHO(i,j,k)) + end do + end do + end do + call this%cfg%sync(this%divU) + call this%cfg%sync(this%Mach) + + end subroutine get_viz + !> Prepare viscosity arrays from vfs, matm, and sgsmodel objects subroutine get_viscosity(this,vf,matmod,sgs_visc,visc_x,visc_y,visc_z) From c334b71795c1fff39d91d5837b65efa9c86da0ab Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 7 Nov 2022 15:17:44 +0100 Subject: [PATCH 006/152] Particle mod Starting to create ability to choose different drag models --- examples/shock_particle/src/simulation.f90 | 8 +++-- src/particles/lpt_class.f90 | 37 +++++++++++----------- 2 files changed, 25 insertions(+), 20 deletions(-) diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 index b9863098e..ce3e043f1 100644 --- a/examples/shock_particle/src/simulation.f90 +++ b/examples/shock_particle/src/simulation.f90 @@ -99,10 +99,13 @@ subroutine simulation_init use random, only: random_uniform use mathtools, only: Pi use parallel, only: amRoot + use lpt_class, only: drag_model real(WP) :: dp,VFp,L,x0,vol,volp integer :: i,np ! Create solver lp=lpt(cfg=cfg,name='LPT') + ! Get drag model from the inpit + call param_read('Drag model',drag_model,default='Tenneti') ! Get particle density from the input call param_read('Particle density',lp%rho) ! Get particle diameter from the input @@ -246,7 +249,7 @@ subroutine simulation_init case('gas') call matmod%register_idealgas('gas',gamm) case('liquid') - call param_read('Liquid Pref', Pref) + call param_read('Pref', Pref) call matmod%register_stiffenedgas('liquid',gamm,Pref) end select ! Create flow solver @@ -379,7 +382,7 @@ subroutine simulation_init call ens_out%add_scalar('Bulkmod',fs%RHOSS2) call ens_out%add_scalar('divU',fs%divU) call ens_out%add_scalar('Viscosity',fs%visc) - call ens_out%add_scalar('Sensor',fs%sl_x) + call ens_out%add_scalar('Mach',fs%Mach) call ens_out%add_particle('particles',pmesh) call ens_out%add_scalar('epsp',lp%VF) ! Output to ensight @@ -560,6 +563,7 @@ subroutine simulation_run end if ! Perform and output monitoring + call fs%get_viz() call fs%get_max() call lp%get_max() call mfile%write() diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 331b40c70..176c7c32d 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -21,7 +21,7 @@ module lpt_class integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing ! Drag model - character(len=str_medium) :: drag_model + character(len=str_medium), public :: drag_model !> Basic particle object definition type :: part @@ -586,7 +586,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) type(part), intent(in) :: p real(WP), dimension(3), intent(out) :: acc real(WP), intent(out) :: opt_dt - real(WP) :: Re,corr,tau,b1,b2 + real(WP) :: Re,corr,tau real(WP) :: fvisc,frho,pVF,fVF real(WP), dimension(3) :: fvel ! Interpolate the fluid phase velocity to the particle location @@ -601,32 +601,33 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) fVF=1.0_WP-pVF ! Particle Reynolds number Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) - ! Stokes correlation - !corr=1.0_WP - ! Schiller Naumann correlation - !corr=1.0_WP+0.15_WP*Re**(0.687_WP) - ! Tenneti and Subramaniam (2011) - b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 - b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - corr=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2 + ! Drag correction + corr=drag_correction(Re,pVF) ! Particle response time tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) ! Return acceleration and optimal timestep size - acc=fVF*(fvel-p%vel)/tau + acc=corr*(fvel-p%vel)/tau opt_dt=tau/real(this%nstep,WP) contains - function drag(Rep,Map,VFp,Knp) result(Fd) - real(WP) :: Fd - real(WP) :: Rep,Map,VFp,Knp + function drag_correction(Rep,VFp) result(F) + real(WP) :: F,Rep,Map,VFp,Knp,b1,b2 select case(trim(drag_model)) - case ('Tenneti') - case ('KC') + case('Stokes') + F=1.0_WP + case('Schiller-Naumann') + F=1.0_WP+0.15_WP*Re**(0.687_WP) + case('Tenneti') + ! Tenneti and Subramaniam (2011) + b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 + b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) + F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2 + case('KC') end select - - end function drag + + end function drag_correction end subroutine get_rhs From d72f61de4b6389b890faae6b67d2c4230f2a9958 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 7 Nov 2022 15:59:07 +0100 Subject: [PATCH 007/152] Fixed Tenneti correlation Terms in Tenneti should all be multiplied by extra fVF --- examples/shock_particle/input | 3 ++- src/particles/lpt_class.f90 | 11 ++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/examples/shock_particle/input b/examples/shock_particle/input index 84d7a4c90..b359f094b 100644 --- a/examples/shock_particle/input +++ b/examples/shock_particle/input @@ -22,8 +22,9 @@ Thermal conductivity : 0 Gamma : 1.4 # Particle parameters -Particle density : 1000 +Particle density : 1000 Particle diameter : 200e-6 +Drag model : Tenneti # Time integration Max timestep size : 8e-7 diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 176c7c32d..cbc2e528e 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -586,7 +586,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) type(part), intent(in) :: p real(WP), dimension(3), intent(out) :: acc real(WP), intent(out) :: opt_dt - real(WP) :: Re,corr,tau + real(WP) :: corr,Re,tau real(WP) :: fvisc,frho,pVF,fVF real(WP), dimension(3) :: fvel ! Interpolate the fluid phase velocity to the particle location @@ -602,7 +602,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) ! Particle Reynolds number Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) ! Drag correction - corr=drag_correction(Re,pVF) + corr=drag_correction() ! Particle response time tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) ! Return acceleration and optimal timestep size @@ -611,8 +611,9 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) contains - function drag_correction(Rep,VFp) result(F) - real(WP) :: F,Rep,Map,VFp,Knp,b1,b2 + function drag_correction() result(F) + real(WP) :: F + real(WP) :: Ma,Kn,b1,b2 select case(trim(drag_model)) case('Stokes') @@ -623,7 +624,7 @@ function drag_correction(Rep,VFp) result(F) ! Tenneti and Subramaniam (2011) b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2 + F=fVF*((1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2) case('KC') end select From adaf88fef66fc9a2d96c6d703d1698c8d01be264 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 7 Nov 2022 15:59:50 +0100 Subject: [PATCH 008/152] Update to MAST Separate where/when viz arrays are computed in MAST --- examples/shock_particle/src/simulation.f90 | 2 +- src/two_phase/mast_class.f90 | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 index ce3e043f1..53a91f348 100644 --- a/examples/shock_particle/src/simulation.f90 +++ b/examples/shock_particle/src/simulation.f90 @@ -559,11 +559,11 @@ subroutine simulation_run pmesh%var(1,i)=0.5_WP*lp%p(i)%d end do end block update_pmesh + call fs%get_viz() call ens_out%write_data(time%t) end if ! Perform and output monitoring - call fs%get_viz() call fs%get_max() call lp%get_max() call mfile%write() diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 4078eaea2..97ec1e81f 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -115,8 +115,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture - real(WP), dimension(:,:,:), allocatable :: divU !< Dilatation - real(WP), dimension(:,:,:), allocatable :: Mach !< Mach number + ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays @@ -156,9 +155,13 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: Hpjump ! < Helmholtz pressure jump real(WP), dimension(:,:,:), allocatable :: dHpjump ! < Helmholtz pressure jump increment, also used for old Hpjump + ! Visualization arrays + real(WP), dimension(:,:,:), allocatable :: divU !< Dilatation + real(WP), dimension(:,:,:), allocatable :: Mach !< Mach number + ! Temporary arrays for a few things real(WP), dimension(:,:,:), pointer :: tmp1,tmp2,tmp3 - + ! Temporary arrays for viscous routine (may be used for more in the future) real(WP), dimension(:,:,:), pointer :: tmp4,tmp5,tmp6,tmp7,tmp8,tmp9,tmp10 From 09a1e4fb0e69e3bdcb364766841e0679dfb8667d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 17 Nov 2022 22:21:55 -0600 Subject: [PATCH 009/152] Added HIT from new_linsol branch --- examples/hit/GNUmakefile | 8 +- examples/hit/input | 28 +- examples/hit/src/simulation.f90 | 200 ++++- src/constant_density/incomp_class.f90 | 160 +--- src/solver/Make.package | 8 +- src/solver/bbox_class.f90 | 380 +++++++++ src/solver/hypre_str_class.f90 | 466 +++++++++++ src/solver/hypre_uns_class.f90 | 654 +++++++++++++++ src/solver/linsol_class.f90 | 74 ++ src/solver/pfft3d_class.f90 | 1070 +++++++++++++++++++++++++ 10 files changed, 2882 insertions(+), 166 deletions(-) create mode 100644 src/solver/bbox_class.f90 create mode 100644 src/solver/hypre_str_class.f90 create mode 100644 src/solver/hypre_uns_class.f90 create mode 100644 src/solver/linsol_class.f90 create mode 100644 src/solver/pfft3d_class.f90 diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index 8b5f7f9bc..36fb402f8 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -6,6 +6,7 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_FFTW = TRUE USE_HYPRE = TRUE +USE_LAPACK= TRUE PROFILE = FALSE DEBUG = FALSE COMP = gnu @@ -22,14 +23,15 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -FFTW_DIR = /Users/desjardi/Builds/fftw +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR = /opt/homebrew/Cellar/fftw/3.3.10_1 +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := core constant_density data solver config grid libraries +Bdirs := particles core constant_density data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/hit/input b/examples/hit/input index ea40e6dd5..0c376b4a8 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -2,24 +2,22 @@ Partition : 1 1 4 # Mesh definition -Lx : 0.01 -Ly : 1 -Lz : 1 -nx : 1 -ny : 100 -nz : 100 +Lx : 1 +nx : 64 # Fluid properties -Gravity : 0 -1 0 -Liquid dynamic viscosity : 1.137e-3 -Gas dynamic viscosity : 1.780e-5 -Liquid density : 1000 -Gas density : 1.226 -Surface tension coefficient : 0.0728 -Static contact angle : 70 +Dynamic viscosity : 0.01 +Density : 1 +Initial rms : 5 +Eddy turnover time : 0.1 + +# Particle properties +Particle density : 0.018 +Particle diameter : 1 +Number of particles : 100000 # Time integration -Max timestep size : 1e-2 +Max timestep size : 1e-3 Max cfl number : 0.9 # Pressure solver @@ -31,4 +29,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 1e-1 +Ensight output period : 0.01 diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index 9ddb6a547..97eefb252 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,24 +2,32 @@ module simulation use precision, only: WP use geometry, only: cfg + use pfft3d_class, only: pfft3d + use hypre_str_class, only: hypre_str use incomp_class, only: incomp + use lpt_class, only: lpt use timetracker_class, only: timetracker use ensight_class, only: ensight + use partmesh_class, only: partmesh use event_class, only: event use monitor_class, only: monitor implicit none private - !> Single-phase incompressible flow solver and corresponding time tracker + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + !type(pfft3d), public :: ps + type(hypre_str), public :: ps type(incomp), public :: fs type(timetracker), public :: time + type(lpt), public :: lp !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt !> Simulation monitor file - type(monitor) :: mfile,cflfile + type(monitor) :: mfile,cflfile,lptfile public :: simulation_init,simulation_run,simulation_final @@ -27,8 +35,10 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - !> Fluid viscosity + !> Fluid and forcing parameters real(WP) :: visc + real(WP) :: Urms0,KE0,KE + real(WP) :: tau_eddy contains @@ -62,29 +72,122 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: bbox + use hypre_str_class, only: pcg_pfmg ! Create flow solver fs=incomp(cfg=cfg,name='NS solver') ! Assign constant viscosity call param_read('Dynamic viscosity',visc); fs%visc=visc ! Assign constant density call param_read('Density',fs%rho) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Prepare and configure pressure solver + !ps=pfft3d(cfg=cfg,name='Pressure') + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Setup the solver - call fs%setup(pressure_ils=bbox,implicit_ils=bbox) - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + call fs%setup(pressure_solver=ps) + end block create_and_initialize_flow_solver + + + ! Prepare initial velocity field + initialize_velocity: block + use random, only: random_normal + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: myKE + ! Read in velocity rms and forcing time scale + call param_read('Initial rms',Urms0) + call param_read('Eddy turnover time',tau_eddy) + ! Gaussian initial field + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + fs%V(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + fs%W(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Project to ensure divergence-free + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho ! Calculate cell-centered velocities and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() - end block create_and_initialize_flow_solver + ! Calculate KE0 + myKE=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + myKE=myKE+0.5_WP*(Ui(i,j,k)**2+Vi(i,j,k)**2+Wi(i,j,k)**2) + end do + end do + end do + call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + KE0=KE + end block initialize_velocity + ! Initialize LPT solver + initialize_lpt: block + use random, only: random_uniform + real(WP) :: dp + integer :: i,np + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Get particle diameter from the input + call param_read('Particle diameter',dp) + ! Get number of particles + call param_read('Number of particles',np) + ! Root process initializes np particles randomly + if (lp%cfg%amRoot) then + call lp%resize(np) + do i=1,np + ! Give id + lp%p(i)%id=int(i,8) + ! Set the diameter + lp%p(i)%d=dp + ! Assign random position in the domain + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin),lp%cfg%x(lp%cfg%imax+1)),& + & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& + & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Locate the particle on the mesh + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + ! Activate the particle + lp%p(i)%flag=0 + end do + end if + ! Distribute particles + call lp%sync() + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + pmesh=partmesh(nvar=0,name='lpt') + call lp%update_partmesh(pmesh) + end block create_pmesh + + ! Add Ensight output create_ensight: block ! Create Ensight output from cfg @@ -94,6 +197,8 @@ subroutine simulation_init call param_read('Ensight output period',ens_evt%tper) ! Add variables to output call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_particle('particles',pmesh) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -114,6 +219,7 @@ subroutine simulation_init call mfile%add_column(fs%Vmax,'Vmax') call mfile%add_column(fs%Wmax,'Wmax') call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(KE,'Kinetic energy') call mfile%add_column(fs%divmax,'Maximum divergence') call mfile%add_column(fs%psolv%it,'Pressure iteration') call mfile%add_column(fs%psolv%rerr,'Pressure error') @@ -129,6 +235,21 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') call cflfile%write() + ! Create LPT monitor + call lp%get_max() + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() end block create_monitor @@ -147,6 +268,10 @@ subroutine simulation_run call time%adjust_dt() call time%increment() + ! Advance particles by dt + resU=fs%rho; resV=fs%visc + call lp%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=resV) + ! Remember old velocity fs%Uold=fs%U fs%Vold=fs%V @@ -171,13 +296,37 @@ subroutine simulation_run resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - + ! Add linear forcing term + linear_forcing: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + real(WP) :: meanU,meanV,meanW,myKE + integer :: i,j,k,ierr + ! Calculate KE + call fs%interp_vel(Ui,Vi,Wi) + myKE=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + myKE=myKE+0.5_WP*(Ui(i,j,k)**2+Vi(i,j,k)**2+Wi(i,j,k)**2) + end do + end do + end do + call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + ! Calculate mean velocity + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + ! Add forcing term + resU=resU+time%dt*KE0/KE*(fs%U-meanU)/(2.0_WP*tau_eddy) + resV=resV+time%dt*KE0/KE*(fs%V-meanV)/(2.0_WP*tau_eddy) + resW=resW+time%dt*KE0/KE*(fs%W-meanW)/(2.0_WP*tau_eddy) + end block linear_forcing + ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW + fs%U=2.0_WP*fs%U-fs%Uold+resU/fs%rho + fs%V=2.0_WP*fs%V-fs%Vold+resV/fs%rho + fs%W=2.0_WP*fs%W-fs%Wold+resW/fs%rho ! Apply other boundary conditions on the resulting fields call fs%apply_bcond(time%t,time%dt) @@ -207,12 +356,17 @@ subroutine simulation_run call fs%get_div() ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) + if (ens_evt%occurs()) then + call lp%update_partmesh(pmesh) + call ens_out%write_data(time%t) + end if ! Perform and output monitoring call fs%get_max() call mfile%write() call cflfile%write() + call lp%get_max() + call lptfile%write() end do diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index 92d24c76f..b2bee2b43 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -6,7 +6,7 @@ module incomp_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -68,10 +68,10 @@ module incomp_class real(WP), dimension(:,:,:), allocatable :: div !< Divergence array ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity @@ -114,8 +114,7 @@ module incomp_class procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values procedure :: interp_vel !< Calculate interpolated velocity - procedure :: get_strainrate !< Calculate strain rate tensor (naive implementation based on Ui/Vi/Wi) - procedure :: get_gradu !< Calculate velocity gradient tensor (optimal implementation based on U/V/W) + procedure :: get_strainrate !< Calculate strain rate tensor procedure :: get_mfr !< Calculate outgoing MFR through each bcond procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation procedure :: shift_p !< Shift pressure to have zero average @@ -166,12 +165,6 @@ function constructor(cfg,name) result(self) allocate(self%Vold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Vold=0.0_WP allocate(self%Wold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Wold=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -736,16 +729,19 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(incomp), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided integer :: i,j,k ! Adjust metrics based on bcflag array call this%adjust_metrics() + ! Point to pressure solver linsol object + this%psolv=>pressure_solver + ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] this%psolv%stc(2,:)=[+1, 0, 0] @@ -779,23 +775,31 @@ subroutine setup(this,pressure_ils,implicit_ils) end do ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) + call this%psolv%init() call this%psolv%setup() - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -1243,9 +1247,9 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) + dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uxp-Uxm); dUdx(1,3)=this%cfg%dzi(k)*(Uxp-Uxm) + dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vxp-Vxm); dUdx(2,3)=this%cfg%dzi(k)*(Vxp-Vxm) + dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wxp-Wxm); dUdx(3,3)=this%cfg%dzi(k)*(Wxp-Wxm) ! Assemble the strain rate SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP @@ -1286,98 +1290,6 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end subroutine get_strainrate - !> Calculate the velocity gradient tensor from U/V/W - !> Note that gradu(i,j)=duj/dxi - subroutine get_gradu(this,gradu) - use messager, only: die - implicit none - class(incomp), intent(inout) :: this - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - - ! Check gradu's first two dimensions - if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - - ! Compute dudx, dvdy, and dwdz first - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) - gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) - gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) - end do - end do - end do - - ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) - dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) - dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) - dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) - dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) - dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) - end do - end do - end do - - ! Interpolate off-diagonal components of the velocity gradient to the cell center - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) - gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) - gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) - gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) - gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) - gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) - end do - end do - end do - - ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then - if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) - if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) - end if - if (.not.this%cfg%yper) then - if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) - if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) - end if - if (.not.this%cfg%zper) then - if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) - if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) - end if - - ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP - end do - end do - end do - - ! Sync it - call this%cfg%sync(gradu) - - ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - - end subroutine get_gradu - - !> Calculate the CFL subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX diff --git a/src/solver/Make.package b/src/solver/Make.package index 701fce15c..ebf581ea0 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -1,4 +1,10 @@ -f90EXE_sources += ils_class.f90 bbmg_class.f90 +f90EXE_sources += linsol_class.f90 bbmg_class.f90 +ifeq ($(USE_HYPRE),TRUE) + f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 +endif +ifeq ($(USE_FFTW),TRUE) + f90EXE_sources += pfft3d_class.f90 +endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver VPATH_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/bbox_class.f90 b/src/solver/bbox_class.f90 new file mode 100644 index 000000000..1e60ac327 --- /dev/null +++ b/src/solver/bbox_class.f90 @@ -0,0 +1,380 @@ +!> Black-box multigrid linear solver concept is +!> defined here by extension of the ilinsol class +module bbox_class + use precision, only: WP + use config_class, only: config + use string, only: str_medium + use ilinsol_class, only: ilinsol + implicit none + private + + ! Expose type/constructor/methods + public :: bbox + + + ! List of known available methods + integer, parameter, public :: bbmg=1 + integer, parameter, public :: pcg_bbmg=2 + + + ! Level data object definition + type :: lvl_data + + ! Global sizes + integer :: ncell,ncello + integer :: nx,imin,imax,nxo,imino,imaxo + integer :: ny,jmin,jmax,nyo,jmino,jmaxo + integer :: nz,kmin,kmax,nzo,kmino,kmaxo + + ! Local sizes + integer :: ncell_,ncello_ + integer :: nx_,imin_,imax_,nxo_,imino_,imaxo_ + integer :: ny_,jmin_,jmax_,nyo_,jmino_,jmaxo_ + integer :: nz_,kmin_,kmax_,nzo_,kmino_,kmaxo_ + + ! Operators + real(WP), dimension(:,:,:,:,:,:), allocatable :: c2f + real(WP), dimension(:,:,:,:,:,:), allocatable :: f2c + real(WP), dimension(:,:,:,:,:,:), allocatable :: opr + real(WP), dimension(:,:,:,:,:,:), allocatable :: oprc2f + + ! Vectors + real(WP), dimension(:,:,:), allocatable :: v + real(WP), dimension(:,:,:), allocatable :: f + real(WP), dimension(:,:,:), allocatable :: r + + ! Parallel information + logical, dimension(:), allocatable :: send_xm,send_xp + logical, dimension(:), allocatable :: send_ym,send_yp + logical, dimension(:), allocatable :: send_zm,send_zp + integer :: nsend_xm,nsend_xp + integer :: nsend_ym,nsend_yp + integer :: nsend_zm,nsend_zp + integer :: recv_xm,recv_xp + integer :: recv_ym,recv_yp + integer :: recv_zm,recv_zp + + end type lvl_data + + + !> bbox object definition + type, extends(ilinsol) :: bbox + + ! General operator information + integer :: nstx !< Number of diagonal in x + integer :: nsty !< Number of diagonal in y + integer :: nstz !< Number of diagonal in z + + ! Direct solver data + integer :: np !< Direct problem size + integer , dimension(:), allocatable :: piv !< Pivoting data + real(WP), dimension(:), allocatable :: myrhs,rhs !< Local and assembled RHS + real(WP), dimension(:,:), allocatable :: myOP,OP !< Local and assembled operator + + ! Solver information + real(WP) :: my_res0 !< Initial L_infty norm of the residual + + ! Configurable solver parameters + integer :: ncycle=1 !< Cycle type: 1=V-cycle (default), 2=W-cycle, ... + integer :: relax_pre =1 !< Number of pre-sweeps (default is 1) + integer :: relax_post=1 !< Number of post-sweeps (default is 1) + integer :: ncell_coarsest=0 !< Coarsest problem size allowed + logical :: use_direct_solve=.false. !< Use direct solve at the coarsest level (default is false) + logical :: use_krylov=.true. !< Use BBMG as a preconditioner to a CG (default is true) + + ! Level data management + integer :: nlvl !< Number of multigrid levels created - by default all will be used. This can be reduced by the user. + type(lvl_data), dimension(:), allocatable :: lvl !< Entire data at each level + + ! Krylov solver data + real(WP), dimension(:,:,:), allocatable :: res,pp,zz,Ap,sol !< Krylov solver work vectors + real(WP) :: alpha,beta,rho1,rho2 !< Krylov solver coefficients + + contains + + procedure :: print_short=>bbox_print_short !< One-line printing of solver status + procedure :: print=>bbox_print !< Long-form printing of solver status + procedure :: log=>bbox_log !< Long-form logging of solver status + procedure :: init=>bbox_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>bbox_setup !< Solver setup (every time the operator changes) + procedure :: solve=>bbox_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>bbox_destroy !< Solver destruction (every time the operator changes) + + procedure :: update !< Operator update (every time the operator changes) + procedure :: solve !< Solve the linear system + procedure :: initialize !< Initialize the solver + + procedure, private :: mgsolve !< Solve the linear system with multigrid + procedure, private :: cgsolve !< Solve the linear system with CG + + procedure, private :: recompute_prolongation !< Recompute the prolongation at a given level + procedure, private :: recompute_restriction !< Recompute the restriction at a given level + procedure, private :: recompute_operator !< Recompute the operator at a given level + procedure, private :: recompute_direct !< Recompute the direct problem at the final level + + procedure, private :: get_residual !< Compute the residual at a given level + procedure, private :: c2f !< Prolongate from a level to the next finer level + procedure, private :: f2c !< Restrict from a level to the next coarser level + procedure, private :: relax !< Relax the problem at a given level + procedure, private :: direct_solve !< Solve directly the problem at the final level + procedure, private :: cycle !< Perform a multigrid cycle + + generic, private :: sync=>vsync,msync !< Synchronization at boundaries + procedure, private :: vsync !< Synchronize boundaries for a vector at a given level + procedure, private :: msync !< Synchronize boundaries for a matrix at a given level + + procedure, private :: pmodx,pmody,pmodz !< Parity calculation that accounts for periodicity + + end type bbox + + + !> Declare bbox constructor + interface bbox + procedure bbox_from_args + end interface bbox + + +contains + + + !> Division of an integer by 2 + pure integer function div(ind) + implicit none + integer, intent(in) :: ind + div=ind/2+mod(ind,2) + end function div + + + !> Parity of point i shifted by n to ensure 1<=i<=n + pure integer function pmodx(this,i,n) + class(bbox), intent(in) :: this + integer, intent(in) :: i,n + if (this%cfg%xper) then + pmodx=1-mod(mod(i+this%lvl(n)%nx-1,this%lvl(n)%nx)+1,2) + else + pmodx=1-mod(i,2) + end if + end function pmodx + pure integer function pmody(this,i,n) + class(bbox), intent(in) :: this + integer, intent(in) :: i,n + if (this%cfg%yper) then + pmody=1-mod(mod(i+this%lvl(n)%ny-1,this%lvl(n)%ny)+1,2) + else + pmody=1-mod(i,2) + end if + end function pmody + pure integer function pmodz(this,i,n) + class(bbox), intent(in) :: this + integer, intent(in) :: i,n + if (this%cfg%zper) then + pmodz=1-mod(mod(i+this%lvl(n)%nz-1,this%lvl(n)%nz)+1,2) + else + pmodz=1-mod(i,2) + end if + end function pmodz + + + !> Constructor for a bbox object + function bbox_from_args(cfg,name,method,nst) result(self) + use messager, only: die + implicit none + type(bbox) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: method + integer, intent(in) :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set solution method + self%method=method + + ! Set up stencil size and map + self%nst=nst + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Zero out some info + self%it=0 + self%aerr=0.0_WP + self%rerr=0.0_WP + + ! Setup is not done + self%setup_done=.false. + + end function bbox_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine bbox_init(this) + use messager, only: die + implicit none + class(bbox), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + integer, dimension(3) :: periodicity,offset + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + + ! Initialize in-house black-box multi-grid solver + bbox() + + ! Adjust parameters + this%relax_pre =2 + this%relax_post=2 + this%use_direct_solve=.true. + this%ncell_coarsest=300 + if (this%method.eq. bbox) this%use_krylov=.false. + if (this%method.eq.pcg_bbox) this%use_krylov=.true. + + ! Initialize solver + call this%initialize() + + end subroutine bbox_init + + + !> Setup solver - done everytime the operator changes + subroutine bbox_setup(this) + implicit none + class(bbox), intent(inout) :: this + integer :: i,j,k,st + + ! If the solver has already been setup, destroy it first + if (this%setup_done) call this%destroy() + + ! Storage for matrix/vectors is already available within bbox, so just copy operator + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%bbox%lvl(1)%opr(:,:,:,i,j,k)=0.0_WP + do st=1,this%nst + this%bbox%lvl(1)%opr(this%stc(st,1),this%stc(st,2),this%stc(st,3),i,j,k)=this%bbox%lvl(1)%opr(this%stc(st,1),this%stc(st,2),this%stc(st,3),i,j,k)+this%opr(st,i,j,k) + end do + end do + end do + end do + + ! Update bbox solver + call this%bbox%update() + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine bbox_setup + + + !> Solve the linear system iteratively + subroutine bbox_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(bbox), intent(inout) :: this + integer :: i,j,k + + ! Check that setup was done + if (.not.this%setup_done) call die('[bbox solve] Solver has not been setup.') + + ! Set solver it and err to standard values + this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + + ! Transfer the RHS and IG + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%bbox%lvl(1)%f(i,j,k)=this%rhs(i,j,k) + this%bbox%lvl(1)%v(i,j,k)=this%sol(i,j,k) + end do + end do + end do + + ! Call the solver + call this%bbox%solve() + this%it =this%bbox%my_ite + this%rerr=this%bbox%my_res + + ! Retrieve solution from bbox + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%sol(i,j,k)=this%bbox%lvl(1)%v(i,j,k) + end do + end do + end do + + ! Sync the solution vector + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine bbox_solve + + + !> Destroy solver - done everytime the operator changes + subroutine bbox_destroy(this) + implicit none + class(bbox), intent(inout) :: this + ! Set setup-flag to false + this%setup_done=.false. + end subroutine bbox_destroy + + + !> Log bbox info + subroutine bbox_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(bbox), intent(in) :: this + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Bbox Linear Solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + write(message,'(" > method = ",i0)') this%method; call log(message) + write(message,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit; call log(message) + write(message,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg; call log(message) + write(message,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg; call log(message) + end if + end subroutine bbox_log + + + !> Print bbox info to the screen + subroutine bbox_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(bbox), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("Bbox Linear Solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'(" > method = ",i0)') this%method + write(output_unit,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit + write(output_unit,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg + write(output_unit,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg + end if + end subroutine bbox_print + + + !> Short print of bbox info to the screen + subroutine bbox_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(bbox), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("Bbox Linear Solver [",a16,"] for config [",a16,"] -> it/maxit = ",i3,"/",i3," and rerr/rcvg = ",es12.5,"/",es12.5)') trim(this%name),trim(this%cfg%name),this%it,this%maxit,this%rerr,this%rcvg + end subroutine ils_print_short + + +end module bbox_class diff --git a/src/solver/hypre_str_class.f90 b/src/solver/hypre_str_class.f90 new file mode 100644 index 000000000..97d5f71af --- /dev/null +++ b/src/solver/hypre_str_class.f90 @@ -0,0 +1,466 @@ +!> Structured hypre linear solver concept is +!> defined by extension of the linsol class +module hypre_str_class + use precision, only: WP + use config_class, only: config + use string, only: str_medium + use linsol_class, only: linsol + implicit none + private + + + ! Expose type/constructor/methods + public :: hypre_str + + + ! List of known available methods + integer, parameter, public :: pfmg=1 + integer, parameter, public :: pcg_pfmg=2 + integer, parameter, public :: gmres_pfmg=3 + integer, parameter, public :: smg=4 + integer, parameter, public :: pcg_smg=5 + integer, parameter, public :: gmres_smg=6 + + + ! List of key solver parameters + integer , parameter :: sprintlvl=0 !< Solver printing: 0=none (default); 3=init and cvg history + integer , parameter :: pprintlvl=0 !< Precond printing: 0=none (default); 3=init and cvg history + + + !> hypre_str object definition + type, extends(linsol) :: hypre_str + + ! For multigrid solvers, maxlevel parameter is needed + integer :: maxlevel !< Maximum number of multigrid levels + + ! Private stuff for hypre + integer(kind=8), private :: hypre_box !< Grid + integer(kind=8), private :: hypre_stc !< Stencil + integer(kind=8), private :: hypre_mat !< Matrix + integer(kind=8), private :: hypre_rhs !< Right-hand side + integer(kind=8), private :: hypre_sol !< Solution + integer(kind=8), private :: hypre_solver !< Solver + integer(kind=8), private :: hypre_precond !< Preconditioner + + contains + + procedure :: print_short=>hypre_str_print_short !< One-line printing of solver status + procedure :: print=>hypre_str_print !< Long-form printing of solver status + procedure :: log=>hypre_str_log !< Long-form logging of solver status + procedure :: init=>hypre_str_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>hypre_str_setup !< Solver setup (every time the operator changes) + procedure :: solve=>hypre_str_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>hypre_str_destroy !< Solver destruction (every time the operator changes) + + end type hypre_str + + + !> Declare hypre_str constructor + interface hypre_str + procedure hypre_str_from_args + end interface hypre_str + + +contains + + + !> Constructor for an hypre_str object + function hypre_str_from_args(cfg,name,method,nst) result(self) + use messager, only: die + implicit none + type(hypre_str) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: method + integer, intent(in) :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set solution method + self%method=method + + ! Set up stencil size and map + self%nst=nst + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Zero out some info + self%it=0 + self%aerr=0.0_WP + self%rerr=0.0_WP + self%maxlevel=0 + + ! Setup is not done + self%setup_done=.false. + + end function hypre_str_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine hypre_str_init(this) + use messager, only: die + implicit none + class(hypre_str), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + integer, dimension(3) :: periodicity,offset + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + + ! Initialize HYPRE + call HYPRE_Init(ierr) + + ! These use HYPRE's structured environment, which requires that we create a HYPRE grid and stencil + call HYPRE_StructGridCreate(this%cfg%comm,3,this%hypre_box,ierr) + call HYPRE_StructGridSetExtents(this%hypre_box,[this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_],[this%cfg%imax_,this%cfg%jmax_,this%cfg%kmax_],ierr) + periodicity=0 + if (this%cfg%xper) periodicity(1)=this%cfg%nx + if (this%cfg%yper) periodicity(2)=this%cfg%ny + if (this%cfg%zper) periodicity(3)=this%cfg%nz + call HYPRE_StructGridSetPeriodic(this%hypre_box,periodicity,ierr) + call HYPRE_StructGridAssemble(this%hypre_box,ierr) + + ! Build Hypre stencil + call HYPRE_StructStencilCreate(3,this%nst,this%hypre_stc,ierr) + do st=1,this%nst + offset=this%stc(st,:) + call HYPRE_StructStencilSetElement(this%hypre_stc,st-1,offset,ierr) + end do + + end subroutine hypre_str_init + + + !> Setup solver - done everytime the operator changes + subroutine hypre_str_setup(this) + use messager, only: die + implicit none + class(hypre_str), intent(inout) :: this + integer :: i,j,k,st,ierr + integer, dimension(:), allocatable :: row + real(WP), dimension(:), allocatable :: val + + ! If the solver has already been setup, destroy it first + if (this%setup_done) call this%destroy() + + ! Create a structured matrix + call HYPRE_StructMatrixCreate(this%cfg%comm,this%hypre_box,this%hypre_stc,this%hypre_mat,ierr) + call HYPRE_StructMatrixInitialize(this%hypre_mat,ierr) + + ! Prepare local storage + allocate(row(1:this%nst),val(1:this%nst)) + do st=1,this%nst + row(st)=st-1 + end do + + ! Transfer the operator + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + val(1)=1.0_WP; val(2:)=0.0_WP + if (abs(this%opr(1,i,j,k)).gt.0.0_WP) val=this%opr(:,i,j,k) + call HYPRE_StructMatrixSetValues(this%hypre_mat,[i,j,k],this%nst,row,val,ierr) + end do + end do + end do + call HYPRE_StructMatrixAssemble(this%hypre_mat,ierr) + + ! Deallocate storage + deallocate(row,val) + + ! For debugging - output the operator to a file + !call HYPRE_StructMatrixPrint('struct_mat'//char(0),this%hypre_mat,0,ierr) + !call die('Matrix was printed out') + + ! Prepare structured rhs vector + call HYPRE_StructVectorCreate(this%cfg%comm,this%hypre_box,this%hypre_rhs,ierr) + call HYPRE_StructVectorInitialize(this%hypre_rhs,ierr) + + ! Prepare structured solution vector + call HYPRE_StructVectorCreate(this%cfg%comm,this%hypre_box,this%hypre_sol,ierr) + call HYPRE_StructVectorInitialize(this%hypre_sol,ierr) + + ! Initialize and setup the actual solver + select case (this%method) + case (smg) + + ! Create SMG solver + call HYPRE_StructSMGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructSMGSetPrintLevel (this%hypre_solver,sprintlvl,ierr) + call HYPRE_StructSMGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructSMGSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_StructSMGSetLogging (this%hypre_solver,1,ierr) + + ! Setup SMG solver + call HYPRE_StructSMGSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case (pcg_smg) + + ! Create SMG preconditioner + call HYPRE_StructSMGCreate (this%cfg%comm,this%hypre_precond,ierr) + call HYPRE_StructSMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_StructSMGSetTol (this%hypre_precond,0.0_WP,ierr) + + ! Create PCG solver + call HYPRE_StructPCGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructPCGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructPCGSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_StructPCGSetLogging (this%hypre_solver,1,ierr) + + ! Set SMG as preconditioner to PCG + call HYPRE_StructPCGSetPrecond (this%hypre_solver,0,this%hypre_precond,ierr) + + ! Setup PCG solver + call HYPRE_StructPCGSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case (gmres_smg) + + ! Create SMG preconditioner + call HYPRE_StructSMGCreate (this%cfg%comm,this%hypre_precond,ierr) + call HYPRE_StructSMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_StructSMGSetTol (this%hypre_precond,0.0_WP,ierr) + + ! Create GMRES solver + call HYPRE_StructGMRESCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructGMRESSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructGMRESSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_StructGMRESSetLogging (this%hypre_solver,1,ierr) + + ! Set SMG as preconditioner to GMRES + call HYPRE_StructGMRESSetPrecond (this%hypre_solver,0,this%hypre_precond,ierr) + + ! Setup GMRES solver + call HYPRE_StructGMRESSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case (pfmg) + + ! Create PFMG solver + call HYPRE_StructPFMGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructPFMGSetRelaxType (this%hypre_solver,2,ierr) + call HYPRE_StructPFMGSetRAPType (this%hypre_solver,1,ierr) + if (this%maxlevel.gt.0) call HYPRE_StructPFMGSetMaxLevels(this%hypre_solver,this%maxlevel,ierr) + call HYPRE_StructPFMGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructPFMGSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_StructPFMGSetLogging (this%hypre_solver,1,ierr) + call HYPRE_StructPFMGSetPrintLevel(this%hypre_solver,sprintlvl,ierr) + + ! Setup PFMG solver + call HYPRE_StructPFMGSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case (pcg_pfmg) + + ! Create PFMG preconditioner + call HYPRE_StructPFMGCreate (this%cfg%comm,this%hypre_precond,ierr) + call HYPRE_StructPFMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_StructPFMGSetTol (this%hypre_precond,0.0_WP,ierr) + call HYPRE_StructPFMGSetRelaxType(this%hypre_precond,2,ierr) + call HYPRE_StructPFMGSetRAPType (this%hypre_precond,1,ierr) + if (this%maxlevel.gt.0) call HYPRE_StructPFMGSetMaxLevels(this%hypre_precond,this%maxlevel,ierr) + + ! Create PCG solver + call HYPRE_StructPCGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructPCGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructPCGSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_StructPCGSetLogging (this%hypre_solver,1,ierr) + + ! Set PFMG as preconditioner to PCG + call HYPRE_StructPCGSetPrecond (this%hypre_solver,1,this%hypre_precond,ierr) + + ! Setup PCG solver + call HYPRE_StructPCGSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case (gmres_pfmg) + + ! Create PFMG preconditioner + call HYPRE_StructPFMGCreate (this%cfg%comm,this%hypre_precond,ierr) + call HYPRE_StructPFMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_StructPFMGSetTol (this%hypre_precond,0.0_WP,ierr) + call HYPRE_StructPFMGSetRelaxType(this%hypre_precond,2,ierr) + call HYPRE_StructPFMGSetRAPType (this%hypre_precond,1,ierr) + if (this%maxlevel.gt.0) call HYPRE_StructPFMGSetMaxLevels(this%hypre_precond,this%maxlevel,ierr) + + ! Create GMRES solver + call HYPRE_StructGMRESCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_StructGMRESSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_StructGMRESSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_StructGMRESSetLogging (this%hypre_solver,1,ierr) + + ! Set PFMG as preconditioner to GMRES + call HYPRE_StructGMRESSetPrecond (this%hypre_solver,1,this%hypre_precond,ierr) + + ! Setup GMRES solver + call HYPRE_StructGMRESSetup (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + + case default + + ! Solver is unknown + call die('[hypre_str setup] Unknown solution method') + + end select + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine hypre_str_setup + + + !> Solve the linear system iteratively + subroutine hypre_str_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(hypre_str), intent(inout) :: this + integer :: i,j,k,ierr + + ! Check that setup was done + if (.not.this%setup_done) call die('[hypre_str solve] Solver has not been setup.') + + ! Set solver it and err to standard values + this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + + ! Transfer data to the structured vectors + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (abs(this%opr(1,i,j,k)).gt.0.0_WP) then + call HYPRE_StructVectorSetValues(this%hypre_rhs,[i,j,k],this%rhs(i,j,k),ierr) + call HYPRE_StructVectorSetValues(this%hypre_sol,[i,j,k],this%sol(i,j,k),ierr) + else + call HYPRE_StructVectorSetValues(this%hypre_rhs,[i,j,k],0.0_WP,ierr) + call HYPRE_StructVectorSetValues(this%hypre_sol,[i,j,k],0.0_WP,ierr) + end if + end do + end do + end do + + ! Call the appropriate solver + select case (this%method) + case (smg) + call HYPRE_StructSMGSolve (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + call HYPRE_StructSMGGetNumIterations(this%hypre_solver,this%it ,ierr) + call HYPRE_StructSMGGetFinalRelative(this%hypre_solver,this%rerr,ierr) + case (pfmg) + call HYPRE_StructPFMGSolve (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + call HYPRE_StructPFMGGetNumIteration(this%hypre_solver,this%it ,ierr) + call HYPRE_StructPFMGGetFinalRelativ(this%hypre_solver,this%rerr,ierr) + case (pcg_smg,pcg_pfmg) + call HYPRE_StructPCGSolve (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + call HYPRE_StructPCGGetNumIterations(this%hypre_solver,this%it ,ierr) + call HYPRE_StructPCGGetFinalRelative(this%hypre_solver,this%rerr,ierr) + case (gmres_smg,gmres_pfmg) + call HYPRE_StructGMRESSolve (this%hypre_solver,this%hypre_mat,this%hypre_rhs,this%hypre_sol,ierr) + call HYPRE_StructGMRESGetNumIteratio(this%hypre_solver,this%it ,ierr) + call HYPRE_StructGMRESGetFinalRelati(this%hypre_solver,this%rerr,ierr) + end select + + ! Retrieve solution from structured vector + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + call HYPRE_StructVectorGetValues(this%hypre_sol,[i,j,k],this%sol(i,j,k),ierr) + end do + end do + end do + + ! Sync the solution vector + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine hypre_str_solve + + + !> Destroy solver - done everytime the operator changes + subroutine hypre_str_destroy(this) + use messager, only: die + implicit none + class(hypre_str), intent(inout) :: this + integer :: ierr + + ! Destroy solver, operator, and rhs/sol vectors + call HYPRE_StructMatrixDestroy(this%hypre_mat,ierr) + call HYPRE_StructVectorDestroy(this%hypre_rhs,ierr) + call HYPRE_StructVectorDestroy(this%hypre_sol,ierr) + select case (this%method) + case (smg) + call HYPRE_StructSMGDestroy(this%hypre_solver,ierr) + case (pcg_smg) + call HYPRE_StructSMGDestroy(this%hypre_precond,ierr) + call HYPRE_StructPCGDestroy(this%hypre_solver,ierr) + case (gmres_smg) + call HYPRE_StructSMGDestroy(this%hypre_precond,ierr) + call HYPRE_StructGMRESDestroy(this%hypre_solver,ierr) + case (pfmg) + call HYPRE_StructPFMGDestroy(this%hypre_solver,ierr) + case (pcg_pfmg) + call HYPRE_StructPFMGDestroy(this%hypre_precond,ierr) + call HYPRE_StructPCGDestroy(this%hypre_solver,ierr) + case (gmres_pfmg) + call HYPRE_StructPFMGDestroy(this%hypre_precond,ierr) + call HYPRE_StructGMRESDestroy(this%hypre_solver,ierr) + end select + + ! Set setup-flag to false + this%setup_done=.false. + + end subroutine hypre_str_destroy + + + !> Log hypre_str info + subroutine hypre_str_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(hypre_str), intent(in) :: this + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Structured HYPRE solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + write(message,'(" > method = ",i0)') this%method; call log(message) + write(message,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit; call log(message) + write(message,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg; call log(message) + write(message,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg; call log(message) + end if + end subroutine hypre_str_log + + + !> Print hypre_str info to the screen + subroutine hypre_str_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(hypre_str), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("Structured HYPRE solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'(" > method = ",i0)') this%method + write(output_unit,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit + write(output_unit,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg + write(output_unit,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg + end if + end subroutine hypre_str_print + + + !> Short print of hypre_str info to the screen + subroutine hypre_str_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(hypre_str), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("Structured HYPRE solver [",a16,"] for config [",a16,"] -> it/maxit = ",i3,"/",i3," and rerr/rcvg = ",es12.5,"/",es12.5)') trim(this%name),trim(this%cfg%name),this%it,this%maxit,this%rerr,this%rcvg + end subroutine hypre_str_print_short + + +end module hypre_str_class diff --git a/src/solver/hypre_uns_class.f90 b/src/solver/hypre_uns_class.f90 new file mode 100644 index 000000000..794ffe323 --- /dev/null +++ b/src/solver/hypre_uns_class.f90 @@ -0,0 +1,654 @@ +!> Unstructured hypre linear solver concept is +!> defined by extension of the linsol class +module hypre_uns_class + use precision, only: WP + use config_class, only: config + use string, only: str_medium + use linsol_class, only: linsol + implicit none + private + + + ! Expose type/constructor/methods + public :: hypre_uns + + + ! List of known available methods + integer, parameter, public :: amg=1 + integer, parameter, public :: pcg_amg=2 + integer, parameter, public :: gmres_amg=3 + integer, parameter, public :: bicgstab_amg=4 + integer, parameter, public :: pcg =5 + integer, parameter, public :: pcg_parasail=6 + integer, parameter, public :: gmres =7 + integer, parameter, public :: gmres_pilut=8 + + + ! List of key solver parameters + integer , parameter :: gmres_kdim=5 !< Number of basis vectors between restarts + real(WP), parameter :: amg_strong_threshold=0.25_WP !< Coarsening parameter (default is 0.25, 0.5 recommended in 3D) + integer , parameter :: amg_coarsen_type=8 !< Falgout=6 (old default); PMIS=8 and HMIS=10 (recommended) + integer , parameter :: amg_interp=6 !< 6=extended classical modified interpolation (default); 8=standard interpolation + integer , parameter :: amg_relax=6 !< 6=Hybrid symmetric Gauss-Seidel (default); 8=symmetric L1-Gauss-Seidel; 0=Weighted Jacobi + integer , parameter :: amg_relax_coarse=6 !< 9=Gauss elim; 99=GE w/ pivot; may be good to use same as above? + integer , parameter :: sprintlvl=0 !< Solver printing: 0=none (default); 3=init and cvg history + integer , parameter :: pprintlvl=0 !< Precond printing: 0=none (default); 3=init and cvg history + + + ! Hypre-related storage parameter + integer(kind=8), parameter :: hypre_ParCSR=5555 + + + !> hypre_uns object definition + type, extends(linsol) :: hypre_uns + + ! For multigrid solvers, maxlevel parameter is needed + integer :: maxlevel !< Maximum number of multigrid levels + + ! Unstructured mapping + integer, dimension(:,:,:), allocatable :: ind !< Unique global index + integer :: ind_min,ind_max !< Local min and max indices + integer :: ncell_,ncell !< Total number of local and global cells + + ! Private stuff for hypre + integer(kind=8), private :: hypre_mat,parse_mat !< Matrix + integer(kind=8), private :: hypre_rhs,parse_rhs !< Right-hand side + integer(kind=8), private :: hypre_sol,parse_sol !< Solution + integer(kind=8), private :: hypre_solver !< Solver + integer(kind=8), private :: hypre_precond !< Preconditioner + + contains + + procedure :: print_short=>hypre_uns_print_short !< One-line printing of solver status + procedure :: print=>hypre_uns_print !< Long-form printing of solver status + procedure :: log=>hypre_uns_log !< Long-form logging of solver status + procedure :: init=>hypre_uns_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>hypre_uns_setup !< Solver setup (every time the operator changes) + procedure :: solve=>hypre_uns_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>hypre_uns_destroy !< Solver destruction (every time the operator changes) + + procedure, private :: prep_umap !< Create unstructured mapping + + end type hypre_uns + + + !> Declare hypre_uns constructor + interface hypre_uns + procedure hypre_uns_from_args + end interface hypre_uns + + +contains + + + !> Constructor for an hypre_uns object + function hypre_uns_from_args(cfg,name,method,nst) result(self) + use messager, only: die + implicit none + type(hypre_uns) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: method + integer, intent(in) :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set solution method + self%method=method + + ! Set up stencil size and map + self%nst=nst + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Zero out some info + self%it=0 + self%aerr=0.0_WP + self%rerr=0.0_WP + self%maxlevel=0 + + ! Setup is not done + self%setup_done=.false. + + end function hypre_uns_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine hypre_uns_init(this) + use messager, only: die + implicit none + class(hypre_uns), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + + ! Initialize HYPRE + call HYPRE_Init(ierr) + + ! These use HYPRE's IJ environment, which requires that we allocate and prepare an unstructed mapping + call this%prep_umap() + + end subroutine hypre_uns_init + + + !> Setup solver - done everytime the operator changes + subroutine hypre_uns_setup(this) + use messager, only: die + implicit none + class(hypre_uns), intent(inout) :: this + integer :: i,j,k,st,count1,count2,ierr,nn + integer, dimension(:), allocatable :: row,ncol,mycol,col + real(WP), dimension(:), allocatable :: myval,val + integer, dimension(:), allocatable :: sizes + + ! If the solver has already been setup, destroy it first + if (this%setup_done) call this%destroy() + + ! Create an IJ matrix + call HYPRE_IJMatrixCreate (this%cfg%comm,this%ind_min,this%ind_max,this%ind_min,this%ind_max,this%hypre_mat,ierr) + call HYPRE_IJMatrixSetObjectType(this%hypre_mat,hypre_ParCSR,ierr) + allocate(sizes(this%ind_min:this%ind_max)); sizes=this%nst + call HYPRE_IJMatrixSetRowSizes (this%hypre_mat,sizes,ierr) + deallocate(sizes) + ! Allocate storage for transfer + allocate(mycol(this%nst)) + allocate(myval(this%nst)) + allocate( row( this%ncell_)) + allocate(ncol( this%ncell_)) + allocate( col(this%nst*this%ncell_)) + allocate( val(this%nst*this%ncell_)) + ! Transfer operator to HYPRE + count1=0; count2=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%ind(i,j,k).ge.0) then + ! Prepare to add the row + count1=count1+1 + row (count1)=this%ind(i,j,k) + ncol(count1)=0 + ! Copy all columns for processing + do st=1,this%nst + mycol(st)=this%ind(i+this%stc(st,1),j+this%stc(st,2),k+this%stc(st,3)) + myval(st)=this%opr(st,i,j,k) + end do + ! Compress columns to avoid redundancy + do st=1,this%nst + do nn=1,st-1 + if (mycol(st).eq.mycol(nn).and.mycol(st).ge.0) then + mycol(st)=0 + myval(nn)=myval(nn)+myval(st) + end if + end do + end do + ! Finally transfer to operator + do st=1,this%nst + if (mycol(st).ge.0) then + count2=count2+1 + ncol(count1)=ncol(count1)+1 + col (count2)=mycol(st) + val (count2)=myval(st) + end if + end do + end if + end do + end do + end do + call HYPRE_IJMatrixInitialize(this%hypre_mat,ierr) + call HYPRE_IJMatrixSetValues (this%hypre_mat,this%ncell_,ncol,row,col,val,ierr) + call HYPRE_IJMatrixAssemble (this%hypre_mat,ierr) + call HYPRE_IJMatrixGetObject (this%hypre_mat,this%parse_mat,ierr) + + ! Deallocate storage + deallocate(row,ncol,mycol,col,myval,val) + + ! For debugging - output the operator to a file + !call HYPRE_IJMatrixPrint(this%hypre_mat,'ij_mat'//char(0),ierr) + !call die('Matrix was printed out') + + ! Create an IJ vector for rhs + call HYPRE_IJVectorCreate (this%cfg%comm,this%ind_min,this%ind_max,this%hypre_rhs,ierr) + call HYPRE_IJVectorSetObjectType(this%hypre_rhs,hypre_ParCSR,ierr) + call HYPRE_IJVectorInitialize (this%hypre_rhs,ierr) + call HYPRE_IJVectorGetObject (this%hypre_rhs,this%parse_rhs,ierr) + + ! Create an IJ vector for solution + call HYPRE_IJVectorCreate (this%cfg%comm,this%ind_min,this%ind_max,this%hypre_sol,ierr) + call HYPRE_IJVectorSetObjectType(this%hypre_sol,hypre_ParCSR,ierr) + call HYPRE_IJVectorInitialize (this%hypre_sol,ierr) + call HYPRE_IJVectorGetObject (this%hypre_sol,this%parse_sol,ierr) + + ! Initialize and setup the actual solver + select case (this%method) + case (amg) + + ! Create AMG solver + call HYPRE_BoomerAMGCreate (this%hypre_solver,ierr) + call HYPRE_BoomerAMGSetPrintLevel (this%hypre_solver,sprintlvl,ierr) + call HYPRE_BoomerAMGSetInterpType (this%hypre_solver,amg_interp,ierr) + call HYPRE_BoomerAMGSetCoarsenType(this%hypre_solver,amg_coarsen_type,ierr) + call HYPRE_BoomerAMGSetStrongThrshld(this%hypre_solver,amg_strong_threshold,ierr) + call HYPRE_BoomerAMGSetRelaxType (this%hypre_solver,amg_relax,ierr) + call HYPRE_BoomerAMGSetCycleRelaxType(this%hypre_solver,amg_relax_coarse,3,ierr) + !if (this%maxlevel.gt.0) call HYPRE_BoomerAMGSetMaxLevels(this%hypre_solver,this%maxlevel,ierr) + call HYPRE_BoomerAMGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_BoomerAMGSetTol (this%hypre_solver,this%rcvg ,ierr) + + ! Setup AMG solver + call HYPRE_BoomerAMGSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (pcg_amg) + + ! Create PCG solver + call HYPRE_ParCSRPCGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRPCGSetPrintLevel (this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRPCGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRPCGSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_ParCSRPCGSetTwoNorm (this%hypre_solver,1,ierr) + call HYPRE_ParCSRPCGSetLogging (this%hypre_solver,1,ierr) + + ! Create AMG preconditioner + call HYPRE_BoomerAMGCreate (this%hypre_precond,ierr) + call HYPRE_BoomerAMGSetPrintLevel (this%hypre_precond,pprintlvl,ierr) + call HYPRE_BoomerAMGSetInterpType (this%hypre_precond,amg_interp,ierr) + call HYPRE_BoomerAMGSetCoarsenType(this%hypre_precond,amg_coarsen_type,ierr) + call HYPRE_BoomerAMGSetStrongThrshld(this%hypre_precond,amg_strong_threshold,ierr) + call HYPRE_BoomerAMGSetRelaxType (this%hypre_precond,amg_relax,ierr) + call HYPRE_BoomerAMGSetCycleRelaxType(this%hypre_precond,amg_relax_coarse,3,ierr) + !if (this%maxlevel.gt.0) call HYPRE_BoomerAMGSetMaxLevels(this%hypre_precond,this%maxlevel,ierr) + call HYPRE_BoomerAMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_BoomerAMGSetTol (this%hypre_precond,0.0_WP,ierr) + call HYPRE_BoomerAMGSetNumSweeps (this%hypre_precond,1,ierr) + + ! Set AMG as preconditioner to PCG + call HYPRE_ParCSRPCGSetPrecond (this%hypre_solver,2,this%hypre_precond,ierr) + + ! Setup PCG solver + call HYPRE_ParCSRPCGSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (pcg_parasail) + + ! Create PCG solver + call HYPRE_ParCSRPCGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRPCGSetPrintLevel (this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRPCGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRPCGSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_ParCSRPCGSetTwoNorm (this%hypre_solver,1,ierr) + call HYPRE_ParCSRPCGSetLogging (this%hypre_solver,1,ierr) + + ! Create PARASAIL preconditioner + call HYPRE_ParaSailsCreate (this%cfg%comm,this%hypre_precond,ierr) + call HYPRE_ParaSailsSetParams (this%hypre_precond,0.1_WP,1,ierr) + call HYPRE_ParaSailsSetFilter (this%hypre_precond,0.05_WP,ierr) + call HYPRE_ParaSailsSetSym (this%hypre_precond,0,ierr) + call HYPRE_ParaSailsSetLogging (this%hypre_precond,1,ierr) + + ! Set PARASAIL as preconditioner to PCG + call HYPRE_ParCSRPCGSetPrecond (this%hypre_solver,4,this%hypre_precond,ierr) + + ! Setup PCG solver + call HYPRE_ParCSRPCGSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (pcg) + + ! Create PCG solver + call HYPRE_ParCSRPCGCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRPCGSetPrintLevel (this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRPCGSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRPCGSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_ParCSRPCGSetTwoNorm (this%hypre_solver,1,ierr) + call HYPRE_ParCSRPCGSetLogging (this%hypre_solver,1,ierr) + + ! Set Diagonal Scaling as preconditioner to PCG + call HYPRE_ParCSRPCGSetPrecond (this%hypre_solver,1,this%hypre_precond,ierr) + + ! Setup PCG solver + call HYPRE_ParCSRPCGSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (gmres) + + ! Create GMRES solver + call HYPRE_ParCSRGMRESCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRGMRESSetPrintLevel(this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRGMRESSetKDim (this%hypre_solver,gmres_kdim,ierr) + call HYPRE_ParCSRGMRESSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRGMRESSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_ParCSRGMRESSetLogging (this%hypre_solver,1,ierr) + + ! Set Diagonal Scaling as preconditioner to GMRES + call HYPRE_ParCSRGMRESSetPrecond (this%hypre_solver,1,this%hypre_precond,ierr) + + ! Setup GMRES solver + call HYPRE_ParCSRGMRESSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (gmres_amg) + + ! Create GMRES solver + call HYPRE_ParCSRGMRESCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRGMRESSetPrintLevel(this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRGMRESSetKDim (this%hypre_solver,gmres_kdim,ierr) + call HYPRE_ParCSRGMRESSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRGMRESSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_ParCSRGMRESSetLogging (this%hypre_solver,1,ierr) + + ! Create AMG preconditioner + call HYPRE_BoomerAMGCreate (this%hypre_precond,ierr) + call HYPRE_BoomerAMGSetPrintLevel (this%hypre_precond,pprintlvl,ierr) + call HYPRE_BoomerAMGSetInterpType (this%hypre_precond,amg_interp,ierr) + call HYPRE_BoomerAMGSetCoarsenType(this%hypre_precond,amg_coarsen_type,ierr) + call HYPRE_BoomerAMGSetStrongThrshld(this%hypre_precond,amg_strong_threshold,ierr) + call HYPRE_BoomerAMGSetRelaxType (this%hypre_precond,amg_relax,ierr) + call HYPRE_BoomerAMGSetCycleRelaxType(this%hypre_precond,amg_relax_coarse,3,ierr) + !if (this%maxlevel.gt.0) call HYPRE_BoomerAMGSetMaxLevels(this%hypre_precond,this%maxlevel,ierr) + call HYPRE_BoomerAMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_BoomerAMGSetTol (this%hypre_precond,0.0_WP,ierr) + call HYPRE_BoomerAMGSetNumSweeps (this%hypre_precond,1,ierr) + + ! Set AMG as preconditioner to GMRES + call HYPRE_ParCSRGMRESSetPrecond (this%hypre_solver,2,this%hypre_precond,ierr) + + ! Setup GMRES solver + call HYPRE_ParCSRGMRESSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + + case (gmres_pilut) + + ! Create GMRES solver + call HYPRE_ParCSRGMRESCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRGMRESSetPrintLevel(this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRGMRESSetKDim (this%hypre_solver,gmres_kdim,ierr) + call HYPRE_ParCSRGMRESSetMaxIter (this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRGMRESSetTol (this%hypre_solver,this%rcvg,ierr) + call HYPRE_ParCSRGMRESSetLogging (this%hypre_solver,1,ierr) + + ! Create PILUT preconditioner + call HYPRE_ParCSRPilutCreate (this%cfg%comm,this%hypre_precond,ierr) + + ! Set PILUT as preconditioner to GMRES + call HYPRE_ParCSRGMRESSetPrecond (this%hypre_solver,3,this%hypre_precond,ierr) + + ! Setup GMRES solver + call HYPRE_ParCSRGMRESSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case (bicgstab_amg) + + ! Create BiCGstab solver + call HYPRE_ParCSRBiCGSTABCreate (this%cfg%comm,this%hypre_solver,ierr) + call HYPRE_ParCSRBiCGSTABSetPrintLev(this%hypre_solver,sprintlvl,ierr) + call HYPRE_ParCSRBiCGSTABSetMaxIter(this%hypre_solver,this%maxit,ierr) + call HYPRE_ParCSRBiCGSTABSetTol (this%hypre_solver,this%rcvg ,ierr) + call HYPRE_ParCSRBiCGSTABSetLogging(this%hypre_solver,1,ierr) + + ! Create AMG preconditioner + call HYPRE_BoomerAMGCreate (this%hypre_precond,ierr) + call HYPRE_BoomerAMGSetPrintLevel (this%hypre_precond,pprintlvl,ierr) + call HYPRE_BoomerAMGSetInterpType (this%hypre_precond,amg_interp,ierr) + call HYPRE_BoomerAMGSetCoarsenType(this%hypre_precond,amg_coarsen_type,ierr) + call HYPRE_BoomerAMGSetStrongThrshld(this%hypre_precond,amg_strong_threshold,ierr) + call HYPRE_BoomerAMGSetRelaxType (this%hypre_precond,amg_relax,ierr) + call HYPRE_BoomerAMGSetCycleRelaxType(this%hypre_precond,amg_relax_coarse,3,ierr) + !if (this%maxlevel.gt.0) call HYPRE_BoomerAMGSetMaxLevels(this%hypre_precond,this%maxlevel,ierr) + call HYPRE_BoomerAMGSetMaxIter (this%hypre_precond,1,ierr) + call HYPRE_BoomerAMGSetTol (this%hypre_precond,0.0_WP,ierr) + call HYPRE_BoomerAMGSetNumSweeps (this%hypre_precond,1,ierr) + + ! Set AMG as preconditioner to BiCGstab + call HYPRE_ParCSRBiCGSTABSetPrecond(this%hypre_solver,2,this%hypre_precond,ierr) + + ! Setup BiCGstab solver + call HYPRE_ParCSRBiCGSTABSetup (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + + case default + + ! Solver is unknown + call die('[hypre_uns setup] Unknown solution method') + + end select + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine hypre_uns_setup + + + !> Solve the linear system iteratively + subroutine hypre_uns_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(hypre_uns), intent(inout) :: this + integer :: i,j,k,count,ierr + integer, dimension(:), allocatable :: ind + real(WP), dimension(:), allocatable :: rhs,sol + + ! Check that setup was done + if (.not.this%setup_done) call die('[hypre_uns solve] Solver has not been setup.') + + ! Set solver it and err to standard values + this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + + ! Transfer data to the IJ vectors + allocate(rhs(this%ncell_)) + allocate(sol(this%ncell_)) + allocate(ind(this%ncell_)) + count=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%ind(i,j,k).ge.0) then + count=count+1 + ind(count)=this%ind(i,j,k) + rhs(count)=this%rhs(i,j,k) + sol(count)=this%sol(i,j,k) + end if + end do + end do + end do + call HYPRE_IJVectorSetValues(this%hypre_rhs,this%ncell_,ind,rhs,ierr) + call HYPRE_IJVectorSetValues(this%hypre_sol,this%ncell_,ind,sol,ierr) + + ! Call the appropriate solver + select case (this%method) + case (amg) + call HYPRE_BoomerAMGSolve (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + call HYPRE_BoomerAMGGetNumIterations(this%hypre_solver,this%it ,ierr) + call HYPRE_BoomerAMGGetFinalReltvRes(this%hypre_solver,this%rerr,ierr) + case (pcg,pcg_amg,pcg_parasail) + call HYPRE_ParCSRPCGSolve (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + call HYPRE_ParCSRPCGGetNumIterations(this%hypre_solver,this%it ,ierr) + call HYPRE_ParCSRPCGGetFinalRelative(this%hypre_solver,this%rerr,ierr) + case (gmres,gmres_pilut,gmres_amg) + call HYPRE_ParCSRGMRESSolve (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + call HYPRE_ParCSRGMRESGetNumIteratio(this%hypre_solver,this%it ,ierr) + call HYPRE_ParCSRGMRESGetFinalRelati(this%hypre_solver,this%rerr,ierr) + case (bicgstab_amg) + call HYPRE_ParCSRBiCGSTABSolve (this%hypre_solver,this%parse_mat,this%parse_rhs,this%parse_sol,ierr) + call HYPRE_ParCSRBiCGSTABGetNumIter (this%hypre_solver,this%it ,ierr) + call HYPRE_ParCSRBiCGSTABGetFinalRel(this%hypre_solver,this%rerr,ierr) + end select + + ! Retrieve solution from IJ vector + call HYPRE_IJVectorGetValues(this%hypre_sol,this%ncell_,ind,sol,ierr) + count=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%ind(i,j,k).ge.0) then + count=count+1 + this%sol(i,j,k)=sol(count) + end if + end do + end do + end do + deallocate(rhs,sol,ind) + + ! Sync the solution vector + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine hypre_uns_solve + + + !> Destroy solver - done everytime the operator changes + subroutine hypre_uns_destroy(this) + use messager, only: die + implicit none + class(hypre_uns), intent(inout) :: this + integer :: ierr + + ! Destroy solver, operator, and rhs/sol vectors + call HYPRE_IJMatrixDestroy(this%hypre_mat,ierr) + call HYPRE_IJVectorDestroy(this%hypre_rhs,ierr) + call HYPRE_IJVectorDestroy(this%hypre_sol,ierr) + select case (this%method) + case (amg) + call HYPRE_BoomerAMGDestroy(this%hypre_solver,ierr) + case (pcg_amg) + call HYPRE_BoomerAMGDestroy(this%hypre_precond,ierr) + call HYPRE_ParCSRPCGDestroy(this%hypre_solver,ierr) + case (pcg_parasail) + call HYPRE_ParaSailsDestroy(this%hypre_precond,ierr) + call HYPRE_ParCSRPCGDestroy(this%hypre_solver,ierr) + case (pcg) + call HYPRE_ParCSRPCGDestroy(this%hypre_solver,ierr) + case (gmres) + call HYPRE_ParCSRGMRESDestroy(this%hypre_solver,ierr) + case (gmres_amg) + call HYPRE_BoomerAMGDestroy(this%hypre_precond,ierr) + call HYPRE_ParCSRGMRESDestroy(this%hypre_solver,ierr) + case (gmres_pilut) + call HYPRE_ParCSRPilutDestroy(this%hypre_precond,ierr) + call HYPRE_ParCSRGMRESDestroy(this%hypre_solver,ierr) + case (bicgstab_amg) + call HYPRE_BoomerAMGDestroy(this%hypre_precond,ierr) + call HYPRE_ParCSRBiCGSTABDestroy(this%hypre_solver,ierr) + end select + + ! Set setup-flag to false + this%setup_done=.false. + + end subroutine hypre_uns_destroy + + + !> Creation of an unstructured mapping + subroutine prep_umap(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM,MPI_INTEGER + implicit none + class(hypre_uns), intent(inout) :: this + integer :: i,j,k,ierr,count + integer, dimension(:), allocatable :: ncell_per_proc + + ! Dump any existing mapping and recreate it + this%ncell =0 + this%ncell_=0 + this%ind_min=0 + this%ind_max=0 + if (.not.allocated(this%ind)) allocate(this%ind(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + this%ind=-1 + + ! Count number of active cells + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (abs(this%opr(1,i,j,k)).gt.10.0_WP*epsilon(1.0_WP)) this%ncell_=this%ncell_+1 + end do + end do + end do + call MPI_ALLREDUCE(this%ncell_,this%ncell,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + + ! Create an array with ncell_ per cpu + allocate(ncell_per_proc(this%cfg%nproc)) + call MPI_ALLGATHER(this%ncell_,1,MPI_INTEGER,ncell_per_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + do i=2,this%cfg%nproc + ncell_per_proc(i)=ncell_per_proc(i)+ncell_per_proc(i-1) + end do + + ! Assign unique global index to all non-empty cells + count=0 + if (this%cfg%rank.gt.0) count=ncell_per_proc(this%cfg%rank) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (abs(this%opr(1,i,j,k)).gt.10.0_WP*epsilon(1.0_WP)) then + this%ind(i,j,k)=count + count=count+1 + end if + end do + end do + end do + + ! Take care of periodicity and domain decomposition + call this%cfg%sync(this%ind) + + ! Get local min/max + this%ind_min=0 + if (this%cfg%rank.gt.0) this%ind_min=ncell_per_proc(this%cfg%rank) + this%ind_max=ncell_per_proc(this%cfg%rank+1)-1 + + ! Deallocate + deallocate(ncell_per_proc) + + end subroutine prep_umap + + + !> Log hypre_uns info + subroutine hypre_uns_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(hypre_uns), intent(in) :: this + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Unstructured Hypre Linear Solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + write(message,'(" > method = ",i0)') this%method; call log(message) + write(message,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit; call log(message) + write(message,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg; call log(message) + write(message,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg; call log(message) + end if + end subroutine hypre_uns_log + + + !> Print hypre_uns info to the screen + subroutine hypre_uns_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(hypre_uns), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("Unstructured Hypre Linear Solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'(" > method = ",i0)') this%method + write(output_unit,'(" > it/maxit = ",i0,"/",i0)') this%it,this%maxit + write(output_unit,'(" > aerr/acvg = ",es12.5,"/",es12.5)') this%aerr,this%acvg + write(output_unit,'(" > rerr/rcvg = ",es12.5,"/",es12.5)') this%rerr,this%rcvg + end if + end subroutine hypre_uns_print + + + !> Short print of hypre_uns info to the screen + subroutine hypre_uns_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(hypre_uns), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("Unstructured Hypre Linear Solver [",a16,"] for config [",a16,"] -> it/maxit = ",i3,"/",i3," and rerr/rcvg = ",es12.5,"/",es12.5)') trim(this%name),trim(this%cfg%name),this%it,this%maxit,this%rerr,this%rcvg + end subroutine hypre_uns_print_short + + +end module hypre_uns_class diff --git a/src/solver/linsol_class.f90 b/src/solver/linsol_class.f90 new file mode 100644 index 000000000..c3bef687b --- /dev/null +++ b/src/solver/linsol_class.f90 @@ -0,0 +1,74 @@ +!> Abstract linear solver concept is defined here: +!> given a config, it provides parallel solvers +module linsol_class + use precision, only: WP + use config_class, only: config + use string, only: str_medium + implicit none + private + + + ! Expose type/constructor/methods + public :: linsol + + + !> linsol object definition + type, abstract :: linsol + + ! A linear solver works for a config + type(config), pointer :: cfg !< Config for linsol + + ! An linsol has a name + character(len=str_medium) :: name !< Name of solver + + ! Specific method to use + integer :: method !< Solution method (we assume all solvers will have some sort of options) + + ! An linsol has a stencil size + integer :: nst !< Stencil size in 3D + integer, dimension(:,:), allocatable :: stc !< Stencil map in 3D (from stencil entry to i/j/k shift) + integer, dimension(:,:,:), allocatable :: stmap !< Inverse stencil map in 3D (from i/j/k shift to stencil entry) + + ! An linsol stores the linear operator and rhs + real(WP), dimension(:,:,:,:), allocatable :: opr !< Linear operator + real(WP), dimension(:,:,:), allocatable :: rhs !< RHS + real(WP), dimension(:,:,:), allocatable :: sol !< Solution + + ! Is the solver setup? + logical :: setup_done !< Check whether the solver has been setup + + ! Convergence criteria + integer :: maxit !< Maximum number of iterations allowed + real(WP) :: rcvg !< Desired relative convergence criterion + real(WP) :: acvg !< Desired absolue convergence criterion + + ! Current convergence info + integer :: it !< Current number of iterations + real(WP) :: rerr !< Current relative error + real(WP) :: aerr !< Current absolute error + + contains + procedure(in_noarg_interface ), deferred :: print_short !< One-line printing of solver status + procedure(in_noarg_interface ), deferred :: print !< Long-form printing of solver status + procedure(in_noarg_interface ), deferred :: log !< Long-form logging of solver status + procedure(inout_noarg_interface), deferred :: init !< Grid and stencil initialization - done once for the grid and stencil + procedure(inout_noarg_interface), deferred :: setup !< Solver setup (every time the operator changes) + procedure(inout_noarg_interface), deferred :: solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure(inout_noarg_interface), deferred :: destroy !< Solver destruction (every time the operator changes) + end type linsol + + + !> Interface + abstract interface + subroutine in_noarg_interface(this) + import linsol + class(linsol), intent(in) :: this + end subroutine in_noarg_interface + subroutine inout_noarg_interface(this) + import linsol + class(linsol), intent(inout) :: this + end subroutine inout_noarg_interface + end interface + + +end module linsol_class diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 new file mode 100644 index 000000000..85605ba08 --- /dev/null +++ b/src/solver/pfft3d_class.f90 @@ -0,0 +1,1070 @@ +!> 3D FFT pressure solver concept is defined by extension of the linsol class +!> This solver is specifically intended to be a FFT-based pressure Poisson solver +!> for 3D periodic uniform computational domains decomposed in at most 2 directions +! Based on serial FFTW here, and manual transpose. It'd be nice to switch to a library +module pfft3d_class + use precision, only: WP + use config_class, only: config + use string, only: str_short + use linsol_class, only: linsol + use, intrinsic :: iso_c_binding + implicit none + private + + + ! Expose type/constructor/methods + public :: pfft3d + + + !> pfft3d object definition + type, extends(linsol) :: pfft3d + + ! FFT's oddball + logical :: oddball + + ! Data storage for FFTW plans + real(C_DOUBLE), dimension(:), allocatable :: in_x,out_x + real(C_DOUBLE), dimension(:), allocatable :: in_y,out_y + real(C_DOUBLE), dimension(:), allocatable :: in_z,out_z + + ! FFTW plans + type(C_PTR) :: fplan_x,bplan_x + type(C_PTR) :: fplan_y,bplan_y + type(C_PTR) :: fplan_z,bplan_z + + ! Storage for transposed data + real(WP), dimension(:,:,:), allocatable :: xtrans + real(WP), dimension(:,:,:), allocatable :: ytrans + real(WP), dimension(:,:,:), allocatable :: ztrans + + ! Transpose partition - X + integer, dimension(:), allocatable :: imin_x,imax_x + integer, dimension(:), allocatable :: jmin_x,jmax_x + integer, dimension(:), allocatable :: kmin_x,kmax_x + integer, dimension(:), allocatable :: nx_x,ny_x,nz_x + real(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + integer :: sendcount_x,recvcount_x + character(len=str_short) :: xdir + + ! Transpose partition - Y + integer, dimension(:), allocatable :: imin_y,imax_y + integer, dimension(:), allocatable :: jmin_y,jmax_y + integer, dimension(:), allocatable :: kmin_y,kmax_y + integer, dimension(:), allocatable :: nx_y,ny_y,nz_y + real(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + integer :: sendcount_y,recvcount_y + character(len=str_short) :: ydir + + ! Transpose partition - Z + integer, dimension(:), allocatable :: imin_z,imax_z + integer, dimension(:), allocatable :: jmin_z,jmax_z + integer, dimension(:), allocatable :: kmin_z,kmax_z + integer, dimension(:), allocatable :: nx_z,ny_z,nz_z + real(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + integer :: sendcount_z,recvcount_z + character(len=str_short) :: zdir + + contains + + procedure :: print_short=>pfft3d_print_short !< One-line printing of solver status + procedure :: print=>pfft3d_print !< Long-form printing of solver status + procedure :: log=>pfft3d_log !< Long-form logging of solver status + procedure :: init=>pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>pfft3d_setup !< Solver setup (every time the operator changes) + procedure :: solve=>pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>pfft3d_destroy !< Solver destruction (every time the operator changes) + + procedure, private :: pfft3d_xtranspose_init + procedure, private :: pfft3d_ytranspose_init + procedure, private :: pfft3d_ztranspose_init + + procedure, private :: pfft3d_xtranspose_forward + procedure, private :: pfft3d_ytranspose_forward + procedure, private :: pfft3d_ztranspose_forward + + procedure, private :: pfft3d_xtranspose_backward + procedure, private :: pfft3d_ytranspose_backward + procedure, private :: pfft3d_ztranspose_backward + + end type pfft3d + + + !> Declare pfft3d constructor + interface pfft3d + procedure pfft3d_from_args + end interface pfft3d + + +contains + + + !> Constructor for an pfft3d object + function pfft3d_from_args(cfg,name) result(self) + use messager, only: die + implicit none + type(pfft3d) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set solution method - not used + self%method=0 + + ! Set up stencil size and map + self%nst=7 + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Zero out some info + self%it=0 + self%aerr=0.0_WP + self%rerr=0.0_WP + + ! Setup is not done + self%setup_done=.false. + + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + integer :: ndim,ndcp + ! Periodicity and uniformity of mesh + if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') + if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') + if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') + ! Ensure that we have at least one non-decomposed direction + ndim=0 + if (self%cfg%nx.gt.1) ndim=ndim+1 + if (self%cfg%ny.gt.1) ndim=ndim+1 + if (self%cfg%nz.gt.1) ndim=ndim+1 + ndcp=0 + if (self%cfg%npx.gt.1) ndcp=ndcp+1 + if (self%cfg%npy.gt.1) ndcp=ndcp+1 + if (self%cfg%npz.gt.1) ndcp=ndcp+1 + if (ndcp.ge.ndim) call die('[pfft3d constructor] Need at least one NON-decomposed direction') + end block check_solver_is_useable + + end function pfft3d_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine pfft3d_init(this) + use messager, only: die + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + integer, dimension(3) :: periodicity,offset + include 'fftw3.f03' + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + + ! Initialize transpose and FFTW plans in x + if (this%cfg%nx.gt.1) then + call this%pfft3d_xtranspose_init() + allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) + this%fplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_R2HC,FFTW_MEASURE) + this%bplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_HC2R,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in y + if (this%cfg%ny.gt.1) then + call this%pfft3d_ytranspose_init() + allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) + this%fplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_R2HC,FFTW_MEASURE) + this%bplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_HC2R,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in z + if (this%cfg%nz.gt.1) then + call this%pfft3d_ztranspose_init() + allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) + this%fplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_R2HC,FFTW_MEASURE) + this%bplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_HC2R,FFTW_MEASURE) + end if + + ! Find who owns the oddball + this%oddball=.false. + if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. + + end subroutine pfft3d_init + + + !> Initialize transpose tool in x + subroutine pfft3d_xtranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,ip,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%xdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%xdir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%xdir='z' + end if + + ! Allocate global partitions + allocate( this%nx_x(this%cfg%npx)) + allocate( this%ny_x(this%cfg%npx)) + allocate( this%nz_x(this%cfg%npx)) + allocate(this%imin_x(this%cfg%npx)) + allocate(this%imax_x(this%cfg%npx)) + allocate(this%jmin_x(this%cfg%npx)) + allocate(this%jmax_x(this%cfg%npx)) + allocate(this%kmin_x(this%cfg%npx)) + allocate(this%kmax_x(this%cfg%npx)) + + ! Partition + select case (trim(this%xdir)) + case ('x') + + ! No transpose required, use local partition + this%nx_x=this%cfg%nx_ + this%ny_x=this%cfg%ny_ + this%nz_x=this%cfg%nz_ + this%imin_x=this%cfg%imin_ + this%imax_x=this%cfg%imax_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%ny/this%cfg%npx + r=mod(this%cfg%ny,this%cfg%npx) + if (ip.le.r) then + this%ny_x(ip) =q+1 + this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) + else + this%ny_x(ip) =q + this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q + end if + this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 + end do + this%nz_x=this%cfg%nz_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%nz/this%cfg%npx + r=mod(this%cfg%nz,this%cfg%npx) + if (ip.le.r) then + this%nz_x(ip) =q+1 + this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) + else + this%nz_x(ip) =q + this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q + end if + this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 + end do + this%ny_x=this%cfg%ny_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + end select + + ! Allocate storage + allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) + + end subroutine pfft3d_xtranspose_init + + + !> Initialize transpose tool in y + subroutine pfft3d_ytranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,jp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%ydir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%ydir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%ydir='x' + end if + + ! Allocate global partitions + allocate( this%nx_y(this%cfg%npy)) + allocate( this%ny_y(this%cfg%npy)) + allocate( this%nz_y(this%cfg%npy)) + allocate(this%imin_y(this%cfg%npy)) + allocate(this%imax_y(this%cfg%npy)) + allocate(this%jmin_y(this%cfg%npy)) + allocate(this%jmax_y(this%cfg%npy)) + allocate(this%kmin_y(this%cfg%npy)) + allocate(this%kmax_y(this%cfg%npy)) + + ! Partition + select case (trim(this%ydir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nx/this%cfg%npy + r=mod(this%cfg%nx,this%cfg%npy) + if (jp.le.r) then + this%nx_y(jp) =q+1 + this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) + else + this%nx_y(jp) =q + this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q + end if + this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 + end do + this%nz_y=this%cfg%nz_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + case ('y') + + ! No transpose required, use local partition + this%nx_y=this%cfg%nx_ + this%ny_y=this%cfg%ny_ + this%nz_y=this%cfg%nz_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + this%jmin_y=this%cfg%jmin_ + this%jmax_y=this%cfg%jmax_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nz/this%cfg%npy + r=mod(this%cfg%nz,this%cfg%npy) + if (jp.le.r) then + this%nz_y(jp) =q+1 + this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) + else + this%nz_y(jp) =q + this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q + end if + this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 + end do + this%nx_y=this%cfg%nx_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + end select + + ! Allocate storage + allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) + + end subroutine pfft3d_ytranspose_init + + + !> Initialize transpose tool in z + subroutine pfft3d_ztranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,kp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%zdir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%zdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%zdir='y' + end if + + ! Allocate global partitions + allocate( this%nx_z(this%cfg%npz)) + allocate( this%ny_z(this%cfg%npz)) + allocate( this%nz_z(this%cfg%npz)) + allocate(this%imin_z(this%cfg%npz)) + allocate(this%imax_z(this%cfg%npz)) + allocate(this%jmin_z(this%cfg%npz)) + allocate(this%jmax_z(this%cfg%npz)) + allocate(this%kmin_z(this%cfg%npz)) + allocate(this%kmax_z(this%cfg%npz)) + + ! Partition + select case (trim(this%zdir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%nx/this%cfg%npz + r=mod(this%cfg%nx,this%cfg%npz) + if (kp.le.r) then + this%nx_z(kp) =q+1 + this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) + else + this%nx_z(kp) =q + this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q + end if + this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 + end do + this%ny_z=this%cfg%ny_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%ny/this%cfg%npz + r=mod(this%cfg%ny,this%cfg%npz) + if (kp.le.r) then + this%ny_z(kp) =q+1 + this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) + else + this%ny_z(kp) =q + this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q + end if + this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 + end do + this%nx_z=this%cfg%nx_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('z') + + ! No transpose required, use local partition + this%nx_z=this%cfg%nx_ + this%ny_z=this%cfg%ny_ + this%nz_z=this%cfg%nz_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + this%kmin_z=this%cfg%kmin_ + this%kmax_z=this%cfg%kmax_ + + end select + + ! Allocate storage + allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) + + end subroutine pfft3d_ztranspose_init + + + !> Perform forward transpose in x + subroutine pfft3d_xtranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + At=A + case ('y') + ! Transpose x=>y + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose x=>z + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine pfft3d_xtranspose_forward + + + !> Perform forward transpose in y + subroutine pfft3d_ytranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose y=>x + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + At=A + case ('z') + ! Transpose y=>z + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine pfft3d_ytranspose_forward + + + !> Perform forward transpose in z + subroutine pfft3d_ztranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose z=>x + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose z=>y + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + At=A + end select + + end subroutine pfft3d_ztranspose_forward + + + !> Perform backward transpose in x + subroutine pfft3d_xtranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + A=At + case ('y') + ! Transpose y=>x + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + jj=j-this%jmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose z=>x + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + kk=k-this%kmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine pfft3d_xtranspose_backward + + + !> Perform backward transpose in y + subroutine pfft3d_ytranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose x=>y + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + A=At + case ('z') + ! Transpose z=>y + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine pfft3d_ytranspose_backward + + + !> Perform backward transpose in z + subroutine pfft3d_ztranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose x=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose y=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + A=At + end select + + end subroutine pfft3d_ztranspose_backward + + + !> Setup solver - done everytime the operator changes + subroutine pfft3d_setup(this) + use messager, only: die + implicit none + class(pfft3d), intent(inout) :: this + integer :: i,j,k,st,ierr + integer, dimension(:), allocatable :: row + real(WP), dimension(:), allocatable :: val + + ! If the solver has already been setup, destroy it first + if (this%setup_done) call this%destroy() + + + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine pfft3d_setup + + + !> Solve the linear system iteratively + subroutine pfft3d_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(pfft3d), intent(inout) :: this + integer :: i,j,k,ierr + + ! Check that setup was done + if (.not.this%setup_done) call die('[pfft3d solve] Solver has not been setup.') + + ! Set solver it and err to standard values + this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + + + + ! Sync the solution vector + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine pfft3d_solve + + + !> Destroy solver - done everytime the operator changes + subroutine pfft3d_destroy(this) + use messager, only: die + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr + + ! Destroy solver, operator, and rhs/sol vectors + + + ! Set setup-flag to false + this%setup_done=.false. + + end subroutine pfft3d_destroy + + + !> Log pfft3d info + subroutine pfft3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(pfft3d), intent(in) :: this + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + end if + end subroutine pfft3d_log + + + !> Print pfft3d info to the screen + subroutine pfft3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(pfft3d), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + end if + end subroutine pfft3d_print + + + !> Short print of pfft3d info to the screen + subroutine pfft3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(pfft3d), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + end subroutine pfft3d_print_short + + +end module pfft3d_class From c7e81784abdeb5aeceb2f38da0a5b5a39f15c347 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 29 Nov 2022 14:00:10 -0500 Subject: [PATCH 010/152] Update lpt_class.f90 Added option to interpolate temperature to particle. Also made drag model public. --- src/particles/lpt_class.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index cbc2e528e..6c3363735 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -19,9 +19,6 @@ module lpt_class !> I/O chunk size to read at a time integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - ! Drag model - character(len=str_medium), public :: drag_model !> Basic particle object definition type :: part @@ -73,6 +70,7 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) + character(len=str_medium), public :: drag_model !< Drag model ! Collisional parameters real(WP) :: Tcol !< Characteristic collision time scale @@ -575,7 +573,7 @@ end subroutine advance !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) + subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) implicit none class(lpt), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) @@ -583,11 +581,12 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(part), intent(in) :: p real(WP), dimension(3), intent(out) :: acc real(WP), intent(out) :: opt_dt real(WP) :: corr,Re,tau - real(WP) :: fvisc,frho,pVF,fVF + real(WP) :: fvisc,frho,pVF,fVF,fT real(WP), dimension(3) :: fvel ! Interpolate the fluid phase velocity to the particle location fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) @@ -599,6 +598,8 @@ subroutine get_rhs(this,U,V,W,rho,visc,p,acc,opt_dt) ! Interpolate the particle volume fraction to the particle location pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') fVF=1.0_WP-pVF + ! Interpolate the fluid temperature to the particle location if present + if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') ! Particle Reynolds number Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) ! Drag correction @@ -615,7 +616,7 @@ function drag_correction() result(F) real(WP) :: F real(WP) :: Ma,Kn,b1,b2 - select case(trim(drag_model)) + select case(trim(this%drag_model)) case('Stokes') F=1.0_WP case('Schiller-Naumann') From d9b56f6bf1dfef1678b3f255ba04561a146ec5ba Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 30 Nov 2022 14:17:23 -0500 Subject: [PATCH 011/152] Update lpt_class.f90 Drag correction was being canceled out --- src/particles/lpt_class.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 6c3363735..11b871c6e 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -607,7 +607,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) ! Particle response time tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) ! Return acceleration and optimal timestep size - acc=corr*(fvel-p%vel)/tau + acc=(fvel-p%vel)/tau opt_dt=tau/real(this%nstep,WP) contains @@ -619,14 +619,17 @@ function drag_correction() result(F) select case(trim(this%drag_model)) case('Stokes') F=1.0_WP - case('Schiller-Naumann') + case('Schiller-Naumann','Schiller Naumann','SN') F=1.0_WP+0.15_WP*Re**(0.687_WP) case('Tenneti') ! Tenneti and Subramaniam (2011) b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) F=fVF*((1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2) - case('KC') + case('Khalloufi Capecelatro','KC') + F=0.0_WP + case default + F=1.0_WP end select end function drag_correction From b674f2819e7baf9c6f7559cc37a4b8eae299f4f4 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 30 Nov 2022 15:06:21 -0500 Subject: [PATCH 012/152] Update simulation.f90 Need to specify drag model in HIT LPT initialization --- examples/hit/src/simulation.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index 97eefb252..c906814b1 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -148,6 +148,8 @@ subroutine simulation_init integer :: i,np ! Create solver lp=lpt(cfg=cfg,name='LPT') + ! Get drag model from the inpit + call param_read('Drag model',lp%drag_model,default='Schiller-Naumann') ! Get particle density from the input call param_read('Particle density',lp%rho) ! Get particle diameter from the input From c6d27d3fc66407dd97224cb6515723269af22732 Mon Sep 17 00:00:00 2001 From: rgrawe Date: Mon, 5 Dec 2022 12:02:17 -0500 Subject: [PATCH 013/152] Fluidized Bed Initialization With Grid Problems Attempting to initialize fluidized bed but there's something wrong with the grid. --- examples/fluidized_bed/GNUmakefile | 8 +- examples/fluidized_bed/input | 24 +- examples/fluidized_bed/src/geometry.f90 | 8 +- examples/fluidized_bed/src/simulation.f90 | 869 +++++++++++----------- examples/hit/GNUmakefile | 6 +- src/particles/.#lpt_class.f90 | 1 + tools/GNUMake/comps/gnu.mak | 8 +- 7 files changed, 473 insertions(+), 451 deletions(-) create mode 120000 src/particles/.#lpt_class.f90 diff --git a/examples/fluidized_bed/GNUmakefile b/examples/fluidized_bed/GNUmakefile index 7088b9a5c..76671101d 100644 --- a/examples/fluidized_bed/GNUmakefile +++ b/examples/fluidized_bed/GNUmakefile @@ -6,7 +6,7 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE -USE_IRL = TRUE +USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE COMP = gnu @@ -24,9 +24,9 @@ VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile #HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/rgrawe/NGA2hypre +#IRL_DIR = /Users/desjardi/Builds/IRL # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 66b49365f..c05ced90d 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -2,11 +2,11 @@ Partition : 4 1 1 # Mesh definition -Lx : 0.5 -Ly : 1 -Lz : 0.02 -nx : 32 -ny : 64 +Lx : .0256 +Ly : .0128 +Lz : 2.19e-4 +nx : 64 +ny : 32 nz : 1 # Time integration @@ -15,15 +15,17 @@ Max cfl number : 1 Max time : 10 # Fluid properties -Dynamic viscosity : 1e-5 -Density : 1 -Gravity : 0 -1 0 -Inlet velocity : 3.5 +Dynamic viscosity : 1.8e-5 +Density : 1.2 +Gravity : -1 0 0 +Inlet velocity : 0.2 # Particle parameters -Number of particles : 3000 +Bed height : .0128 +Avg. volume fraction : 0.4 +Coefficient of restitution : 0.8 Particle density : 1000 -Particle diameter : 0.01 +Particle diameter : 200e-6 # Pressure solver Pressure tolerance : 1e-6 diff --git a/examples/fluidized_bed/src/geometry.f90 b/examples/fluidized_bed/src/geometry.f90 index 4ea526928..5b63072fc 100644 --- a/examples/fluidized_bed/src/geometry.f90 +++ b/examples/fluidized_bed/src/geometry.f90 @@ -38,14 +38,14 @@ subroutine geometry_init x(i)=real(i-1,WP)/real(nx,WP)*Lx end do do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly end do do k=1,nz+1 z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz end do ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='FBed') + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='FBed') end block create_grid @@ -70,8 +70,8 @@ subroutine geometry_init do k=cfg%kmino_,cfg%kmaxo_ do j=cfg%jmino_,cfg%jmaxo_ do i=cfg%imino_,cfg%imaxo_ - if (cfg%ym(j).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP - if (cfg%ym(j).gt.cfg%yL) cfg%VF(i,j,k)=0.0_WP + if (cfg%xm(i).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP + if (cfg%xm(i).gt.cfg%xL) cfg%VF(i,j,k)=0.0_WP end do end do end do diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index d16bc0711..af71c769a 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -1,434 +1,453 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use lpt_class, only: lpt - use lowmach_class, only: lowmach - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get an LPT solver, a lowmach solver, and corresponding time tracker - type(lowmach), public :: fs - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - type(monitor) :: lptfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,dRHOdt - real(WP) :: visc,rho,inlet_velocity + use precision, only: WP + use geometry, only: cfg + use lpt_class, only: lpt + use lowmach_class, only: lowmach + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker + type(lowmach), public :: fs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + type(monitor) :: lptfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,dRHOdt + real(WP) :: visc,rho,inlet_velocity contains - - - !> Function that localizes the top of the domain - function top_locator(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (j.eq.pg%jmax+1) isIn=.true. - end function top_locator - - - !> Function that localizes the bottom of the domain - function bottom_locator(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (j.eq.pg%jmin) isIn=.true. - end function bottom_locator - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create a low Mach flow solver with bconds - create_flow_solver: block - use ils_class, only: pcg_pfmg,pcg_amg - use lowmach_class, only: dirichlet,clipped_neumann - ! Create flow solver - fs=lowmach(cfg=cfg,name='Variable density low Mach NS') - ! Define boundary conditions - call fs%add_bcond(name='inflow' ,type=dirichlet ,locator=bottom_locator,face='y',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator= top_locator,face='y',dir=+1,canCorrect=.true. ) - ! Assign constant density - call param_read('Density',rho); fs%rho=rho - ! Assign constant viscosity - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_pfmg) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT solver - initialize_lpt: block - use random, only: random_uniform - real(WP) :: dp - integer :: i,np - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle diameter',dp) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - - ! Read in file - call lp%read(filename='bed.file') - - ! Root process initializes np particles randomly - !call param_read('Number of particles',np) - !if (lp%cfg%amRoot) then - ! call lp%resize(np) - ! do i=1,np - ! ! Give id - ! lp%p(i)%id=int(i,8) - ! ! Set the diameter - ! lp%p(i)%d=dp - ! ! Assign random position in the domain - ! lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin),lp%cfg%x(lp%cfg%imax+1)),& - ! & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - ! & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - ! lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin_) - ! ! Give zero velocity - ! lp%p(i)%vel=0.0_WP - ! ! Give zero collision force - ! lp%p(i)%col=0.0_WP - ! ! Give zero dt - ! lp%p(i)%dt=0.0_WP - ! ! Locate the particle on the mesh - ! lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! ! Activate the particle - ! lp%p(i)%flag=0 - ! end do - !end if - !call lp%sync() - - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - lp%e_n=0.7_WP - ! Set gravity - call param_read('Gravity',lp%gravity) - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - integer :: i - pmesh=partmesh(nvar=1,name='lpt') - pmesh%varname(1)='radius' - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block create_pmesh - - - ! Initialize our velocity field - initialize_velocity: block - use lowmach_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Set inflow velocity/momentum - call param_read('Inlet velocity',inlet_velocity) - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoV(i,j,k)=inlet_velocity - fs%V(i,j,k) =inlet_velocity + + + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_of_domain + + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use ils_class, only: pcg_pfmg,pcg_amg + use lowmach_class, only: dirichlet,clipped_neumann + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + ! Define boundary conditions + call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) + + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_pfmg) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_uniform + use mathtools, only: Pi + real(WP) :: dp,Hbed,VFavg,Tp,Lpart,Lparty,Lpartz,Volp + integer :: i,ix,iy,iz,np,npx,npy,npz + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Get particle diameter from the input + call param_read('Particle diameter',dp) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + + ! Root process initializes particles uniformly + call param_read('Bed height',Hbed) + call param_read('Avg. volume fraction',VFavg) + call param_read('Particle temperature',Tp,default=298.15_WP) + if (lp%cfg%amRoot) then + ! Particle volume + Volp = Pi/6.0_WP*dp**3 + ! Get number of particles + Lpart = (Volp/VFavg)**(1.0_WP/3.0_WP) + npx=int(Hbed/Lpart) + npy = int(cfg%yL/Lpart) + Lparty = cfg%yL/real(npy,WP) + npz = int(cfg%zL/Lpart) + Lpartz = cfg%zL/real(npz,WP) + np = npx*npy*npz + call lp%resize(np) + ! Distribute particles + do i=1,np + ! Give position + ix = (i-1)/(npy*npz) + iy = (i-1-npy*npz*ix)/npz + iz = i-1-npy*npz*ix-npz*iy + lp%p(i)%pos(1) = lp%cfg%x(lp%cfg%imin)+(real(ix,WP)+0.5_WP)*Lpart + lp%p(i)%pos(2) = lp%cfg%y(lp%cfg%jmin)+(real(iy,WP)+0.5_WP)*Lparty + lp%p(i)%pos(3) = lp%cfg%z(lp%cfg%kmin)+(real(iz,WP)+0.5_WP)*Lpartz + + ! Give id + lp%p(i)%id=int(i,8) + ! Set the diameter + lp%p(i)%d=dp + ! Set the temperature + lp%p(i)%T=Tp + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%col=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Locate the particle on the mesh + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + ! Activate the particle + lp%p(i)%flag=0 end do - ! Set density from particle volume fraction - fs%rho=rho*(1.0_WP-lp%VF) - ! Form momentum - call fs%rho_multiply - ! Apply all other boundary conditions - call fs%apply_bcond(time%t,time%dt) - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div(drhodt=dRHOdt) - ! Compute MFR through all boundary conditions - call fs%get_mfr() - end block initialize_velocity - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='fluidized_bed') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_particle('particles',pmesh) - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('epsp',lp%VF) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%VFmean,'VFp') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - use mathtools, only: twoPi - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old density, velocity, and momentum - fs%rhoold=fs%rho - fs%Uold=fs%U; fs%rhoUold=fs%rhoU - fs%Vold=fs%V; fs%rhoVold=fs%rhoV - fs%Wold=fs%W; fs%rhoWold=fs%rhoW - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - resU=rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) - - ! Update density based on particle volume fraction - fs%rho=rho*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity and momentum - fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) - fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) - fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) - resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) - resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) - - ! Add momentum source term from lpt - add_lpt_src: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*lp%srcU(i-1:i,j,k)) - resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*lp%srcV(i,j-1:j,k)) - resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*lp%srcW(i,j,k-1:k)) - end do + end if + call lp%sync() + + ! Get initial particle volume fraction + call lp%update_VF() + ! Set collision timescale + call param_read('Collision timescale',lp%Tcol,default=5.0_WP*time%dt) + lp%Tcol=5.0_WP*time%dt + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + ! Set gravity + call param_read('Gravity',lp%gravity) + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,name='lpt') + pmesh%varname(1)='radius' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=0.5_WP*lp%p(i)%d + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Set inflow velocity/momentum + call param_read('Inlet velocity',inlet_velocity) + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=inlet_velocity + fs%U(i,j,k) =inlet_velocity + end do + ! Set density from particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + ! Form momentum + call fs%rho_multiply + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + end block initialize_velocity + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='fluidized_bed') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('epsp',lp%VF) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use mathtools, only: twoPi + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Collide and advance particles + call lp%collide(dt=time%dtmid) + resU=rho + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*lp%srcU(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*lp%srcV(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*lp%srcW(i,j,k-1:k)) end do end do - end block add_lpt_src - - ! Form implicit residuals - call fs%solve_implicit(time%dtmid,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply other boundary conditions and update momentum - call fs%apply_bcond(time%tmid,time%dtmid) - call fs%rho_multiply() - call fs%apply_bcond(time%tmid,time%dtmid) - - ! Reset Dirichlet BCs - dirichlet_velocity: block - use lowmach_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoV(i,j,k)=inlet_velocity - fs%V(i,j,k) =inlet_velocity - end do - end block dirichlet_velocity - - ! Solve Poisson equation - call fs%correct_mfr(drhodt=dRHOdt) - call fs%get_div(drhodt=dRHOdt) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct momentum and rebuild velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%rhoU=fs%rhoU-time%dtmid*resU - fs%rhoV=fs%rhoV-time%dtmid*resV - fs%rhoW=fs%rhoW-time%dtmid*resW - call fs%rho_divide - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do + end do + end block add_lpt_src + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=inlet_velocity + fs%U(i,j,k) =inlet_velocity + end do + end block dirichlet_velocity + + ! Solve Poisson equation + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=0.5_WP*lp%p(i)%d + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + end do + + ! Ouput particle bed + !call lp%write(filename='part.file') + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,dRHOdt) + + end subroutine simulation_final - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div(drhodt=dRHOdt) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block update_pmesh - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - end do - - ! Ouput particle bed - !call lp%write(filename='part.file') - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi,dRHOdt) - - end subroutine simulation_final - end module simulation diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index 36fb402f8..f61dc7ef2 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -23,9 +23,9 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR = /opt/homebrew/Cellar/fftw/3.3.10_1 -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/rgrawe/NGA2hypre +FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/src/particles/.#lpt_class.f90 b/src/particles/.#lpt_class.f90 new file mode 120000 index 000000000..b549de368 --- /dev/null +++ b/src/particles/.#lpt_class.f90 @@ -0,0 +1 @@ +rgrawe@Rebeccas-MBP-3.830 \ No newline at end of file diff --git a/tools/GNUMake/comps/gnu.mak b/tools/GNUMake/comps/gnu.mak index 9696ddb46..fa254a9e3 100644 --- a/tools/GNUMake/comps/gnu.mak +++ b/tools/GNUMake/comps/gnu.mak @@ -50,10 +50,10 @@ ifeq ($(DEBUG),TRUE) else - CXXFLAGS += -O3 -ftree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp - CFLAGS += -O3 -ftree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp - FFLAGS += -O3 -ftree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp - F90FLAGS += -O3 -ftree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp + CXXFLAGS += -O3 -fno-tree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp + CFLAGS += -O3 -fno-tree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp + FFLAGS += -O3 -fno-tree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp + F90FLAGS += -O3 -fno-tree-vectorize -ffast-math -funroll-loops -fomit-frame-pointer -pipe -fopenmp endif From a3119877dddb9b31136c93e833f56669e882bd4d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 5 Dec 2022 14:45:42 -0500 Subject: [PATCH 014/152] Delete .#lpt_class.f90 remove garbage file --- src/particles/.#lpt_class.f90 | 1 - 1 file changed, 1 deletion(-) delete mode 120000 src/particles/.#lpt_class.f90 diff --git a/src/particles/.#lpt_class.f90 b/src/particles/.#lpt_class.f90 deleted file mode 120000 index b549de368..000000000 --- a/src/particles/.#lpt_class.f90 +++ /dev/null @@ -1 +0,0 @@ -rgrawe@Rebeccas-MBP-3.830 \ No newline at end of file From 73053379114f3b585d15451457919d5ec6292c92 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 7 Dec 2022 08:42:42 -0500 Subject: [PATCH 015/152] Update lpt_class.f90 Working on fluidized bed example. Started adding ability to do implicit filtering of projected terms. Still need to interpolate fluid stress to particle location. Case does not run using 3 or 4 procs in x, but runs with 1, 3, and 5... --- src/particles/lpt_class.f90 | 118 ++++++++++++++++++++++++++++-------- 1 file changed, 92 insertions(+), 26 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 11b871c6e..ad0466c76 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -97,6 +97,7 @@ module lpt_class real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered ! Filtering operation + logical :: implicit_filter !< Solve implicitly real(WP) :: filter_width !< Characteristic filter width real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator @@ -156,8 +157,11 @@ function constructor(cfg,name) result(self) allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP - ! Set default filter width to zero by default + ! Set filter width to zero by default self%filter_width=0.0_WP + + ! Solve explicitly by default + self%implicit_filter=.false. ! Allocate finite volume divergence operators allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered @@ -625,7 +629,7 @@ function drag_correction() result(F) ! Tenneti and Subramaniam (2011) b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - F=fVF*((1.0_WP+0.15_WP*Re**(0.687_WP))/fVF**3+b1+b2) + F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) case('Khalloufi Capecelatro','KC') F=0.0_WP case default @@ -669,46 +673,108 @@ subroutine filter(this,A) real(WP) :: filter_coeff integer :: i,j,k,n,nstep real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az + real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz ! Return without filtering if filter width is zero if (this%filter_width.le.0.0_WP) return - + ! Recompute filter coeff and number of explicit steps needed filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 - nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) - filter_coeff=filter_coeff/real(nstep,WP) - - ! Allocate flux arrays - allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Apply filter - do n=1,nstep - ! Diffusive flux of A - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) - FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) - FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) + + if (this%implicit_filter) then + ! Apply filter implicitly via approximate factorization + ! Allocate implicit arrays + allocate(Ax(this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%imino_+1:this%cfg%imaxo_-1,-1:+1)) + allocate(Ay(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,-1:+1)) + allocate(Az(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,-1:+1)) + allocate(Rx(this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%imino_+1:this%cfg%imaxo_-1)) + allocate(Ry(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1)) + allocate(Rz(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1)) + ! Inverse in X-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) + Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) + Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) + Rx(j,k,i) = A(i,j,k) + end do + end do + end do + !!call linear_solver_x(3) + ! Inverse in Y-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) + Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & + + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) + Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) + Ry(i,k,j) = Rx(j,k,i) + end do + end do + end do + !!call linear_solver_y(3) + ! Inverse in Z-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) + Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) + Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) + Rz(i,j,k) = Ry(i,k,j) end do end do end do - ! Divergence of fluxes + !!call linear_solver_z(3) + ! Update A do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) + A(i,j,k)=Rz(i,j,k) end do end do end do ! Sync A call this%cfg%sync(A) - end do - - ! Deallocate flux arrays - deallocate(FX,FY,FZ) + ! Deallocate implicit arrays + deallocate(Ax,Ay,Az,Rx,Ry,Rz) + else + ! Apply filter explicitly + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) + filter_coeff=filter_coeff/real(nstep,WP) + do n=1,nstep + ! Diffusive flux of A + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) + FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) + FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) + end do + end do + end do + ! Divergence of fluxes + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync A + call this%cfg%sync(A) + end do + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + end if end subroutine filter From be802f8580d5529b3f5e0de6d09fbf74559d2f98 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 7 Dec 2022 08:44:19 -0500 Subject: [PATCH 016/152] fbed input Updates to fluidized bed input --- examples/fluidized_bed/input | 16 +- src/compressible/matm_class.f90 | 541 ++++++++++++++++++++++++++++++++ 2 files changed, 549 insertions(+), 8 deletions(-) create mode 100644 src/compressible/matm_class.f90 diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index c05ced90d..4902660bd 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 4 1 1 +Partition : 2 1 1 # Mesh definition Lx : .0256 @@ -10,25 +10,25 @@ ny : 32 nz : 1 # Time integration -Max timestep size : 1e-4 +Max timestep size : 1e-5 Max cfl number : 1 Max time : 10 # Fluid properties Dynamic viscosity : 1.8e-5 Density : 1.2 -Gravity : -1 0 0 -Inlet velocity : 0.2 +Gravity : -9.81 0 0 +Inlet velocity : 0.4 # Particle parameters Bed height : .0128 -Avg. volume fraction : 0.4 +Particle volume fraction : 0.4 Coefficient of restitution : 0.8 -Particle density : 1000 +Particle density : 2600 Particle diameter : 200e-6 # Pressure solver -Pressure tolerance : 1e-6 +Pressure tolerance : 1e-5 Pressure iteration : 100 # Implicit velocity solver @@ -36,4 +36,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 1e-2 +Ensight output period : 40e-5 \ No newline at end of file diff --git a/src/compressible/matm_class.f90 b/src/compressible/matm_class.f90 new file mode 100644 index 000000000..6a9c783f4 --- /dev/null +++ b/src/compressible/matm_class.f90 @@ -0,0 +1,541 @@ +!> Single-phase material modeling class: +!> Provides equations of state and temperature-dependent properties +module matm_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + implicit none + private + + ! Expose type/constructor/methods + public :: matm + + ! Parameters for viscosity, and heat diffusion models + integer, parameter, public :: none =0 !< Sets the constant to 0 (for inviscid, isothermal, etc.). Careful, overwrites input values + integer, parameter, public :: constant =1 !< Assumes default value, available for all types, overwritten by input + integer, parameter, public :: water =2 !< Empirical models for water (mu, kappa, cv) + integer, parameter, public :: air =3 !< Empirical models for air (mu, kappa, cv) + ! More can be added for other materials, alongside functions that feature models + + !> Material modeling type intended for single-phase flows (gases or liquids) + type :: matm + + ! This is our config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the structure + character(len=str_medium) :: name='UNNAMED_MATM' !< class name (default=UNNAMED_MATM) + + ! Flag for if things vary with temperature or not + logical :: const_prop + ! Flag for if temperature equil of multiphase cells is enforced + logical :: mult_iso + + ! Fluid properties + real(WP) :: gamm,Pref,b,q + + ! Pointers for local thermodynamic or flow variables + real(WP), dimension(:,:,:), pointer :: rho,U,V,W,rhoE,P + + ! Variables to store chosen diffusion & thermo models (defaults to constant model, M references "model") + integer :: M_mu = 1 + integer :: M_kappa = 1 + integer :: M_cv = 1 + + ! Defaults for constant diffusion & thermo parameters + real(WP) :: mu_0 = 1.81e-5_WP + real(WP) :: kappa_0 = 0.026_WP + real(WP) :: cv_0 = 717.6_WP + + ! Default temperature guess (for the sake of variable cv) upon initialization, can be overwritten + ! Also used by EOS_gas and EOS_liquid functions if temperature guess is not directly supplied + real(WP) :: Tdefault = 25.0_WP + 273.15_WP + + contains + procedure :: EOS_gas, EOS_liquid !< Output solver to the screen + procedure :: EOS_energy !< Calculates phase total energy from pressure and kinetic energy + procedure :: EOS_temp !< Calculates phase temperature from pressure directly + procedure :: EOS_density !< Calculates phase density from pressure and temperature directly + procedure :: EOS_pressure !< Calculates phase pressure from density and temperature directly + procedure :: EOS_all !< Calculates vol-avg pressure for entire domain from conserved variables + + procedure :: register_idealgas !< EOS available for gas-like fluids + procedure :: register_stiffenedgas !< EOS for liquid-like fluids + procedure :: register_NobleAbelstiffenedgas !< EOS for liquid-like fluids + + procedure :: register_diffusion_thermo_models !< Choose models or set parameters for viscosity, thermal conductivity, and specific heat + + procedure :: register_thermoflow_variables !< Creates pointers from material models to flow solver variables + + procedure :: update_temperature !< Updates entire array of mixture temperature as passed in + procedure :: get_local_temperature !< Calculates local mixture temperature + + procedure :: viscosity_water, viscosity_air !< Empirical models for temperature dependence of dynamic viscosity + procedure :: spec_heat_water, spec_heat_air !< Empirical models for temperature dependence of specific heat (cv) + procedure :: therm_cond_water, therm_cond_air !< Empirical models for temperature dependence of thermal conductivity + + procedure :: viscosity, spec_heat, therm_cond !< Provide diffusive/thermal parameters according to registered model + + end type matm + + + !> Declare compressible solver constructor + interface matm + procedure constructor + end interface matm + +contains + + + !> Default constructor for material modeling + function constructor(cfg,name) result(self) + implicit none + type(matm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Zero EOS parameters + self%gamm = 0.0_WP; self%Pref = 0.0_WP; self%q = 0.0_WP; self%b = 0.0_WP + + end function constructor + + subroutine register_idealgas(this,gamm) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: gamm + + this%gamm = gamm + + end subroutine register_idealgas + + subroutine register_stiffenedgas(this,gamm,Pref) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: gamm,Pref + + this%gamm = gamm + this%Pref = Pref + + end subroutine register_stiffenedgas + + subroutine register_NobleAbelstiffenedgas(this,gamm,Pref,q,b) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: gamm,Pref,q,b + + this%gamm = gamm + this%Pref = Pref + this%q = q + this%b = b + + end subroutine register_NobleAbelstiffenedgas + + subroutine register_diffusion_thermo_models(this,viscmodel,hdffmodel,sphtmodel,viscconst,hdffconst,sphtconst) + use messager, only: die + implicit none + class(matm), intent(inout) :: this + integer , intent(in), optional :: viscmodel,hdffmodel,sphtmodel + real(WP), intent(in), optional :: viscconst,hdffconst,sphtconst + + ! If constants are supplied, replace default constants with provided constants + if (present(viscconst)) then + this%mu_0 = viscconst + end if + if (present(hdffconst)) then + this%kappa_0 = hdffconst + end if + if (present(sphtconst)) then + this%cv_0 = sphtconst + end if + + ! If models are supplied, replace default models (constant) with specified models + ! Specifying a non-constant model will override specifying a constant parameter above + if (present(viscmodel)) then + this%M_mu = viscmodel + ! Check allowed values + select case (this%M_mu) + case (none,constant,air,water); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown viscosity model') + end select + end if + if (present(hdffmodel)) then + this%M_kappa = hdffmodel + ! Check allowed values + select case (this%M_kappa) + case (none,constant,air,water); ! do nothing + case default; call die('[matm register_diffusion_thermo_models] Unknown heat diffusivity model') + end select + end if + if (present(sphtmodel)) then + this%M_cv = sphtmodel + ! Check allowed values + select case (this%M_cv) + case (constant,air,water); ! do nothing - never zero, so none is not allowed + case default; call die('[matm register_diffusion_thermo_models] Unknown specific heat model') + end select + end if + + ! Set parameter values to zero if prescribed + if (this%M_mu .eq.none) this%mu_0 = 0.0_WP + if (this%M_kappa.eq.none) this%kappa_0 = 0.0_WP + + end subroutine register_diffusion_thermo_models + + subroutine register_thermoflow_variables(this,rho,u,v,w,rhoe,p) + implicit none + class(matm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), target, intent(in) :: rho,u,v,w,rhoE,p + + this%rho => rho + this%U => u + this%V => v + this%W => w + this%rhoE => rhoE + this%P => p + + end subroutine register_thermoflow_variables + + + function viscosity(this,T) result(mu) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: mu + + select case(this%M_mu) + case(none,constant) + mu = this%mu_0 + case(air) + mu = this%viscosity_air(T) + case(water) + mu = this%viscosity_water(T) + end select + + return + end function viscosity + + function therm_cond(this,T) result(kappa) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: kappa + + select case(this%M_kappa) + case(none,constant) + kappa = this%kappa_0 + case(air) + kappa = this%therm_cond_air(T) + case(water) + kappa = this%therm_cond_water(T) + end select + + return + end function therm_cond + + function spec_heat(this,T) result(cv) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: T ! Temperature - always supplied, not always used + real(WP) :: cv + + select case(this%M_cv) + case(none,constant) + cv = this%cv_0 + case(air) + cv = this%spec_heat_air(T) + case(water) + cv = this%spec_heat_water(T) + end select + + return + end function spec_heat + + subroutine update_temperature(this,phase,Temperature) + implicit none + class(matm), intent(inout) :: this + character(len=*),intent(in) :: phase + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: Temperature + integer :: i,j,k + + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Get local temperature, use current temperature as first guess for cv + Temperature(i,j,k) = this%get_local_temperature(phase,i,j,k,Temperature(i,j,k)) + end do + end do + end do + + end subroutine update_temperature + + function get_local_temperature(this,phase,i,j,k,Tguess) result(T) + implicit none + class(matm), intent(inout) :: this + character(len=*),intent(in) :: phase + integer, intent(in) :: i,j,k + real(WP), intent(in) :: Tguess + real(WP) :: Tlast,delta_T,temp,T + real(WP) :: cv = 0.0_WP + integer :: n + real(WP), parameter :: T_cvg = 1e-1_WP + integer, parameter :: n_loop = 10 + + ! Initialize guess + temp = Tguess + select case(trim(adjustl(phase))) + case('gas') + ! Gas temperature + n = 0; delta_T = 1.0_WP + T_cvg + do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) + Tlast = temp + ! Calculate temperature with latest temperature in cv calculation + temp = this%EOS_gas(i,j,k,'T',temp) + ! Increment interation number + n = n+1 + ! Convergence residual + delta_T = abs(temp-Tlast) + ! Exit loop if constant model + if (this%M_cv.eq.constant) n = n_loop + ! Exit loop if not converging + if (temp.le.0.0_WP) then + n = n_loop + temp = Tlast ! hopefully last iteration had better value + end if + end do + ! Update cv value using current temperature value + cv = this%spec_heat(temp) + case('liquid') + ! Liquid temperature + n = 0; delta_T = 1.0_WP + T_cvg + do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) + Tlast = temp + ! Calculate temperature with latest temperature in cv calculation + temp = this%EOS_liquid(i,j,k,'T',temp) + ! Increment interation number + n = n+1 + ! Convergence residual + delta_T = abs(temp-Tlast) + ! Exit loop if constant model + if (this%M_cv.eq.constant) n = n_loop + ! Exit loop if not converging + if (temp.le.0.0_WP) then + n = n_loop + temp = Tlast ! hopefully last iteration had better value + end if + end do + ! Update cv value using current temperature value + cv = this%spec_heat(temp) + end select + + ! Return temperature + T = temp + + return + end function get_local_temperature + + function EOS_liquid(this,i,j,k,flag,temp) result(property) + implicit none + class(matm), intent(inout) :: this + integer,intent(in) :: i,j,k + character(len=1),intent(in) :: flag + real(WP), intent(in), optional :: temp ! Just for getting cv + real(WP) :: property + + select case(flag) + case('p') ! Pressure + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& + (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& + (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q)-this%gamm*this%Pref + case('K') ! Bulk modulus + property = this%P(i,j,k)+this%Pref + property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property + case('T') ! Temperature + if (present(temp)) then; property = temp; else; property = this%Tdefault; end if + property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & + -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) + case('v') ! (1/rho)(dp/de), for viscous pressure term + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) + case('M') ! Bulk modulus calculated from conserved variables + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & + -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q)-this%gamm*this%Pref + property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) + end select + + return + end function EOS_liquid + + function EOS_gas(this,i,j,k,flag,temp) result(property) + implicit none + class(matm), intent(inout) :: this + integer,intent(in) :: i,j,k + character(len=1),intent(in) :: flag + real(WP), intent(in), optional :: temp ! Just for getting cv + real(WP) :: property + + select case(flag) + case('p') ! Pressure + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& + (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& + (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q)-this%gamm*this%Pref + case('K') ! Bulk modulus + property = this%P(i,j,k)+this%Pref + property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property + case('T') ! Temperature + if (present(temp)) then; property = temp; else; property = this%Tdefault; end if + property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & + -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) + case('v') ! (1/rho)(dp/de), for viscous pressure term + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) + case('M') ! Bulk modulus calculated from conserved variables + property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & + -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & + -this%rho(i,j,k)*this%q)-this%gamm*this%Pref + property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) + end select + + return + end function EOS_gas + + function EOS_energy(this,pres,dens,uvel,vvel,wvel) result(energy) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: pres,dens,uvel,vvel,wvel + real(WP) :: KE,energy + + KE = 0.5_WP*dens*(uvel**2+vvel**2+wvel**2) + energy = (pres + this%gamm*this%Pref)*(1.0_WP-dens*this%b)/(this%gamm-1.0_WP) + dens*this%q + KE + + return + end function EOS_energy + + function EOS_temp(this,pres,dens,cv) result(temp) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: pres,dens,cv + real(WP) :: temp + + temp = (1.0_WP-dens*this%b)*(pres+this%Pref)/(this%gamm-1.0_WP)/(dens*cv) + + return + end function EOS_temp + + function EOS_pressure(this,temp,dens,cv) result(pres) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: temp,dens,cv + real(WP) :: pres + + pres = temp*(dens*cv)*(this%gamm-1.0_WP)/(1.0_WP-dens*this%b)-this%Pref + + return + end function EOS_pressure + + function EOS_density(this,pres,temp,cv) result(dens) + implicit none + class(matm), intent(inout) :: this + real(WP), intent(in) :: pres,temp,cv + real(WP) :: dens + + dens = (pres+this%Pref)/(cv*(this%gamm-1.0_WP)*temp+this%b*(pres+this%Pref)) + + return + end function EOS_density + + function EOS_all(this) result(buf_P) + implicit none + class(matm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: buf_P + + buf_P = (this%gamm-1.0_WP)/(1.0_WP-this%rho*this%b)*(this%rhoE-0.5_WP* & + this%rho*(this%U**2+this%V**2+this%W**2)-this%rho*this%q)-this%gamm*this%Pref + + return + end function EOS_all + + function viscosity_air(this,T) result(mu) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,mu + + TC = max(100.0_WP,min(T,800.0_WP)) + mu = 1.716e-5_WP*(TC/273.15_WP)**1.5_WP*(273.15+110.4_WP)/(TC+110.4_WP) + ! mu = 2.5e-2_WP*(T/(1.488095e2/(1.4-1.0_WP)/717.6_WP))**0.75_WP + + return + end function viscosity_air + + function viscosity_water(this,T) result(mu) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,mu + + TC = max(276.15_WP,max(T,473.15_WP)) + mu = 2.414e-5_WP*10**(247.8_WP/(TC-140.0_WP)) + + return + end function viscosity_water + + function spec_heat_air(this,T) result(cv) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,cv + + TC = max(173.15_WP,min(T,773.15_WP)) + cv = 717.8_WP+0.07075_WP*(TC-300_WP)+2.6125e-4_WP*(TC-300_WP)**2 + + return + end function spec_heat_air + + function spec_heat_water(this,T) result(cv) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,cv + + TC = max(3.0_WP,max(T-273.15_WP,200.0_WP)) + cv = (4209.0_WP-1.31_WP*TC+0.014_WP*TC**2)/this%gamm + + return + end function spec_heat_water + + function therm_cond_air(this,T) result(kappa) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,kappa + + TC = max(100.0_WP,min(T,1000.0_WP)) + kappa = 2.646e-3_WP*TC**1.5_WP/(TC+245.4_WP*10.0_WP**(-12.0_WP/TC)) + + return + end function therm_cond_air + + function therm_cond_water(this,T) result(kappa) + implicit none + class(matm), intent(inout) :: this + real(WP),intent(in) :: T + real(WP) :: TC,kappa + + TC = max(1.0_WP,min(T-273.15_WP,200.0_WP)) + kappa = 0.5706_WP+1.75e-3_WP*TC-6.46e-6_WP*TC**2 + + return + end function therm_cond_water + +end module matm_class + + From 55eeef5e292c93c3536099a13e3a74eb99ee9043 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 7 Dec 2022 08:49:45 -0500 Subject: [PATCH 017/152] Update .gitignore We should ignore makefiles. Doesn't seem to be working though.... --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 31ec775b7..48d591885 100644 --- a/.gitignore +++ b/.gitignore @@ -39,7 +39,7 @@ stat/ # Ignore all content of examples examples/*/* -!examples/*/GNUmakefile +examples/*/GNUmakefile !examples/*/input* examples/*/input*~ !examples/*/README From c2aebbf0c8ae99e4d99b608f917c7359a38e358f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 7 Dec 2022 08:50:43 -0500 Subject: [PATCH 018/152] Updates to fluidized bed Still working on it --- examples/fluidized_bed/src/geometry.f90 | 19 ++++++------ examples/fluidized_bed/src/simulation.f90 | 36 +++++++++++++++-------- 2 files changed, 34 insertions(+), 21 deletions(-) diff --git a/examples/fluidized_bed/src/geometry.f90 b/examples/fluidized_bed/src/geometry.f90 index 5b63072fc..5a87cd2e4 100644 --- a/examples/fluidized_bed/src/geometry.f90 +++ b/examples/fluidized_bed/src/geometry.f90 @@ -66,15 +66,16 @@ subroutine geometry_init ! Create masks for this config create_walls: block - integer :: i,j,k - do k=cfg%kmino_,cfg%kmaxo_ - do j=cfg%jmino_,cfg%jmaxo_ - do i=cfg%imino_,cfg%imaxo_ - if (cfg%xm(i).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP - if (cfg%xm(i).gt.cfg%xL) cfg%VF(i,j,k)=0.0_WP - end do - end do - end do + integer :: i,j,k + cfg%VF=1.0_WP + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + if (cfg%xm(i).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP + if (cfg%xm(i).gt.cfg%xL) cfg%VF(i,j,k)=0.0_WP + end do + end do + end do end block create_walls diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index af71c769a..b078317bc 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -21,6 +21,7 @@ module simulation type(partmesh) :: pmesh type(ensight) :: ens_out type(event) :: ens_evt + integer, dimension(:,:,:), allocatable :: cpu_rank !> Simulation monitor file type(monitor) :: mfile,cflfile @@ -104,16 +105,23 @@ subroutine simulation_init ! Allocate work arrays allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays + ! Store processor decomposition for visualization + store_cpu_rank: block + allocate(cpu_rank(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + cpu_rank=cfg%rank + end block store_cpu_rank + + ! Initialize our LPT solver initialize_lpt: block use random, only: random_uniform @@ -122,6 +130,8 @@ subroutine simulation_init integer :: i,ix,iy,iz,np,npx,npy,npz ! Create solver lp=lpt(cfg=cfg,name='LPT') + ! Get drag model from the inpit + call param_read('Drag model',lp%drag_model,default='Tenneti') ! Get particle density from the input call param_read('Particle density',lp%rho) ! Get particle diameter from the input @@ -131,7 +141,7 @@ subroutine simulation_init ! Root process initializes particles uniformly call param_read('Bed height',Hbed) - call param_read('Avg. volume fraction',VFavg) + call param_read('Particle volume fraction',VFavg) call param_read('Particle temperature',Tp,default=298.15_WP) if (lp%cfg%amRoot) then ! Particle volume @@ -184,6 +194,11 @@ subroutine simulation_init call param_read('Coefficient of restitution',lp%e_n) ! Set gravity call param_read('Gravity',lp%gravity) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', np + print*,'Mean volume fraction',VFavg + end if end block initialize_lpt @@ -239,11 +254,11 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('epsp',lp%VF) call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('CPU',cpu_rank) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight - ! Create a monitor file create_monitor: block ! Prepare some info about fields @@ -429,9 +444,6 @@ subroutine simulation_run end do - ! Ouput particle bed - !call lp%write(filename='part.file') - end subroutine simulation_run From ab391b272e69928c1a1eed4724171cbfc1aadd8c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 7 Dec 2022 15:31:42 -0500 Subject: [PATCH 019/152] Output part vector to EnSight Added vectors to particle mesh following Max's suggestions --- examples/boat/src/simulation.f90 | 2 +- examples/bus/src/geometry.f90 | 2 +- examples/drop_breakup/src/simulation.f90 | 2 +- examples/fluidized_bed/src/simulation.f90 | 11 ++++--- examples/nozzle_2phase/src/simulation.f90 | 2 +- examples/nozzle_3grids/src/simulation.f90 | 2 +- examples/part_bed/src/simulation.f90 | 2 +- examples/part_tester/src/simulation.f90 | 2 +- src/data/ensight_class.f90 | 35 ++++++++++++++++++++++- src/grid/partmesh_class.f90 | 22 +++++++++----- 10 files changed, 63 insertions(+), 19 deletions(-) diff --git a/examples/boat/src/simulation.f90 b/examples/boat/src/simulation.f90 index f42ca288a..5875b8510 100644 --- a/examples/boat/src/simulation.f90 +++ b/examples/boat/src/simulation.f90 @@ -267,7 +267,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,nvec=0,name='lpt') call lp%update_partmesh(pmesh) end block create_pmesh diff --git a/examples/bus/src/geometry.f90 b/examples/bus/src/geometry.f90 index c66729ce1..c591679ce 100644 --- a/examples/bus/src/geometry.f90 +++ b/examples/bus/src/geometry.f90 @@ -561,7 +561,7 @@ subroutine geometry_init end do ! While we're at it, create a particle mesh for plotting the passenger positions - psg_mesh=partmesh(nvar=1,name='psg'); psg_mesh%varname(1)='id'; call psg_mesh%reset() + psg_mesh=partmesh(nvar=1,nvec=0,name='psg'); psg_mesh%varname(1)='id'; call psg_mesh%reset() call psg_mesh%set_size(npsg) do n=1,npsg psg_mesh%pos(:,n)=xpsg(:,n) diff --git a/examples/drop_breakup/src/simulation.f90 b/examples/drop_breakup/src/simulation.f90 index 17ecea505..922c9bda5 100644 --- a/examples/drop_breakup/src/simulation.f90 +++ b/examples/drop_breakup/src/simulation.f90 @@ -383,7 +383,7 @@ subroutine simulation_init create_pmesh: block integer :: i ! Include an extra variable for droplet diameter - pmesh=partmesh(nvar=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=0,name='lpt') pmesh%varname(1)='diameter' ! Transfer particles to pmesh call lp%update_partmesh(pmesh) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index b078317bc..37c433c06 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -205,11 +205,13 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,name='lpt') - pmesh%varname(1)='radius' + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel end do end block create_pmesh @@ -429,7 +431,8 @@ subroutine simulation_run integer :: i call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel end do end block update_pmesh call ens_out%write_data(time%t) diff --git a/examples/nozzle_2phase/src/simulation.f90 b/examples/nozzle_2phase/src/simulation.f90 index 1c142b349..8c3c96138 100644 --- a/examples/nozzle_2phase/src/simulation.f90 +++ b/examples/nozzle_2phase/src/simulation.f90 @@ -496,7 +496,7 @@ subroutine simulation_init create_pmesh: block integer :: i ! Include an extra variable for droplet diameter - pmesh=partmesh(nvar=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=0,name='lpt') pmesh%varname(1)='diameter' ! Transfer particles to pmesh call lp%update_partmesh(pmesh) diff --git a/examples/nozzle_3grids/src/simulation.f90 b/examples/nozzle_3grids/src/simulation.f90 index 90dbed85e..80fa99650 100644 --- a/examples/nozzle_3grids/src/simulation.f90 +++ b/examples/nozzle_3grids/src/simulation.f90 @@ -921,7 +921,7 @@ subroutine simulation_init create_pmesh3: block integer :: i ! Include an extra variable for droplet diameter - pmesh3=partmesh(nvar=1,name='lpt') + pmesh3=partmesh(nvar=1,nvec=0,name='lpt') pmesh3%varname(1)='diameter' ! Transfer particles to pmesh call lp3%update_partmesh(pmesh3) diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index b4d9d475b..589c2a838 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -122,7 +122,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=0,name='lpt') pmesh%varname(1)='radius' call lp%update_partmesh(pmesh) do i=1,lp%np_ diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index 635c21261..ef10fe6ac 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -137,7 +137,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,nvec=0,name='lpt') call lp%update_partmesh(pmesh) end block create_pmesh diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index 70ff33cce..e033c87f0 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -705,6 +705,9 @@ subroutine write_part(this,part) do n=1,part%ptr%nvar write(iunit,'(a)') 'scalar per measured node: 1 '//trim(part%ptr%varname(n))//' '//trim(part%name)//'/'//trim(part%ptr%varname(n))//'.******' end do + do n=1,part%ptr%nvec + write(iunit,'(a)') 'vector per measured node: 1 '//trim(part%ptr%vecname(n))//' '//trim(part%name)//'/'//trim(part%ptr%vecname(n))//'.******' + end do ! Write the time information write(iunit,'(/,a,/,a,/,a,i0,/,a,/,a,/,a)') 'TIME','time set: 1','number of steps: ',this%ntime,'filename start number: 1','filename increment: 1','time values:' write(iunit,'(999999(es12.5,/))') this%time @@ -746,7 +749,7 @@ subroutine write_part(this,part) call MPI_BARRIER(this%cfg%comm,ierr) end do - ! Generate the additional variable files + ! Generate the particle scalar files do n=1,part%ptr%nvar filename='ensight/'//trim(this%name)//'/'//trim(part%name)//'/'//trim(part%ptr%varname(n))//'.' write(filename(len_trim(filename)+1:len_trim(filename)+6),'(i6.6)') this%ntime @@ -776,6 +779,36 @@ subroutine write_part(this,part) end do end do + ! Generate the particle vector files + do n=1,part%ptr%nvec + filename='ensight/'//trim(this%name)//'/'//trim(part%name)//'/'//trim(part%ptr%vecname(n))//'.' + write(filename(len_trim(filename)+1:len_trim(filename)+6),'(i6.6)') this%ntime + ! Root write the header + if (this%cfg%amRoot) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[ensight write part] Could not open file: '//trim(filename)) + ! General header + cbuff='particle'//trim(adjustl(part%ptr%vecname(n))) ; write(iunit) cbuff + ! Close the file + close(iunit) + end if + ! Write the vector at the particle location + do rank=0,this%cfg%nproc-1 + if (rank.eq.this%cfg%rank) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='old',access='stream',position='append',iostat=ierr) + if (ierr.ne.0) call die('[ensight write part] Could not open file: '//trim(filename)) + ! Write part info if it exists on the processor + if (part%ptr%n.gt.0) write(iunit) real(part%ptr%vec(:,n,:),SP) + ! Close the file + close(iunit) + end if + ! Force synchronization + call MPI_BARRIER(this%cfg%comm,ierr) + end do + end do + end subroutine write_part diff --git a/src/grid/partmesh_class.f90 b/src/grid/partmesh_class.f90 index 902e2f300..74eb1cac8 100644 --- a/src/grid/partmesh_class.f90 +++ b/src/grid/partmesh_class.f90 @@ -12,9 +12,12 @@ module partmesh_class character(len=str_medium) :: name='PARTMESH' !< Name for the particle mesh integer :: n !< Number of particles real(WP), dimension(:,:), allocatable :: pos !< Position of the particles - integer :: nvar !< Number of particle variables stored - real(WP), dimension(:,:), allocatable :: var !< Particle variable storage - character(len=str_medium), dimension(:), allocatable :: varname !< Name of particle variable fields + integer :: nvar !< Number of particle scalars stored + integer :: nvec !< Number of particle vectors stored + real(WP), dimension(:,:), allocatable :: var !< Particle scalar storage + real(WP), dimension(:,:,:), allocatable :: vec !< Particle vector storage + character(len=str_medium), dimension(:), allocatable :: varname !< Name of particle scalar fields + character(len=str_medium), dimension(:), allocatable :: vecname !< Name of particle vector fields contains procedure :: reset !< Reset particle mesh to zero size procedure :: set_size !< Set particle mesh to provided size @@ -31,10 +34,10 @@ module partmesh_class !> Constructor for particle mesh object - function constructor(nvar,name) result(self) + function constructor(nvar,nvec,name) result(self) implicit none type(partmesh) :: self - integer, intent(in) :: nvar + integer, intent(in) :: nvar,nvec character(len=*), optional :: name ! Set the name of the particle mesh if (present(name)) self%name=trim(adjustl(name)) @@ -44,6 +47,9 @@ function constructor(nvar,name) result(self) self%nvar=nvar allocate(self%varname(self%nvar)) self%varname='' !< Users will set the name themselves + self%nvec=nvec + allocate(self%vecname(self%nvec)) + self%vecname='' !< Users will set the name themselves end function constructor @@ -54,6 +60,7 @@ subroutine reset(this) this%n=0 if (allocated(this%pos)) deallocate(this%pos) if (allocated(this%var)) deallocate(this%var) + if (allocated(this%vec)) deallocate(this%vec) end subroutine reset @@ -63,8 +70,9 @@ subroutine set_size(this,size) class(partmesh), intent(inout) :: this integer, intent(in) :: size this%n=size - allocate(this%pos( 3,this%n)) - allocate(this%var(this%nvar,this%n)) + allocate(this%pos( 3 ,this%n)) + allocate(this%vec( 3,this%nvec,this%n)) + allocate(this%var(this%nvar ,this%n)) end subroutine set_size From 8f9a8cfc4693adb15bdd397d3a72fbc8fc73a131 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 9 Dec 2022 11:27:45 -0500 Subject: [PATCH 020/152] New diagonal solver class Added a diagonal solver class, taken from old NGA. Haven't yet tested. Will test on implicit filter in lpt class --- src/solver/Make.package | 2 +- src/solver/diag_class.f90 | 1070 +++++++++++++++++++++++++++++++++++++ 2 files changed, 1071 insertions(+), 1 deletion(-) create mode 100644 src/solver/diag_class.f90 diff --git a/src/solver/Make.package b/src/solver/Make.package index ebf581ea0..6fc6cc525 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -1,4 +1,4 @@ -f90EXE_sources += linsol_class.f90 bbmg_class.f90 +f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 new file mode 100644 index 000000000..969f6d5d9 --- /dev/null +++ b/src/solver/diag_class.f90 @@ -0,0 +1,1070 @@ +!> Direct diagonal solvers defined here +module diag_class + use precision, only: WP + use config_class, only: config + implicit none + private + + ! Expose type/constructor/methods + public :: diag + + !> diag object definition + type :: diag + ! Diagonalr solver works for a config + type(config), pointer :: cfg !< Config for the diag solver + real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays + real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays + + contains + + procedure :: tridiagonal !< Tridiagonal solver + procedure :: pentadiagonal !< Pentadiagonal solver + procedure :: polydiagonal !< Polydiagonal solver + final :: destructor !< Destructor for diag + end type diag + + !> Declare diag constructor + interface diag + procedure diag_from_args + end interface diag + +contains + + !> Destructor for diag object + subroutine destructor(this) + implicit none + type(diag) :: this + if (allocated(this%Ax)) deallocate(this%Ax) + if (allocated(this%Ay)) deallocate(this%Ay) + if (allocated(this%Az)) deallocate(this%Az) + if (allocated(this%Rx)) deallocate(this%Rx) + if (allocated(this%Ry)) deallocate(this%Ry) + if (allocated(this%Rz)) deallocate(this%Rz) + end subroutine destructor + + + !> Constructor for a diag object + function diag_from_args(cfg,n) result(self) + use messager, only: die + implicit none + type(diag) :: self + class(config), target, intent(in) :: cfg + integer, intent(in) :: n + + ! Link the config + self%cfg=>cfg + + ! Allocate arrays + allocate(self%Ax(self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%imino_+n:self%cfg%imaxo_-n,-n:+n)) + allocate(self%Ay(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,-n:+n)) + allocate(self%Az(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,-n:+n)) + allocate(self%Rx(self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%imino_+n:self%cfg%imaxo_-n)) + allocate(self%Ry(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n)) + allocate(self%Rz(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n)) + + end function diag_from_args + + subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER + real(WP), dimension(lot,n) :: B ! DIAGONAL + real(WP), dimension(lot,n) :: C ! UPPER + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot) :: r1 + real(WP), dimension(lot) :: r2 + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:), allocatable :: sendbuf + real(WP), dimension(:,:,:), allocatable :: recvbuf1 + real(WP), dimension(:,:), allocatable :: recvbuf2 + integer, dimension(:), allocatable :: ngroup + ! Stuff + integer :: i,igroup + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call tridiagonal_serial(A,B,C,R,n,lot) + else + call tridiagonal_periodic_serial(A,B,C,R,n,lot) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot*12*proc)) + allocate(recvbuf1(nlot,6,2*proc)) + allocate(recvbuf2(nlot,2*proc)) + + ! Initialize boundary values + s1(:,1) = a(:,1) + s2(:,n) = c(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(i) + do i=2,n + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + s1(:,i) = -s1(:,i-1)*const(:) + end do + + ! Backward elimination + ! Lower boundary in s2(i) + do i=n-1,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) + s2(:,i) = -s2(:,i+1)*const(:) + end do + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced pentadiagonal system + ! Use of pentadiagonal system is more robust than the + ! reordered (removes zeros) tridiagonal system + + ! Send rows of pentadiagonal system + ! (0, s1, b, 0, s2; r) + ! (s1, 0, b, s2, 0; r) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = ngroup(igroup) + + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) + + ! Clear unused values + nk = ngroup(nrank+1) + recvbuf1(nk+1:nlot, :, :) = 0.0_WP + recvbuf1(nk+1:nlot, 3, :) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + call pentadiagonal_serial(& + recvbuf1(:,1,2:2*proc-1),recvbuf1(:,2,2:2*proc-1),recvbuf1(:,3,2:2*proc-1),& + recvbuf1(:,4,2:2*proc-1),recvbuf1(:,5,2:2*proc-1),recvbuf1(:,6,2:2*proc-1),& + 2*proc-2,nlot) + else + call pentadiagonal_periodic_serial(& + recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& + recvbuf1(:,4,:),recvbuf1(:,5,:),recvbuf1(:,6,:),& + 2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) + end if + + ! Move solution to first slot + do i=1,2*proc + recvbuf2(:,i) = recvbuf1(:,6,i) + end do + + ! Permute the order + do i=1,proc-1 + const(1:nlot) = recvbuf2(:,2*i) + recvbuf2(:,2*i) = recvbuf2(:,2*i+1) + recvbuf2(:,2*i+1) = const(1:nlot) + end do + + ! If periodic, don't forget the end points + if (nper) then + const(1:nlot) = recvbuf2(:,1) + recvbuf2(:,1) = recvbuf2(:,2*proc) + recvbuf2(:,2*proc) = const(1:nlot) + end if + + ! Scatter back the solution + call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + do i=1,n + r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) + end do + + deallocate(sendbuf) + deallocate(recvbuf2) + deallocate(recvbuf1) + deallocate(ngroup) + + return + end subroutine tridiagonal + + + !> TriDiagonal Solver - Serial Case - Periodic + subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + r = r/(a + b + c) + return + else if (n .eq. 2) then + ! Solve 2x2 system + c(:,1) = c(:,1) + a(:,1) + a(:,2) = a(:,2) + c(:,2) + const(:) = a(:,2)/b(:,1) + b(:,2) = b(:,2) - c(:,1)*const(:) + r(:,2) = r(:,2) - r(:,1)*const(:) + r(:,2) = r(:,2)/b(:,2) + r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) + return + end if + + ! Forward elimination + do i=2,n-2 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + ! Boundary is stored in a(i) + a(:,i) = -a(:,i-1)*const(:) + end do + i=n-1 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = c(:,i) - a(:,i-1)*const(:) + i=n + const(:) = a(:,i)/b(:,i-1) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = b(:,i) - a(:,i-1)*const(:) + + ! Backward elimination + do i=n-2,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + a(:,i) = a(:,i) - a(:,i+1)*const(:) + end do + + ! Eliminate oddball + const(:) = c(:,n)/b(:,1) + r(:,n) = r(:,n) - r(:,1)*const(:) + a(:,n) = a(:,n) - a(:,1)*const(:) + + ! Backward substitution + r(:,n) = r(:,n)/a(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) + end do + + return + end subroutine tridiagonal_periodic_serial + + + !> TriDiagonal Solver - Serial Case - Not Periodic + subroutine tridiagonal_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + ! Forward elimination + do i=2,n + const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + end do + + ! Back-substitution + r(:,n) = r(:,n)/b(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) + end do + + return + end subroutine tridiagonal_serial + + subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot,2) :: r1 + real(WP), dimension(lot,2) :: r2 + real(WP), dimension(lot,n,2) :: s1 + real(WP), dimension(lot,n,2) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:,:), allocatable :: sendbuf + real(WP), dimension(:,:), allocatable :: recvbuf + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:,:), allocatable :: AA + real(WP), dimension(:,:), allocatable :: swap + + ! Stuff + integer :: i,igroup,j,k,m + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call pentadiagonal_serial(A,B,C,D,E,R,n,lot) + else + call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot,24*proc)) + allocate(recvbuf(nlot,24*proc)) + + if (n > 1) then ! do normal stuff + + ! Initialize boundary values + s1(:,1,1) = a(:,1) + s1(:,1,2) = b(:,1) + s1(:,2,1) = 0.0_WP + s1(:,2,2) = a(:,2) + s2(:,n-1,1) = e(:,n-1) + s2(:,n-1,2) = 0.0_WP + s2(:,n,1) = d(:,n) + s2(:,n,2) = e(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(:,i,1:2) + do i=1,n-2 + ! Eliminate a(i+2) + const(:) = a(:,i+2)/c(:,i) + b(:,i+2) = b(:,i+2) - d(:,i)*const(:) + c(:,i+2) = c(:,i+2) - e(:,i)*const(:) + r(:,i+2) = r(:,i+2) - r(:,i)*const(:) + s1(:,i+2,1) = -s1(:,i,1)*const(:) + s1(:,i+2,2) = -s1(:,i,2)*const(:) + + ! Eliminate b(i+1) + const(:) = b(:,i+1)/c(:,i) + c(:,i+1) = c(:,i+1) - d(:,i)*const(:) + d(:,i+1) = d(:,i+1) - e(:,i)*const(:) + r(:,i+1) = r(:,i+1) - r(:,i)*const(:) + s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) + s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) + end do + ! Eliminate b(n) + const(:) = b(:,n)/c(:,n-1) + c(:,n) = c(:,n) - d(:,n-1)*const(:) + r(:,n) = r(:,n) - r(:,n-1)*const(:) + s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) + s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) + s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) + + ! Backward elimination + ! Lower boundary in s2(:,i,1:2) + do i=n,3,-1 + ! Eliminate e(i-2) + const(:) = e(:,i-2)/c(:,i) + r(:,i-2) = r(:,i-2) - r(:,i)*const(:) + s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) + s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) + s2(:,i-2,1) = -s2(:,i,1)*const(:) + s2(:,i-2,2) = -s2(:,i,2)*const(:) + + ! Eliminate d(i-1) + const(:) = d(:,i-1)/c(:,i) + r(:,i-1) = r(:,i-1) - r(:,i)*const(:) + s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) + s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) + s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) + s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) + end do + ! Eliminate d(1) + const(:) = d(:,1)/c(:,2) + r(:,1) = r(:,1) - r(:,2)*const(:) + s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) + s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) + s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) + s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) + + end if ! n > 1 + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced 11-diagonal system + ! Use of 11-diagonal system is more robust than the + ! reordered (removes zeros) 7-diagonal system + + ! Send rows of 11-diagonal system + ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) + ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) + ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) + ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) + ! For efficiency, only send non-zero elements + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + if (n > 1) then ! do normal stuff + + do i=1,2 + sendbuf(1:nk, L+0) = c(k1:k2, i) + sendbuf(1:nk, L+1) = r(k1:k2, i) + sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) + sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + sendbuf(1:nk, L+0) = s1(k1:k2, i,j) + sendbuf(1:nk, L+1) = s2(k1:k2, i,j) + sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) + sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) + L = L + 4 + end do + end do + + else ! n == 1 special case + + sendbuf(1:nk, L+0) = c(k1:k2, 1) + sendbuf(1:nk, L+1) = r(k1:k2, 1) + sendbuf(1:nk, L+2) = 1.0_WP + sendbuf(1:nk, L+3) = 0.0_WP + sendbuf(1:nk, L+4) = 1.0_WP + sendbuf(1:nk, L+5) = 0.0_WP + sendbuf(1:nk, L+6) = c(k1:k2, 1) + sendbuf(1:nk, L+7) = r(k1:k2, 1) + sendbuf(1:nk, L+8) = a(k1:k2, 1) + sendbuf(1:nk, L+9) = d(k1:k2, 1) + sendbuf(1:nk, L+10) = 0.0_WP + sendbuf(1:nk, L+11) = 0.0_WP + sendbuf(1:nk, L+12) = b(k1:k2, 1) + sendbuf(1:nk, L+13) = e(k1:k2, 1) + sendbuf(1:nk, L+14) = -1.0_WP + sendbuf(1:nk, L+15) = 0.0_WP + sendbuf(1:nk, L+16) = 0.0_WP + sendbuf(1:nk, L+17) = -1.0_WP + sendbuf(1:nk, L+18) = a(k1:k2, 1) + sendbuf(1:nk, L+19) = d(k1:k2, 1) + sendbuf(1:nk, L+20) = 0.0_WP + sendbuf(1:nk, L+21) = 0.0_WP + sendbuf(1:nk, L+22) = b(k1:k2, 1) + sendbuf(1:nk, L+23) = e(k1:k2, 1) + L = L + 24 + + end if + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) + + ! Build reduced matrix + allocate(AA(nlot, 4*proc, -5:5 + 1)) + AA = 0.0_WP + L = 1 + do k=1,proc + m = 4*(k-1) + + do i=1,2 + AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) + AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) + AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) + AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) + AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) + AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) + AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) + L = L + 4 + end do + end do + + end do + + ! Clear unused values + nk = ngroup(nrank+1) + AA(nk+1:nlot, :, :) = 0.0_WP + AA(nk+1:nlot, :, 0) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) + else + if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' + call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) + end if + + ! Move solution to beginning of recvbuf + recvbuf(:, 1:4*proc) = AA(:, :, 6) + deallocate(AA) + + ! Permute the order + allocate (swap(nlot,2)) + do i=1,proc-1 + swap(:,:) = recvbuf(:, 4*i-1:4*i) + recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) + recvbuf(:, 4*i+1:4*i+2) = swap(:,:) + end do + ! If periodic, don't forget the end points + if (nper) then + swap(:,:) = recvbuf(:, 4*proc-1:4*proc) + recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) + recvbuf(:, 1:2) = swap(:,:) + end if + deallocate (swap) + + ! Scatter back the solution + deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) + call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) + r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) + L = L + 4 + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + if (n > 1) then ! do normal stuff + + do j=1,2 + do i=1,n + r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) + end do + end do + r = r / c + + else ! n == 1 special case + + r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & + -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) + + end if + + deallocate(sendbuf) + deallocate(recvbuf) + deallocate(ngroup) + + return + end subroutine pentadiagonal + + + ! ================================================= ! + ! PentaDiagonal Solver - Serial Case - Not periodic ! + ! ================================================= ! + subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,1) = R(:,1)/C(:,1) + return + else if (n .eq. 2) then + ! Solve 2x2 system + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + end if + + ! Forward elimination + do i=1,n-2 + ! Eliminate A(2,i+1) + const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + + ! Eliminate A(1,i+2) + const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + end do + ! Eliminate A(2,n) + const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) + C(:,n) = C(:,n) - D(:,n-1)*const(:) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + + ! Back-substitution + R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) + R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) + end do + + return + end subroutine pentadiagonal_serial + + + + ! ============================================= ! + ! PentaDiagonal Solver - Serial Case - Periodic ! + ! ============================================= ! + subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) + return + else if (n .eq. 2) then + ! Solve 2x2 system + C(:,:) = C(:,:) + A(:,:) + E(:,:) + D(:,1) = D(:,1) + B(:,1) + B(:,2) = B(:,2) + D(:,2) + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + else if (n .eq. 3) then + B(:,:) = B(:,:) + E(:,:) + D(:,:) = D(:,:) + A(:,:) + call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) + return + else if (n .eq. 4) then + A(:,:) = A(:,:) + E(:,:) + E(:,:) = 0.0_WP + end if + + ! Initialize boundary data + s1 = 0.0_WP + s1(:,1) = A(:,1) + s1(:,n-3) = s1(:,n-3) + E(:,n-3) + s1(:,n-2) = D(:,n-2) + s1(:,n-1) = C(:,n-1) + s1(:,n) = B(:,n) + s2 = 0.0_WP + s2(:,1) = B(:,1) + s2(:,2) = A(:,2) + s2(:,n-2) = s2(:,n-2) + E(:,n-2) + s2(:,n-1) = D(:,n-1) + s2(:,n) = C(:,n) + + ! Forward elimination + do i=1,n-2 + ! Eliminate b(i+1) + const(:) = B(:,i+1)/C(:,i) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) + s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) + + ! Eliminate a(i+2) + const(:) = A(:,i+2)/C(:,i) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) + s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) + end do + + ! Backward elimination + do i=n-2,3,-1 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate e(i-2) + const(:) = E(:,i-2)/C(:,i) + R(:,i-2) = R(:,i-2) - R(:,i)*const(:) + s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) + s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) + end do + i=2 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate oddball region + const(:) = E(:,n-1)/C(:,1) + R(:,n-1) = R(:,n-1) - R(:,1)*const(:) + s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) + s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) + + const(:) = D(:,n)/C(:,1) + R(:,n) = R(:,n) - R(:,1)*const(:) + s1(:,n) = s1(:,n) - s1(:,1)*const(:) + s2(:,n) = s2(:,n) - s2(:,1)*const(:) + + const(:) = E(:,n)/C(:,2) + R(:,n) = R(:,n) - R(:,2)*const(:) + s1(:,n) = s1(:,n) - s1(:,2)*const(:) + s2(:,n) = s2(:,n) - s2(:,2)*const(:) + + ! Eliminate corner region + const(:) = s1(:,n)/s1(:,n-1) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) + + R(:,n) = R(:,n)/s2(:,n) + R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) + end do + + return + end subroutine pentadiagonal_periodic_serial + + + subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) + implicit none + class(diag), intent(inout) :: this + character(len=*), intent(in) :: dir + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + integer :: proc + logical :: nper + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc.eq.1) then + if (.not.nper) then + call polydiagonal_serial(nd,A,R,n,lot) + else + call polydiagonal_periodic_serial(nd,A,R,n,lot,b) + end if + return + else + stop 'polydiagonal: Implemented only in serial.' + end if + + return + end subroutine polydiagonal + + + subroutine polydiagonal_serial(nd,A,R,n,lot) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k + + ! Forward elimination + do i=1,n-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,n-i) + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,min(nd,n-i) + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Back-substitution + do i=n,1,-1 + do j=1,min(nd,n-i) + R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + return + end subroutine polydiagonal_serial + + + subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k,i0 + + if (n.eq.1) then + const(:) = 0.0_WP + do j=-nd,nd + const(:) = const(:) + A(:,j,1) + end do + R(:,1) = R(:,1) / const(:) + return + end if + + ! Setup bridge array + do j=1,nd + do i=1,n + b(:,i,j) = 0.0_WP + end do + end do + do i=1,nd + do j=i,nd + b(:,i,j) = A(:,i,-nd+j-i) + b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) + end do + end do + do i=n-nd+1,n + do j=1,nd + b(:,i,j) = A(:,i,-nd+j-(i-n)) + end do + end do + + ! Forward elimination + do i=1,n-nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,nd + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,nd + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Backward elimination + do i=n-nd,1,-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,i-1) + const(:) = A(:,i-j,j)*pivot(:) + do k=1,nd + b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) + end do + R(:,i-j) = R(:,i-j) - R(:,i)*const(:) + end do + end do + + ! Eliminate oddball region + do i=1,nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=i,nd + const(:) = A(:,n-j+i,j)*pivot(:) + do k=1,nd + b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) + end do + R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) + end do + end do + + ! Elimination for corner matrix + i0 = n-nd + do i=1,nd-1 + pivot(:) = 1.0_WP/b(:,i+i0,i) + do j=i+1,nd + const(:) = b(:,j+i0,i)*pivot(:) + do k=i+1,nd + b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) + end do + R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) + end do + end do + + ! Back-substitution for corner matrix + i0 = n-nd + do i=nd,1,-1 + do j=i+1,nd + R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) + end do + R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) + end do + + ! Back-substitution for bridge + do i=n-nd,1,-1 + do j=1,nd + R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + return + end subroutine polydiagonal_periodic_serial + + +end module diag_class From 6016beb4be983d316cb789a80c103d586a42f542 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Fri, 9 Dec 2022 17:03:45 -0500 Subject: [PATCH 021/152] fixed bad tab character --- src/grid/pgrid_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index f0ba13b90..1d64ba061 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -92,7 +92,7 @@ module pgrid_class procedure, private :: pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries for integer procedure, private :: pgrid_rsync,pgrid_rsync_no !< Commmunicate inner and periodic boundaries for real(WP) procedure, private :: pgrid_rsync_array !< Commmunicate inner and periodic boundaries for arrays of real(WP) of the form (:,i,j,k) - procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) + procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) generic :: syncsum=>pgrid_rsyncsum !< Summation across inner and periodic boundaries - generic procedure, private :: pgrid_rsyncsum !< Summation inner and periodic boundaries for real(WP) procedure :: get_rank !< Function that returns rank of processor that contains provided indices From b0a321eee41603046760c123ae22a98d922bf208 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 10 Dec 2022 12:34:36 -0500 Subject: [PATCH 022/152] diag solver updates The diagonal solver compiles and computes things but it is not working yet. haven't yet switched to the abstract linear solver --- src/particles/lpt_class.f90 | 57 +++++++--------- src/solver/diag_class.f90 | 132 ++++++++++++++++++++++++++++++++---- 2 files changed, 144 insertions(+), 45 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index ad0466c76..6e863c251 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -4,6 +4,7 @@ module lpt_class use precision, only: WP use string, only: str_medium use config_class, only: config + use diag_class, only: diag use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION implicit none private @@ -48,6 +49,8 @@ module lpt_class ! This is our underlying config class(config), pointer :: cfg !< This is the config the solver is build for + + type(diag) :: tridiag !< Tridiagonal solver for implicit filter ! This is the name of the solver character(len=str_medium) :: name='UNNAMED_LPT' !< Solver name (default=UNNAMED_LPT) @@ -141,6 +144,9 @@ function constructor(cfg,name) result(self) ! Point to pgrid object self%cfg=>cfg + + ! Create tridiagonal solver object + self%tridiag=diag(cfg=self%cfg,name='Tridiagonal',n=3) ! Allocate variables allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 @@ -161,7 +167,7 @@ function constructor(cfg,name) result(self) self%filter_width=0.0_WP ! Solve explicitly by default - self%implicit_filter=.false. + self%implicit_filter=.true. ! Allocate finite volume divergence operators allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered @@ -673,8 +679,6 @@ subroutine filter(this,A) real(WP) :: filter_coeff integer :: i,j,k,n,nstep real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ - real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az - real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz ! Return without filtering if filter width is zero if (this%filter_width.le.0.0_WP) return @@ -682,68 +686,57 @@ subroutine filter(this,A) ! Recompute filter coeff and number of explicit steps needed filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 - if (this%implicit_filter) then - ! Apply filter implicitly via approximate factorization - ! Allocate implicit arrays - allocate(Ax(this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%imino_+1:this%cfg%imaxo_-1,-1:+1)) - allocate(Ay(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,-1:+1)) - allocate(Az(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,-1:+1)) - allocate(Rx(this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%imino_+1:this%cfg%imaxo_-1)) - allocate(Ry(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1)) - allocate(Rz(this%cfg%imino_+1:this%cfg%imaxo_-1,this%cfg%jmino_+1:this%cfg%jmaxo_-1,this%cfg%kmino_+1:this%cfg%kmaxo_-1)) + if (this%implicit_filter) then !< Apply filter implicitly via approximate factorization ! Inverse in X-direction do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) - Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) + this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) - Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) - Rx(j,k,i) = A(i,j,k) + this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) + this%tridiag%Rx(j,k,i) = A(i,j,k) end do end do end do - !!call linear_solver_x(3) + call this%tridiag%linsol_x() ! Inverse in Y-direction do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) - Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & + this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) + this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) - Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) - Ry(i,k,j) = Rx(j,k,i) + this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) + this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) end do end do end do - !!call linear_solver_y(3) + call this%tridiag%linsol_y() ! Inverse in Z-direction do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) - Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + this%tridiag%Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) + this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) - Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) - Rz(i,j,k) = Ry(i,k,j) + this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) + this%tridiag% Rz(i,j,k) = this%tridiag%Ry(i,k,j) end do end do end do - !!call linear_solver_z(3) + call this%tridiag%linsol_z() ! Update A do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=Rz(i,j,k) + A(i,j,k)=this%tridiag%Rz(i,j,k) end do end do end do ! Sync A call this%cfg%sync(A) - ! Deallocate implicit arrays - deallocate(Ax,Ay,Az,Rx,Ry,Rz) - else - ! Apply filter explicitly + else !< Apply filter explicitly ! Allocate flux arrays allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index 969f6d5d9..3bb6e1f98 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -2,6 +2,7 @@ module diag_class use precision, only: WP use config_class, only: config + use string, only: str_medium implicit none private @@ -12,14 +13,19 @@ module diag_class type :: diag ! Diagonalr solver works for a config type(config), pointer :: cfg !< Config for the diag solver + character(len=str_medium) :: name !< Name of solver + integer :: ndiags !< Number of diagonals real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays + real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays contains - - procedure :: tridiagonal !< Tridiagonal solver - procedure :: pentadiagonal !< Pentadiagonal solver - procedure :: polydiagonal !< Polydiagonal solver + procedure :: linsol_x !< Linear solver in x + procedure :: linsol_y !< Linear solver in y + procedure :: linsol_z !< Linear solver in z + procedure :: tridiagonal + procedure :: pentadiagonal + procedure :: polydiagonal final :: destructor !< Destructor for diag end type diag @@ -40,30 +46,130 @@ subroutine destructor(this) if (allocated(this%Rx)) deallocate(this%Rx) if (allocated(this%Ry)) deallocate(this%Ry) if (allocated(this%Rz)) deallocate(this%Rz) + if (allocated(this%stackmem)) deallocate(this%stackmem) end subroutine destructor !> Constructor for a diag object - function diag_from_args(cfg,n) result(self) + function diag_from_args(cfg,name,n) result(self) use messager, only: die implicit none type(diag) :: self class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name integer, intent(in) :: n - - ! Link the config + integer :: nst + + ! Link the config and store the name self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Number of diagonals and stencil size + self%ndiags=n + nst=(n-1)/2 ! Allocate arrays - allocate(self%Ax(self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%imino_+n:self%cfg%imaxo_-n,-n:+n)) - allocate(self%Ay(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,-n:+n)) - allocate(self%Az(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,-n:+n)) - allocate(self%Rx(self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%imino_+n:self%cfg%imaxo_-n)) - allocate(self%Ry(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n)) - allocate(self%Rz(self%cfg%imino_+n:self%cfg%imaxo_-n,self%cfg%jmino_+n:self%cfg%jmaxo_-n,self%cfg%kmino_+n:self%cfg%kmaxo_-n)) + allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) + allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) + allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) + allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) + allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) + allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) end function diag_from_args + + ! Real solver in x + subroutine linsol_x(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,& + -(this%ndiags-1)/2),this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) + end select + + return + end subroutine linsol_x + + + ! Real solver in y + subroutine linsol_y(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,& + -(this%ndiags-1)/2),this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) + end select + + return + end subroutine linsol_y + + + ! Real solver in z + subroutine linsol_z(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,& + -(this%ndiags-1)/2),this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) + end select + + return + end subroutine linsol_z + + subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) use parallel use mpi_f08, only : mpi_comm From 677da16cc25c9781311da7c409f31fce2a61136c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 16 Dec 2022 23:01:25 -0500 Subject: [PATCH 023/152] New LPT capabilities Added injection routine. This allows for particles to be injected randomly within a circular region. Special care is taken to avoid overlap if collisions are used. Also added separate coeff of restitution for walls. The example case injects particles with diameters sampled from a random lognormal distribution. --- examples/fluidized_bed/src/simulation.f90 | 1 + examples/part_inject/README | 1 + examples/part_inject/input | 40 + examples/part_inject/src/Make.package | 2 + examples/part_inject/src/geometry.f90 | 84 + examples/part_inject/src/simulation.f90 | 221 ++ src/particles/lpt_class.f90 | 2931 +++++++++++---------- 7 files changed, 1931 insertions(+), 1349 deletions(-) create mode 100644 examples/part_inject/README create mode 100644 examples/part_inject/input create mode 100644 examples/part_inject/src/Make.package create mode 100644 examples/part_inject/src/geometry.f90 create mode 100644 examples/part_inject/src/simulation.f90 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 37c433c06..672b3de52 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -192,6 +192,7 @@ subroutine simulation_init lp%Tcol=5.0_WP*time%dt ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) ! Set gravity call param_read('Gravity',lp%gravity) if (lp%cfg%amRoot) then diff --git a/examples/part_inject/README b/examples/part_inject/README new file mode 100644 index 000000000..0edd414b0 --- /dev/null +++ b/examples/part_inject/README @@ -0,0 +1 @@ +This is a particle injection case, intended to test the particle injection routine with polydisperse particles injected randomly within a circular region at a given mass flow rate. The injection routine checks overlap to avoid placing particles on top of others. diff --git a/examples/part_inject/input b/examples/part_inject/input new file mode 100644 index 000000000..6c23990d9 --- /dev/null +++ b/examples/part_inject/input @@ -0,0 +1,40 @@ +# Parallelization +Partition : 1 2 2 + +# Mesh definition +Lx : 0.007 +Ly : 0.01792 +Lz : 0.01792 +nx : 50 +ny : 128 +nz : 128 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 + +# Fluid properties +Gravity : 9.81 0 0 +Viscosity : 1.8e-5 +Density : 1 + +# Particle parameters +Particle mean diameter : 37.515e-6 +Particle standard deviation : 1.7894e-5 +Particle min diameter : 8.1e-6 +Particle max diameter : 139.1e-6 +Particle diameter shift : 0 +Particle density : 2250 + +# Particle collisions +Coefficient of restitution : 0.85 +Wall restitution : 0.1 +Friction coefficient : 0.5 + +# Particle injection +Particle inject diameter: 0.00127 +Particle mass flow rate: 0.00001 +Particle velocity: 0.18 0 0 + +# Ensight output +Ensight output period : 40e-5 \ No newline at end of file diff --git a/examples/part_inject/src/Make.package b/examples/part_inject/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/part_inject/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/part_inject/src/geometry.f90 b/examples/part_inject/src/geometry.f90 new file mode 100644 index 000000000..ec14741b8 --- /dev/null +++ b/examples/part_inject/src/geometry.f90 @@ -0,0 +1,84 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='Particles') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + cfg%VF=1.0_WP + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + if (cfg%xm(i).gt.cfg%xL) cfg%VF(i,j,k)=0.0_WP + end do + end do + end do + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 new file mode 100644 index 000000000..4f9b87867 --- /dev/null +++ b/examples/part_inject/src/simulation.f90 @@ -0,0 +1,221 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Only get a LPT solver and corresponding time tracker + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile + + public :: simulation_init,simulation_run,simulation_final + + !> Fluid phase arrays + real(WP), dimension(:,:,:), allocatable :: U,V,W + real(WP), dimension(:,:,:), allocatable :: rho,visc + +contains + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + time%dt=time%dtmax + time%itmax=1 + end block initialize_timetracker + + + ! Initialize our LPT + initialize_lpt: block + use random, only: random_uniform + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Turn off drag + lp%drag_model='none' + ! Initialize with zero particles + call lp%resize(0) + ! Get initial particle volume fraction + call lp%update_VF() + ! Set collision timescale + lp%Tcol=15.0_WP*time%dt + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w) + call param_read('Friction coefficient',lp%mu_f) + ! Injection parameters + call param_read('Particle mass flow rate',lp%mfr) + call param_read('Particle velocity',lp%inj_vel) + call param_read('Particle mean diameter',lp%inj_dmean) + call param_read('Particle standard deviation',lp%inj_dsd,default=0.0_WP) + call param_read('Particle min diameter',lp%inj_dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',lp%inj_dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',lp%inj_dshift,default=0.0_WP) + if (lp%inj_dsd.le.epsilon(1.0_WP)) then + lp%inj_dmin=lp%inj_dmean + lp%inj_dmax=lp%inj_dmean + end if + call param_read('Particle inject diameter',lp%inj_d) + lp%inj_pos=0.0_WP + lp%inj_T=300.0_WP + end block initialize_lpt + + + ! Initialize quiescent fluid + initialize_fluid: block + use mathtools, only: twoPi + integer :: i,j,k + real(WP) :: rhof,viscf + ! Allocate arrays + allocate(rho (lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(visc(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(U(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(V(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(W(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + U=0.0_WP; V=0.0_WP; W=0.0_WP + ! Set constant density and viscosity + call param_read('Density',rhof); rho=rhof + call param_read('Viscosity',viscf); visc=viscf + end block initialize_fluid + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=lp%cfg,name='particles') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',U,V,W) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call lp%get_max() + ! Create simulation monitor + mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(lp%np,'Particle number') + call mfile%add_column(lp%ncol,'Particle collisions') + call mfile%add_column(lp%VFmean,'Mean VF') + call mfile%add_column(lp%Umin,'Particle Umin') + call mfile%add_column(lp%Umax,'Particle Umax') + call mfile%add_column(lp%Vmin,'Particle Vmin') + call mfile%add_column(lp%Vmax,'Particle Vmax') + call mfile%add_column(lp%Wmin,'Particle Wmin') + call mfile%add_column(lp%Wmax,'Particle Wmax') + call mfile%add_column(lp%dmin,'Particle dmin') + call mfile%add_column(lp%dmax,'Particle dmax') + call mfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call time%increment() + + ! Inject particles + call lp%inject(dt=time%dt) + + ! Collide particles + call lp%collide(dt=time%dt) + + ! Advance particles by dt + call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc) + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call lp%get_max() + call mfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(rho,visc,U,V,W) + + end subroutine simulation_final + +end module simulation diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 6e863c251..38a29657d 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -1,1379 +1,1612 @@ !> Basic Lagrangian particle solver class: !> Provides support for Lagrangian-transported objects module lpt_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use diag_class, only: diag - use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION - implicit none - private - - - ! Expose type/constructor/methods - public :: lpt - - - !> Memory adaptation parameter - real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor - real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor - - !> I/O chunk size to read at a time - integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - !> Basic particle object definition - type :: part - !> MPI_INTEGER8 data - integer(kind=8) :: id !< Particle ID - !> MPI_DOUBLE_PRECISION data - real(WP) :: d !< Particle diameter - real(WP), dimension(3) :: pos !< Particle center coordinates - real(WP), dimension(3) :: vel !< Velocity of particle - real(WP), dimension(3) :: col !< Collision force - real(WP) :: T !< Temperature - real(WP) :: dt !< Time step size for the particle - !> MPI_INTEGER data - integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) - end type part - !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=3 - integer , dimension(part_nblock) :: part_lblock=[1,12,4] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] - !> MPI_PART derived datatype and size - type(MPI_Datatype) :: MPI_PART - integer :: MPI_PART_SIZE - - !> Lagrangian particle tracking solver object definition - type :: lpt - - ! This is our underlying config - class(config), pointer :: cfg !< This is the config the solver is build for - - type(diag) :: tridiag !< Tridiagonal solver for implicit filter - - ! This is the name of the solver - character(len=str_medium) :: name='UNNAMED_LPT' !< Solver name (default=UNNAMED_LPT) - - ! Particle data - integer :: np !< Global number of particles - integer :: np_ !< Local number of particles - integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor - type(part), dimension(:), allocatable :: p !< Array of particles of type part - - ! Overlap particle (i.e., ghost) data - integer :: ng_ !< Local number of ghosts - type(part), dimension(:), allocatable :: g !< Array of ghosts of type part - - ! Particle density - real(WP) :: rho !< Density of particle - - ! Gravitational acceleration - real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity - - ! Solver parameters - real(WP) :: nstep=1 !< Number of substeps (default=1) - character(len=str_medium), public :: drag_model !< Drag model - - ! Collisional parameters - real(WP) :: Tcol !< Characteristic collision time scale - real(WP) :: e_n=0.9_WP !< Normal restitution coefficient - real(WP) :: clip_col=0.2_WP !< Maximum allowable overlap - real(WP), dimension(:,:,:), allocatable :: Wdist !< Signed wall distance - naive for now (could be redone with FMM) - real(WP), dimension(:,:,:,:), allocatable :: Wnorm !< Wall normal function - naive for now (could be redone with FMM) - - ! Monitoring info - real(WP) :: VFmin,VFmax,VFmean,VFvar !< Volume fraction info - real(WP) :: dmin,dmax,dmean,dvar !< Diameter info - real(WP) :: Umin,Umax,Umean,Uvar !< U velocity info - real(WP) :: Vmin,Vmax,Vmean,Vvar !< V velocity info - real(WP) :: Wmin,Wmax,Wmean,Wvar !< W velocity info - integer :: np_new,np_out !< Number of new and removed particles - - ! Particle volume fraction - real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered - - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered - - ! Filtering operation - logical :: implicit_filter !< Solve implicitly - real(WP) :: filter_width !< Characteristic filter width - real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator - real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator - + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use diag_class, only: diag + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: lpt + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic particle object definition + type :: part + !> MPI_INTEGER8 data + integer(kind=8) :: id !< Particle ID + !> MPI_DOUBLE_PRECISION data + real(WP) :: d !< Particle diameter + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + real(WP), dimension(3) :: col !< Collision force + real(WP) :: T !< Temperature + real(WP) :: dt !< Time step size for the particle + !> MPI_INTEGER data + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=3 + integer , dimension(part_nblock) :: part_lblock=[1,12,4] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Lagrangian particle tracking solver object definition + type :: lpt + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + type(diag) :: tridiag !< Tridiagonal solver for implicit filter + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_LPT' !< Solver name (default=UNNAMED_LPT) + + ! Particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Overlap particle (i.e., ghost) data + integer :: ng_ !< Local number of ghosts + type(part), dimension(:), allocatable :: g !< Array of ghosts of type part + + ! Particle density + real(WP) :: rho !< Density of particle + + ! Gravitational acceleration + real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + character(len=str_medium), public :: drag_model !< Drag model + + ! Collisional parameters + logical :: use_col=.true. !< Flag for collisions + real(WP) :: Tcol !< Characteristic collision time scale + real(WP) :: e_n !< Normal restitution coefficient + real(WP) :: e_w !< Wall restitution coefficient + real(WP) :: mu_f !< Friction coefficient + real(WP) :: clip_col=0.2_WP !< Maximum allowable overlap + real(WP), dimension(:,:,:), allocatable :: Wdist !< Signed wall distance - naive for now (could be redone with FMM) + real(WP), dimension(:,:,:,:), allocatable :: Wnorm !< Wall normal function - naive for now (could be redone with FMM) + + ! Injection parameters + real(WP) :: mfr !< Mass flow rate for particle injection + real(WP), dimension(3) :: inj_pos !< Center location to inject particles + real(WP), dimension(3) :: inj_vel !< Celocity assigned during injection + real(WP) :: inj_T !< Temperature assigned during injection + real(WP) :: inj_dmean !< Mean diameter assigned during injection + real(WP) :: inj_dsd !< STD diameter assigned during injection + real(WP) :: inj_dmin !< Min diameter assigned during injection + real(WP) :: inj_dmax !< Max diameter assigned during injection + real(WP) :: inj_dshift !< Diameter shift assigned during injection + real(WP) :: inj_d !< Diameter to inject particles within + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean,VFvar !< Volume fraction info + real(WP) :: dmin,dmax,dmean,dvar !< Diameter info + real(WP) :: Umin,Umax,Umean,Uvar !< U velocity info + real(WP) :: Vmin,Vmax,Vmean,Vvar !< V velocity info + real(WP) :: Wmin,Wmax,Wmean,Wvar !< W velocity info + integer :: np_new,np_out !< Number of new and removed particles + integer :: ncol=0 !< Number of collisions + + ! Particle volume fraction + real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered + + ! Filtering operation + logical :: implicit_filter !< Solve implicitly + real(WP) :: filter_width !< Characteristic filter width + real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator + real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator + contains - procedure :: update_partmesh !< Update a partmesh object using current particles - procedure :: collide !< Evaluate interparticle collision force - procedure :: advance !< Step forward the particle ODEs - procedure :: get_rhs !< Compute rhs of particle odes - procedure :: resize !< Resize particle array to given size - procedure :: resize_ghost !< Resize ghost array to given size - procedure :: recycle !< Recycle particle array by removing flagged particles - procedure :: sync !< Synchronize particles across interprocessor boundaries - procedure :: share !< Share particles across interprocessor boundaries - procedure :: read !< Parallel read particles from file - procedure :: write !< Parallel write particles to file - procedure :: get_max !< Extract various monitoring data - procedure :: update_VF !< Compute particle volume fraction - procedure :: filter !< Apply volume filtering to field - end type lpt - - - !> Declare lpt solver constructor - interface lpt - procedure constructor - end interface lpt - + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: collide !< Evaluate interparticle collision force + procedure :: advance !< Step forward the particle ODEs + procedure :: get_rhs !< Compute rhs of particle odes + procedure :: resize !< Resize particle array to given size + procedure :: resize_ghost !< Resize ghost array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: share !< Share particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: update_VF !< Compute particle volume fraction + procedure :: filter !< Apply volume filtering to field + procedure :: inject !< Inject particles at a prescribed boundary + end type lpt + + + !> Declare lpt solver constructor + interface lpt + procedure constructor + end interface lpt + contains - - - !> Default constructor for lpt solver - function constructor(cfg,name) result(self) - implicit none - type(lpt) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - integer :: i,j,k - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Create tridiagonal solver object - self%tridiag=diag(cfg=self%cfg,name='Tridiagonal',n=3) - - ! Allocate variables - allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 - self%np_=0; self%np=0 - call self%resize(0) - - ! Initialize MPI derived datatype for a particle - call prepare_mpi_part() - - ! Allocate VF and src arrays on cfg mesh - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP - - ! Set filter width to zero by default - self%filter_width=0.0_WP - - ! Solve explicitly by default - self%implicit_filter=.true. - - ! Allocate finite volume divergence operators - allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - allocate(self%div_y(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - allocate(self%div_z(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - ! Create divergence operator to cell center [xm,ym,zm] - do k=self%cfg%kmin_,self%cfg%kmax_ - do j=self%cfg%jmin_,self%cfg%jmax_ - do i=self%cfg%imin_,self%cfg%imax_ - self%div_x(:,i,j,k)=self%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< Divergence from [x ,ym,zm] - self%div_y(:,i,j,k)=self%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,y ,zm] - self%div_z(:,i,j,k)=self%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,ym,z ] - end do - end do - end do - - ! Allocate finite difference velocity gradient operators - allocate(self%grd_x(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< X-face-centered - allocate(self%grd_y(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Y-face-centered - allocate(self%grd_z(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Z-face-centered - ! Create gradient coefficients to cell faces - do k=self%cfg%kmin_,self%cfg%kmax_+1 - do j=self%cfg%jmin_,self%cfg%jmax_+1 - do i=self%cfg%imin_,self%cfg%imax_+1 - self%grd_x(:,i,j,k)=self%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< Gradient in x from [xm,ym,zm] to [x,ym,zm] - self%grd_y(:,i,j,k)=self%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< Gradient in y from [xm,ym,zm] to [xm,y,zm] - self%grd_z(:,i,j,k)=self%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< Gradient in z from [xm,ym,zm] to [xm,ym,z] - end do - end do - end do - - ! Loop over the domain and zero divergence in walls - do k=self%cfg%kmin_,self%cfg%kmax_ - do j=self%cfg%jmin_,self%cfg%jmax_ - do i=self%cfg%imin_,self%cfg%imax_ - if (self%cfg%VF(i,j,k).eq.0.0_WP) then - self%div_x(:,i,j,k)=0.0_WP - self%div_y(:,i,j,k)=0.0_WP - self%div_z(:,i,j,k)=0.0_WP - end if - end do - end do - end do - - ! Zero out gradient to wall faces - do k=self%cfg%kmin_,self%cfg%kmax_+1 - do j=self%cfg%jmin_,self%cfg%jmax_+1 - do i=self%cfg%imin_,self%cfg%imax_+1 - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i-1,j,k).eq.0.0_WP) self%grd_x(:,i,j,k)=0.0_WP - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j-1,k).eq.0.0_WP) self%grd_y(:,i,j,k)=0.0_WP - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j,k-1).eq.0.0_WP) self%grd_z(:,i,j,k)=0.0_WP - end do - end do - end do - - ! Adjust metrics to account for lower dimensionality - if (self%cfg%nx.eq.1) then - self%div_x=0.0_WP - self%grd_x=0.0_WP - end if - if (self%cfg%ny.eq.1) then - self%div_y=0.0_WP - self%grd_y=0.0_WP - end if - if (self%cfg%nz.eq.1) then - self%div_z=0.0_WP - self%grd_z=0.0_WP + + + !> Default constructor for lpt solver + function constructor(cfg,name) result(self) + implicit none + type(lpt) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Create tridiagonal solver object + self%tridiag=diag(cfg=self%cfg,name='Tridiagonal',n=3) + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate VF and src arrays on cfg mesh + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP + + ! Set filter width to zero by default + self%filter_width=0.0_WP + + ! Solve explicitly by default + self%implicit_filter=.false. + + ! Set default drag + self%drag_model='Schiller-Naumann' + + ! Allocate finite volume divergence operators + allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + allocate(self%div_y(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + allocate(self%div_z(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + ! Create divergence operator to cell center [xm,ym,zm] + do k=self%cfg%kmin_,self%cfg%kmax_ + do j=self%cfg%jmin_,self%cfg%jmax_ + do i=self%cfg%imin_,self%cfg%imax_ + self%div_x(:,i,j,k)=self%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< Divergence from [x ,ym,zm] + self%div_y(:,i,j,k)=self%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,y ,zm] + self%div_z(:,i,j,k)=self%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,ym,z ] + end do + end do + end do + + ! Allocate finite difference velocity gradient operators + allocate(self%grd_x(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< X-face-centered + allocate(self%grd_y(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Y-face-centered + allocate(self%grd_z(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Z-face-centered + ! Create gradient coefficients to cell faces + do k=self%cfg%kmin_,self%cfg%kmax_+1 + do j=self%cfg%jmin_,self%cfg%jmax_+1 + do i=self%cfg%imin_,self%cfg%imax_+1 + self%grd_x(:,i,j,k)=self%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< Gradient in x from [xm,ym,zm] to [x,ym,zm] + self%grd_y(:,i,j,k)=self%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< Gradient in y from [xm,ym,zm] to [xm,y,zm] + self%grd_z(:,i,j,k)=self%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< Gradient in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + + ! Loop over the domain and zero divergence in walls + do k=self%cfg%kmin_,self%cfg%kmax_ + do j=self%cfg%jmin_,self%cfg%jmax_ + do i=self%cfg%imin_,self%cfg%imax_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) then + self%div_x(:,i,j,k)=0.0_WP + self%div_y(:,i,j,k)=0.0_WP + self%div_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Zero out gradient to wall faces + do k=self%cfg%kmin_,self%cfg%kmax_+1 + do j=self%cfg%jmin_,self%cfg%jmax_+1 + do i=self%cfg%imin_,self%cfg%imax_+1 + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i-1,j,k).eq.0.0_WP) self%grd_x(:,i,j,k)=0.0_WP + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j-1,k).eq.0.0_WP) self%grd_y(:,i,j,k)=0.0_WP + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j,k-1).eq.0.0_WP) self%grd_z(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Adjust metrics to account for lower dimensionality + if (self%cfg%nx.eq.1) then + self%div_x=0.0_WP + self%grd_x=0.0_WP + end if + if (self%cfg%ny.eq.1) then + self%div_y=0.0_WP + self%grd_y=0.0_WP + end if + if (self%cfg%nz.eq.1) then + self%div_z=0.0_WP + self%grd_z=0.0_WP + end if + + ! Generate a wall distance/norm function + allocate(self%Wdist( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) + allocate(self%Wnorm(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) + ! First pass to set correct sign + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) then + self%Wdist(i,j,k)=-sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) + else + self%Wdist(i,j,k)=+sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) + end if + self%Wnorm(:,i,j,k)=0.0_WP + end do + end do + end do + ! Second pass to compute local distance + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_+1,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i-1,j,k).lt.0.0_WP) then + ! There is a wall at x(i) + if (abs(self%cfg%xm(i )-self%cfg%x(i)).lt.abs(self%Wdist(i ,j,k))) then + self%Wdist(i ,j,k)=sign(self%cfg%xm(i )-self%cfg%x(i),self%Wdist(i ,j,k)) + self%Wnorm(:,i ,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] + end if + if (abs(self%cfg%xm(i-1)-self%cfg%x(i)).lt.abs(self%Wdist(i-1,j,k))) then + self%Wdist(i-1,j,k)=sign(self%cfg%xm(i-1)-self%cfg%x(i),self%Wdist(i-1,j,k)) + self%Wnorm(:,i-1,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_+1,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i,j-1,k).lt.0.0_WP) then + ! There is a wall at y(j) + if (abs(self%cfg%ym(j )-self%cfg%y(j)).lt.abs(self%Wdist(i,j ,k))) then + self%Wdist(i,j ,k)=sign(self%cfg%ym(j )-self%cfg%y(j),self%Wdist(i,j ,k)) + self%Wnorm(:,i,j ,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] + end if + if (abs(self%cfg%ym(j-1)-self%cfg%y(j)).lt.abs(self%Wdist(i,j-1,k))) then + self%Wdist(i,j-1,k)=sign(self%cfg%ym(j-1)-self%cfg%y(j),self%Wdist(i,j-1,k)) + self%Wnorm(:,i,j-1,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + do k=self%cfg%kmino_+1,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i,j,k-1).lt.0.0_WP) then + ! There is a wall at z(k) + if (abs(self%cfg%zm(k )-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k ))) then + self%Wdist(i,j,k )=sign(self%cfg%zm(k )-self%cfg%z(k),self%Wdist(i,j,k )) + self%Wnorm(:,i,j,k )=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] + end if + if (abs(self%cfg%zm(k-1)-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k-1))) then + self%Wdist(i,j,k-1)=sign(self%cfg%zm(k-1)-self%cfg%z(k),self%Wdist(i,j,k-1)) + self%Wnorm(:,i,j,k-1)=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) end if - - ! Generate a wall distance/norm function - allocate(self%Wdist( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) - allocate(self%Wnorm(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) - ! First pass to set correct sign - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%cfg%VF(i,j,k).eq.0.0_WP) then - self%Wdist(i,j,k)=-sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) - else - self%Wdist(i,j,k)=+sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) - end if - self%Wnorm(:,i,j,k)=0.0_WP - end do - end do - end do - ! Second pass to compute local distance - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_+1,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i-1,j,k).lt.0.0_WP) then - ! There is a wall at x(i) - if (abs(self%cfg%xm(i )-self%cfg%x(i)).lt.abs(self%Wdist(i ,j,k))) then - self%Wdist(i ,j,k)=sign(self%cfg%xm(i )-self%cfg%x(i),self%Wdist(i ,j,k)) - self%Wnorm(:,i ,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] - end if - if (abs(self%cfg%xm(i-1)-self%cfg%x(i)).lt.abs(self%Wdist(i-1,j,k))) then - self%Wdist(i-1,j,k)=sign(self%cfg%xm(i-1)-self%cfg%x(i),self%Wdist(i-1,j,k)) - self%Wnorm(:,i-1,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_+1,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i,j-1,k).lt.0.0_WP) then - ! There is a wall at y(j) - if (abs(self%cfg%ym(j )-self%cfg%y(j)).lt.abs(self%Wdist(i,j ,k))) then - self%Wdist(i,j ,k)=sign(self%cfg%ym(j )-self%cfg%y(j),self%Wdist(i,j ,k)) - self%Wnorm(:,i,j ,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] - end if - if (abs(self%cfg%ym(j-1)-self%cfg%y(j)).lt.abs(self%Wdist(i,j-1,k))) then - self%Wdist(i,j-1,k)=sign(self%cfg%ym(j-1)-self%cfg%y(j),self%Wdist(i,j-1,k)) - self%Wnorm(:,i,j-1,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - do k=self%cfg%kmino_+1,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i,j,k-1).lt.0.0_WP) then - ! There is a wall at z(k) - if (abs(self%cfg%zm(k )-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k ))) then - self%Wdist(i,j,k )=sign(self%cfg%zm(k )-self%cfg%z(k),self%Wdist(i,j,k )) - self%Wnorm(:,i,j,k )=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] - end if - if (abs(self%cfg%zm(k-1)-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k-1))) then - self%Wdist(i,j,k-1)=sign(self%cfg%zm(k-1)-self%cfg%z(k),self%Wdist(i,j,k-1)) - self%Wnorm(:,i,j,k-1)=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (self%cfg%amRoot) then - write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) - end if - end block logging - - end function constructor - - - !> Resolve collisional interaction between particles - !> Requires Tcol and e_n to be set beforehand - subroutine collide(this,dt) - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - - ! Start by zeroing out the collision force - zero_force: block - integer :: i - do i=1,this%np_ - this%p(i)%col=0.0_WP - end do - end block zero_force - - ! Then share particles across overlap - call this%share() - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - - ! Finally, calculate collision force - collision_force: block - use mathtools, only: Pi,normalize - integer :: i1,i2,ii,jj,kk,nn - real(WP) :: d1,m1,d2,m2,d12,m12 - real(WP), dimension(3) :: r1,v1,r2,v2,v12,n12,f_n - real(WP) :: k_n,eta_n,lne,pilne2,rnv,r_influ,delta_n - - ! Precompute ln(e_n) and Pi^2+ln(e_n)^2 - lne=log(this%e_n); pilne2=Pi**2+lne**2 - - ! Loop over all local particles - do i1=1,this%np_ - - ! Store particle data - r1=this%p(i1)%pos - v1=this%p(i1)%vel - d1=this%p(i1)%d - m1=this%rho*Pi/6.0_WP*d1**3 - - ! First collide with walls - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') - n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) - n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1/(this%Tcol**2*pilne2) - eta_n=-2.0_WP*lne*sqrt(m1*k_n)/pilne2 - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Calculate collision force - this%p(i1)%col=this%p(i1)%col+f_n/m1 - end if - - ! Loop over nearest cells - do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 - do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 - do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - v2=this%p(i2)%vel - d2=this%p(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - v2=this%g(i2)%vel - d2=this%g(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - end if - - ! Compute relative information - d12=norm2(r1-r2) - if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision - n12=(r2-r1)/d12 - v12=v1-v2 - rnv=dot_product(v12,n12) - r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) - delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - m12=m1*m2/(m1+m2) - k_n=m12/(this%Tcol**2*pilne2) - eta_n=-2.0_WP*lne*sqrt(m12*k_n)/pilne2 - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Calculate collision force - this%p(i1)%col=this%p(i1)%col+f_n/m1 - end if - - end do - - end do - end do - end do - - ! Deal with dimensionality - if (this%cfg%nx.eq.1) this%p(i1)%col(1)=0.0_WP - if (this%cfg%ny.eq.1) this%p(i1)%col(2)=0.0_WP - if (this%cfg%nz.eq.1) this%p(i1)%col(3)=0.0_WP - - end do - - end block collision_force - - end subroutine collide - - - !> Advance the particle equations by a specified time step dt - subroutine advance(this,dt,U,V,W,rho,visc) - use mathtools, only: Pi - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i - real(WP) :: mydt,dt_done,deng - real(WP), dimension(3) :: acc,dmom - type(part) :: pold - - ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - this%srcE=0.0_WP - - ! Advance the equations - do i=1,this%np_ - ! Time-integrate until dt_done=dt - dt_done=0.0_WP - do while (dt_done.lt.dt) - ! Decide the timestep size - mydt=min(this%p(i)%dt,dt-dt_done) - ! Remember the particle - pold=this%p(i) - ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+0.5_WP*mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+this%p(i)%col) - ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+mydt*(acc+this%gravity+this%p(i)%col) - ! Relocalize - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - ! Send source term back to the mesh - dmom=mydt*acc*this%rho*Pi/6.0_WP*this%p(i)%d**3 - deng=sum(dmom*this%p(i)%vel) - if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcU,bc='n') - if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcV,bc='n') - if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcW,bc='n') - call this%cfg%set_scalar(Sp=-deng ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcE,bc='n') - ! Increment - dt_done=dt_done+mydt - end do - ! Correct the position to take into account periodicity - if (this%cfg%xper) this%p(i)%pos(1)=this%cfg%x(this%cfg%imin)+modulo(this%p(i)%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) - if (this%cfg%yper) this%p(i)%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(this%p(i)%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) - if (this%cfg%zper) this%p(i)%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(this%p(i)%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) - ! Handle particles that have left the domain - if (this%p(i)%pos(1).lt.this%cfg%x(this%cfg%imin).or.this%p(i)%pos(1).gt.this%cfg%x(this%cfg%imax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(2).lt.this%cfg%y(this%cfg%jmin).or.this%p(i)%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(3).lt.this%cfg%z(this%cfg%kmin).or.this%p(i)%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) this%p(i)%flag=1 - ! Relocalize the particle - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - - ! Communicate particles - call this%sync() - - ! Divide source arrays by volume, sum at boundaries, and volume filter - this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) - this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) - this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) - this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) - - ! Recompute volume fraction - call this%update_VF() - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) - end if - end block logging - - end subroutine advance - - - !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) - implicit none - class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - type(part), intent(in) :: p - real(WP), dimension(3), intent(out) :: acc - real(WP), intent(out) :: opt_dt - real(WP) :: corr,Re,tau - real(WP) :: fvisc,frho,pVF,fVF,fT - real(WP), dimension(3) :: fvel - ! Interpolate the fluid phase velocity to the particle location - fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) - ! Interpolate the fluid phase viscosity to the particle location - fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') - fvisc=fvisc+epsilon(1.0_WP) - ! Interpolate the fluid phase density to the particle location - frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') - ! Interpolate the particle volume fraction to the particle location - pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') - fVF=1.0_WP-pVF - ! Interpolate the fluid temperature to the particle location if present - if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Particle Reynolds number - Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) - ! Drag correction - corr=drag_correction() - ! Particle response time - tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) - ! Return acceleration and optimal timestep size - acc=(fvel-p%vel)/tau - opt_dt=tau/real(this%nstep,WP) - - contains - - function drag_correction() result(F) - real(WP) :: F - real(WP) :: Ma,Kn,b1,b2 - - select case(trim(this%drag_model)) - case('Stokes') - F=1.0_WP - case('Schiller-Naumann','Schiller Naumann','SN') - F=1.0_WP+0.15_WP*Re**(0.687_WP) - case('Tenneti') - ! Tenneti and Subramaniam (2011) - b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 - b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) - case('Khalloufi Capecelatro','KC') - F=0.0_WP - case default - F=1.0_WP - end select - - end function drag_correction - end subroutine get_rhs - - - !> Update particle volume fraction using our current particles - subroutine update_VF(this) - use mathtools, only: Pi - implicit none - class(lpt), intent(inout) :: this + end block logging + + end function constructor + + + !> Resolve collisional interaction between particles + !> Requires Tcol, e_n, and e_w to be set beforehand + subroutine collide(this,dt) + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + + ! Start by zeroing out the collision force + zero_force: block integer :: i - real(WP) :: Vp - ! Reset volume fraction - this%VF=0.0_WP - ! Transfer particle volume do i=1,this%np_ - ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle - ! Transfer particle volume - Vp=Pi/6.0_WP*this%p(i)%d**3 - call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') + this%p(i)%col=0.0_WP end do - this%VF=this%VF/this%cfg%vol - ! Sum at boundaries - call this%cfg%syncsum(this%VF) - ! Apply volume filter - call this%filter(this%VF) - end subroutine update_VF + end block zero_force + ! Return if not used + if (.not.this%use_col) return - !> Laplacian filtering operation - subroutine filter(this,A) - implicit none - class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: filter_coeff - integer :: i,j,k,n,nstep - real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ - - ! Return without filtering if filter width is zero - if (this%filter_width.le.0.0_WP) return - - ! Recompute filter coeff and number of explicit steps needed - filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 - - if (this%implicit_filter) then !< Apply filter implicitly via approximate factorization - ! Inverse in X-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) - this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & - + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) - this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) - this%tridiag%Rx(j,k,i) = A(i,j,k) - end do - end do - end do - call this%tridiag%linsol_x() - ! Inverse in Y-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) - this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & - + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) - this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) - this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) - end do - end do - end do - call this%tridiag%linsol_y() - ! Inverse in Z-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) - this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & - + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) - this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) - this%tridiag% Rz(i,j,k) = this%tridiag%Ry(i,k,j) - end do - end do - end do - call this%tridiag%linsol_z() - ! Update A - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=this%tridiag%Rz(i,j,k) - end do - end do - end do - ! Sync A - call this%cfg%sync(A) - else !< Apply filter explicitly - ! Allocate flux arrays - allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) - filter_coeff=filter_coeff/real(nstep,WP) - do n=1,nstep - ! Diffusive flux of A - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) - FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) - FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) - end do - end do - end do - ! Divergence of fluxes - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) - end do - end do - end do - ! Sync A - call this%cfg%sync(A) - end do - ! Deallocate flux arrays - deallocate(FX,FY,FZ) - end if - - end subroutine filter - - - !> Extract various monitoring data from particle field - subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(lpt), intent(inout) :: this - real(WP) :: buf,safe_np - integer :: i,j,k,ierr - - ! Create safe np - safe_np=real(max(this%np,1),WP) - - ! Diameter and velocity min/max/mean - this%dmin=huge(1.0_WP); this%dmax=-huge(1.0_WP); this%dmean=0.0_WP - this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP - this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP - this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP - do i=1,this%np_ - this%dmin=min(this%dmin,this%p(i)%d ); this%dmax=max(this%dmax,this%p(i)%d ); this%dmean=this%dmean+this%p(i)%d - this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) - this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) - this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) - end do - call MPI_ALLREDUCE(this%dmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%dmin =buf - call MPI_ALLREDUCE(this%dmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%dmax =buf - call MPI_ALLREDUCE(this%dmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dmean=buf/safe_np - call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf - call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf - call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np - call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf - call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf - call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np - call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf - call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf - call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - - ! Diameter and velocity variance - this%dvar=0.0_WP - this%Uvar=0.0_WP - this%Vvar=0.0_WP - this%Wvar=0.0_WP + ! Then share particles across overlap + call this%share() + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell do i=1,this%np_ - this%dvar=this%dvar+(this%p(i)%d -this%dmean)**2.0_WP - this%Uvar=this%Uvar+(this%p(i)%vel(1)-this%Umean)**2.0_WP - this%Vvar=this%Vvar+(this%p(i)%vel(2)-this%Vmean)**2.0_WP - this%Wvar=this%Wvar+(this%p(i)%vel(3)-this%Wmean)**2.0_WP + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 end do - call MPI_ALLREDUCE(this%dvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dvar=buf/safe_np - call MPI_ALLREDUCE(this%Uvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Uvar=buf/safe_np - call MPI_ALLREDUCE(this%Vvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vvar=buf/safe_np - call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np - - ! Get mean, max, and min volume fraction - this%VFmean=0.0_WP - this%VFmax =-huge(1.0_WP) - this%VFmin =+huge(1.0_WP) - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) - this%VFmax =max(this%VFmax,this%VF(i,j,k)) - this%VFmin =min(this%VFmin,this%VF(i,j,k)) - end do - end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf - call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf - - ! Get volume fraction variance - this%VFvar=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFvar=this%VFvar+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*(this%VF(i,j,k)-this%VFmean)**2.0_WP - end do - end do - end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total - - end subroutine get_max - - - !> Update particle mesh using our current particles - subroutine update_partmesh(this,pmesh) - use partmesh_class, only: partmesh - implicit none - class(lpt), intent(inout) :: this - class(partmesh), intent(inout) :: pmesh - integer :: i - ! Reset particle mesh storage - call pmesh%reset() - ! Nothing else to do if no particle is present - if (this%np_.eq.0) return - ! Copy particle info - call pmesh%set_size(this%np_) + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 do i=1,this%np_ - pmesh%pos(:,i)=this%p(i)%pos - end do - end subroutine update_partmesh - - - !> Creation of the MPI datatype for particle - subroutine prepare_mpi_part() - use mpi_f08 - use messager, only: die - implicit none - integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp - integer(MPI_ADDRESS_KIND) :: lb,extent - type(MPI_Datatype) :: MPI_PART_TMP - integer :: i,mysize,ierr - ! Prepare the displacement array - disp(1)=0 - do i=2,part_nblock - call MPI_Type_size(part_tblock(i-1),mysize,ierr) - disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) - end do - ! Create and commit the new type - call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) - call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) - call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) - call MPI_Type_commit(MPI_PART,ierr) - ! If a problem was encountered, say it - if (ierr.ne.0) call die('[lpt prepare_mpi_part] MPI Particle type creation failed') - ! Get the size of this type - call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) - end subroutine prepare_mpi_part - - - !> Synchronize particle arrays across processors - subroutine sync(this) - use mpi_f08 - implicit none - class(lpt), intent(inout) :: this - integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc - integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp - integer :: n,prank,ierr - type(part), dimension(:), allocatable :: buf_send - ! Recycle first to minimize communication load - call this%recycle() - ! Prepare information about what to send - nsend_proc=0 - do n=1,this%np_ - prank=this%cfg%get_rank(this%p(n)%ind) - nsend_proc(prank)=nsend_proc(prank)+1 + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i end do - nsend_proc(this%cfg%rank)=0 - ! Inform processors of what they will receive - call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - ! Prepare displacements for all-to-all - nsend_disp(0)=0 - nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array - do n=1,this%cfg%nproc-1 - nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) - nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i end do - ! Allocate buffer to send particles - allocate(buf_send(sum(nsend_proc))) - ! Pack the particles in the send buffer - nsend_proc=0 - do n=1,this%np_ - ! Get the rank - prank=this%cfg%get_rank(this%p(n)%ind) - ! Skip particles still inside - if (prank.eq.this%cfg%rank) cycle - ! Pack up for sending - nsend_proc(prank)=nsend_proc(prank)+1 - buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) - ! Flag particle for removal - this%p(n)%flag=1 - end do - ! Allocate buffer for receiving particles - call this%resize(this%np_+sum(nrecv_proc)) - ! Perform communication - call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) - ! Deallocate buffer - deallocate(buf_send) - ! Recycle to remove duplicate particles - call this%recycle() - end subroutine sync - - - !> Share particles across processor boundaries - subroutine share(this,nover) + + end block pic_prep + + ! Finally, calculate collision force + collision_force: block use mpi_f08 - use messager, only: warn,die - implicit none - class(lpt), intent(inout) :: this - integer, optional :: nover - type(part), dimension(:), allocatable :: tosend - type(part), dimension(:), allocatable :: torecv - integer :: no,nsend,nrecv - type(MPI_Status) :: status - integer :: icnt,isrc,idst,ierr - integer :: i,n - - ! Check overlap size - if (present(nover)) then - no=nover - if (no.gt.this%cfg%no) then - call warn('[lpt_class share] Specified overlap is larger than that of cfg - reducing no') - no=this%cfg%no - else if (no.le.0) then - call die('[lpt_class share] Specified overlap cannot be less or equal to zero') - end if - else - no=1 - end if - - ! Clean up ghost array - call this%resize_ghost(n=0); this%ng_=0 - - ! Share ghost particles to the left in x - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).lt.this%cfg%imin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).lt.this%cfg%imin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%xper.and.tosend(nsend)%ind(1).lt.this%cfg%imin+no) then - tosend(nsend)%pos(1)=tosend(nsend)%pos(1)+this%cfg%xL - tosend(nsend)%ind(1)=tosend(nsend)%ind(1)+this%cfg%nx - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,0,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in x - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).gt.this%cfg%imax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).gt.this%cfg%imax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%xper.and.tosend(nsend)%ind(1).gt.this%cfg%imax-no) then - tosend(nsend)%pos(1)=tosend(nsend)%pos(1)-this%cfg%xL - tosend(nsend)%ind(1)=tosend(nsend)%ind(1)-this%cfg%nx - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,0,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the left in y - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%yper.and.tosend(nsend)%ind(2).lt.this%cfg%jmin+no) then - tosend(nsend)%pos(2)=tosend(nsend)%pos(2)+this%cfg%yL - tosend(nsend)%ind(2)=tosend(nsend)%ind(2)+this%cfg%ny - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,1,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in y - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%yper.and.tosend(nsend)%ind(2).gt.this%cfg%jmax-no) then - tosend(nsend)%pos(2)=tosend(nsend)%pos(2)-this%cfg%yL - tosend(nsend)%ind(2)=tosend(nsend)%ind(2)-this%cfg%ny - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,1,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the left in z - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%zper.and.tosend(nsend)%ind(3).lt.this%cfg%kmin+no) then - tosend(nsend)%pos(3)=tosend(nsend)%pos(3)+this%cfg%zL - tosend(nsend)%ind(3)=tosend(nsend)%ind(3)+this%cfg%nz - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,2,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in z - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%zper.and.tosend(nsend)%ind(3).gt.this%cfg%kmax-no) then - tosend(nsend)%pos(3)=tosend(nsend)%pos(3)-this%cfg%zL - tosend(nsend)%ind(3)=tosend(nsend)%ind(3)-this%cfg%nz - end if + use mathtools, only: Pi,normalize + integer :: i1,i2,ii,jj,kk,nn,ierr + real(WP) :: d1,m1,d2,m2,d12,m12 + real(WP), dimension(3) :: r1,v1,r2,v2,v12,n12,f_n + real(WP) :: k_n,eta_n,lne,pilne2,lne_w,pilne2_w,rnv,r_influ,delta_n + + ! Reset collision counter + this%ncol=0 + + ! Precompute ln(e_n) and Pi^2+ln(e_n)^2 + lne=log(this%e_n); pilne2=Pi**2+lne**2 + lne_w=log(this%e_w); pilne2_w=Pi**2+lne**2 + + ! Loop over all local particles + do i1=1,this%np_ + + ! Store particle data + r1=this%p(i1)%pos + v1=this%p(i1)%vel + d1=this%p(i1)%d + m1=this%rho*Pi/6.0_WP*d1**3 + + ! First collide with walls + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') + n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) + n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1/(this%Tcol**2*pilne2_w) + eta_n=-2.0_WP*lne_w*sqrt(m1*k_n)/pilne2_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Calculate collision force + this%p(i1)%col=this%p(i1)%col+f_n/m1 end if + + ! Loop over nearest cells + do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 + do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 + do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + v2=this%p(i2)%vel + d2=this%p(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + v2=this%g(i2)%vel + d2=this%g(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + end if + + ! Compute relative information + d12=norm2(r1-r2) + if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision + n12=(r2-r1)/d12 + v12=v1-v2 + rnv=dot_product(v12,n12) + r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) + delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + m12=m1*m2/(m1+m2) + k_n=m12/(this%Tcol**2*pilne2) + eta_n=-2.0_WP*lne*sqrt(m12*k_n)/pilne2 + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Calculate collision force + this%p(i1)%col=this%p(i1)%col+f_n/m1 + this%ncol=this%ncol+1 + end if + + end do + + end do + end do + end do + + ! Deal with dimensionality + if (this%cfg%nx.eq.1) this%p(i1)%col(1)=0.0_WP + if (this%cfg%ny.eq.1) this%p(i1)%col(2)=0.0_WP + if (this%cfg%nz.eq.1) this%p(i1)%col(3)=0.0_WP + end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,2,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - end subroutine share - - - !> Adaptation of particle array size - subroutine resize(this,n) - implicit none - class(lpt), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize particle array to size n - if (.not.allocated(this%p)) then - ! Allocate directly to size n - allocate(this%p(n)) - this%p(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%p,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%p - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%p) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%p(1:n) - call move_alloc(tmp,this%p) - end if + + ! Determine total number of collisions + call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 + + end block collision_force + + end subroutine collide + + + !> Advance the particle equations by a specified time step dt + subroutine advance(this,dt,U,V,W,rho,visc) + use mathtools, only: Pi + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i + real(WP) :: mydt,dt_done,deng + real(WP), dimension(3) :: acc,dmom + type(part) :: pold + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + this%srcE=0.0_WP + + ! Advance the equations + do i=1,this%np_ + ! Time-integrate until dt_done=dt + dt_done=0.0_WP + do while (dt_done.lt.dt) + ! Decide the timestep size + mydt=min(this%p(i)%dt,dt-dt_done) + ! Remember the particle + pold=this%p(i) + ! Advance with Euler prediction + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) + this%p(i)%pos=pold%pos+0.5_WP*mydt*this%p(i)%vel + this%p(i)%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+this%p(i)%col) + ! Correct with midpoint rule + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) + this%p(i)%pos=pold%pos+mydt*this%p(i)%vel + this%p(i)%vel=pold%vel+mydt*(acc+this%gravity+this%p(i)%col) + ! Relocalize + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + ! Send source term back to the mesh + dmom=mydt*acc*this%rho*Pi/6.0_WP*this%p(i)%d**3 + deng=sum(dmom*this%p(i)%vel) + if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcU,bc='n') + if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcV,bc='n') + if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcW,bc='n') + call this%cfg%set_scalar(Sp=-deng ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcE,bc='n') + ! Increment + dt_done=dt_done+mydt + end do + ! Correct the position to take into account periodicity + if (this%cfg%xper) this%p(i)%pos(1)=this%cfg%x(this%cfg%imin)+modulo(this%p(i)%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) + if (this%cfg%yper) this%p(i)%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(this%p(i)%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) + if (this%cfg%zper) this%p(i)%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(this%p(i)%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) + ! Handle particles that have left the domain + if (this%p(i)%pos(1).lt.this%cfg%x(this%cfg%imin).or.this%p(i)%pos(1).gt.this%cfg%x(this%cfg%imax+1)) this%p(i)%flag=1 + if (this%p(i)%pos(2).lt.this%cfg%y(this%cfg%jmin).or.this%p(i)%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) this%p(i)%flag=1 + if (this%p(i)%pos(3).lt.this%cfg%z(this%cfg%kmin).or.this%p(i)%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) this%p(i)%flag=1 + ! Relocalize the particle + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + + ! Communicate particles + call this%sync() + + ! Divide source arrays by volume, sum at boundaries, and volume filter + this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) + this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) + this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) + this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) end if - end subroutine resize + end block logging + + end subroutine advance + + + !> Calculate RHS of the particle ODEs + subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) + implicit none + class(lpt), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + type(part), intent(in) :: p + real(WP), dimension(3), intent(out) :: acc + real(WP), intent(out) :: opt_dt + real(WP) :: corr,Re,tau + real(WP) :: fvisc,frho,pVF,fVF,fT + real(WP), dimension(3) :: fvel + ! Interpolate the fluid phase velocity to the particle location + fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + ! Interpolate the fluid phase viscosity to the particle location + fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') + fvisc=fvisc+epsilon(1.0_WP) + ! Interpolate the fluid phase density to the particle location + frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') + ! Interpolate the particle volume fraction to the particle location + pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') + fVF=1.0_WP-pVF + ! Interpolate the fluid temperature to the particle location if present + if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') + ! Particle Reynolds number + Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) + ! Drag correction + corr=drag_correction() + ! Particle response time + tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) + ! Return acceleration and optimal timestep size + acc=(fvel-p%vel)/tau + opt_dt=tau/real(this%nstep,WP) + + contains + + function drag_correction() result(F) + real(WP) :: F + real(WP) :: Ma,Kn,b1,b2 + + select case(trim(this%drag_model)) + case('None','none') + F=epsilon(1.0_WP) + case('Stokes') + F=1.0_WP + case('Schiller-Naumann','Schiller Naumann','SN') + F=1.0_WP+0.15_WP*Re**(0.687_WP) + case('Tenneti') + ! Tenneti and Subramaniam (2011) + b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 + b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) + F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) + case('Khalloufi Capecelatro','KC') + F=0.0_WP + case default + F=1.0_WP + end select + + end function drag_correction + end subroutine get_rhs + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(lpt), intent(inout) :: this + integer :: i + real(WP) :: Vp + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Transfer particle volume + Vp=Pi/6.0_WP*this%p(i)%d**3 + call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') + end do + this%VF=this%VF/this%cfg%vol + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + ! Apply volume filter + call this%filter(this%VF) + end subroutine update_VF + + + !> Laplacian filtering operation + subroutine filter(this,A) + implicit none + class(lpt), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP) :: filter_coeff + integer :: i,j,k,n,nstep + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Return without filtering if filter width is zero + if (this%filter_width.le.0.0_WP) return + + ! Recompute filter coeff and number of explicit steps needed + filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 + + if (this%implicit_filter) then !< Apply filter implicitly via approximate factorization + ! Inverse in X-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) + this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) + this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) + this%tridiag%Rx(j,k,i) = A(i,j,k) + end do + end do + end do + call this%tridiag%linsol_x() + ! Inverse in Y-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) + this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & + + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) + this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) + this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) + end do + end do + end do + call this%tridiag%linsol_y() + ! Inverse in Z-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) + this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) + this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) + this%tridiag% Rz(i,j,k) = this%tridiag%Ry(i,k,j) + end do + end do + end do + call this%tridiag%linsol_z() + ! Update A + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + A(i,j,k)=this%tridiag%Rz(i,j,k) + end do + end do + end do + ! Sync A + call this%cfg%sync(A) + else !< Apply filter explicitly + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) + filter_coeff=filter_coeff/real(nstep,WP) + do n=1,nstep + ! Diffusive flux of A + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) + FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) + FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) + end do + end do + end do + ! Divergence of fluxes + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync A + call this%cfg%sync(A) + end do + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + end if + + end subroutine filter + + + !> Inject particles from a prescribed location with given mass flowrate + !> Requires injection parameters to be set beforehand + subroutine inject(this,dt) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection + real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters + real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep + integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id + integer :: i,j,np0_,np2,np_tmp,count,ierr + integer, dimension(:), allocatable :: nrecv + type(part), dimension(:), allocatable :: p2 + type(MPI_Status) :: status + logical :: overlap + + ! Initial number of particles + np0_=this%np_ + + ! Get the particle mass that should be added to the system + Mgoal = this%mfr*dt+previous_error + Madded = 0.0_WP + + ! Determine id to assign to particle + maxid_=0 + do i=1,this%np_ + maxid_=max(maxid_,this%p(i)%id) + end do + call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) + + ! Communicate nearby particles to check for overlap + if (this%use_col) then + allocate(nrecv(this%cfg%nproc)) + count=0 + inj_min(1)=this%cfg%x(this%cfg%imino) + inj_max(1)=this%cfg%x(this%cfg%imin+1)+this%inj_dmax + inj_min(2)=this%inj_pos(2)-0.5_WP*this%inj_d-this%inj_dmax + inj_max(2)=this%inj_pos(2)+0.5_WP*this%inj_d+this%inj_dmax + inj_min(3)=this%inj_pos(3)-0.5_WP*this%inj_d-this%inj_dmax + inj_max(3)=this%inj_pos(3)+0.5_WP*this%inj_d+this%inj_dmax + do i=1,this%np_ + if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& + this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& + this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) count=count+1 + end do + call MPI_GATHER(count,1,MPI_INTEGER,nrecv,1,MPI_INTEGER,0,this%cfg%comm,ierr) + if (this%cfg%amRoot) then + np2=sum(nrecv) + allocate(p2(np2)) + else + allocate(p2(count)) + end if + count=0 + do i=1,this%np_ + if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& + this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& + this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) then + count=count+1 + p2(count)=this%p(i) + end if + end do + if (this%cfg%amRoot) then + do i=2,this%cfg%nproc + if (nrecv(i).gt.0) then + call MPI_recv(p2(sum(nrecv(1:i-1))+1:sum(nrecv(1:i))),nrecv(i),MPI_PART,i-1,0,this%cfg%comm,status,ierr) + end if + end do + else + if (count.gt.0) call MPI_send(p2,count,MPI_PART,0,0,this%cfg%comm,ierr) + end if + deallocate(nrecv) + end if + + ! Add new particles until desired mass is achieved + do while (Madded.lt.Mgoal) + + if (this%cfg%amRoot) then + ! Initialize parameters + Mtmp = 0.0_WP + np_tmp = 0 + ! Loop while the added volume is not sufficient + do while (Mtmp.lt.Mgoal-Madded) + ! Increment counter + np_tmp=np_tmp+1 + count = np0_+np_tmp + ! Create space for new particle + call this%resize(count) + ! Generate a diameter + this%p(count)%d=get_diameter() + ! Set various parameters for the particle + this%p(count)%id =maxid+int(np_tmp,8) + this%p(count)%dt =0.0_WP + this%p(count)%col=0.0_WP + this%p(count)%T = this%inj_T + ! Give a position at the injector to the particle + this%p(count)%pos=get_position(0.6_WP*this%p(count)%d) + overlap=.false. + ! Check overlap with particles recently injected + if (this%use_col) then + do j=1,np_tmp-1 + if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. + end do + ! Check overlap with all other particles + if (.not.overlap) then + do j=1,np2 + if (norm2(this%p(count)%pos-p2(j)%pos).lt.0.5_WP*(this%p(count)%d+p2(j)%d)) overlap=.true. + end do + end if + end if + + if (overlap) then + ! Try again + np_tmp=np_tmp-1 + else + ! Localize the particle + this%p(count)%ind(1)=1; this%p(count)%ind(2)=1; this%p(count)%ind(3)=1 + this%p(count)%ind=this%cfg%get_ijk_global(this%p(count)%pos,this%p(count)%ind) + ! Give it a velocity + this%p(count)%vel=this%inj_vel + ! Make it an "official" particle + this%p(count)%flag=0 + ! Update the added mass for the timestep + Mtmp = Mtmp + this%rho*Pi/6.0_WP*this%p(count)%d**3 + end if + end do + end if + ! Communicate particles + call this%sync() + ! Loop through newly created particles + buf=0.0_WP + do i=np0_+1,this%np_ + ! Remove if out of bounds + if (this%cfg%VF(this%p(i)%ind(1),this%p(i)%ind(2),this%p(i)%ind(3)).le.0.0_WP) this%p(i)%flag=1 + if (this%p(i)%flag.eq.0) then + ! Update the added mass for the timestep + buf = buf + this%rho*Pi/6.0_WP*this%p(i)%d**3 + ! Update the max particle id + maxid = max(maxid,this%p(i)%id) + end if + end do + ! Total mass added + call MPI_ALLREDUCE(buf,Mtmp,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); Madded=Madded+Mtmp + ! Clean up particles + call this%recycle() + ! Update initial npart + np0_=this%np_ + ! Maximum particle id + call MPI_ALLREDUCE(maxid,maxid_,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr); maxid=maxid_ + end do + + ! Remember the error + previous_error = Mgoal-Madded + if (allocated(p2)) deallocate(p2) - !> Adaptation of ghost array size - subroutine resize_ghost(this,n) + contains + + ! Compute particle diameter + function get_diameter() result(dp) + use random, only: random_lognormal implicit none - class(lpt), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize ghost array to size n - if (.not.allocated(this%g)) then - ! Allocate directly to size n - allocate(this%g(n)) - this%g(1:n)%flag=1 + real(WP) :: dp + dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift + do while (dp.gt.this%inj_dmax+epsilon(1.0_WP).or.dp.lt.this%inj_dmin-epsilon(1.0_WP)) + dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift + end do + end function get_diameter + + ! Position for bulk injection of particles + function get_position(mind) result(pos) + use random, only: random_uniform + use mathtools, only: twoPi + implicit none + real(WP), intent(in) :: mind + real(WP), dimension(3) :: pos + real(WP) :: rand,r,theta + integer :: ip,jp,kp + ! Set x position + pos(1) = this%cfg%x(this%cfg%imin)+mind + ! Random y & z position within a circular region + if (this%cfg%nz.eq.1) then + pos(2)=random_uniform(lo=this%inj_pos(2)-0.5_WP*this%inj_d,hi=this%inj_pos(3)+0.5_WP*this%inj_d) + pos(3) = this%cfg%zm(this%cfg%kmin_) else - ! Update from a non-zero size to another non-zero size - size_now=size(this%g,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%g - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%g) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%g(1:n) - call move_alloc(tmp,this%g) - end if + rand=random_uniform(lo=0.0_WP,hi=1.0_WP) + r=0.5_WP*this%inj_d*sqrt(rand) !< sqrt(rand) avoids accumulation near the center + call random_number(rand) + theta=random_uniform(lo=0.0_WP,hi=twoPi) + pos(2) = this%inj_pos(2)+r*sin(theta) + pos(3) = this%inj_pos(3)+r*cos(theta) end if - end subroutine resize_ghost - - - !> Clean-up of particle array by removing flag=1 particles - subroutine recycle(this) - implicit none - class(lpt), intent(inout) :: this - integer :: new_size,i,ierr - ! Compact all active particles at the beginning of the array - new_size=0 - if (allocated(this%p)) then - do i=1,size(this%p,dim=1) - if (this%p(i)%flag.ne.1) then - new_size=new_size+1 - if (i.ne.new_size) then - this%p(new_size)=this%p(i) - this%p(i)%flag=1 - end if - end if - end do + end function get_position + + end subroutine inject + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(lpt), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%dmin=huge(1.0_WP); this%dmax=-huge(1.0_WP); this%dmean=0.0_WP + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%dmin=min(this%dmin,this%p(i)%d ); this%dmax=max(this%dmax,this%p(i)%d ); this%dmean=this%dmean+this%p(i)%d + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%dmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%dmin =buf + call MPI_ALLREDUCE(this%dmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%dmax =buf + call MPI_ALLREDUCE(this%dmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dmean=buf/safe_np + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Diameter and velocity variance + this%dvar=0.0_WP + this%Uvar=0.0_WP + this%Vvar=0.0_WP + this%Wvar=0.0_WP + do i=1,this%np_ + this%dvar=this%dvar+(this%p(i)%d -this%dmean)**2.0_WP + this%Uvar=this%Uvar+(this%p(i)%vel(1)-this%Umean)**2.0_WP + this%Vvar=this%Vvar+(this%p(i)%vel(2)-this%Vmean)**2.0_WP + this%Wvar=this%Wvar+(this%p(i)%vel(3)-this%Wmean)**2.0_WP + end do + call MPI_ALLREDUCE(this%dvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dvar=buf/safe_np + call MPI_ALLREDUCE(this%Uvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Uvar=buf/safe_np + call MPI_ALLREDUCE(this%Vvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vvar=buf/safe_np + call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np + + ! Get mean, max, and min volume fraction + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + + ! Get volume fraction variance + this%VFvar=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFvar=this%VFvar+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*(this%VF(i,j,k)-this%VFmean)**2.0_WP + end do + end do + end do + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(lpt), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[lpt prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(lpt), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Share particles across processor boundaries + subroutine share(this,nover) + use mpi_f08 + use messager, only: warn,die + implicit none + class(lpt), intent(inout) :: this + integer, optional :: nover + type(part), dimension(:), allocatable :: tosend + type(part), dimension(:), allocatable :: torecv + integer :: no,nsend,nrecv + type(MPI_Status) :: status + integer :: icnt,isrc,idst,ierr + integer :: i,n + + ! Check overlap size + if (present(nover)) then + no=nover + if (no.gt.this%cfg%no) then + call warn('[lpt_class share] Specified overlap is larger than that of cfg - reducing no') + no=this%cfg%no + else if (no.le.0) then + call die('[lpt_class share] Specified overlap cannot be less or equal to zero') + end if + else + no=1 + end if + + ! Clean up ghost array + call this%resize_ghost(n=0); this%ng_=0 + + ! Share ghost particles to the left in x + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).lt.this%cfg%imin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).lt.this%cfg%imin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%xper.and.tosend(nsend)%ind(1).lt.this%cfg%imin+no) then + tosend(nsend)%pos(1)=tosend(nsend)%pos(1)+this%cfg%xL + tosend(nsend)%ind(1)=tosend(nsend)%ind(1)+this%cfg%nx + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,0,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in x + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).gt.this%cfg%imax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).gt.this%cfg%imax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%xper.and.tosend(nsend)%ind(1).gt.this%cfg%imax-no) then + tosend(nsend)%pos(1)=tosend(nsend)%pos(1)-this%cfg%xL + tosend(nsend)%ind(1)=tosend(nsend)%ind(1)-this%cfg%nx + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,0,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the left in y + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%yper.and.tosend(nsend)%ind(2).lt.this%cfg%jmin+no) then + tosend(nsend)%pos(2)=tosend(nsend)%pos(2)+this%cfg%yL + tosend(nsend)%ind(2)=tosend(nsend)%ind(2)+this%cfg%ny + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,1,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in y + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%yper.and.tosend(nsend)%ind(2).gt.this%cfg%jmax-no) then + tosend(nsend)%pos(2)=tosend(nsend)%pos(2)-this%cfg%yL + tosend(nsend)%ind(2)=tosend(nsend)%ind(2)-this%cfg%ny + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,1,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the left in z + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%zper.and.tosend(nsend)%ind(3).lt.this%cfg%kmin+no) then + tosend(nsend)%pos(3)=tosend(nsend)%pos(3)+this%cfg%zL + tosend(nsend)%ind(3)=tosend(nsend)%ind(3)+this%cfg%nz + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,2,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in z + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%zper.and.tosend(nsend)%ind(3).gt.this%cfg%kmax-no) then + tosend(nsend)%pos(3)=tosend(nsend)%pos(3)-this%cfg%zL + tosend(nsend)%ind(3)=tosend(nsend)%ind(3)-this%cfg%nz + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,2,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + end subroutine share + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(lpt), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if + end if + end subroutine resize + + + !> Adaptation of ghost array size + subroutine resize_ghost(this,n) + implicit none + class(lpt), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize ghost array to size n + if (.not.allocated(this%g)) then + ! Allocate directly to size n + allocate(this%g(n)) + this%g(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%g,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%g + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%g) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%g(1:n) + call move_alloc(tmp,this%g) + end if + end if + end subroutine resize_ghost + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(lpt), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do + end if + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(lpt), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header + if (this%cfg%amRoot) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[lpt write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) + end if + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[lpt write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) end if - ! Resize to new size - call this%resize(new_size) - ! Update number of particles - this%np_=new_size - call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - this%np=sum(this%np_proc) - end subroutine recycle - - - !> Parallel write particles to file - subroutine write(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(lpt), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset - integer :: i,ierr,iunit - - ! Root serial-writes the file header + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(lpt), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[lpt read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[lpt read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message if (this%cfg%amRoot) then - ! Open the file - open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[lpt write] Problem encountered while serial-opening data file: '//trim(filename)) - ! Number of particles and particle object size - write(iunit) this%np,MPI_PART_SIZE - ! Done with the header - close(iunit) + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) end if - - ! The rest is done in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[lpt write] Problem encountered while parallel-opening data file: '//trim(filename)) - - ! Get current position - call MPI_FILE_GET_POSITION(ifile,offset,ierr) - - ! Compute the offset and write - do i=1,this%cfg%rank - offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) - end do - if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) - end if - end block logging - - end subroutine write - - - !> Parallel read particles to file - subroutine read(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(lpt), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset,header_offset - integer :: i,j,ierr,npadd,psize,nchunk,cnt - integer, dimension(:,:), allocatable :: ppp - - ! First open the file in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[lpt read] Problem encountered while reading data file: '//trim(filename)) - - ! Read file header first - call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) - call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) - - ! Remember current position - call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) - - ! Check compatibility of particle type - if (psize.ne.MPI_PART_SIZE) call die('[lpt read] Particle type unreadable') - - ! Naively share reading task among all processors - nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 - allocate(ppp(this%cfg%nproc,nchunk)) - ppp=int(npadd/(this%cfg%nproc*nchunk)) - cnt=0 - out:do j=1,nchunk - do i=1,this%cfg%nproc - cnt=cnt+1 - if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out - ppp(i,j)=ppp(i,j)+1 - end do - end do out - - ! Read by chunk - do j=1,nchunk - ! Find offset - offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) - ! Resize particle array - call this%resize(this%np_+ppp(this%cfg%rank+1,j)) - ! Read this file - call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) - ! Most general case: relocate every droplet - do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - ! Exchange all that - call this%sync() - end do - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) - end if - end block logging - - end subroutine read - - + end block logging + + end subroutine read + + end module lpt_class From dc0922e7cd0dfbcff0a09822067dceb45f4ace5d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 17 Dec 2022 00:17:30 -0500 Subject: [PATCH 024/152] LPT updates Keep track of number of particles added and removed each timestep --- examples/part_inject/src/geometry.f90 | 4 ++-- examples/part_inject/src/simulation.f90 | 2 ++ src/particles/lpt_class.f90 | 20 ++++++++++++++++++-- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/examples/part_inject/src/geometry.f90 b/examples/part_inject/src/geometry.f90 index ec14741b8..9de351e64 100644 --- a/examples/part_inject/src/geometry.f90 +++ b/examples/part_inject/src/geometry.f90 @@ -45,7 +45,7 @@ subroutine geometry_init end do ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='Particles') + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='Particles') end block create_grid @@ -71,7 +71,7 @@ subroutine geometry_init do k=cfg%kmino_,cfg%kmaxo_ do j=cfg%jmino_,cfg%jmaxo_ do i=cfg%imino_,cfg%imaxo_ - if (cfg%xm(i).gt.cfg%xL) cfg%VF(i,j,k)=0.0_WP + if (i.ge.cfg%imax) cfg%VF(i,j,k)=0.0_WP end do end do end do diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index 4f9b87867..111b6fed9 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -146,6 +146,8 @@ subroutine simulation_init call mfile%add_column(time%t,'Time') call mfile%add_column(time%dt,'Timestep size') call mfile%add_column(lp%np,'Particle number') + call mfile%add_column(lp%np_new,'Npart new') + call mfile%add_column(lp%np_out,'Npart removed') call mfile%add_column(lp%ncol,'Particle collisions') call mfile%add_column(lp%VFmean,'Mean VF') call mfile%add_column(lp%Umin,'Particle Umin') diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 38a29657d..d316941c9 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -169,6 +169,7 @@ function constructor(cfg,name) result(self) allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 self%np_=0; self%np=0 call self%resize(0) + self%np_new=0; self%np_out=0 ! Initialize MPI derived datatype for a particle call prepare_mpi_part() @@ -444,7 +445,7 @@ subroutine collide(this,dt) rnv=dot_product(v1,n12) r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - + ! Assess if there is collision if (delta_n.gt.0.0_WP) then ! Normal collision @@ -524,6 +525,7 @@ end subroutine collide !> Advance the particle equations by a specified time step dt subroutine advance(this,dt,U,V,W,rho,visc) + use mpi_f08, only : MPI_SUM,MPI_INTEGER use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this @@ -533,7 +535,7 @@ subroutine advance(this,dt,U,V,W,rho,visc) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i + integer :: i,ierr real(WP) :: mydt,dt_done,deng real(WP), dimension(3) :: acc,dmom type(part) :: pold @@ -544,6 +546,9 @@ subroutine advance(this,dt,U,V,W,rho,visc) this%srcW=0.0_WP this%srcE=0.0_WP + ! Zero out number of particles removed + this%np_out=0 + ! Advance the equations do i=1,this%np_ ! Time-integrate until dt_done=dt @@ -583,11 +588,16 @@ subroutine advance(this,dt,U,V,W,rho,visc) if (this%p(i)%pos(3).lt.this%cfg%z(this%cfg%kmin).or.this%p(i)%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) this%p(i)%flag=1 ! Relocalize the particle this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + ! Count number of particles removed + if (this%p(i)%flag.eq.1) this%np_out=this%np_out+1 end do ! Communicate particles call this%sync() + ! Sum up particles removed + call MPI_ALLREDUCE(this%np_out,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_out=i + ! Divide source arrays by volume, sum at boundaries, and volume filter this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) @@ -827,6 +837,7 @@ subroutine inject(this,dt) ! Initial number of particles np0_=this%np_ + this%np_new=0 ! Get the particle mass that should be added to the system Mgoal = this%mfr*dt+previous_error @@ -947,6 +958,8 @@ subroutine inject(this,dt) buf = buf + this%rho*Pi/6.0_WP*this%p(i)%d**3 ! Update the max particle id maxid = max(maxid,this%p(i)%id) + ! Increment counter + this%np_new=this%np_new+1 end if end do ! Total mass added @@ -962,6 +975,9 @@ subroutine inject(this,dt) ! Remember the error previous_error = Mgoal-Madded + ! Sum up injected particles + call MPI_ALLREDUCE(this%np_new,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_new=i + if (allocated(p2)) deallocate(p2) contains From 6260927f031ab503130f262851ed54c5f20d2c2d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 17 Dec 2022 00:25:51 -0500 Subject: [PATCH 025/152] Update simulation.f90 Particles leave the domain if they are too soft. Lowering Tcol helps --- examples/part_inject/src/simulation.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index 111b6fed9..ed2a8d6bb 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -65,7 +65,7 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - lp%Tcol=15.0_WP*time%dt + lp%Tcol=5.0_WP*time%dt ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) call param_read('Wall restitution',lp%e_w) From bb645e19e617efe8a8d254118a85f88a770c8e44 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 17 Dec 2022 00:58:08 -0500 Subject: [PATCH 026/152] Update lpt_class.f90 I think there was a bug in how Olivier implemented the spring stiffness. Updated version is consistent with old NGA and (I think) is the correct version --- src/particles/lpt_class.f90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index d316941c9..5dbd9bcd2 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -427,7 +427,7 @@ subroutine collide(this,dt) ! Precompute ln(e_n) and Pi^2+ln(e_n)^2 lne=log(this%e_n); pilne2=Pi**2+lne**2 - lne_w=log(this%e_w); pilne2_w=Pi**2+lne**2 + lne_w=log(this%e_w); pilne2_w=Pi**2+lne_w**2 ! Loop over all local particles do i1=1,this%np_ @@ -449,8 +449,10 @@ subroutine collide(this,dt) ! Assess if there is collision if (delta_n.gt.0.0_WP) then ! Normal collision - k_n=m1/(this%Tcol**2*pilne2_w) - eta_n=-2.0_WP*lne_w*sqrt(m1*k_n)/pilne2_w + !k_n=m1/(this%Tcol**2*pilne2_w) + k_n=m1/this%Tcol**2*pilne2_w + !eta_n=-2.0_WP*lne_w*sqrt(m1*k_n)/pilne2_w + eta_n=-2.0_WP*lne_w*m1/this%Tcol f_n=-k_n*delta_n*n12-eta_n*rnv*n12 ! Calculate collision force this%p(i1)%col=this%p(i1)%col+f_n/m1 @@ -494,8 +496,10 @@ subroutine collide(this,dt) if (delta_n.gt.0.0_WP) then ! Normal collision m12=m1*m2/(m1+m2) - k_n=m12/(this%Tcol**2*pilne2) - eta_n=-2.0_WP*lne*sqrt(m12*k_n)/pilne2 + !k_n=m12/(this%Tcol**2*pilne2) + k_n=m12/this%Tcol**2*pilne2 + !eta_n=-2.0_WP*lne*sqrt(m12*k_n)/pilne2 + eta_n=-2.0_WP*lne*m12/this%Tcol f_n=-k_n*delta_n*n12-eta_n*rnv*n12 ! Calculate collision force this%p(i1)%col=this%p(i1)%col+f_n/m1 From 248792c1c9417badb44b2100fb621f6f46cd5ebc Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 17 Dec 2022 10:44:56 -0500 Subject: [PATCH 027/152] new LPT CFL Added CFLs to LPT, if collisions are used this prevents particles to move more than 1/10 their diameter, otherwise they cannot move more than dx --- examples/part_inject/src/simulation.f90 | 450 ++++++++++++------------ src/particles/lpt_class.f90 | 45 ++- 2 files changed, 276 insertions(+), 219 deletions(-) diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index ed2a8d6bb..c200da2d6 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -1,223 +1,237 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use lpt_class, only: lpt - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Only get a LPT solver and corresponding time tracker - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile - - public :: simulation_init,simulation_run,simulation_final - - !> Fluid phase arrays - real(WP), dimension(:,:,:), allocatable :: U,V,W - real(WP), dimension(:,:,:), allocatable :: rho,visc - + use precision, only: WP + use geometry, only: cfg + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Only get a LPT solver and corresponding time tracker + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Fluid phase arrays + real(WP), dimension(:,:,:), allocatable :: U,V,W + real(WP), dimension(:,:,:), allocatable :: rho,visc + contains - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - time%dt=time%dtmax - time%itmax=1 - end block initialize_timetracker - - - ! Initialize our LPT - initialize_lpt: block - use random, only: random_uniform - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Set gravity - call param_read('Gravity',lp%gravity) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Turn off drag - lp%drag_model='none' - ! Initialize with zero particles - call lp%resize(0) - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - ! Set coefficient of restitution - call param_read('Coefficient of restitution',lp%e_n) - call param_read('Wall restitution',lp%e_w) - call param_read('Friction coefficient',lp%mu_f) - ! Injection parameters - call param_read('Particle mass flow rate',lp%mfr) - call param_read('Particle velocity',lp%inj_vel) - call param_read('Particle mean diameter',lp%inj_dmean) - call param_read('Particle standard deviation',lp%inj_dsd,default=0.0_WP) - call param_read('Particle min diameter',lp%inj_dmin,default=tiny(1.0_WP)) - call param_read('Particle max diameter',lp%inj_dmax,default=huge(1.0_WP)) - call param_read('Particle diameter shift',lp%inj_dshift,default=0.0_WP) - if (lp%inj_dsd.le.epsilon(1.0_WP)) then - lp%inj_dmin=lp%inj_dmean - lp%inj_dmax=lp%inj_dmean - end if - call param_read('Particle inject diameter',lp%inj_d) - lp%inj_pos=0.0_WP - lp%inj_T=300.0_WP - end block initialize_lpt - - - ! Initialize quiescent fluid - initialize_fluid: block - use mathtools, only: twoPi - integer :: i,j,k - real(WP) :: rhof,viscf - ! Allocate arrays - allocate(rho (lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) - allocate(visc(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) - allocate(U(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) - allocate(V(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) - allocate(W(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) - U=0.0_WP; V=0.0_WP; W=0.0_WP - ! Set constant density and viscosity - call param_read('Density',rhof); rho=rhof - call param_read('Viscosity',viscf); visc=viscf - end block initialize_fluid - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='lpt') - pmesh%varname(1)='diameter' - pmesh%vecname(1)='velocity' - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d - pmesh%vec(:,1,i)=lp%p(i)%vel - end do - end block create_pmesh - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=lp%cfg,name='particles') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_particle('particles',pmesh) - call ens_out%add_vector('velocity',U,V,W) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call lp%get_max() - ! Create simulation monitor - mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(lp%np,'Particle number') - call mfile%add_column(lp%np_new,'Npart new') - call mfile%add_column(lp%np_out,'Npart removed') - call mfile%add_column(lp%ncol,'Particle collisions') - call mfile%add_column(lp%VFmean,'Mean VF') - call mfile%add_column(lp%Umin,'Particle Umin') - call mfile%add_column(lp%Umax,'Particle Umax') - call mfile%add_column(lp%Vmin,'Particle Vmin') - call mfile%add_column(lp%Vmax,'Particle Vmax') - call mfile%add_column(lp%Wmin,'Particle Wmin') - call mfile%add_column(lp%Wmax,'Particle Wmax') - call mfile%add_column(lp%dmin,'Particle dmin') - call mfile%add_column(lp%dmax,'Particle dmax') - call mfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call time%increment() - - ! Inject particles - call lp%inject(dt=time%dt) - - ! Collide particles - call lp%collide(dt=time%dt) - - ! Advance particles by dt - call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d - pmesh%vec(:,1,i)=lp%p(i)%vel - end do - end block update_pmesh - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call lp%get_max() - call mfile%write() - + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=1 + end block initialize_timetracker + + + ! Initialize our LPT + initialize_lpt: block + use random, only: random_uniform + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Turn off drag + lp%drag_model='none' + ! Initialize with zero particles + call lp%resize(0) + ! Get initial particle volume fraction + call lp%update_VF() + ! Set collision timescale + lp%Tcol=15.0_WP*time%dt + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w) + call param_read('Friction coefficient',lp%mu_f) + ! Injection parameters + call param_read('Particle mass flow rate',lp%mfr) + call param_read('Particle velocity',lp%inj_vel) + call param_read('Particle mean diameter',lp%inj_dmean) + call param_read('Particle standard deviation',lp%inj_dsd,default=0.0_WP) + call param_read('Particle min diameter',lp%inj_dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',lp%inj_dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',lp%inj_dshift,default=0.0_WP) + if (lp%inj_dsd.le.epsilon(1.0_WP)) then + lp%inj_dmin=lp%inj_dmean + lp%inj_dmax=lp%inj_dmean + end if + call param_read('Particle inject diameter',lp%inj_d) + lp%inj_pos=0.0_WP + lp%inj_T=300.0_WP + end block initialize_lpt + + + ! Initialize quiescent fluid + initialize_fluid: block + use mathtools, only: twoPi + integer :: i,j,k + real(WP) :: rhof,viscf + ! Allocate arrays + allocate(rho (lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(visc(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(U(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(V(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + allocate(W(lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)) + U=0.0_WP; V=0.0_WP; W=0.0_WP + ! Set constant density and viscosity + call param_read('Density',rhof); rho=rhof + call param_read('Viscosity',viscf); visc=viscf + end block initialize_fluid + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(rho,visc,U,V,W) - - end subroutine simulation_final - + end block create_pmesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=lp%cfg,name='particles') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',U,V,W) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call lp%get_cfl(time%dt,time%cfl) + call lp%get_max() + ! Create simulation monitor + mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(lp%np,'Particle number') + call mfile%add_column(lp%np_new,'Npart new') + call mfile%add_column(lp%np_out,'Npart removed') + call mfile%add_column(lp%ncol,'Particle collisions') + call mfile%add_column(lp%VFmean,'Mean VF') + call mfile%add_column(lp%Umin,'Particle Umin') + call mfile%add_column(lp%Umax,'Particle Umax') + call mfile%add_column(lp%Vmin,'Particle Vmin') + call mfile%add_column(lp%Vmax,'Particle Vmax') + call mfile%add_column(lp%Wmin,'Particle Wmin') + call mfile%add_column(lp%Wmax,'Particle Wmax') + call mfile%add_column(lp%dmin,'Particle dmin') + call mfile%add_column(lp%dmax,'Particle dmax') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(lp%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(lp%CFLp_x,'Particle xCFL') + call cflfile%add_column(lp%CFLp_y,'Particle yCFL') + call cflfile%add_column(lp%CFLp_z,'Particle zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call lp%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Inject particles + call lp%inject(dt=time%dt) + + ! Collide particles + call lp%collide(dt=time%dt) + + ! Advance particles by dt + call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc) + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call lp%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(rho,visc,U,V,W) + + end subroutine simulation_final + end module simulation diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 5dbd9bcd2..6111deda0 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -65,6 +65,9 @@ module lpt_class integer :: ng_ !< Local number of ghosts type(part), dimension(:), allocatable :: g !< Array of ghosts of type part + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z,CFL_col !< CFL numbers + ! Particle density real(WP) :: rho !< Density of particle @@ -134,6 +137,7 @@ module lpt_class procedure :: read !< Parallel read particles from file procedure :: write !< Parallel write particles to file procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL procedure :: update_VF !< Compute particle volume fraction procedure :: filter !< Apply volume filtering to field procedure :: inject !< Inject particles at a prescribed boundary @@ -939,7 +943,7 @@ subroutine inject(this,dt) np_tmp=np_tmp-1 else ! Localize the particle - this%p(count)%ind(1)=1; this%p(count)%ind(2)=1; this%p(count)%ind(3)=1 + this%p(count)%ind(1)=this%cfg%imin; this%p(count)%ind(2)=this%cfg%jmin; this%p(count)%ind(3)=this%cfg%kmin this%p(count)%ind=this%cfg%get_ijk_global(this%p(count)%pos,this%p(count)%ind) ! Give it a velocity this%p(count)%vel=this%inj_vel @@ -1023,6 +1027,45 @@ function get_position(mind) result(pos) end function get_position end subroutine inject + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP; my_CFL_col=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxmi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dymi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzmi(this%p(i)%ind(3))) + my_CFL_col=max(my_CFL_col,sqrt(sum(this%p(i)%vel**2))/this%p(i)%d) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum convective CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + if (this%use_col) then + my_CFL_col=10.0_WP*my_CFL_col*dt + call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + cfl = max(cfl,this%CFL_col) + else + this%CFL_col=0.0_WP + end if + + end subroutine get_cfl !> Extract various monitoring data from particle field From 4849175979ba7bb5d05ce170b297c04ee958ebba Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 18 Dec 2022 13:00:37 -0500 Subject: [PATCH 028/152] LPT updates More progress porting old LPT stuff into lpt_class. Particles now have angular velocity and tangential collisions. By default friction coeff is set to 0, if it is given a value larger than 0 then torque due to collisions is accounted for. Also started making progress to account for lift and fluid torque due to drag. This requires interpolating fluid vorticity. --- examples/fluidized_bed/src/simulation.f90 | 4 +- examples/part_bed/src/simulation.f90 | 2 +- examples/part_inject/src/simulation.f90 | 7 +- examples/part_tester/src/simulation.f90 | 2 +- src/particles/lpt_class.f90 | 285 ++++++++++++++++------ 5 files changed, 224 insertions(+), 76 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 672b3de52..c077f9bec 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -188,8 +188,8 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - call param_read('Collision timescale',lp%Tcol,default=5.0_WP*time%dt) - lp%Tcol=5.0_WP*time%dt + call param_read('Collision timescale',lp%tau_col,default=5.0_WP*time%dt) + lp%tau_col=5.0_WP*time%dt ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) call param_read('Wall restitution',lp%e_w,default=lp%e_n) diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index 589c2a838..ab3c8a29a 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -97,7 +97,7 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - lp%Tcol=5.0_WP*time%dt + lp%tau_col=5.0_WP*time%dt lp%e_n=0.7_WP ! Set gravity call param_read('Gravity',lp%gravity) diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index c200da2d6..cce52c896 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -66,7 +66,7 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - lp%Tcol=15.0_WP*time%dt + lp%tau_col=5.0_WP*time%dt ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) call param_read('Wall restitution',lp%e_w) @@ -110,13 +110,15 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=2,name='lpt') pmesh%varname(1)='diameter' pmesh%vecname(1)='velocity' + pmesh%vecname(2)='ang_vel' call lp%update_partmesh(pmesh) do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel end do end block create_pmesh @@ -204,6 +206,7 @@ subroutine simulation_run do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel end do end block update_pmesh call ens_out%write_data(time%t) diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index ef10fe6ac..b0fad014e 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -90,7 +90,7 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - lp%Tcol=5.0_WP*time%dt + lp%tau_col=5.0_WP*time%dt end block initialize_lpt diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 6111deda0..cc3646fc6 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -29,7 +29,9 @@ module lpt_class real(WP) :: d !< Particle diameter real(WP), dimension(3) :: pos !< Particle center coordinates real(WP), dimension(3) :: vel !< Velocity of particle - real(WP), dimension(3) :: col !< Collision force + real(WP), dimension(3) :: angVel !< Angular velocity of particle + real(WP), dimension(3) :: col !< Normal collision force + real(WP), dimension(3) :: Tcol !< Collision torque real(WP) :: T !< Temperature real(WP) :: dt !< Time step size for the particle !> MPI_INTEGER data @@ -38,7 +40,7 @@ module lpt_class end type part !> Number of blocks, block length, and block types in a particle integer, parameter :: part_nblock=3 - integer , dimension(part_nblock) :: part_lblock=[1,12,4] + integer , dimension(part_nblock) :: part_lblock=[1,18,4] type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] !> MPI_PART derived datatype and size type(MPI_Datatype) :: MPI_PART @@ -77,10 +79,11 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) character(len=str_medium), public :: drag_model !< Drag model + logical :: use_lift=.false. !< Compute lift force on particles ! Collisional parameters logical :: use_col=.true. !< Flag for collisions - real(WP) :: Tcol !< Characteristic collision time scale + real(WP) :: tau_col !< Characteristic collision time scale real(WP) :: e_n !< Normal restitution coefficient real(WP) :: e_w !< Wall restitution coefficient real(WP) :: mu_f !< Friction coefficient @@ -141,6 +144,7 @@ module lpt_class procedure :: update_VF !< Compute particle volume fraction procedure :: filter !< Apply volume filtering to field procedure :: inject !< Inject particles at a prescribed boundary + !procedure :: get_vorticity !< Calculate vorticity end type lpt @@ -194,6 +198,9 @@ function constructor(cfg,name) result(self) ! Set default drag self%drag_model='Schiller-Naumann' + ! Zero friction by default + self%mu_f=0.0_WP + ! Allocate finite volume divergence operators allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered allocate(self%div_y(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered @@ -355,7 +362,7 @@ end function constructor !> Resolve collisional interaction between particles - !> Requires Tcol, e_n, and e_w to be set beforehand + !> Requires tau_col, e_n, e_w and mu_f to be set beforehand subroutine collide(this,dt) implicit none class(lpt), intent(inout) :: this @@ -368,6 +375,7 @@ subroutine collide(this,dt) integer :: i do i=1,this%np_ this%p(i)%col=0.0_WP + this%p(i)%Tcol=0.0_WP end do end block zero_force @@ -420,25 +428,31 @@ subroutine collide(this,dt) ! Finally, calculate collision force collision_force: block use mpi_f08 - use mathtools, only: Pi,normalize + use mathtools, only: Pi,normalize,cross_product integer :: i1,i2,ii,jj,kk,nn,ierr real(WP) :: d1,m1,d2,m2,d12,m12 - real(WP), dimension(3) :: r1,v1,r2,v2,v12,n12,f_n - real(WP) :: k_n,eta_n,lne,pilne2,lne_w,pilne2_w,rnv,r_influ,delta_n + real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t + real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv + real(WP), parameter :: aclipnorm=1.0e-6_WP + real(WP), parameter :: acliptan=1.0e-9_WP + real(WP), parameter :: rcliptan=0.05_WP ! Reset collision counter this%ncol=0 - ! Precompute ln(e_n) and Pi^2+ln(e_n)^2 - lne=log(this%e_n); pilne2=Pi**2+lne**2 - lne_w=log(this%e_w); pilne2_w=Pi**2+lne_w**2 + ! Precompute coefficients for k and eta + k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 + eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col + k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 + eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col ! Loop over all local particles do i1=1,this%np_ - + ! Store particle data r1=this%p(i1)%pos v1=this%p(i1)%vel + w1=this%p(i1)%angVel d1=this%p(i1)%d m1=this%rho*Pi/6.0_WP*d1**3 @@ -449,17 +463,30 @@ subroutine collide(this,dt) rnv=dot_product(v1,n12) r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - + ! Assess if there is collision if (delta_n.gt.0.0_WP) then ! Normal collision - !k_n=m1/(this%Tcol**2*pilne2_w) - k_n=m1/this%Tcol**2*pilne2_w - !eta_n=-2.0_WP*lne_w*sqrt(m1*k_n)/pilne2_w - eta_n=-2.0_WP*lne_w*m1/this%Tcol + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if ! Calculate collision force - this%p(i1)%col=this%p(i1)%col+f_n/m1 + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%col=this%p(i1)%col+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) end if ! Loop over nearest cells @@ -477,12 +504,14 @@ subroutine collide(this,dt) if (i2.gt.0) then r2=this%p(i2)%pos v2=this%p(i2)%vel + w2=this%p(i2)%angVel d2=this%p(i2)%d m2=this%rho*Pi/6.0_WP*d2**3 else if (i2.lt.0) then i2=-i2 r2=this%g(i2)%pos v2=this%g(i2)%vel + w2=this%g(i2)%angVel d2=this%g(i2)%d m2=this%rho*Pi/6.0_WP*d2**3 end if @@ -500,13 +529,27 @@ subroutine collide(this,dt) if (delta_n.gt.0.0_WP) then ! Normal collision m12=m1*m2/(m1+m2) - !k_n=m12/(this%Tcol**2*pilne2) - k_n=m12/this%Tcol**2*pilne2 - !eta_n=-2.0_WP*lne*sqrt(m12*k_n)/pilne2 - eta_n=-2.0_WP*lne*m12/this%Tcol + k_n=m12*k_coeff + eta_n=m12*eta_coeff f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if ! Calculate collision force - this%p(i1)%col=this%p(i1)%col+f_n/m1 + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%col=this%p(i1)%col+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + ! Add up the collisions this%ncol=this%ncol+1 end if @@ -543,9 +586,9 @@ subroutine advance(this,dt,U,V,W,rho,visc) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,ierr - real(WP) :: mydt,dt_done,deng - real(WP), dimension(3) :: acc,dmom + integer :: i,j,k,ierr + real(WP) :: mydt,dt_done,deng,Ip + real(WP), dimension(3) :: acc,torque,dmom type(part) :: pold ! Zero out source term arrays @@ -557,6 +600,9 @@ subroutine advance(this,dt,U,V,W,rho,visc) ! Zero out number of particles removed this%np_out=0 + ! Get fluid vorticity if needed + !if (this%use_torque) call get_vorticity(U,V,W,vort) + ! Advance the equations do i=1,this%np_ ! Time-integrate until dt_done=dt @@ -566,12 +612,15 @@ subroutine advance(this,dt,U,V,W,rho,visc) mydt=min(this%p(i)%dt,dt-dt_done) ! Remember the particle pold=this%p(i) + ! Particle moment of inertia per unit mass + Ip = 0.1_WP*this%p(i)%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) this%p(i)%pos=pold%pos+0.5_WP*mydt*this%p(i)%vel this%p(i)%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+this%p(i)%col) + this%p(i)%angVel=pold%angVel+0.5_WP*mydt*(torque+this%p(i)%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,opt_dt=this%p(i)%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) this%p(i)%pos=pold%pos+mydt*this%p(i)%vel this%p(i)%vel=pold%vel+mydt*(acc+this%gravity+this%p(i)%col) ! Relocalize @@ -633,7 +682,7 @@ end subroutine advance !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) + subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) implicit none class(lpt), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) @@ -643,58 +692,83 @@ subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,opt_dt) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(part), intent(in) :: p - real(WP), dimension(3), intent(out) :: acc + real(WP), dimension(3), intent(out) :: acc,torque real(WP), intent(out) :: opt_dt - real(WP) :: corr,Re,tau real(WP) :: fvisc,frho,pVF,fVF,fT - real(WP), dimension(3) :: fvel - ! Interpolate the fluid phase velocity to the particle location - fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) - ! Interpolate the fluid phase viscosity to the particle location - fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') - fvisc=fvisc+epsilon(1.0_WP) - ! Interpolate the fluid phase density to the particle location - frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') - ! Interpolate the particle volume fraction to the particle location - pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') - fVF=1.0_WP-pVF - ! Interpolate the fluid temperature to the particle location if present - if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Particle Reynolds number - Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) - ! Drag correction - corr=drag_correction() - ! Particle response time - tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) - ! Return acceleration and optimal timestep size - acc=(fvel-p%vel)/tau - opt_dt=tau/real(this%nstep,WP) - - contains - - function drag_correction() result(F) - real(WP) :: F - real(WP) :: Ma,Kn,b1,b2 - + real(WP), dimension(3) :: fvel,fvort + + ! Interpolate fluid quantities to particle location + interpolate: block + ! Interpolate the fluid phase velocity to the particle location + fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + ! Interpolate the fluid phase viscosity to the particle location + fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') + fvisc=fvisc+epsilon(1.0_WP) + ! Interpolate the fluid phase density to the particle location + frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') + ! Interpolate the particle volume fraction to the particle location + pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') + fVF=1.0_WP-pVF + ! Interpolate the fluid temperature to the particle location if present + if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') + ! Interpolate the fluid vorticity to the particle location if needed + if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + end block interpolate + + ! Compute acceleration due to drag + compute_drag: block + real(WP) :: Re,tau,corr,b1,b2 + ! Particle Reynolds number + Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) + ! Drag correction select case(trim(this%drag_model)) case('None','none') - F=epsilon(1.0_WP) + corr=epsilon(1.0_WP) case('Stokes') - F=1.0_WP + corr=1.0_WP case('Schiller-Naumann','Schiller Naumann','SN') - F=1.0_WP+0.15_WP*Re**(0.687_WP) + corr=1.0_WP+0.15_WP*Re**(0.687_WP) case('Tenneti') ! Tenneti and Subramaniam (2011) b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - F=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) + corr=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) case('Khalloufi Capecelatro','KC') - F=0.0_WP + !> Todo case default - F=1.0_WP + corr=1.0_WP end select + ! Particle response time + tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) + ! Return acceleration and optimal timestep size + acc=(fvel-p%vel)/tau + opt_dt=tau/real(this%nstep,WP) + end block compute_drag + + ! Compute acceleration due to Saffman lift + compute_lift: block + use mathtools, only: Pi,cross_product + real(WP) :: omegag,Cl,Reg + if (this%use_lift) then + omegag=sqrt(sum(fvort**2)) + if (omegag.gt.0.0_WP) then + Reg = p%d**2*omegag*frho/fvisc + Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) + acc=acc+Cl*cross_product(fvel-p%vel,fvort) + end if + end if + end block compute_lift + + ! Compute fluid torque (assumed Stokes drag) + compute_torque: block + torque=0.0_WP!6.0_WP*fvisc*(0.5_WP*fvort-p%angVel)/this%rho + end block compute_torque + + ! Compute heat transfer + compute_heat_transfer: block + !> Todo + end block compute_heat_transfer - end function drag_correction end subroutine get_rhs @@ -824,6 +898,76 @@ subroutine filter(this,A) end subroutine filter +!!$ !> Calculate vorticity +!!$ subroutine get_vorticity(this,U,V,W,vort) +!!$ use messager, only: die +!!$ implicit none +!!$ class(lowmach), intent(inout) :: this +!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) +!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) +!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) +!!$ real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) +!!$ integer :: i,j,k +!!$ real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp +!!$ real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp +!!$ real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp +!!$ real(WP), dimension(3,3) :: dUdx +!!$ +!!$ ! Check vort's first dimension +!!$ if (size(vort,dim=1).ne.3) call die('[lpt get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') +!!$ +!!$ ! Calculate inside +!!$ do k=this%cfg%kmin_,this%cfg%kmax_ +!!$ do j=this%cfg%jmin_,this%cfg%jmax_ +!!$ do i=this%cfg%imin_,this%cfg%imax_ +!!$ ! Rebuild face velocities from interpolated velocities +!!$ Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) +!!$ Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) +!!$ Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) +!!$ ! Get velocity gradient tensor +!!$ dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) +!!$ dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) +!!$ dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) +!!$ ! Assemble the strain rate +!!$ SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP +!!$ SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP +!!$ SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP +!!$ SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) +!!$ SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) +!!$ SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) +!!$ end do +!!$ end do +!!$ end do +!!$ +!!$ ! Apply a Neumann condition in non-periodic directions +!!$ if (.not.this%cfg%xper) then +!!$ if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) +!!$ if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) +!!$ end if +!!$ if (.not.this%cfg%yper) then +!!$ if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) +!!$ if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) +!!$ end if +!!$ if (.not.this%cfg%zper) then +!!$ if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) +!!$ if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) +!!$ end if +!!$ +!!$ ! Ensure zero in walls +!!$ do k=this%cfg%kmino_,this%cfg%kmaxo_ +!!$ do j=this%cfg%jmino_,this%cfg%jmaxo_ +!!$ do i=this%cfg%imino_,this%cfg%imaxo_ +!!$ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP +!!$ end do +!!$ end do +!!$ end do +!!$ +!!$ ! Sync it +!!$ call this%cfg%sync(SR) +!!$ +!!$ end subroutine get_vorticity + + !> Inject particles from a prescribed location with given mass flowrate !> Requires injection parameters to be set beforehand subroutine inject(this,dt) @@ -918,10 +1062,11 @@ subroutine inject(this,dt) ! Generate a diameter this%p(count)%d=get_diameter() ! Set various parameters for the particle - this%p(count)%id =maxid+int(np_tmp,8) - this%p(count)%dt =0.0_WP - this%p(count)%col=0.0_WP - this%p(count)%T = this%inj_T + this%p(count)%id =maxid+int(np_tmp,8) + this%p(count)%dt =0.0_WP + this%p(count)%col =0.0_WP + this%p(count)%T =this%inj_T + this%p(count)%angVel=0.0_WP ! Give a position at the injector to the particle this%p(count)%pos=get_position(0.6_WP*this%p(count)%d) overlap=.false. From 9180874aed385870f50a8df5bc600962c9ea4cc7 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 20 Dec 2022 13:07:58 -0500 Subject: [PATCH 029/152] Update lowmach_class.f90 Added routine that computes divergence of fluid stress. This will be needed by LPT to interpolate stress to particle location. --- src/variable_density/lowmach_class.f90 | 117 +++++++++++++++++++++++++ 1 file changed, 117 insertions(+) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index b6653a3c5..8e7678977 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -122,6 +122,7 @@ module lowmach_class procedure :: get_dmomdt !< Calculate dmom/dt procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient + procedure :: get_div_stress !< Calculate divergence of stress procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL @@ -1242,6 +1243,122 @@ subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) call this%cfg%sync(Pgrady) call this%cfg%sync(Pgradz) end subroutine get_pgrad + + + !> Calculate divergence of stress based on U/V/W/P (needed by LPT class) + subroutine get_div_stress(this,divx,divy,divz) + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divy !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ii,jj,kk + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Stress tensor in X + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii-1; j=jj-1; k=kk-1 + FX(i,j,k)=+this%visc(i,j,k)*(sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))+sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))+sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))) + end do + end do + end do + ! Divergence of X stress + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divx(i,j,k)=sum(this%divu_x(:,i,j,k)*FX(i-1:i,j,k))+& + & sum(this%divu_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divu_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divx) + + ! Stress tensor in Y + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))+sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))) + ! Fluxes on y-face + i=ii-1; j=jj-1; k=kk-1 + FY(i,j,k)=+this%visc(i,j,k)*(sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))+sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))) + end do + end do + end do + ! Divergence of Y stress + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divy(i,j,k)=sum(this%divv_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divv_y(:,i,j,k)*FY(i,j-1:j,k))+& + & sum(this%divv_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divy) + + ! Stress tensor in Z + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))+sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))+sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))) + ! Fluxes on z-face + i=ii-1; j=jj-1; k=kk-1 + FZ(i,j,k)=+this%visc(i,j,k)*(sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))+sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + end do + end do + end do + ! Divergence in Z + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divz(i,j,k)=sum(this%divw_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divw_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divw_z(:,i,j,k)*FZ(i,j,k-1:k)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divz) + + print *, minval(divx),maxval(divx), minval(divy),maxval(divy), minval(divz),maxval(divz) + + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + + end subroutine get_div_stress !> Divide momentum by rho to form velocity From cf9d4a1a29d0587be43ae1ab53a3c7e983302649 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 20 Dec 2022 13:34:29 -0500 Subject: [PATCH 030/152] More LPT changes LPT now slips over particles with id<=0 to allow for "glued" particles. Renamed p%col to p%Acol (acceleration due to collisions). Also LPT now reads in fluid stress and interpolates to particle position. --- examples/drop_breakup/src/simulation.f90 | 2 +- examples/fluidized_bed/input | 8 +- examples/fluidized_bed/src/simulation.f90 | 28 ++- examples/nozzle_2phase/src/simulation.f90 | 2 +- examples/part_bed/src/simulation.f90 | 2 +- examples/part_inject/input | 14 +- examples/part_inject/src/simulation.f90 | 19 +- examples/part_tester/src/simulation.f90 | 2 +- src/particles/lpt_class.f90 | 225 +++++++++------------- 9 files changed, 134 insertions(+), 168 deletions(-) diff --git a/examples/drop_breakup/src/simulation.f90 b/examples/drop_breakup/src/simulation.f90 index 922c9bda5..d7a3c612d 100644 --- a/examples/drop_breakup/src/simulation.f90 +++ b/examples/drop_breakup/src/simulation.f90 @@ -814,7 +814,7 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force lp%p(np)%d =diam !< Assign diameter to account for full volume lp%p(np)%pos =[cc%meta_structures_list(m)%x,cc%meta_structures_list(m)%y,cc%meta_structures_list(m)%z] !< Place the drop at the liquid barycenter lp%p(np)%vel =[cc%meta_structures_list(m)%u,cc%meta_structures_list(m)%v,cc%meta_structures_list(m)%w] !< Assign mean structure velocity as drop velocity diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 4902660bd..4347e2eeb 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 2 1 1 +Partition : 1 1 1 # Mesh definition Lx : .0256 @@ -18,14 +18,16 @@ Max time : 10 Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 -Inlet velocity : 0.4 +Inlet velocity : 0.02 # Particle parameters Bed height : .0128 Particle volume fraction : 0.4 Coefficient of restitution : 0.8 +Friction coefficient : 0.2 Particle density : 2600 Particle diameter : 200e-6 +Collision timescale : 15e-6 # Pressure solver Pressure tolerance : 1e-5 @@ -36,4 +38,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 40e-5 \ No newline at end of file +Ensight output period : 80e-5 \ No newline at end of file diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index c077f9bec..7c1d4a6bc 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -21,7 +21,6 @@ module simulation type(partmesh) :: pmesh type(ensight) :: ens_out type(event) :: ens_evt - integer, dimension(:,:,:), allocatable :: cpu_rank !> Simulation monitor file type(monitor) :: mfile,cflfile @@ -31,7 +30,7 @@ module simulation !> Work arrays and fluid properties real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,dRHOdt + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP) :: visc,rho,inlet_velocity contains @@ -112,16 +111,10 @@ subroutine simulation_init allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays - ! Store processor decomposition for visualization - store_cpu_rank: block - allocate(cpu_rank(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - cpu_rank=cfg%rank - end block store_cpu_rank - - ! Initialize our LPT solver initialize_lpt: block use random, only: random_uniform @@ -174,7 +167,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh @@ -188,11 +182,11 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - call param_read('Collision timescale',lp%tau_col,default=5.0_WP*time%dt) - lp%tau_col=5.0_WP*time%dt + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) ! Set gravity call param_read('Gravity',lp%gravity) if (lp%cfg%amRoot) then @@ -232,8 +226,9 @@ subroutine simulation_init fs%rhoU(i,j,k)=inlet_velocity fs%U(i,j,k) =inlet_velocity end do - ! Set density from particle volume fraction + ! Set density from particle volume fraction and store initial density fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho ! Form momentum call fs%rho_multiply ! Apply all other boundary conditions @@ -257,7 +252,6 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('epsp',lp%VF) call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('CPU',cpu_rank) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -333,10 +327,12 @@ subroutine simulation_run fs%Vold=fs%V; fs%rhoVold=fs%rhoV fs%Wold=fs%W; fs%rhoWold=fs%rhoW + ! Get fluid stress + call fs%get_div_stress(resU,resV,resW) + ! Collide and advance particles call lp%collide(dt=time%dtmid) - resU=rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW) ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) diff --git a/examples/nozzle_2phase/src/simulation.f90 b/examples/nozzle_2phase/src/simulation.f90 index 8c3c96138..3ddea7849 100644 --- a/examples/nozzle_2phase/src/simulation.f90 +++ b/examples/nozzle_2phase/src/simulation.f90 @@ -852,7 +852,7 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force lp%p(np)%d =(6.0_WP*Vd/pi)**(1.0_WP/3.0_WP) !< Assign diameter from model above lp%p(np)%pos =vf%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp%p(np)%vel =fs%cfg%get_velocity(pos=lp%p(np)%pos,i0=i,j0=j,k0=k,U=fs%U,V=fs%V,W=fs%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index ab3c8a29a..43f5cfdb5 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -83,7 +83,7 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/part_inject/input b/examples/part_inject/input index 6c23990d9..ce0325099 100644 --- a/examples/part_inject/input +++ b/examples/part_inject/input @@ -5,9 +5,9 @@ Partition : 1 2 2 Lx : 0.007 Ly : 0.01792 Lz : 0.01792 -nx : 50 -ny : 128 -nz : 128 +nx : 70 +ny : 180 +nz : 180 # Time integration Max timestep size : 1e-5 @@ -20,20 +20,20 @@ Density : 1 # Particle parameters Particle mean diameter : 37.515e-6 -Particle standard deviation : 1.7894e-5 -Particle min diameter : 8.1e-6 +Particle standard deviation : 17.894e-6 +Particle min diameter : 10e-6 Particle max diameter : 139.1e-6 Particle diameter shift : 0 Particle density : 2250 # Particle collisions -Coefficient of restitution : 0.85 +Coefficient of restitution : 0.5 Wall restitution : 0.1 Friction coefficient : 0.5 # Particle injection Particle inject diameter: 0.00127 -Particle mass flow rate: 0.00001 +Particle mass flow rate: 0.00002 Particle velocity: 0.18 0 0 # Ensight output diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index cce52c896..09d75af36 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -84,7 +84,8 @@ subroutine simulation_init lp%inj_dmax=lp%inj_dmean end if call param_read('Particle inject diameter',lp%inj_d) - lp%inj_pos=0.0_WP + lp%inj_pos(1)=lp%cfg%x(lp%cfg%imin)+lp%inj_dmax + lp%inj_pos(2:3)=0.0_WP lp%inj_T=300.0_WP end block initialize_lpt @@ -110,13 +111,15 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,nvec=2,name='lpt') - pmesh%varname(1)='diameter' + pmesh=partmesh(nvar=2,nvec=2,name='lpt') + pmesh%varname(1)='id' + pmesh%varname(2)='diameter' pmesh%vecname(1)='velocity' pmesh%vecname(2)='ang_vel' call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d + pmesh%var(1,i)=real(lp%p(i)%id,WP) + pmesh%var(2,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel pmesh%vec(:,2,i)=lp%p(i)%angVel end do @@ -153,7 +156,7 @@ subroutine simulation_init call mfile%add_column(lp%np_new,'Npart new') call mfile%add_column(lp%np_out,'Npart removed') call mfile%add_column(lp%ncol,'Particle collisions') - call mfile%add_column(lp%VFmean,'Mean VF') + call mfile%add_column(lp%VFmax,'Max VF') call mfile%add_column(lp%Umin,'Particle Umin') call mfile%add_column(lp%Umax,'Particle Umax') call mfile%add_column(lp%Vmin,'Particle Vmin') @@ -196,7 +199,8 @@ subroutine simulation_run call lp%collide(dt=time%dt) ! Advance particles by dt - call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc) + U=0.0_WP; V=0.0_WP; W=0.0_WP + call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc,stress_x=U,stress_y=V,stress_z=W) ! Output to ensight if (ens_evt%occurs()) then @@ -204,7 +208,8 @@ subroutine simulation_run integer :: i call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d + pmesh%var(1,i)=real(lp%p(i)%id,WP) + pmesh%var(2,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel pmesh%vec(:,2,i)=lp%p(i)%angVel end do diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index b0fad014e..988bbb6aa 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -76,7 +76,7 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index cc3646fc6..9fb17deed 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -30,7 +30,7 @@ module lpt_class real(WP), dimension(3) :: pos !< Particle center coordinates real(WP), dimension(3) :: vel !< Velocity of particle real(WP), dimension(3) :: angVel !< Angular velocity of particle - real(WP), dimension(3) :: col !< Normal collision force + real(WP), dimension(3) :: Acol !< Collision acceleration real(WP), dimension(3) :: Tcol !< Collision torque real(WP) :: T !< Temperature real(WP) :: dt !< Time step size for the particle @@ -144,7 +144,6 @@ module lpt_class procedure :: update_VF !< Compute particle volume fraction procedure :: filter !< Apply volume filtering to field procedure :: inject !< Inject particles at a prescribed boundary - !procedure :: get_vorticity !< Calculate vorticity end type lpt @@ -359,7 +358,7 @@ function constructor(cfg,name) result(self) end block logging end function constructor - + !> Resolve collisional interaction between particles !> Requires tau_col, e_n, e_w and mu_f to be set beforehand @@ -374,7 +373,7 @@ subroutine collide(this,dt) zero_force: block integer :: i do i=1,this%np_ - this%p(i)%col=0.0_WP + this%p(i)%Acol=0.0_WP this%p(i)%Tcol=0.0_WP end do end block zero_force @@ -447,7 +446,10 @@ subroutine collide(this,dt) eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col ! Loop over all local particles - do i1=1,this%np_ + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision ! Store particle data r1=this%p(i1)%pos @@ -484,7 +486,7 @@ subroutine collide(this,dt) end if ! Calculate collision force f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%col=this%p(i1)%col+f_n+f_t + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) end if @@ -546,13 +548,13 @@ subroutine collide(this,dt) end if ! Calculate collision force f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%col=this%p(i1)%col+f_n+f_t + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) ! Add up the collisions this%ncol=this%ncol+1 end if - + end do end do @@ -560,11 +562,23 @@ subroutine collide(this,dt) end do ! Deal with dimensionality - if (this%cfg%nx.eq.1) this%p(i1)%col(1)=0.0_WP - if (this%cfg%ny.eq.1) this%p(i1)%col(2)=0.0_WP - if (this%cfg%nz.eq.1) this%p(i1)%col(3)=0.0_WP + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if - end do + end do collision ! Determine total number of collisions call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 @@ -575,21 +589,30 @@ end subroutine collide !> Advance the particle equations by a specified time step dt - subroutine advance(this,dt,U,V,W,rho,visc) + !> p%id=0 => no coll, no solve + !> p%id=-1=> no coll, no move + subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T) use mpi_f08, only : MPI_SUM,MPI_INTEGER use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom - type(part) :: pold + type(part) :: myp,pold ! Zero out source term arrays this%srcU=0.0_WP @@ -600,53 +623,58 @@ subroutine advance(this,dt,U,V,W,rho,visc) ! Zero out number of particles removed this%np_out=0 - ! Get fluid vorticity if needed - !if (this%use_torque) call get_vorticity(U,V,W,vort) - ! Advance the equations do i=1,this%np_ + ! Avoid particles with id=0 + if (this%p(i)%id.eq.0) cycle + ! Create local copy of particle + myp=this%p(i) ! Time-integrate until dt_done=dt dt_done=0.0_WP do while (dt_done.lt.dt) ! Decide the timestep size - mydt=min(this%p(i)%dt,dt-dt_done) + mydt=min(myp%dt,dt-dt_done) ! Remember the particle - pold=this%p(i) + pold=myp ! Particle moment of inertia per unit mass - Ip = 0.1_WP*this%p(i)%d**2 + Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+0.5_WP*mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+this%p(i)%col) - this%p(i)%angVel=pold%angVel+0.5_WP*mydt*(torque+this%p(i)%Tcol)/Ip + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) + myp%pos=pold%pos+0.5_WP*mydt*myp%vel + myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+mydt*(acc+this%gravity+this%p(i)%col) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + myp%pos=pold%pos+mydt*myp%vel + myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip ! Relocalize - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) ! Send source term back to the mesh - dmom=mydt*acc*this%rho*Pi/6.0_WP*this%p(i)%d**3 - deng=sum(dmom*this%p(i)%vel) - if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcU,bc='n') - if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcV,bc='n') - if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcW,bc='n') - call this%cfg%set_scalar(Sp=-deng ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcE,bc='n') + dmom=mydt*acc*this%rho*Pi/6.0_WP*myp%d**3 + deng=sum(dmom*myp%vel) + if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcU,bc='n') + if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcV,bc='n') + if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcW,bc='n') + call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcE,bc='n') ! Increment dt_done=dt_done+mydt end do ! Correct the position to take into account periodicity - if (this%cfg%xper) this%p(i)%pos(1)=this%cfg%x(this%cfg%imin)+modulo(this%p(i)%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) - if (this%cfg%yper) this%p(i)%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(this%p(i)%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) - if (this%cfg%zper) this%p(i)%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(this%p(i)%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) + if (this%cfg%xper) myp%pos(1)=this%cfg%x(this%cfg%imin)+modulo(myp%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) + if (this%cfg%yper) myp%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(myp%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) + if (this%cfg%zper) myp%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(myp%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) ! Handle particles that have left the domain - if (this%p(i)%pos(1).lt.this%cfg%x(this%cfg%imin).or.this%p(i)%pos(1).gt.this%cfg%x(this%cfg%imax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(2).lt.this%cfg%y(this%cfg%jmin).or.this%p(i)%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(3).lt.this%cfg%z(this%cfg%kmin).or.this%p(i)%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) this%p(i)%flag=1 + if (myp%pos(1).lt.this%cfg%x(this%cfg%imin).or.myp%pos(1).gt.this%cfg%x(this%cfg%imax+1)) myp%flag=1 + if (myp%pos(2).lt.this%cfg%y(this%cfg%jmin).or.myp%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) myp%flag=1 + if (myp%pos(3).lt.this%cfg%z(this%cfg%kmin).or.myp%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) myp%flag=1 ! Relocalize the particle - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) ! Count number of particles removed - if (this%p(i)%flag.eq.1) this%np_out=this%np_out+1 + if (myp%flag.eq.1) this%np_out=this%np_out+1 + ! Copy back to particle + if (myp%id.ne.-1) this%p(i)=myp end do ! Communicate particles @@ -682,25 +710,30 @@ end subroutine advance !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) + subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque,opt_dt) implicit none class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(part), intent(in) :: p real(WP), dimension(3), intent(out) :: acc,torque real(WP), intent(out) :: opt_dt real(WP) :: fvisc,frho,pVF,fVF,fT - real(WP), dimension(3) :: fvel,fvort + real(WP), dimension(3) :: fvel,fstress,fvort ! Interpolate fluid quantities to particle location interpolate: block ! Interpolate the fluid phase velocity to the particle location fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + ! Interpolate the fluid phase stress to the particle location + fstress=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=stress_x,V=stress_y,W=stress_z) ! Interpolate the fluid phase viscosity to the particle location fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') fvisc=fvisc+epsilon(1.0_WP) @@ -741,7 +774,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) ! Particle response time tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) ! Return acceleration and optimal timestep size - acc=(fvel-p%vel)/tau + acc=(fvel-p%vel)/tau+fstress/this%rho opt_dt=tau/real(this%nstep,WP) end block compute_drag @@ -898,76 +931,6 @@ subroutine filter(this,A) end subroutine filter -!!$ !> Calculate vorticity -!!$ subroutine get_vorticity(this,U,V,W,vort) -!!$ use messager, only: die -!!$ implicit none -!!$ class(lowmach), intent(inout) :: this -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ integer :: i,j,k -!!$ real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp -!!$ real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp -!!$ real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp -!!$ real(WP), dimension(3,3) :: dUdx -!!$ -!!$ ! Check vort's first dimension -!!$ if (size(vort,dim=1).ne.3) call die('[lpt get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') -!!$ -!!$ ! Calculate inside -!!$ do k=this%cfg%kmin_,this%cfg%kmax_ -!!$ do j=this%cfg%jmin_,this%cfg%jmax_ -!!$ do i=this%cfg%imin_,this%cfg%imax_ -!!$ ! Rebuild face velocities from interpolated velocities -!!$ Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) -!!$ Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) -!!$ Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) -!!$ ! Get velocity gradient tensor -!!$ dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) -!!$ dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) -!!$ dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) -!!$ ! Assemble the strain rate -!!$ SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) -!!$ SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) -!!$ SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) -!!$ end do -!!$ end do -!!$ end do -!!$ -!!$ ! Apply a Neumann condition in non-periodic directions -!!$ if (.not.this%cfg%xper) then -!!$ if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) -!!$ if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) -!!$ end if -!!$ if (.not.this%cfg%yper) then -!!$ if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) -!!$ if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) -!!$ end if -!!$ if (.not.this%cfg%zper) then -!!$ if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) -!!$ if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) -!!$ end if -!!$ -!!$ ! Ensure zero in walls -!!$ do k=this%cfg%kmino_,this%cfg%kmaxo_ -!!$ do j=this%cfg%jmino_,this%cfg%jmaxo_ -!!$ do i=this%cfg%imino_,this%cfg%imaxo_ -!!$ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP -!!$ end do -!!$ end do -!!$ end do -!!$ -!!$ ! Sync it -!!$ call this%cfg%sync(SR) -!!$ -!!$ end subroutine get_vorticity - - !> Inject particles from a prescribed location with given mass flowrate !> Requires injection parameters to be set beforehand subroutine inject(this,dt) @@ -1007,7 +970,7 @@ subroutine inject(this,dt) allocate(nrecv(this%cfg%nproc)) count=0 inj_min(1)=this%cfg%x(this%cfg%imino) - inj_max(1)=this%cfg%x(this%cfg%imin+1)+this%inj_dmax + inj_max(1)=this%inj_pos(1)+this%inj_dmax inj_min(2)=this%inj_pos(2)-0.5_WP*this%inj_d-this%inj_dmax inj_max(2)=this%inj_pos(2)+0.5_WP*this%inj_d+this%inj_dmax inj_min(3)=this%inj_pos(3)-0.5_WP*this%inj_d-this%inj_dmax @@ -1064,11 +1027,12 @@ subroutine inject(this,dt) ! Set various parameters for the particle this%p(count)%id =maxid+int(np_tmp,8) this%p(count)%dt =0.0_WP - this%p(count)%col =0.0_WP + this%p(count)%Acol =0.0_WP + this%p(count)%Tcol =0.0_WP this%p(count)%T =this%inj_T this%p(count)%angVel=0.0_WP ! Give a position at the injector to the particle - this%p(count)%pos=get_position(0.6_WP*this%p(count)%d) + this%p(count)%pos=get_position() overlap=.false. ! Check overlap with particles recently injected if (this%use_col) then @@ -1147,16 +1111,15 @@ function get_diameter() result(dp) end function get_diameter ! Position for bulk injection of particles - function get_position(mind) result(pos) + function get_position() result(pos) use random, only: random_uniform use mathtools, only: twoPi implicit none - real(WP), intent(in) :: mind real(WP), dimension(3) :: pos real(WP) :: rand,r,theta integer :: ip,jp,kp ! Set x position - pos(1) = this%cfg%x(this%cfg%imin)+mind + pos(1) = this%inj_pos(1) ! Random y & z position within a circular region if (this%cfg%nz.eq.1) then pos(2)=random_uniform(lo=this%inj_pos(2)-0.5_WP*this%inj_d,hi=this%inj_pos(3)+0.5_WP*this%inj_d) From 4cf450668ef53ca6450ee871f1cb6f24c20d4ae7 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 20 Dec 2022 16:51:00 -0500 Subject: [PATCH 031/152] Remove print statement Remove print statement --- examples/fluidized_bed/src/simulation.f90 | 4 ++-- src/variable_density/lowmach_class.f90 | 2 -- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 7c1d4a6bc..ae47ec8a1 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -223,7 +223,7 @@ subroutine simulation_init call fs%get_bcond('inflow',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=inlet_velocity + fs%rhoU(i,j,k)=rho*inlet_velocity fs%U(i,j,k) =inlet_velocity end do ! Set density from particle volume fraction and store initial density @@ -392,7 +392,7 @@ subroutine simulation_run call fs%get_bcond('inflow',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=inlet_velocity + fs%rhoU(i,j,k)=rho*inlet_velocity fs%U(i,j,k) =inlet_velocity end do end block dirichlet_velocity diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 8e7678977..c54923f44 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -1352,8 +1352,6 @@ subroutine get_div_stress(this,divx,divy,divz) end do ! Sync it call this%cfg%sync(divz) - - print *, minval(divx),maxval(divx), minval(divy),maxval(divy), minval(divz),maxval(divz) ! Deallocate flux arrays deallocate(FX,FY,FZ) From e3d440f82b528fee9ac785af1ee7127f9cfbed5d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 20 Dec 2022 20:16:42 -0500 Subject: [PATCH 032/152] Fluidize bed works! Collisions need to be properly resolved otherwise everything goes crazy... Added LPT CFL and some other small things. This case now bubbles --- examples/fluidized_bed/input | 16 ++++++++-------- examples/fluidized_bed/src/simulation.f90 | 12 +++++++++++- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 4347e2eeb..d2198ca7f 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 1 1 +Partition : 1 2 1 # Mesh definition Lx : .0256 @@ -11,23 +11,23 @@ nz : 1 # Time integration Max timestep size : 1e-5 -Max cfl number : 1 -Max time : 10 +Max cfl number : 1 +Max time : 10 # Fluid properties Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 -Inlet velocity : 0.02 +Inlet velocity : 0.2 # Particle parameters Bed height : .0128 -Particle volume fraction : 0.4 -Coefficient of restitution : 0.8 -Friction coefficient : 0.2 +Particle volume fraction : 0.5 +Coefficient of restitution : 0.9 +Friction coefficient : 0.1 Particle density : 2600 Particle diameter : 200e-6 -Collision timescale : 15e-6 +Collision timescale : 15e-5 # Pressure solver Pressure tolerance : 1e-5 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index ae47ec8a1..6143271b9 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -70,6 +70,7 @@ subroutine simulation_init time=timetracker(amRoot=cfg%amRoot) call param_read('Max timestep size',time%dtmax) call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) time%dt=time%dtmax time%itmax=2 end block initialize_timetracker @@ -200,13 +201,17 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=3,name='lpt') pmesh%varname(1)='diameter' pmesh%vecname(1)='velocity' + pmesh%vecname(2)='ang_vel' + pmesh%vecname(3)='Fcol' call lp%update_partmesh(pmesh) do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel + pmesh%vec(:,3,i)=lp%p(i)%Acol end do end block create_pmesh @@ -260,6 +265,7 @@ subroutine simulation_init create_monitor: block ! Prepare some info about fields call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -286,6 +292,7 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') call cflfile%write() ! Create LPT monitor lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') @@ -318,6 +325,7 @@ subroutine simulation_run ! Increment time call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() @@ -430,6 +438,8 @@ subroutine simulation_run do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel + pmesh%vec(:,3,i)=lp%p(i)%Acol end do end block update_pmesh call ens_out%write_data(time%t) From d6d3e6433f6c9c775422649fed2afe409f6af817 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 23 Dec 2022 12:46:03 -0500 Subject: [PATCH 033/152] New direct forcing IBM solver Created a simple immersed boundary solver based on direct forcing. The marker particle ID determines the number of objects. At the moment objects cannot move, but will eventually add an advance routine to update objects. --- examples/bus/GNUmakefile | 5 +- examples/ibm_tester/README | 1 + examples/ibm_tester/input | 38 ++ examples/ibm_tester/src/Make.package | 2 + examples/ibm_tester/src/geometry.f90 | 76 +++ examples/ibm_tester/src/simulation.f90 | 416 +++++++++++++ src/immersed/Make.package | 4 + src/immersed/df_class.f90 | 806 +++++++++++++++++++++++++ 8 files changed, 1346 insertions(+), 2 deletions(-) create mode 100644 examples/ibm_tester/README create mode 100644 examples/ibm_tester/input create mode 100644 examples/ibm_tester/src/Make.package create mode 100644 examples/ibm_tester/src/geometry.f90 create mode 100644 examples/ibm_tester/src/simulation.f90 create mode 100644 src/immersed/Make.package create mode 100644 src/immersed/df_class.f90 diff --git a/examples/bus/GNUmakefile b/examples/bus/GNUmakefile index 4649d1344..5c202ce34 100644 --- a/examples/bus/GNUmakefile +++ b/examples/bus/GNUmakefile @@ -22,8 +22,9 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre + # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ibm_tester/README b/examples/ibm_tester/README new file mode 100644 index 000000000..8f62622e1 --- /dev/null +++ b/examples/ibm_tester/README @@ -0,0 +1 @@ +This is a basic IBM case, intended as a test of the direct forcing IBM with the incompressible solver. It solves flow past a bumpy cylinder. diff --git a/examples/ibm_tester/input b/examples/ibm_tester/input new file mode 100644 index 000000000..2908ecf91 --- /dev/null +++ b/examples/ibm_tester/input @@ -0,0 +1,38 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 8 +Ly : 4 +Lz : 0.125 +nx : 128 +ny : 64 +nz : 1 + +# IBM properties +Number of particles : 100 +Diameter : 1 +Position : 2 +Perturbation amp : .05 +Perturbation freq : 6 + +# Time integration +Max timestep size : 0.02 +Max cfl number : 1 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : .002 +Density : 1 +Inlet velocity : 1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 \ No newline at end of file diff --git a/examples/ibm_tester/src/Make.package b/examples/ibm_tester/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ibm_tester/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ibm_tester/src/geometry.f90 b/examples/ibm_tester/src/geometry.f90 new file mode 100644 index 000000000..bbad77ef3 --- /dev/null +++ b/examples/ibm_tester/src/geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='IBM') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 new file mode 100644 index 000000000..a82006fcd --- /dev/null +++ b/examples/ibm_tester/src/simulation.f90 @@ -0,0 +1,416 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use df_class, only: dfibm + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(dfibm), public :: df + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + type(monitor) :: ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP) :: inlet_velocity + +contains + + + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_of_domain + + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + use incomp_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define boundary conditions + call fs%add_bcond(name='inflow', type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi + integer :: i,np + real(WP) :: Dcyl,Xcyl,amp,freq,theta,r + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + ! Read cylinder properties + call param_read('Number of particles',np) + call param_read('Diameter',Dcyl) + call param_read('Position',Xcyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =int(1,kind=8) + df%p(i)%vel =0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm = df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(1)=df%p(i)%pos(1)+Xcyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%xL*real(df%cfg%nx,WP) + end if + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + ! Initial fields + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! Set inflow velocity/momentum + call param_read('Inlet velocity',inlet_velocity) + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ibm') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VF',df%VF) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%np,'Particle number') + call ibmfile%add_column(df%Umin,'Particle Umin') + call ibmfile%add_column(df%Umax,'Particle Umax') + call ibmfile%add_column(df%Vmin,'Particle Vmin') + call ibmfile%add_column(df%Vmax,'Particle Vmax') + call ibmfile%add_column(df%Wmin,'Particle Wmin') + call ibmfile%add_column(df%Wmax,'Particle Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use mathtools, only: twoPi + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+sum(fs%itpi_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + fs%V(i,j,k)=fs%V(i,j,k)+sum(fs%itpi_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + fs%W(i,j,k)=fs%W(i,j,k)+sum(fs%itpi_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do + end do + end do + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + end block dirichlet_velocity + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation diff --git a/src/immersed/Make.package b/src/immersed/Make.package new file mode 100644 index 000000000..246e3ea51 --- /dev/null +++ b/src/immersed/Make.package @@ -0,0 +1,4 @@ +f90EXE_sources += df_class.f90 + +INCLUDE_LOCATIONS += $(NGA_HOME)/src/immersed +VPATH_LOCATIONS += $(NGA_HOME)/src/immersed diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 new file mode 100644 index 000000000..7f158f870 --- /dev/null +++ b/src/immersed/df_class.f90 @@ -0,0 +1,806 @@ +!> Basicdirect forcing IBM class: +!> Provides support for Lagrangian marker particles +module df_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use diag_class, only: diag + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: dfibm + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic marker particle definition + type :: part + !> MPI_INTEGER8 data + integer(kind=8) :: id !< Particle ID + !> MPI_DOUBLE_PRECISION data + real(WP) :: dA !< Element area + real(WP), dimension(3) :: norm !< Outward normal vector + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + !> MPI_INTEGER data + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=3 + integer , dimension(part_nblock) :: part_lblock=[1,10,4] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Basic ibm object definition + type :: obj + !> MPI_DOUBLE_PRECISION data + real(WP) :: vol !< Object volume + real(WP), dimension(3) :: pos !< Center of mass + real(WP), dimension(3) :: vel !< Translational velocity of the object + real(WP), dimension(3) :: angVel !< Angular velocity of the object + real(WP), dimension(3) :: F !< Hydrodynamic force + end type obj + + !> Direct forcing IBM solver object definition + type :: dfibm + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + type(diag) :: tridiag !< Tridiagonal solver for implicit filter + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM + + ! Marker particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Object data + integer :: nobj !< Global number of objects + type(obj), dimension(:), allocatable :: o !< Array of objects of type obj + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + logical :: can_move !< Flag to allow moving IBM objects + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info + real(WP) :: Umin,Umax,Umean !< U velocity info + real(WP) :: Vmin,Vmax,Vmean !< V velocity info + real(WP) :: Wmin,Wmax,Wmean !< W velocity info + + ! Volume fraction associated with IBM projection + real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + + contains + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: setup_obj !< Setup IBM object + procedure :: get_source !< Compute direct forcing source + procedure :: resize !< Resize particle array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute volume fraction + procedure :: get_delta !< Compute regularized delta function + procedure :: interpolate !< Interpolation routine from mesh=>marker + procedure :: extrapolate !< Extrapolation routine from marker=>mesh + end type dfibm + + + !> Declare df solver constructor + interface dfibm + procedure constructor + end interface dfibm + +contains + + + !> Default constructor for direct forcing solver + function constructor(cfg,name) result(self) + implicit none + type(dfibm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate VF and src arrays on cfg mesh + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + + ! Initialize object + self%can_move=.false. + self%nobj=0 + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Setup IBM objects, each processors own all objects + subroutine setup_obj(this) + use mpi_f08, only : MPI_MAX,MPI_INTEGER + implicit none + class(dfibm), intent(inout) :: this + integer :: i,n,ibuf,ierr + + ! Determine number of objects based on marker ID + n=0 + do i=1,this%np_ + n=max(n,int(this%p(i)%id)) + end do + call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate and zero out the object array + allocate(this%o(1:this%nobj)) + do i=1,this%nobj + this%o(i)%pos=0.0_WP + this%o(i)%vel=0.0_WP + this%o(i)%angVel=0.0_WP + this%o(i)%F=0.0_WP + end do + + end subroutine setup_obj + + + !> Compute direct forcing source by a specified time step dt + subroutine get_source(this,dt,U,V,W) + use mpi_f08, only : MPI_SUM,MPI_INTEGER + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: dV + real(WP), dimension(3) :: vel,src + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + + ! Zero-out forces on objects + do i=1,this%nobj + this%o(i)%F=0.0_WP + end do + + ! Advance the equations + do i=1,this%np_ + ! Interpolate the velocity to the particle location + vel=0.0_WP + if (this%cfg%nx.gt.1) call this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(1),dir='U') + if (this%cfg%ny.gt.1) call this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(2),dir='V') + if (this%cfg%nz.gt.1) call this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(3),dir='W') + ! Compute the source term + src=(this%p(i)%vel-vel) + ! Get element volume + dV = this%p(i)%dA * sqrt( & + (this%cfg%dxm(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + ! Send source term back to the mesh + if (this%cfg%nx.gt.1) call this%extrapolate(A=this%srcU,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(1)*dV,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(A=this%srcV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(2)*dV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(A=this%srcW,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(3)*dV,dir='W') + end do + + ! Sum at boundaries + call this%cfg%syncsum(this%srcU) + call this%cfg%syncsum(this%srcV) + call this%cfg%syncsum(this%srcW) + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end subroutine get_source + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i + real(WP) :: dV + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Get element volume + dV = this%p(i)%dA * sqrt( & + (this%cfg%dxm(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + ! Transfer volume to mesh + call this%extrapolate(A=this%VF,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=dV,dir='SC') + end do + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + end subroutine update_VF + + + !> Compute regularized delta function + subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(out) :: delta !< Return delta function + integer, intent(in) :: ic,jc,kc !< Cell index + real(WP), intent(in) :: xp,yp,zp !< Position of marker particle + character(len=*) :: dir + real(WP) :: deltax,deltay,deltaz,r + + ! Compute in X + if (trim(adjustl(dir)).eq.'U') then + r = (xp-this%cfg%x(ic))*this%cfg%dxmi(ic) + deltax = roma_kernel(r)*this%cfg%dxmi(ic) + else + r = (xp-this%cfg%xm(ic))*this%cfg%dxi(ic) + deltax = roma_kernel(r)*this%cfg%dxi(ic) + end if + + ! Compute in Y + if (trim(adjustl(dir)).eq.'V') then + r = (yp-this%cfg%y(jc))*this%cfg%dymi(jc) + deltay = roma_kernel(r)*this%cfg%dymi(jc) + else + r = (yp-this%cfg%ym(jc))*this%cfg%dyi(jc) + deltay = roma_kernel(r)*this%cfg%dyi(jc) + end if + + ! Compute in Z + if (trim(adjustl(dir)).eq.'W') then + r = (zp-this%cfg%z(kc))*this%cfg%dzmi(kc) + deltaz = roma_kernel(r)*this%cfg%dzmi(kc) + else + r = (zp-this%cfg%zm(kc))*this%cfg%dzi(kc) + deltaz = roma_kernel(r)*this%cfg%dzi(kc) + end if + + ! Put it all together + delta=deltax*deltay*deltaz + + contains + ! Mollification kernel + ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 + function roma_kernel(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + if (abs(r).le.0.5_WP) then + phi = 1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) + else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then + phi = 1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + else + phi = 0.0_WP + end if + end function roma_kernel + + end subroutine get_delta + + + !> Interpolation routine + subroutine interpolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(out) :: Ap + character(len=*) :: dir + integer :: di,dj,dk + integer :: i1,i2,j1,j2,k1,k2 + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + + ! Get the interpolation points + i1=ip-2; i2=ip+2 + j1=jp-2; j2=jp+2 + k1=kp-2; k2=kp+2 + + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + + ! Perform the actual interpolation on Ap + Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) + + end subroutine interpolate + + + !> Extrapolation routine + subroutine extrapolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) + use messager, only: die + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(in) :: Ap + character(len=*) :: dir + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + integer :: di,dj,dk + + ! If particle has left processor domain or reached last ghost cell, kill job + if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& + jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& + kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then + write(*,*) ip,jp,kp,xp,yp,zp + call die('[df extrapolate] Particle has left the domain') + end if + + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + + ! Perform the actual extrapolation on A + A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap + + end subroutine extrapolate + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z + + ! Return if not used + if (.not.this%can_move) then + cfl=0.0_WP + return + end if + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxmi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dymi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzmi(this%p(i)%ind(3))) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Get mean, max, and min volume fraction + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(dfibm), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(dfibm), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(dfibm), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if + end if + end subroutine resize + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(dfibm), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do + end if + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header + if (this%cfg%amRoot) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) + end if + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + +end module df_class From 563b1d0f0d6cb9290884d5b33c9bc595ca35476d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 23 Dec 2022 16:03:35 -0500 Subject: [PATCH 034/152] direct forcing update Make ID integer not integer8, unlikely we'll have THAT many IBM objects --- examples/ibm_tester/src/simulation.f90 | 2 +- src/immersed/df_class.f90 | 13 ++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 index a82006fcd..91dbf9ef1 100644 --- a/examples/ibm_tester/src/simulation.f90 +++ b/examples/ibm_tester/src/simulation.f90 @@ -136,7 +136,7 @@ subroutine simulation_init ! Distribute marker particles do i=1,np ! Set various parameters for the marker - df%p(i)%id =int(1,kind=8) + df%p(i)%id =1 df%p(i)%vel =0.0_WP ! Set position theta=real(i-1,WP)*twoPi/real(np,WP) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 7f158f870..9d60d1b35 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -23,21 +23,20 @@ module df_class !> Basic marker particle definition type :: part - !> MPI_INTEGER8 data - integer(kind=8) :: id !< Particle ID !> MPI_DOUBLE_PRECISION data real(WP) :: dA !< Element area real(WP), dimension(3) :: norm !< Outward normal vector real(WP), dimension(3) :: pos !< Particle center coordinates real(WP), dimension(3) :: vel !< Velocity of particle !> MPI_INTEGER data + integer :: id !< ID the object is associated with integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) end type part !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=3 - integer , dimension(part_nblock) :: part_lblock=[1,10,4] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] + integer, parameter :: part_nblock=2 + integer , dimension(part_nblock) :: part_lblock=[10,5] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] !> MPI_PART derived datatype and size type(MPI_Datatype) :: MPI_PART integer :: MPI_PART_SIZE @@ -179,7 +178,7 @@ subroutine setup_obj(this) ! Determine number of objects based on marker ID n=0 do i=1,this%np_ - n=max(n,int(this%p(i)%id)) + n=max(n,this%p(i)%id) end do call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) From bdba18b2843d4425695e5bd23afd5a7bade6a106 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 23 Dec 2022 16:36:59 -0500 Subject: [PATCH 035/152] Update mathtools.f90 Added safe arctan function --- src/libraries/mathtools.f90 | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/libraries/mathtools.f90 b/src/libraries/mathtools.f90 index 2b18578e1..94c11b56e 100644 --- a/src/libraries/mathtools.f90 +++ b/src/libraries/mathtools.f90 @@ -10,6 +10,7 @@ module mathtools public :: cross_product public :: normalize public :: qrotate + public :: arctan ! Trigonometric parameters real(WP), parameter :: Pi =3.1415926535897932385_WP @@ -146,7 +147,25 @@ pure function qrotate(v,q) result(w) w(3)= 2.0_WP*(q(2)*q(4)-q(1)*q(3)) *v(1)+& & 2.0_WP*(q(3)*q(4)+q(1)*q(2)) *v(2)+& & (2.0_WP*(q(1)*q(1)+q(4)*q(4))-1.0_WP)*v(3) - end function + end function qrotate + + + ! Safe arctan + function arctan(dx,dy) + implicit none + real(WP), intent(in) :: dx,dy + real(WP) :: arctan + if (abs(dx)+abs(dy).lt.1.0e-9_WP) then + arctan = 0.0_WP + else + arctan = atan(dy/dx) + end if + if (dx.le.0.0_WP) then + arctan = Pi+arctan + elseif (dy.le.0.0_WP .and. dx.gt.0.0_WP) then + arctan = twoPi+arctan + end if + end function arctan end module mathtools From ea4b12b0a1ea1d957ba1de9b3fef1c585f9b1c9d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 23 Dec 2022 16:37:35 -0500 Subject: [PATCH 036/152] Update df_class.f90 Added levelset array to direct forcing class. This is only used for visualization and eventually collision detection with LPT --- src/immersed/df_class.f90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 9d60d1b35..197965c66 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -93,6 +93,9 @@ module df_class real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + ! Levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: levelset !< Levelset, cell-centered + contains procedure :: update_partmesh !< Update a partmesh object using current particles procedure :: setup_obj !< Setup IBM object @@ -141,11 +144,12 @@ function constructor(cfg,name) result(self) ! Initialize MPI derived datatype for a particle call prepare_mpi_part() - ! Allocate VF and src arrays on cfg mesh - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + ! Allocate levelset, VF and src arrays on cfg mesh + allocate(self%levelset(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%levelset=huge(1.0_WP) + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP ! Initialize object self%can_move=.false. From 620e9f7ea86d0d9a4bd5baaf2cbc6def0a7b520a Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 25 Dec 2022 09:46:26 -0500 Subject: [PATCH 037/152] Update df_class.f90 cleanup --- src/immersed/df_class.f90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 197965c66..bab7fb677 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -1,10 +1,9 @@ -!> Basicdirect forcing IBM class: +!> Basic direct forcing IBM class: !> Provides support for Lagrangian marker particles module df_class use precision, only: WP use string, only: str_medium use config_class, only: config - use diag_class, only: diag use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION implicit none private @@ -57,8 +56,6 @@ module df_class ! This is our underlying config class(config), pointer :: cfg !< This is the config the solver is build for - type(diag) :: tridiag !< Tridiagonal solver for implicit filter - ! This is the name of the solver character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM From 9d3b0bee6ffd7916e30febef5fcf65164d21d79f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 25 Dec 2022 12:35:37 -0500 Subject: [PATCH 038/152] IBM update Added force computation acting on each 'object' and changes interpolation subroutine to be a function --- examples/ibm_tester/src/simulation.f90 | 39 +++++++---- src/immersed/df_class.f90 | 90 ++++++++++++++------------ 2 files changed, 78 insertions(+), 51 deletions(-) diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 index 91dbf9ef1..7ef4eed34 100644 --- a/examples/ibm_tester/src/simulation.f90 +++ b/examples/ibm_tester/src/simulation.f90 @@ -119,8 +119,8 @@ subroutine simulation_init ! Initialize our direct forcing solver initialize_df: block - use mathtools, only: twoPi - integer :: i,np + use mathtools, only: twoPi,arctan + integer :: i,j,k,np real(WP) :: Dcyl,Xcyl,amp,freq,theta,r ! Create solver df=dfibm(cfg=cfg,name='IBM') @@ -164,6 +164,18 @@ subroutine simulation_init ! All processes initialize IBM objects call df%setup_obj() + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%levelset(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r + end do + end do + end do + call df%cfg%sync(df%levelset) + if (df%cfg%amRoot) then print*,"===== Direct Forcing Setup Description =====" print*,'Number of marker particles', df%np @@ -219,9 +231,10 @@ subroutine simulation_init ens_evt=event(time=time,name='Ensight output') call param_read('Ensight output period',ens_evt%tper) ! Add variables to output - call ens_out%add_particle('particles',pmesh) + call ens_out%add_particle('markers',pmesh) call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('VF',df%VF) + call ens_out%add_scalar('levelset',df%levelset) call ens_out%add_scalar('pressure',fs%P) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) @@ -264,13 +277,16 @@ subroutine simulation_init call ibmfile%add_column(time%t,'Time') call ibmfile%add_column(df%VFmin,'VF min') call ibmfile%add_column(df%VFmax,'VF max') - call ibmfile%add_column(df%np,'Particle number') - call ibmfile%add_column(df%Umin,'Particle Umin') - call ibmfile%add_column(df%Umax,'Particle Umax') - call ibmfile%add_column(df%Vmin,'Particle Vmin') - call ibmfile%add_column(df%Vmax,'Particle Vmax') - call ibmfile%add_column(df%Wmin,'Particle Wmin') - call ibmfile%add_column(df%Wmax,'Particle Wmax') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') call ibmfile%write() end block create_monitor @@ -322,7 +338,8 @@ subroutine simulation_run ! Add momentum source term from direct forcing ibm_correction: block integer :: i,j,k - call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + resU=fs%rho + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index bab7fb677..2e128ced3 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -81,6 +81,7 @@ module df_class real(WP) :: Umin,Umax,Umean !< U velocity info real(WP) :: Vmin,Vmax,Vmean !< V velocity info real(WP) :: Wmin,Wmax,Wmean !< W velocity info + real(WP) :: Fx,Fy,Fz !< Total force ! Volume fraction associated with IBM projection real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered @@ -175,14 +176,12 @@ subroutine setup_obj(this) implicit none class(dfibm), intent(inout) :: this integer :: i,n,ibuf,ierr - ! Determine number of objects based on marker ID - n=0 + n=1 do i=1,this%np_ n=max(n,this%p(i)%id) end do call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - ! Allocate and zero out the object array allocate(this%o(1:this%nobj)) do i=1,this%nobj @@ -191,22 +190,23 @@ subroutine setup_obj(this) this%o(i)%angVel=0.0_WP this%o(i)%F=0.0_WP end do - end subroutine setup_obj - + !> Compute direct forcing source by a specified time step dt - subroutine get_source(this,dt,U,V,W) - use mpi_f08, only : MPI_SUM,MPI_INTEGER + subroutine get_source(this,dt,U,V,W,rho) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP use mathtools, only: Pi implicit none class(dfibm), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,ierr - real(WP) :: dV + real(WP) :: dti,rho_,dV real(WP), dimension(3) :: vel,src ! Zero out source term arrays @@ -220,15 +220,18 @@ subroutine get_source(this,dt,U,V,W) end do ! Advance the equations + dti=1.0_WP/dt do i=1,this%np_ ! Interpolate the velocity to the particle location vel=0.0_WP - if (this%cfg%nx.gt.1) call this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(1),dir='U') - if (this%cfg%ny.gt.1) call this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(2),dir='V') - if (this%cfg%nz.gt.1) call this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=vel(3),dir='W') + if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') + if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') + if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') + rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') ! Compute the source term src=(this%p(i)%vel-vel) ! Get element volume @@ -237,12 +240,15 @@ subroutine get_source(this,dt,U,V,W) (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) ! Send source term back to the mesh - if (this%cfg%nx.gt.1) call this%extrapolate(A=this%srcU,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(1)*dV,dir='U') - if (this%cfg%ny.gt.1) call this%extrapolate(A=this%srcV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(2)*dV,dir='V') - if (this%cfg%nz.gt.1) call this%extrapolate(A=this%srcW,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=src(3)*dV,dir='W') + if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') + ! Sum up force on object (Newton's 3rd law) + j=max(this%p(i)%id,1) + this%o(j)%F=this%o(j)%F-rho_*src*dV*dti end do ! Sum at boundaries @@ -250,6 +256,11 @@ subroutine get_source(this,dt,U,V,W) call this%cfg%syncsum(this%srcV) call this%cfg%syncsum(this%srcW) + ! Sum over each object + do j=1,this%nobj + call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src + end do + ! Recompute volume fraction call this%update_VF() @@ -289,8 +300,8 @@ subroutine update_VF(this) (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) ! Transfer volume to mesh - call this%extrapolate(A=this%VF,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),Ap=dV,dir='SC') + call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') end do ! Sum at boundaries call this%cfg%syncsum(this%VF) @@ -303,7 +314,7 @@ subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) class(dfibm), intent(inout) :: this real(WP), intent(out) :: delta !< Return delta function integer, intent(in) :: ic,jc,kc !< Cell index - real(WP), intent(in) :: xp,yp,zp !< Position of marker particle + real(WP), intent(in) :: xp,yp,zp !< Position of marker character(len=*) :: dir real(WP) :: deltax,deltay,deltaz,r @@ -357,23 +368,21 @@ end subroutine get_delta !> Interpolation routine - subroutine interpolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) + function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) implicit none class(dfibm), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), intent(in) :: xp,yp,zp integer, intent(in) :: ip,jp,kp - real(WP), intent(out) :: Ap character(len=*) :: dir + real(WP) :: Ap integer :: di,dj,dk integer :: i1,i2,j1,j2,k1,k2 real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - ! Get the interpolation points i1=ip-2; i2=ip+2 j1=jp-2; j2=jp+2 k1=kp-2; k2=kp+2 - ! Loop over neighboring cells and compute regularized delta function do dk=-2,+2 do dj=-2,+2 @@ -382,26 +391,23 @@ subroutine interpolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) end do end do end do - ! Perform the actual interpolation on Ap Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) - - end subroutine interpolate + end function interpolate !> Extrapolation routine - subroutine extrapolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) + subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) use messager, only: die implicit none class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), intent(in) :: xp,yp,zp integer, intent(in) :: ip,jp,kp real(WP), intent(in) :: Ap character(len=*) :: dir real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta integer :: di,dj,dk - ! If particle has left processor domain or reached last ghost cell, kill job if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& @@ -409,7 +415,6 @@ subroutine extrapolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) write(*,*) ip,jp,kp,xp,yp,zp call die('[df extrapolate] Particle has left the domain') end if - ! Loop over neighboring cells and compute regularized delta function do dk=-2,+2 do dj=-2,+2 @@ -418,10 +423,8 @@ subroutine extrapolate(this,A,xp,yp,zp,ip,jp,kp,Ap,dir) end do end do end do - ! Perform the actual extrapolation on A A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap - end subroutine extrapolate @@ -493,22 +496,29 @@ subroutine get_max(this) call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - ! Get mean, max, and min volume fraction + ! Get mean, max, and min volume fraction and total force this%VFmean=0.0_WP this%VFmax =-huge(1.0_WP) this%VFmin =+huge(1.0_WP) + this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) this%VFmax =max(this%VFmax,this%VF(i,j,k)) this%VFmin =min(this%VFmin,this%VF(i,j,k)) + this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) + this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) + this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) end do end do end do call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total end subroutine get_max From ab9668a30cd87e645a13aafc501d0b8fb1dd13da Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 25 Dec 2022 21:58:05 -0500 Subject: [PATCH 039/152] LPT and DF update CFLs for particles should be based on dx not dxm --- src/immersed/df_class.f90 | 18 +++++++++--------- src/particles/lpt_class.f90 | 12 ++++++------ 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 2e128ced3..66cb13e5d 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -236,9 +236,9 @@ subroutine get_source(this,dt,U,V,W,rho) src=(this%p(i)%vel-vel) ! Get element volume dV = this%p(i)%dA * sqrt( & - (this%cfg%dxm(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) ! Send source term back to the mesh if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') @@ -296,9 +296,9 @@ subroutine update_VF(this) if (this%p(i)%flag.eq.1) cycle ! Get element volume dV = this%p(i)%dA * sqrt( & - (this%cfg%dxm(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dym(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dzm(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) ! Transfer volume to mesh call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') @@ -448,9 +448,9 @@ subroutine get_cfl(this,dt,cfl) ! Set the CFLs to zero my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxmi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dymi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzmi(this%p(i)%ind(3))) + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) end do my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 9fb17deed..ab6bcf64b 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -657,7 +657,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcU,bc='n') if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcV,bc='n') if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcW,bc='n') - call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcE,bc='n') + !call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcE,bc='n') ! Increment dt_done=dt_done+mydt end do @@ -687,7 +687,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) - this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) + !this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) ! Recompute volume fraction call this%update_VF() @@ -745,7 +745,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') ! Interpolate the fluid vorticity to the particle location if needed - if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) end block interpolate ! Compute acceleration due to drag @@ -1151,9 +1151,9 @@ subroutine get_cfl(this,dt,cfl) ! Set the CFLs to zero my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP; my_CFL_col=0.0_WP do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxmi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dymi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzmi(this%p(i)%ind(3))) + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) my_CFL_col=max(my_CFL_col,sqrt(sum(this%p(i)%vel**2))/this%p(i)%d) end do my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt From 90577ffb3827e8c7973750e3e98be7fae852878f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 29 Dec 2022 16:27:58 -0500 Subject: [PATCH 040/152] Update simulation.f90 Important to sync U after adding IBM correction --- examples/ibm_tester/src/simulation.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 index 7ef4eed34..ebb411db4 100644 --- a/examples/ibm_tester/src/simulation.f90 +++ b/examples/ibm_tester/src/simulation.f90 @@ -26,8 +26,7 @@ module simulation type(event) :: ens_evt !> Simulation monitor file - type(monitor) :: mfile,cflfile - type(monitor) :: ibmfile + type(monitor) :: mfile,cflfile,ibmfile public :: simulation_init,simulation_run,simulation_final @@ -295,7 +294,6 @@ end subroutine simulation_init !> Perform an NGA2 simulation subroutine simulation_run - use mathtools, only: twoPi implicit none ! Perform time integration @@ -349,6 +347,9 @@ subroutine simulation_run end do end do end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) end block ibm_correction ! Apply other boundary conditions on the resulting fields From 057fa6cd932bbac13031899b7599c799aa641d2d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 29 Dec 2022 22:58:47 -0500 Subject: [PATCH 041/152] Update df_class.f90 Calculate center of mass and volume of each IBM object based on marker location and size. Does not work when object crosses a periodic boundary! --- src/immersed/df_class.f90 | 45 +++++++++++++++++++++++++++++++++------ 1 file changed, 39 insertions(+), 6 deletions(-) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 66cb13e5d..764385a93 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -168,14 +168,18 @@ function constructor(cfg,name) result(self) end block logging end function constructor - - + + !> Setup IBM objects, each processors own all objects subroutine setup_obj(this) - use mpi_f08, only : MPI_MAX,MPI_INTEGER + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi implicit none class(dfibm), intent(inout) :: this - integer :: i,n,ibuf,ierr + integer :: i,j,n,ibuf,ierr + real(WP) :: myVol,dV,fac + real(WP), dimension(3) :: pos0,dist ! Determine number of objects based on marker ID n=1 do i=1,this%np_ @@ -184,15 +188,44 @@ subroutine setup_obj(this) call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) ! Allocate and zero out the object array allocate(this%o(1:this%nobj)) + if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then + fac=1.0_WP/3.0_WP + else + fac=1.0_WP/2.0_WP + end if do i=1,this%nobj + ! Zero-out object properties this%o(i)%pos=0.0_WP this%o(i)%vel=0.0_WP this%o(i)%angVel=0.0_WP this%o(i)%F=0.0_WP + ! Compute center of mass + myVol=0.0_WP + do j=1,this%np_ + ! Determine particle associated with object + if (this%p(j)%id.eq.i) then + myVol=myVol+this%p(j)%dA + this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV + ! Determine object volume + myVol=0.0_WP + do j=1,this%np_ + if (this%p(j)%id.eq.i) then + dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) + if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) + if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) + if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) + myVol=myVol+fac*sum(dist)*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV end do end subroutine setup_obj - - + + !> Compute direct forcing source by a specified time step dt subroutine get_source(this,dt,U,V,W,rho) use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE From 5705bd5ffc387020f9be63a81289be2e3c7c3abf Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 31 Dec 2022 14:25:27 -0500 Subject: [PATCH 042/152] Rename variable To be consistent with other classes --- examples/ibm_tester/src/simulation.f90 | 6 +++--- src/immersed/df_class.f90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 index ebb411db4..75e95fa38 100644 --- a/examples/ibm_tester/src/simulation.f90 +++ b/examples/ibm_tester/src/simulation.f90 @@ -169,11 +169,11 @@ subroutine simulation_init do i=df%cfg%imin_,df%cfg%imax_ theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) r=0.5_WP*Dcyl+amp*sin(freq*theta) - df%levelset(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r + df%F(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r end do end do end do - call df%cfg%sync(df%levelset) + call df%cfg%sync(df%G) if (df%cfg%amRoot) then print*,"===== Direct Forcing Setup Description =====" @@ -233,7 +233,7 @@ subroutine simulation_init call ens_out%add_particle('markers',pmesh) call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('VF',df%VF) - call ens_out%add_scalar('levelset',df%levelset) + call ens_out%add_scalar('levelset',df%G) call ens_out%add_scalar('pressure',fs%P) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 764385a93..36d6b4ae1 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -91,8 +91,8 @@ module df_class real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - ! Levelset for visualization and collision detection - real(WP), dimension(:,:,:), allocatable :: levelset !< Levelset, cell-centered + ! Distance levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered contains procedure :: update_partmesh !< Update a partmesh object using current particles @@ -143,7 +143,7 @@ function constructor(cfg,name) result(self) call prepare_mpi_part() ! Allocate levelset, VF and src arrays on cfg mesh - allocate(self%levelset(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%levelset=huge(1.0_WP) + allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP From 55478fdcbc6cd653bf0d8c27ad51645222666f0d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 31 Dec 2022 14:27:07 -0500 Subject: [PATCH 043/152] Simple IB pipe case A very simple implementation of pipe flow using a direct forcing-type scheme. --- examples/ib_pipe/README | 2 + examples/ib_pipe/input | 34 +++ examples/ib_pipe/src/Make.package | 2 + examples/ib_pipe/src/geometry.f90 | 76 ++++++ examples/ib_pipe/src/simulation.f90 | 365 ++++++++++++++++++++++++++++ 5 files changed, 479 insertions(+) create mode 100644 examples/ib_pipe/README create mode 100644 examples/ib_pipe/input create mode 100644 examples/ib_pipe/src/Make.package create mode 100644 examples/ib_pipe/src/geometry.f90 create mode 100644 examples/ib_pipe/src/simulation.f90 diff --git a/examples/ib_pipe/README b/examples/ib_pipe/README new file mode 100644 index 000000000..2b14326d8 --- /dev/null +++ b/examples/ib_pipe/README @@ -0,0 +1,2 @@ +Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: +Atmani, H., Zamansky, R., Climent, E., & Legendre, D. (2022). Stochastic wall model for turbulent pipe flow using Immersed Boundary Method and Large Eddy Simulation. Computers & Fluids. diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input new file mode 100644 index 000000000..1c95eebd5 --- /dev/null +++ b/examples/ib_pipe/input @@ -0,0 +1,34 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 4 +Ly : 1.5 +Lz : 0.015625 +nx : 256 +ny : 96 +nz : 1 + +# Pipe properties +Pipe diameter : 1 +Target velocity : 1 + +# Time integration +Max timestep size : 0.008 +Max cfl number : 0.9 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : .001 +Density : 1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 \ No newline at end of file diff --git a/examples/ib_pipe/src/Make.package b/examples/ib_pipe/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_pipe/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 new file mode 100644 index 000000000..331e0bc44 --- /dev/null +++ b/examples/ib_pipe/src/geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 new file mode 100644 index 000000000..13c14daef --- /dev/null +++ b/examples/ib_pipe/src/simulation.f90 @@ -0,0 +1,365 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G,VF + real(WP) :: target_velocity,Umean,Dpipe + +contains + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + real(WP) :: visc + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + integer :: i,j,k + ! Initial fields + call param_read('Pipe diameter',Dpipe) + call param_read('Target velocity',target_velocity) + fs%U=target_velocity; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + call fs%cfg%sync(VF) + call fs%cfg%sync(G) + end block initialize_ibm + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',VF) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call get_Umean + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(Umean,'Umean') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + VFx =get_VF(i,j,k,'U') + VFy =get_VF(i,j,k,'V') + VFz =get_VF(i,j,k,'W') + fs%U(i,j,k)=VFx*fs%U(i,j,k) + fs%V(i,j,k)=VFy*fs%V(i,j,k) + fs%W(i,j,k)=VFz*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + call fs%cfg%sync(VF) + end block ibm_correction + + ! Enforce constant mass flow rate + mfr_correction: block + integer :: i,j,k + real(WP) :: VFx + ! Add forcing + call get_Umean + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + fs%U(i,j,k)=fs%U(i,j,k)+Vfx*(target_velocity-Umean) + end do + end do + end do + call fs%cfg%sync(fs%U) + end block mfr_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call get_Umean + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + case('V') + delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r + case('W') + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r + case default + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta))) + end function get_VF + + + !> Calculate mean velocity + subroutine get_Umean + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + real(WP) :: VFx,myVol,vol + integer :: i,j,k,ierr + Umean=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + myVol=myVol+fs%cfg%vol(i,j,k)*VFx + Umean=Umean+fs%cfg%vol(i,j,k)*VFx*fs%U(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(myVol,vol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(Umean,myVol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=myVol/vol + end subroutine get_Umean + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation From c4645dabe5ffa330d18591f87fce42be7145493c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 31 Dec 2022 14:36:46 -0500 Subject: [PATCH 044/152] Add fluctuations to pipe Basic idea, this can be improved --- examples/ib_pipe/input | 1 + examples/ib_pipe/src/simulation.f90 | 19 ++++++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 1c95eebd5..59be7ad9a 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -12,6 +12,7 @@ nz : 1 # Pipe properties Pipe diameter : 1 Target velocity : 1 +Fluctuation amp : 0.2 # Time integration Max timestep size : 0.008 diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 13c14daef..bfbc173da 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -91,11 +91,28 @@ subroutine simulation_init ! Initialize our velocity field initialize_velocity: block use mathtools, only: twoPi + use random, only: random_uniform integer :: i,j,k + real(WP) :: amp ! Initial fields call param_read('Pipe diameter',Dpipe) call param_read('Target velocity',target_velocity) - fs%U=target_velocity; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + call param_read('Fluctuation amp',amp,default=0.0_WP) + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=target_velocity*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) + fs%V(i,j,k)=target_velocity*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) + fs%U(i,j,k)=fs%U(i,j,k)+amp*target_velocity*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+amp*target_velocity*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) ! Compute cell-centered velocity call fs%interp_vel(Ui,Vi,Wi) ! Compute divergence From 85bd226437b8784be58b7be818760df306d88e85 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 31 Dec 2022 18:41:44 -0500 Subject: [PATCH 045/152] ib_pipe updates Small edits to ib pipe case --- examples/ib_pipe/input | 6 ++---- examples/ib_pipe/src/geometry.f90 | 27 +++++++++++++++++++++------ examples/ib_pipe/src/simulation.f90 | 2 +- 3 files changed, 24 insertions(+), 11 deletions(-) diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 59be7ad9a..29618aca0 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -2,15 +2,13 @@ Partition : 4 1 1 # Mesh definition -Lx : 4 -Ly : 1.5 -Lz : 0.015625 +Pipe diameter : 1 +Pipe length : 4 nx : 256 ny : 96 nz : 1 # Pipe properties -Pipe diameter : 1 Target velocity : 1 Fluctuation amp : 0.2 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 331e0bc44..27a956cad 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -24,15 +24,30 @@ subroutine geometry_init ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,D,dx real(WP), dimension(:), allocatable :: x,y,z ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) - + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + ! Create simple rectilinear grid do i=1,nx+1 x(i)=real(i-1,WP)/real(nx,WP)*Lx diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index bfbc173da..2c25d3d6b 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -339,7 +339,7 @@ function get_VF(i,j,k,dir) result(VF) r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta))) end function get_VF From 12523ebf18b550502267a13139784dc7f860be40 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 1 Jan 2023 15:32:40 -0500 Subject: [PATCH 046/152] Update README proper reference --- examples/ib_pipe/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/ib_pipe/README b/examples/ib_pipe/README index 2b14326d8..ba28b9a69 100644 --- a/examples/ib_pipe/README +++ b/examples/ib_pipe/README @@ -1,2 +1,2 @@ Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: -Atmani, H., Zamansky, R., Climent, E., & Legendre, D. (2022). Stochastic wall model for turbulent pipe flow using Immersed Boundary Method and Large Eddy Simulation. Computers & Fluids. +Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. From 0328a0087315cefe4e16dcf039beceabd13ffded Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 2 Jan 2023 17:03:51 -0500 Subject: [PATCH 047/152] Part_inject makefil Makefile for part.inject requires updating .gitignore --- .gitignore | 2 +- examples/part_inject/GNUmakefile | 50 ++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 1 deletion(-) create mode 100644 examples/part_inject/GNUmakefile diff --git a/.gitignore b/.gitignore index 48d591885..31ec775b7 100644 --- a/.gitignore +++ b/.gitignore @@ -39,7 +39,7 @@ stat/ # Ignore all content of examples examples/*/* -examples/*/GNUmakefile +!examples/*/GNUmakefile !examples/*/input* examples/*/input*~ !examples/*/README diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile new file mode 100644 index 000000000..d155cf16e --- /dev/null +++ b/examples/part_inject/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = TRUE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +#HDF5_DIR = /Users/desjardi/Builds/hdf5 +LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre +IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules From b78a1f39254af2d795f63d50d1e193e970446913 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 2 Jan 2023 17:25:11 -0500 Subject: [PATCH 048/152] Update GNUmakefile part_inject does not require IRL --- examples/part_inject/GNUmakefile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile index d155cf16e..071153a99 100644 --- a/examples/part_inject/GNUmakefile +++ b/examples/part_inject/GNUmakefile @@ -6,7 +6,7 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE -USE_IRL = TRUE +USE_IRL = FALSE PROFILE = TRUE DEBUG = FALSE COMP = gnu @@ -26,7 +26,6 @@ VPATH_LOCATIONS += $(Ulocs) #HDF5_DIR = /Users/desjardi/Builds/hdf5 LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre -IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs From 042b2501c495f81c1d58a36943666812ac0981df Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 3 Jan 2023 17:41:23 -0500 Subject: [PATCH 049/152] Update simulation.f90 Added timers to fluidized bed case, might be handy later on --- examples/fluidized_bed/src/simulation.f90 | 43 ++++++++++++++++++++--- 1 file changed, 39 insertions(+), 4 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 6143271b9..f7548be58 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -23,8 +23,7 @@ module simulation type(event) :: ens_evt !> Simulation monitor file - type(monitor) :: mfile,cflfile - type(monitor) :: lptfile + type(monitor) :: mfile,cflfile,lptfile,tfile public :: simulation_init,simulation_run,simulation_final @@ -33,6 +32,10 @@ module simulation real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP) :: visc,rho,inlet_velocity + !> Wallclock time for monitor + real(WP) :: wt_total,wt_time,wt_fs,wt_lpt,wt_rest + real(WP) :: wt_fs_pct,wt_lpt_pct,wt_rest_pct + contains @@ -244,7 +247,7 @@ subroutine simulation_init call fs%get_mfr() end block initialize_velocity - + ! Add Ensight output create_ensight: block ! Create Ensight output from cfg @@ -261,7 +264,8 @@ subroutine simulation_init if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight - ! Create a monitor file + + ! Create monitor filea create_monitor: block ! Prepare some info about fields call fs%get_cfl(time%dt,time%cfl) @@ -310,6 +314,18 @@ subroutine simulation_init call lptfile%add_column(lp%dmin,'Particle dmin') call lptfile%add_column(lp%dmax,'Particle dmax') call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total,'Total [s]') + call tfile%add_column(wt_fs,'Flow solver [s]') + call tfile%add_column(wt_fs_pct,'Flow solver [%]') + call tfile%add_column(wt_lpt,'LPT [s]') + call tfile%add_column(wt_lpt_pct,'LPT [%]') + call tfile%add_column(wt_rest,'Rest [s]') + call tfile%add_column(wt_rest_pct,'Rest [%]') + call tfile%write() end block create_monitor end subroutine simulation_init @@ -318,16 +334,23 @@ end subroutine simulation_init !> Perform an NGA2 simulation subroutine simulation_run use mathtools, only: twoPi + use parallel, only: parallel_time implicit none + real(WP) :: wt,wti ! Perform time integration do while (.not.time%done()) + ! Initial wallclock time + wti=parallel_time() + ! Increment time + wt=parallel_time() call fs%get_cfl(time%dt,time%cfl) call lp%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() + wt_time=parallel_time()-wt ! Remember old density, velocity, and momentum fs%rhoold=fs%rho @@ -336,6 +359,7 @@ subroutine simulation_run fs%Wold=fs%W; fs%rhoWold=fs%rhoW ! Get fluid stress + wt=parallel_time() call fs%get_div_stress(resU,resV,resW) ! Collide and advance particles @@ -345,8 +369,10 @@ subroutine simulation_run ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt=parallel_time()-wt ! Perform sub-iterations + wt=parallel_time() do while (time%it.le.time%itmax) ! Build mid-time velocity and momentum @@ -429,6 +455,7 @@ subroutine simulation_run ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div(drhodt=dRHOdt) + wt_fs=parallel_time()-wt ! Output to ensight if (ens_evt%occurs()) then @@ -452,6 +479,14 @@ subroutine simulation_run call cflfile%write() call lptfile%write() + ! Monitor timing + wt_total=parallel_time()-wti + wt_fs_pct=wt_fs/wt_total*100.0_WP + wt_lpt_pct=wt_lpt/wt_total*100.0_WP + wt_rest=wt_total-wt_fs-wt_lpt + wt_rest_pct=wt_rest/wt_total*100.0_WP + call tfile%write() + end do end subroutine simulation_run From 4b3f51c594618714a4c7e8029aee1ba15a31be00 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 3 Jan 2023 18:05:24 -0500 Subject: [PATCH 050/152] Update simulation.f90 Slightly cleaner way to handle timing --- examples/fluidized_bed/src/simulation.f90 | 47 ++++++++++++----------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index f7548be58..f85be73b2 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -32,9 +32,13 @@ module simulation real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP) :: visc,rho,inlet_velocity - !> Wallclock time for monitor - real(WP) :: wt_total,wt_time,wt_fs,wt_lpt,wt_rest - real(WP) :: wt_fs_pct,wt_lpt_pct,wt_rest_pct + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_fs,wt_lpt,wt_rest contains @@ -318,13 +322,13 @@ subroutine simulation_init tfile=monitor(amroot=fs%cfg%amRoot,name='timing') call tfile%add_column(time%n,'Timestep number') call tfile%add_column(time%t,'Time') - call tfile%add_column(wt_total,'Total [s]') - call tfile%add_column(wt_fs,'Flow solver [s]') - call tfile%add_column(wt_fs_pct,'Flow solver [%]') - call tfile%add_column(wt_lpt,'LPT [s]') - call tfile%add_column(wt_lpt_pct,'LPT [%]') - call tfile%add_column(wt_rest,'Rest [s]') - call tfile%add_column(wt_rest_pct,'Rest [%]') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_fs%time,'Flow solver [s]') + call tfile%add_column(wt_fs%percent,'Flow solver [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') call tfile%write() end block create_monitor @@ -336,21 +340,18 @@ subroutine simulation_run use mathtools, only: twoPi use parallel, only: parallel_time implicit none - real(WP) :: wt,wti ! Perform time integration do while (.not.time%done()) ! Initial wallclock time - wti=parallel_time() + wt_total%time_in=parallel_time() ! Increment time - wt=parallel_time() call fs%get_cfl(time%dt,time%cfl) call lp%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() - wt_time=parallel_time()-wt ! Remember old density, velocity, and momentum fs%rhoold=fs%rho @@ -359,7 +360,7 @@ subroutine simulation_run fs%Wold=fs%W; fs%rhoWold=fs%rhoW ! Get fluid stress - wt=parallel_time() + wt_lpt%time_in=parallel_time() call fs%get_div_stress(resU,resV,resW) ! Collide and advance particles @@ -369,10 +370,10 @@ subroutine simulation_run ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - wt_lpt=parallel_time()-wt + wt_lpt%time=parallel_time()-wt_lpt%time_in ! Perform sub-iterations - wt=parallel_time() + wt_fs%time_in=parallel_time() do while (time%it.le.time%itmax) ! Build mid-time velocity and momentum @@ -455,7 +456,7 @@ subroutine simulation_run ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div(drhodt=dRHOdt) - wt_fs=parallel_time()-wt + wt_fs%time=parallel_time()-wt_fs%time_in ! Output to ensight if (ens_evt%occurs()) then @@ -480,11 +481,11 @@ subroutine simulation_run call lptfile%write() ! Monitor timing - wt_total=parallel_time()-wti - wt_fs_pct=wt_fs/wt_total*100.0_WP - wt_lpt_pct=wt_lpt/wt_total*100.0_WP - wt_rest=wt_total-wt_fs-wt_lpt - wt_rest_pct=wt_rest/wt_total*100.0_WP + wt_total%time=parallel_time()-wt_total%time_in + wt_fs%percent=wt_fs%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_fs%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP call tfile%write() end do From 65dd294773ffbc8e1825eefdb9993abb8f0f3b24 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 3 Jan 2023 18:34:23 -0500 Subject: [PATCH 051/152] Update simulation.f90 Time velocity and pressure separately. This can probably be written cleaner --- examples/fluidized_bed/src/simulation.f90 | 40 ++++++++++++++++++----- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index f85be73b2..cebe60889 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -38,7 +38,7 @@ module simulation real(WP) :: time real(WP) :: percent end type timer - type(timer) :: wt_total,wt_fs,wt_lpt,wt_rest + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest contains @@ -83,6 +83,16 @@ subroutine simulation_init end block initialize_timetracker + ! Initialize timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + ! Create a low Mach flow solver with bconds create_flow_solver: block use ils_class, only: pcg_pfmg,pcg_amg @@ -323,8 +333,10 @@ subroutine simulation_init call tfile%add_column(time%n,'Timestep number') call tfile%add_column(time%t,'Time') call tfile%add_column(wt_total%time,'Total [s]') - call tfile%add_column(wt_fs%time,'Flow solver [s]') - call tfile%add_column(wt_fs%percent,'Flow solver [%]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') call tfile%add_column(wt_lpt%time,'LPT [s]') call tfile%add_column(wt_lpt%percent,'LPT [%]') call tfile%add_column(wt_rest%time,'Rest [s]') @@ -370,12 +382,13 @@ subroutine simulation_run ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - wt_lpt%time=parallel_time()-wt_lpt%time_in + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in ! Perform sub-iterations - wt_fs%time_in=parallel_time() do while (time%it.le.time%itmax) + wt_vel%time_in=parallel_time() + ! Build mid-time velocity and momentum fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) @@ -432,7 +445,10 @@ subroutine simulation_run end do end block dirichlet_velocity + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + ! Solve Poisson equation + wt_pres%time_in=parallel_time() call fs%correct_mfr(drhodt=dRHOdt) call fs%get_div(drhodt=dRHOdt) fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid @@ -447,6 +463,7 @@ subroutine simulation_run fs%rhoV=fs%rhoV-time%dtmid*resV fs%rhoW=fs%rhoW-time%dtmid*resW call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in ! Increment sub-iteration counter time%it=time%it+1 @@ -454,9 +471,10 @@ subroutine simulation_run end do ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() call fs%interp_vel(Ui,Vi,Wi) call fs%get_div(drhodt=dRHOdt) - wt_fs%time=parallel_time()-wt_fs%time_in + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in ! Output to ensight if (ens_evt%occurs()) then @@ -482,11 +500,17 @@ subroutine simulation_run ! Monitor timing wt_total%time=parallel_time()-wt_total%time_in - wt_fs%percent=wt_fs%time/wt_total%time*100.0_WP + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP - wt_rest%time=wt_total%time-wt_fs%time-wt_lpt%time + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP end do From 319148b31c0c18efdde8e702c7fd8312654e6f59 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 3 Jan 2023 21:17:12 -0500 Subject: [PATCH 052/152] Update lpt_class.f90 Fixed a bug with the implicit filter. It is now working! --- src/particles/lpt_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index ab6bcf64b..9f2f5b454 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -853,7 +853,7 @@ subroutine filter(this,A) this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) - this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) + this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(0,i+1,j,k) this%tridiag%Rx(j,k,i) = A(i,j,k) end do end do @@ -865,7 +865,7 @@ subroutine filter(this,A) do i=this%cfg%imin_,this%cfg%imax_ this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & - + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) + + this%div_y(1,i,j,k) * filter_coeff * this%grd_y(-1,i,j+1,k)) this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) end do @@ -880,7 +880,7 @@ subroutine filter(this,A) this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) - this%tridiag% Rz(i,j,k) = this%tridiag%Ry(i,k,j) + this%tridiag%Rz(i,j,k) = this%tridiag%Ry(i,k,j) end do end do end do From 2f95259059a3ba9b43ab4e5a7cb1c713270a253c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 3 Jan 2023 22:30:45 -0500 Subject: [PATCH 053/152] LPT implicit filter now works and doesn't print warnings Store recbuf in buf to avoid annoying warnings. Also by default the implicit filter should be true, it is cheaper. --- src/particles/lpt_class.f90 | 4 ++-- src/solver/diag_class.f90 | 21 +++++++++++++++++---- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 9f2f5b454..350fb3246 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -191,8 +191,8 @@ function constructor(cfg,name) result(self) ! Set filter width to zero by default self%filter_width=0.0_WP - ! Solve explicitly by default - self%implicit_filter=.false. + ! Solve implicitly by default + self%implicit_filter=.true. ! Set default drag self%drag_model='Schiller-Naumann' diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index 3bb6e1f98..b671d7f84 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -201,6 +201,7 @@ subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) real(WP), dimension(:,:,:), allocatable :: recvbuf1 real(WP), dimension(:,:), allocatable :: recvbuf2 integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 ! Stuff integer :: i,igroup integer :: k1,L,k2,nk @@ -316,10 +317,22 @@ subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) ! Solve reduced systems if (.not.nper) then - call pentadiagonal_serial(& - recvbuf1(:,1,2:2*proc-1),recvbuf1(:,2,2:2*proc-1),recvbuf1(:,3,2:2*proc-1),& - recvbuf1(:,4,2:2*proc-1),recvbuf1(:,5,2:2*proc-1),recvbuf1(:,6,2:2*proc-1),& - 2*proc-2,nlot) + ! Store in buf to avoid creating a temporary array (there must be a better way to do this) + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,2:2*proc-1) + buf2=recvbuf1(:,2,2:2*proc-1) + buf3=recvbuf1(:,3,2:2*proc-1) + buf4=recvbuf1(:,4,2:2*proc-1) + buf5=recvbuf1(:,5,2:2*proc-1) + buf6=recvbuf1(:,6,2:2*proc-1) + call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) + recvbuf1(:,1,2:2*proc-1)=buf1 + recvbuf1(:,2,2:2*proc-1)=buf2 + recvbuf1(:,3,2:2*proc-1)=buf3 + recvbuf1(:,4,2:2*proc-1)=buf4 + recvbuf1(:,5,2:2*proc-1)=buf5 + recvbuf1(:,6,2:2*proc-1)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) else call pentadiagonal_periodic_serial(& recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& From cd0cbd4d7e69b4e678f04ddc7989d29ef5a61930 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 4 Jan 2023 11:00:11 -0500 Subject: [PATCH 054/152] Update lpt_class.f90 Nothing important. --- src/particles/lpt_class.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 350fb3246..90a9f3e21 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -893,8 +893,6 @@ subroutine filter(this,A) end do end do end do - ! Sync A - call this%cfg%sync(A) else !< Apply filter explicitly ! Allocate flux arrays allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) @@ -921,13 +919,14 @@ subroutine filter(this,A) end do end do end do - ! Sync A - call this%cfg%sync(A) end do ! Deallocate flux arrays deallocate(FX,FY,FZ) end if + ! Sync A + call this%cfg%sync(A) + end subroutine filter From 5780cd58c802f3773288de66a11f2f184336eb08 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 4 Jan 2023 16:49:53 -0500 Subject: [PATCH 055/152] LPT updates I prefer to have src terms as optional arguments in lpt_advance, this avoids us having to compute these terms if one-way coupled, and also allows us to eventually include sources for energy. Also reduced the inlet velocity in the fluidized bed test case to get proper bubbling. --- examples/fluidized_bed/input | 6 +-- examples/fluidized_bed/src/simulation.f90 | 15 ++++--- src/particles/lpt_class.f90 | 50 ++++++++++++----------- 3 files changed, 39 insertions(+), 32 deletions(-) diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index d2198ca7f..424988008 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 2 1 +Partition : 2 1 1 # Mesh definition Lx : .0256 @@ -18,12 +18,12 @@ Max time : 10 Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 -Inlet velocity : 0.2 +Inlet velocity : 0.1 # Particle parameters Bed height : .0128 Particle volume fraction : 0.5 -Coefficient of restitution : 0.9 +Coefficient of restitution : 0.8 Friction coefficient : 0.1 Particle density : 2600 Particle diameter : 200e-6 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index cebe60889..897c196a3 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -30,6 +30,7 @@ module simulation !> Work arrays and fluid properties real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp real(WP) :: visc,rho,inlet_velocity !> Wallclock time for monitoring @@ -126,6 +127,9 @@ subroutine simulation_init allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) @@ -377,7 +381,8 @@ subroutine simulation_run ! Collide and advance particles call lp%collide(dt=time%dtmid) - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) @@ -411,9 +416,9 @@ subroutine simulation_run do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*lp%srcU(i-1:i,j,k)) - resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*lp%srcV(i,j-1:j,k)) - resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*lp%srcW(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) end do end do end do @@ -528,7 +533,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi,dRHOdt) + deallocate(resU,resV,resW,srcUlp.srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt) end subroutine simulation_final diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 90a9f3e21..4765b6fd3 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -115,12 +115,6 @@ module lpt_class ! Particle volume fraction real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered - ! Filtering operation logical :: implicit_filter !< Solve implicitly real(WP) :: filter_width !< Characteristic filter width @@ -183,10 +177,6 @@ function constructor(cfg,name) result(self) ! Allocate VF and src arrays on cfg mesh allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP ! Set filter width to zero by default self%filter_width=0.0_WP @@ -591,7 +581,7 @@ end subroutine collide !> Advance the particle equations by a specified time step dt !> p%id=0 => no coll, no solve !> p%id=-1=> no coll, no move - subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T) + subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T,srcU,srcV,srcW,srcE) use mpi_f08, only : MPI_SUM,MPI_INTEGER use mathtools, only: Pi implicit none @@ -609,16 +599,20 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcE !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom type(part) :: myp,pold ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - this%srcE=0.0_WP + if (present(srcU)) srcU=0.0_WP + if (present(srcV)) srcV=0.0_WP + if (present(srcW)) srcW=0.0_WP + if (present(srcE)) srcE=0.0_WP ! Zero out number of particles removed this%np_out=0 @@ -654,10 +648,10 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Send source term back to the mesh dmom=mydt*acc*this%rho*Pi/6.0_WP*myp%d**3 deng=sum(dmom*myp%vel) - if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcU,bc='n') - if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcV,bc='n') - if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcW,bc='n') - !call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=this%srcE,bc='n') + if (this%cfg%nx.gt.1.and.present(srcU)) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcU,bc='n') + if (this%cfg%ny.gt.1.and.present(srcV)) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcV,bc='n') + if (this%cfg%nz.gt.1.and.present(srcW)) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcW,bc='n') + if (present(srcE)) call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcE,bc='n') ! Increment dt_done=dt_done+mydt end do @@ -683,11 +677,19 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Sum up particles removed call MPI_ALLREDUCE(this%np_out,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_out=i - ! Divide source arrays by volume, sum at boundaries, and volume filter - this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) - this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) - this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) - !this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) + ! Divide source arrays by volume, sum at boundaries, and volume filter if present + if (present(srcU)) then + srcU=srcU/this%cfg%vol; call this%cfg%syncsum(srcU); call this%filter(srcU) + end if + if (present(srcV)) then + srcV=srcV/this%cfg%vol; call this%cfg%syncsum(srcV); call this%filter(srcV) + end if + if (present(srcW)) then + srcW=srcW/this%cfg%vol; call this%cfg%syncsum(srcW); call this%filter(srcW) + end if + if (present(srcE)) then + srcE=srcE/this%cfg%vol; call this%cfg%syncsum(srcE); call this%filter(srcE) + end if ! Recompute volume fraction call this%update_VF() From 7a2b63e1cde9ddd137d42c56b4defe4c78869b7f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 4 Jan 2023 20:56:25 -0500 Subject: [PATCH 056/152] Delete matm_class.f90 --- src/compressible/matm_class.f90 | 541 -------------------------------- 1 file changed, 541 deletions(-) delete mode 100644 src/compressible/matm_class.f90 diff --git a/src/compressible/matm_class.f90 b/src/compressible/matm_class.f90 deleted file mode 100644 index 6a9c783f4..000000000 --- a/src/compressible/matm_class.f90 +++ /dev/null @@ -1,541 +0,0 @@ -!> Single-phase material modeling class: -!> Provides equations of state and temperature-dependent properties -module matm_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - implicit none - private - - ! Expose type/constructor/methods - public :: matm - - ! Parameters for viscosity, and heat diffusion models - integer, parameter, public :: none =0 !< Sets the constant to 0 (for inviscid, isothermal, etc.). Careful, overwrites input values - integer, parameter, public :: constant =1 !< Assumes default value, available for all types, overwritten by input - integer, parameter, public :: water =2 !< Empirical models for water (mu, kappa, cv) - integer, parameter, public :: air =3 !< Empirical models for air (mu, kappa, cv) - ! More can be added for other materials, alongside functions that feature models - - !> Material modeling type intended for single-phase flows (gases or liquids) - type :: matm - - ! This is our config - class(config), pointer :: cfg !< This is the config the solver is build for - - ! This is the name of the structure - character(len=str_medium) :: name='UNNAMED_MATM' !< class name (default=UNNAMED_MATM) - - ! Flag for if things vary with temperature or not - logical :: const_prop - ! Flag for if temperature equil of multiphase cells is enforced - logical :: mult_iso - - ! Fluid properties - real(WP) :: gamm,Pref,b,q - - ! Pointers for local thermodynamic or flow variables - real(WP), dimension(:,:,:), pointer :: rho,U,V,W,rhoE,P - - ! Variables to store chosen diffusion & thermo models (defaults to constant model, M references "model") - integer :: M_mu = 1 - integer :: M_kappa = 1 - integer :: M_cv = 1 - - ! Defaults for constant diffusion & thermo parameters - real(WP) :: mu_0 = 1.81e-5_WP - real(WP) :: kappa_0 = 0.026_WP - real(WP) :: cv_0 = 717.6_WP - - ! Default temperature guess (for the sake of variable cv) upon initialization, can be overwritten - ! Also used by EOS_gas and EOS_liquid functions if temperature guess is not directly supplied - real(WP) :: Tdefault = 25.0_WP + 273.15_WP - - contains - procedure :: EOS_gas, EOS_liquid !< Output solver to the screen - procedure :: EOS_energy !< Calculates phase total energy from pressure and kinetic energy - procedure :: EOS_temp !< Calculates phase temperature from pressure directly - procedure :: EOS_density !< Calculates phase density from pressure and temperature directly - procedure :: EOS_pressure !< Calculates phase pressure from density and temperature directly - procedure :: EOS_all !< Calculates vol-avg pressure for entire domain from conserved variables - - procedure :: register_idealgas !< EOS available for gas-like fluids - procedure :: register_stiffenedgas !< EOS for liquid-like fluids - procedure :: register_NobleAbelstiffenedgas !< EOS for liquid-like fluids - - procedure :: register_diffusion_thermo_models !< Choose models or set parameters for viscosity, thermal conductivity, and specific heat - - procedure :: register_thermoflow_variables !< Creates pointers from material models to flow solver variables - - procedure :: update_temperature !< Updates entire array of mixture temperature as passed in - procedure :: get_local_temperature !< Calculates local mixture temperature - - procedure :: viscosity_water, viscosity_air !< Empirical models for temperature dependence of dynamic viscosity - procedure :: spec_heat_water, spec_heat_air !< Empirical models for temperature dependence of specific heat (cv) - procedure :: therm_cond_water, therm_cond_air !< Empirical models for temperature dependence of thermal conductivity - - procedure :: viscosity, spec_heat, therm_cond !< Provide diffusive/thermal parameters according to registered model - - end type matm - - - !> Declare compressible solver constructor - interface matm - procedure constructor - end interface matm - -contains - - - !> Default constructor for material modeling - function constructor(cfg,name) result(self) - implicit none - type(matm) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Zero EOS parameters - self%gamm = 0.0_WP; self%Pref = 0.0_WP; self%q = 0.0_WP; self%b = 0.0_WP - - end function constructor - - subroutine register_idealgas(this,gamm) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm - - this%gamm = gamm - - end subroutine register_idealgas - - subroutine register_stiffenedgas(this,gamm,Pref) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm,Pref - - this%gamm = gamm - this%Pref = Pref - - end subroutine register_stiffenedgas - - subroutine register_NobleAbelstiffenedgas(this,gamm,Pref,q,b) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm,Pref,q,b - - this%gamm = gamm - this%Pref = Pref - this%q = q - this%b = b - - end subroutine register_NobleAbelstiffenedgas - - subroutine register_diffusion_thermo_models(this,viscmodel,hdffmodel,sphtmodel,viscconst,hdffconst,sphtconst) - use messager, only: die - implicit none - class(matm), intent(inout) :: this - integer , intent(in), optional :: viscmodel,hdffmodel,sphtmodel - real(WP), intent(in), optional :: viscconst,hdffconst,sphtconst - - ! If constants are supplied, replace default constants with provided constants - if (present(viscconst)) then - this%mu_0 = viscconst - end if - if (present(hdffconst)) then - this%kappa_0 = hdffconst - end if - if (present(sphtconst)) then - this%cv_0 = sphtconst - end if - - ! If models are supplied, replace default models (constant) with specified models - ! Specifying a non-constant model will override specifying a constant parameter above - if (present(viscmodel)) then - this%M_mu = viscmodel - ! Check allowed values - select case (this%M_mu) - case (none,constant,air,water); ! do nothing - case default; call die('[matm register_diffusion_thermo_models] Unknown viscosity model') - end select - end if - if (present(hdffmodel)) then - this%M_kappa = hdffmodel - ! Check allowed values - select case (this%M_kappa) - case (none,constant,air,water); ! do nothing - case default; call die('[matm register_diffusion_thermo_models] Unknown heat diffusivity model') - end select - end if - if (present(sphtmodel)) then - this%M_cv = sphtmodel - ! Check allowed values - select case (this%M_cv) - case (constant,air,water); ! do nothing - never zero, so none is not allowed - case default; call die('[matm register_diffusion_thermo_models] Unknown specific heat model') - end select - end if - - ! Set parameter values to zero if prescribed - if (this%M_mu .eq.none) this%mu_0 = 0.0_WP - if (this%M_kappa.eq.none) this%kappa_0 = 0.0_WP - - end subroutine register_diffusion_thermo_models - - subroutine register_thermoflow_variables(this,rho,u,v,w,rhoe,p) - implicit none - class(matm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), target, intent(in) :: rho,u,v,w,rhoE,p - - this%rho => rho - this%U => u - this%V => v - this%W => w - this%rhoE => rhoE - this%P => p - - end subroutine register_thermoflow_variables - - - function viscosity(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: mu - - select case(this%M_mu) - case(none,constant) - mu = this%mu_0 - case(air) - mu = this%viscosity_air(T) - case(water) - mu = this%viscosity_water(T) - end select - - return - end function viscosity - - function therm_cond(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: kappa - - select case(this%M_kappa) - case(none,constant) - kappa = this%kappa_0 - case(air) - kappa = this%therm_cond_air(T) - case(water) - kappa = this%therm_cond_water(T) - end select - - return - end function therm_cond - - function spec_heat(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: cv - - select case(this%M_cv) - case(none,constant) - cv = this%cv_0 - case(air) - cv = this%spec_heat_air(T) - case(water) - cv = this%spec_heat_water(T) - end select - - return - end function spec_heat - - subroutine update_temperature(this,phase,Temperature) - implicit none - class(matm), intent(inout) :: this - character(len=*),intent(in) :: phase - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: Temperature - integer :: i,j,k - - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - ! Get local temperature, use current temperature as first guess for cv - Temperature(i,j,k) = this%get_local_temperature(phase,i,j,k,Temperature(i,j,k)) - end do - end do - end do - - end subroutine update_temperature - - function get_local_temperature(this,phase,i,j,k,Tguess) result(T) - implicit none - class(matm), intent(inout) :: this - character(len=*),intent(in) :: phase - integer, intent(in) :: i,j,k - real(WP), intent(in) :: Tguess - real(WP) :: Tlast,delta_T,temp,T - real(WP) :: cv = 0.0_WP - integer :: n - real(WP), parameter :: T_cvg = 1e-1_WP - integer, parameter :: n_loop = 10 - - ! Initialize guess - temp = Tguess - select case(trim(adjustl(phase))) - case('gas') - ! Gas temperature - n = 0; delta_T = 1.0_WP + T_cvg - do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) - Tlast = temp - ! Calculate temperature with latest temperature in cv calculation - temp = this%EOS_gas(i,j,k,'T',temp) - ! Increment interation number - n = n+1 - ! Convergence residual - delta_T = abs(temp-Tlast) - ! Exit loop if constant model - if (this%M_cv.eq.constant) n = n_loop - ! Exit loop if not converging - if (temp.le.0.0_WP) then - n = n_loop - temp = Tlast ! hopefully last iteration had better value - end if - end do - ! Update cv value using current temperature value - cv = this%spec_heat(temp) - case('liquid') - ! Liquid temperature - n = 0; delta_T = 1.0_WP + T_cvg - do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) - Tlast = temp - ! Calculate temperature with latest temperature in cv calculation - temp = this%EOS_liquid(i,j,k,'T',temp) - ! Increment interation number - n = n+1 - ! Convergence residual - delta_T = abs(temp-Tlast) - ! Exit loop if constant model - if (this%M_cv.eq.constant) n = n_loop - ! Exit loop if not converging - if (temp.le.0.0_WP) then - n = n_loop - temp = Tlast ! hopefully last iteration had better value - end if - end do - ! Update cv value using current temperature value - cv = this%spec_heat(temp) - end select - - ! Return temperature - T = temp - - return - end function get_local_temperature - - function EOS_liquid(this,i,j,k,flag,temp) result(property) - implicit none - class(matm), intent(inout) :: this - integer,intent(in) :: i,j,k - character(len=1),intent(in) :: flag - real(WP), intent(in), optional :: temp ! Just for getting cv - real(WP) :: property - - select case(flag) - case('p') ! Pressure - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& - (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& - (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - case('K') ! Bulk modulus - property = this%P(i,j,k)+this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property - case('T') ! Temperature - if (present(temp)) then; property = temp; else; property = this%Tdefault; end if - property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) - case('v') ! (1/rho)(dp/de), for viscous pressure term - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) - case('M') ! Bulk modulus calculated from conserved variables - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) - end select - - return - end function EOS_liquid - - function EOS_gas(this,i,j,k,flag,temp) result(property) - implicit none - class(matm), intent(inout) :: this - integer,intent(in) :: i,j,k - character(len=1),intent(in) :: flag - real(WP), intent(in), optional :: temp ! Just for getting cv - real(WP) :: property - - select case(flag) - case('p') ! Pressure - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& - (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& - (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - case('K') ! Bulk modulus - property = this%P(i,j,k)+this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property - case('T') ! Temperature - if (present(temp)) then; property = temp; else; property = this%Tdefault; end if - property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) - case('v') ! (1/rho)(dp/de), for viscous pressure term - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) - case('M') ! Bulk modulus calculated from conserved variables - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) - end select - - return - end function EOS_gas - - function EOS_energy(this,pres,dens,uvel,vvel,wvel) result(energy) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,dens,uvel,vvel,wvel - real(WP) :: KE,energy - - KE = 0.5_WP*dens*(uvel**2+vvel**2+wvel**2) - energy = (pres + this%gamm*this%Pref)*(1.0_WP-dens*this%b)/(this%gamm-1.0_WP) + dens*this%q + KE - - return - end function EOS_energy - - function EOS_temp(this,pres,dens,cv) result(temp) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,dens,cv - real(WP) :: temp - - temp = (1.0_WP-dens*this%b)*(pres+this%Pref)/(this%gamm-1.0_WP)/(dens*cv) - - return - end function EOS_temp - - function EOS_pressure(this,temp,dens,cv) result(pres) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: temp,dens,cv - real(WP) :: pres - - pres = temp*(dens*cv)*(this%gamm-1.0_WP)/(1.0_WP-dens*this%b)-this%Pref - - return - end function EOS_pressure - - function EOS_density(this,pres,temp,cv) result(dens) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,temp,cv - real(WP) :: dens - - dens = (pres+this%Pref)/(cv*(this%gamm-1.0_WP)*temp+this%b*(pres+this%Pref)) - - return - end function EOS_density - - function EOS_all(this) result(buf_P) - implicit none - class(matm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: buf_P - - buf_P = (this%gamm-1.0_WP)/(1.0_WP-this%rho*this%b)*(this%rhoE-0.5_WP* & - this%rho*(this%U**2+this%V**2+this%W**2)-this%rho*this%q)-this%gamm*this%Pref - - return - end function EOS_all - - function viscosity_air(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,mu - - TC = max(100.0_WP,min(T,800.0_WP)) - mu = 1.716e-5_WP*(TC/273.15_WP)**1.5_WP*(273.15+110.4_WP)/(TC+110.4_WP) - ! mu = 2.5e-2_WP*(T/(1.488095e2/(1.4-1.0_WP)/717.6_WP))**0.75_WP - - return - end function viscosity_air - - function viscosity_water(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,mu - - TC = max(276.15_WP,max(T,473.15_WP)) - mu = 2.414e-5_WP*10**(247.8_WP/(TC-140.0_WP)) - - return - end function viscosity_water - - function spec_heat_air(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,cv - - TC = max(173.15_WP,min(T,773.15_WP)) - cv = 717.8_WP+0.07075_WP*(TC-300_WP)+2.6125e-4_WP*(TC-300_WP)**2 - - return - end function spec_heat_air - - function spec_heat_water(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,cv - - TC = max(3.0_WP,max(T-273.15_WP,200.0_WP)) - cv = (4209.0_WP-1.31_WP*TC+0.014_WP*TC**2)/this%gamm - - return - end function spec_heat_water - - function therm_cond_air(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,kappa - - TC = max(100.0_WP,min(T,1000.0_WP)) - kappa = 2.646e-3_WP*TC**1.5_WP/(TC+245.4_WP*10.0_WP**(-12.0_WP/TC)) - - return - end function therm_cond_air - - function therm_cond_water(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,kappa - - TC = max(1.0_WP,min(T-273.15_WP,200.0_WP)) - kappa = 0.5706_WP+1.75e-3_WP*TC-6.46e-6_WP*TC**2 - - return - end function therm_cond_water - -end module matm_class - - From 644f8b81f3d29ee57bc5d335d8aa3b380d81e9ec Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 5 Jan 2023 11:24:40 -0500 Subject: [PATCH 057/152] Updates to SGS Max's changes separating out different SGS models and including Vreman model. --- src/subgrid/sgsmodel_class.f90 | 162 +++++++++++++++++++++---- src/variable_density/lowmach_class.f90 | 94 +++++++++++++- 2 files changed, 230 insertions(+), 26 deletions(-) diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index 93d3faf27..d74b623ae 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -10,8 +10,10 @@ module sgsmodel_class ! Expose type/constructor/methods public :: sgsmodel - ! Some clipping parameters - real(WP), parameter :: Cs_ref=0.1_WP + ! List of SGS LES models available + integer, parameter, public :: dynamic_smag =1 !< Dynamic Smagorinsky -- BROKEN + integer, parameter, public :: constant_smag=2 !< Constant Smagorinsky + integer, parameter, public :: vreman =3 !< Vreman 2004 !> SGS model object definition type :: sgsmodel @@ -22,6 +24,9 @@ module sgsmodel_class ! Safe index bounds integer :: imin_in,jmin_in,kmin_in !< Safe min in each direction integer :: imax_in,jmax_in,kmax_in !< Safe max in each direction + + ! Some clipping parameters + real(WP) :: Cs_ref=0.1_WP ! LM and MM tensor norms and eddy viscosity real(WP), dimension(:,:,:), allocatable :: LM,MM !< LM and MM tensor norms @@ -41,8 +46,11 @@ module sgsmodel_class procedure :: log=>sgs_log !< Log SGS info procedure :: print=>sgs_print !< Output SGS info to the screen - procedure :: get_visc !< Calculate the SGS viscosity - + procedure :: get_visc !< Calls appropriate eddy viscosity subroutine + procedure :: visc_dynamic !< Calculate the SGS viscosity (Dynamic Smag) + procedure :: visc_cst !< Calculate the SGS viscosity (Constant Smag) + procedure :: visc_vreman !< Calculate the SGS viscosity (Vreman 2004) + procedure, private :: interpolate !< Helper function that interpolates a field to a point end type sgsmodel @@ -58,7 +66,6 @@ module sgsmodel_class !> Default constructor for model function constructor(cfg,umask,vmask,wmask) result(self) - use messager, only: die implicit none type(sgsmodel) :: self class(config), target, intent(in) :: cfg @@ -249,10 +256,51 @@ function constructor(cfg,umask,vmask,wmask) result(self) end function constructor - - !> Get subgrid scale dynamic viscosity - subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) - use param, only: verbose + !> Calls appropriate eddy viscosity subroutine according to SGSmodel%type + subroutine get_visc(this,type,dt,rho,Ui,Vi,Wi,SR,gradu) + use messager, only: die + use param, only: verbose + implicit none + class(sgsmodel), intent(inout) :: this + integer, intent(in) :: type !< Model type + real(WP), intent(in) :: dt !< dt since the last call to the model + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Ui !< Interpolated velocities including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Vi !< Interpolated velocities including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Wi !< Interpolated velocities including all ghosts + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: SR !< Strain rate tensor + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: gradu !< Velocity gradient tensor + + select case(type) + case(dynamic_smag) + if (.not.present(Ui).or..not.(present(Vi)).or..not.present(Wi).or..not.present(SR)) & + call die('[sgs get_visc] Dynamic Smagorinsky model requires Ui, Vi, Wi, and SR') + call this%visc_dynamic(dt,rho,Ui,Vi,Wi,SR,gradu) + case(constant_smag) + if (.not.present(SR)) call die('[sgs get_visc] Constant Smagorinsky model requires SR') + call this%visc_cst(rho,SR) + case(vreman) + if (.not.present(gradu)) call die('[sgs get_visc] Vreman model requires gradu') + call this%visc_vreman(rho,gradu) + end select + + ! Calculate some info on the model + calc_info: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN + use parallel, only: MPI_REAL_WP + integer :: ierr + call MPI_ALLREDUCE(maxval(this%visc),this%max_visc,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(minval(this%visc),this%min_visc,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + end block calc_info + + ! Output info about model + if (verbose.gt.0) call this%log() + if (verbose.gt.1) call this%print() + + end subroutine get_visc + + !> Get subgrid scale dynamic viscosity - Dynamic + subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) implicit none class(sgsmodel), intent(inout) :: this real(WP), intent(in) :: dt !< dt since the last call to the model @@ -261,6 +309,7 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: Vi !< Interpolated velocities including all ghosts real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: Wi !< Interpolated velocities including all ghosts real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SR !< Strain rate tensor + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient tensor integer :: i,j,k real(WP) :: Frho,FU,FV,FW,FS_ real(WP) :: Cs,tau,alpha @@ -329,7 +378,6 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) end do end do end do - ! Synchronize LM and MM call this%cfg%sync(this%LM) call this%cfg%sync(this%MM) @@ -349,7 +397,7 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) this%MM(i,j,k)=alpha*this%MM(i,j,k)+(1.0_WP-alpha)*this%interpolate(pos,i,j,k,MMold) ! Safe limits this%LM(i,j,k)=max(this%LM(i,j,k),100.0_WP*epsilon(1.0_WP)) - this%MM(i,j,k)=max(this%MM(i,j,k),100.0_WP*epsilon(1.0_WP)/Cs_ref**2) + this%MM(i,j,k)=max(this%MM(i,j,k),100.0_WP*epsilon(1.0_WP)/this%Cs_ref**2) end do end do end do @@ -363,33 +411,97 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) else Cs=0.0_WP end if - Cs=Cs_ref + Cs = this%Cs_ref this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*Cs*this%delta(i,j,k)**2 end do end do end do - ! Synchronize visc call this%cfg%sync(this%visc) ! Deallocate work arrays deallocate(LMold,MMold,S_) - ! Calculate some info on the model - calc_info: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN - use parallel, only: MPI_REAL_WP - integer :: ierr - call MPI_ALLREDUCE(maxval(this%visc),this%max_visc,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(minval(this%visc),this%min_visc,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) - end block calc_info + end subroutine visc_dynamic + + + !> Get subgrid scale dynamic viscosity - Constant + subroutine visc_cst(this,rho,SR) + implicit none + class(sgsmodel), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SR !< Strain rate tensor + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: S_ - ! Output info about model - if (verbose.gt.0) call this%log() - if (verbose.gt.1) call this%print() + ! Prepare magnitude of SR tensor + allocate(S_(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + S_=sqrt(SR(1,:,:,:)**2+SR(2,:,:,:)**2+SR(3,:,:,:)**2+2.0_WP*(SR(4,:,:,:)**2+SR(5,:,:,:)**2+SR(6,:,:,:)**2)) - end subroutine get_visc + ! Compute the eddy viscosity + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref*this%delta(i,j,k)**2 + end do + end do + end do + + ! Synchronize visc + call this%cfg%sync(this%visc) + + ! Deallocate work arrays + deallocate(S_) + + end subroutine visc_cst + + !> Get subgrid scale dynamic viscosity - Vreman + subroutine visc_vreman(this,rho,gradu) + implicit none + class(sgsmodel), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient + real(WP), dimension(:,:,:), allocatable :: alph2 !< velocity gradient tensor squared + real(WP) :: C,B,beta11,beta22,beta33,beta12,beta13,beta23 + integer :: i,j,k + + allocate(alph2(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + alph2 = gradu(1,1,:,:,:)**2 + gradu(1,2,:,:,:)**2 + gradu(1,3,:,:,:)**2 + & + gradu(2,1,:,:,:)**2 + gradu(2,2,:,:,:)**2 + gradu(2,3,:,:,:)**2 + & + gradu(3,1,:,:,:)**2 + gradu(3,2,:,:,:)**2 + gradu(3,3,:,:,:)**2 + + ! Model constant - FOR HIT c \approx 0.07 + ! For complex flows c = 2.5*Cs**2 + C = 2.5*this%Cs_ref**2 + + ! Compute the eddy viscosity + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + beta11 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)**2 + gradu(2,1,i,j,k)**2 + gradu(3,1,i,j,k)**2) + beta22 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)**2 + gradu(2,2,i,j,k)**2 + gradu(3,2,i,j,k)**2) + beta33 = this%delta(i,j,k)**2*(gradu(1,3,i,j,k)**2 + gradu(2,3,i,j,k)**2 + gradu(3,3,i,j,k)**2) + beta12 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,2,i,j,k) + gradu(2,1,i,j,k)*gradu(2,2,i,j,k) + & + gradu(3,1,i,j,k)*gradu(3,2,i,j,k)) + beta13 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,3,i,j,k) + gradu(2,1,i,j,k)*gradu(2,3,i,j,k) + & + gradu(3,1,i,j,k)*gradu(3,3,i,j,k)) + beta23 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)*gradu(1,3,i,j,k) + gradu(2,2,i,j,k)*gradu(2,3,i,j,k) + & + gradu(3,2,i,j,k)*gradu(3,3,i,j,k)) + + B = beta11*beta22 - beta12**2 + beta11*beta33 - beta13**2 + beta22*beta33 - beta23**2 + this%visc(i,j,k) = C*sqrt(B/alph2(i,j,k)) + end do + end do + end do + + ! Synchronize visc + call this%cfg%sync(this%visc) + + ! Deallocate work arrays + deallocate(alph2) + + end subroutine visc_vreman !> Private function that performs an trilinear interpolation of a cell-centered !> field A to the provided position pos in the vicinity of cell i0,j0,k0 diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index c54923f44..02b1848cf 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -123,6 +123,7 @@ module lowmach_class procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient procedure :: get_div_stress !< Calculate divergence of stress + procedure :: get_gradu !< Calculate velocity gradient tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL @@ -1356,7 +1357,98 @@ subroutine get_div_stress(this,divx,divy,divz) ! Deallocate flux arrays deallocate(FX,FY,FZ) - end subroutine get_div_stress + end subroutine get_div_stress + + + !> Calculate velocity gradient tensor + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu !> Divide momentum by rho to form velocity From ced0d796b4d6075cc0af339c823a20b7403d30c8 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 6 Jan 2023 16:40:49 -0500 Subject: [PATCH 058/152] Update lowmach_class.f90 Added routine to calculate fluid vorticity. This will be needed when using lift in LPT --- src/variable_density/lowmach_class.f90 | 72 ++++++++++++++++++++++++-- 1 file changed, 68 insertions(+), 4 deletions(-) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 02b1848cf..0325bc59e 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -124,6 +124,7 @@ module lowmach_class procedure :: get_pgrad !< Calculate pressure gradient procedure :: get_div_stress !< Calculate divergence of stress procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_vorticity !< Calculate vorticity tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL @@ -1370,7 +1371,7 @@ subroutine get_gradu(this,gradu) real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy ! Check gradu's first two dimensions - if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[lowmach get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') ! Compute dudx, dvdy, and dwdz first do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1448,7 +1449,70 @@ subroutine get_gradu(this,gradu) ! Deallocate velocity gradient storage deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - end subroutine get_gradu + end subroutine get_gradu + + + !> Calculate vorticity vector + subroutine get_vorticity(this,vort) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check vort's first two dimensions + if (size(vort,dim=1).ne.3) call die('[lowmach get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + vort(1,i,j,k)=0.25_WP*(sum(dwdy(i,j:j+1,k:k+1))-sum(dvdz(i,j:j+1,k:k+1))) + vort(2,i,j,k)=0.25_WP*(sum(dudz(i:i+1,j,k:k+1))-sum(dwdx(i:i+1,j,k:k+1))) + vort(3,i,j,k)=0.25_WP*(sum(dvdx(i:i+1,j:j+1,k))-sum(dudy(i:i+1,j:j+1,k))) + end do + end do + end do + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(vort) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_vorticity !> Divide momentum by rho to form velocity @@ -1551,7 +1615,7 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) real(WP), dimension(3,3) :: dUdx ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + if (size(SR,dim=1).ne.6) call die('[lowmach get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') ! Calculate inside do k=this%cfg%kmin_,this%cfg%kmax_ @@ -2079,7 +2143,7 @@ subroutine addsrc_gravity(this,resU,resV,resW) end subroutine addsrc_gravity - !> Print out info for incompressible flow solver + !> Print out info for low-Mach flow solver subroutine lowmach_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none From 4a524360118acf88c5382b006c476bc3b8ee07b6 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 7 Jan 2023 18:30:31 -0500 Subject: [PATCH 059/152] channel case Added Olivier's channel case (without non-Newtonian visc). Modified forcing in IB_pipe to be consistent. --- examples/channel/GNUmakefile | 50 ++++ examples/channel/README | 1 + examples/channel/input | 34 +++ examples/channel/src/Make.package | 2 + examples/channel/src/geometry.f90 | 67 +++++ examples/channel/src/simulation.f90 | 369 ++++++++++++++++++++++++++++ examples/ib_pipe/input | 2 +- examples/ib_pipe/src/simulation.f90 | 73 ++---- 8 files changed, 551 insertions(+), 47 deletions(-) create mode 100644 examples/channel/GNUmakefile create mode 100644 examples/channel/README create mode 100644 examples/channel/input create mode 100644 examples/channel/src/Make.package create mode 100644 examples/channel/src/geometry.f90 create mode 100644 examples/channel/src/simulation.f90 diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile new file mode 100644 index 000000000..6efcf30a0 --- /dev/null +++ b/examples/channel/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = #TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HYPRE_DIR = /opt/homebrew +#HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre +#FFTW_DIR = /Users/desjardi/Builds/fftw +#LAPACK_DIR= /Users/desjardi/Builds/lapack + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core constant_density data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/channel/README b/examples/channel/README new file mode 100644 index 000000000..b3393d325 --- /dev/null +++ b/examples/channel/README @@ -0,0 +1 @@ +Periodic channel flow with forcing. diff --git a/examples/channel/input b/examples/channel/input new file mode 100644 index 000000000..8ded82286 --- /dev/null +++ b/examples/channel/input @@ -0,0 +1,34 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 5 +Ly : 1 +Lz : 0.04 +nx : 128 +ny : 40 +nz : 1 +Stretching : 2.1 + +# Fluid properties and velocity +Dynamic viscosity : 0.01 +Density : 1 +Ubulk : 1 +Wbulk : 0 +Perturbation : 0 + +# Time integration +Max timestep size : 2e-2 +Max cfl number : 0.9 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 +Postproc output period : 10 diff --git a/examples/channel/src/Make.package b/examples/channel/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/channel/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/channel/src/geometry.f90 b/examples/channel/src/geometry.f90 new file mode 100644 index 000000000..fdd61597f --- /dev/null +++ b/examples/channel/src/geometry.f90 @@ -0,0 +1,67 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz,stretch + real(WP), dimension(:), allocatable :: x,y,z + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)); call param_read('Stretching',stretch) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + ! Create simple rectilinear grid in x and z, tanh-stretched grid in y + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=0.5_WP*Ly*tanh(stretch*(2.0_WP*real(j-1,WP)/real(ny,WP)-1.0_WP))/tanh(stretch) + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + ! General serial grid object + grid=sgrid(coord=cartesian,no=1,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='channel') + end block create_grid + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=0.0_WP + cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP + call cfg%sync(cfg%VF) + end block create_walls + + end subroutine geometry_init + + +end module geometry diff --git a/examples/channel/src/simulation.f90 b/examples/channel/src/simulation.f90 new file mode 100644 index 000000000..9933b0715 --- /dev/null +++ b/examples/channel/src/simulation.f90 @@ -0,0 +1,369 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver and corresponding time tracker + type(incomp), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,forcefile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:,:), allocatable :: SR + + !> Fluid viscosity + real(WP) :: visc + + !> Channel forcing + real(WP) :: Ubulk,Wbulk + real(WP) :: meanU,meanW + + !> Event for post-processing + type(event) :: ppevt + +contains + + + !> Specialized subroutine that outputs the velocity distribution + subroutine postproc_vel() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp + ! Allocate vertical line storage + allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP + allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP + allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP + allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP + ! Integrate all data over x and z + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) + Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) + end do + end do + end do + ! All-reduce the data + call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + do j=fs%cfg%jmin,fs%cfg%jmax + if (vol(j).gt.0.0_WP) then + Uavg(j)=Uavg(j)/vol(j) + else + Uavg(j)=0.0_WP + end if + end do + ! If root, print it out + if (fs%cfg%amRoot) then + filename='Uavg_' + write(timestamp,'(es12.5)') time%t + open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) + write(iunit,'(a12,3x,a12)') 'Height','Uavg' + do j=fs%cfg%jmin,fs%cfg%jmax + write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) + end do + close(iunit) + end if + ! Deallocate work arrays + deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc_vel + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: gmres_amg,pcg_pfmg + use mathtools, only: twoPi + integer :: i,j,k + real(WP) :: amp,vel + ! Create flow solver + fs=incomp(cfg=cfg,name='NS solver') + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign constant density + call param_read('Density',fs%rho) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + ! Initialize velocity based on specified bulk + call param_read('Ubulk',Ubulk) + call param_read('Wbulk',Wbulk) + where (fs%umask.eq.0) fs%U=Ubulk + where (fs%wmask.eq.0) fs%W=Wbulk + meanU=Ubulk + meanW=Wbulk + ! To facilitate transition + call param_read('Perturbation',amp) + vel=sqrt(Ubulk**2+Wbulk**2) + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (fs%umask(i,j,k).eq.0) fs%U(i,j,k)=fs%U(i,j,k)+amp*vel*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL) + if (fs%wmask(i,j,k).eq.0) fs%W(i,j,k)=fs%W(i,j,k)+amp*vel*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='channel') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('viscosity',fs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create forcing monitor + forcefile=monitor(fs%cfg%amRoot,'forcing') + call forcefile%add_column(time%n,'Timestep number') + call forcefile%add_column(time%t,'Time') + call forcefile%add_column(meanU,'Bulk U') + call forcefile%add_column(meanW,'Bulk W') + call forcefile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc_vel() + end block create_postproc + + + end subroutine simulation_init + + + !> Time integrate our problem + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + forcing: block + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: myU,myUvol,myW,myWvol,Uvol,Wvol + myU=0.0_WP; myUvol=0.0_WP; myW=0.0_WP; myWvol=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + if (fs%umask(i,j,k).eq.0) then + myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) + myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k) + end if + if (fs%wmask(i,j,k).eq.0) then + myW =myW +fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k)*(2.0_WP*fs%W(i,j,k)-fs%Wold(i,j,k)) + myWvol=myWvol+fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k) + end if + end do + end do + end do + call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myU ,meanU,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanU=meanU/Uvol + where (fs%umask.eq.0) resU=resU+Ubulk-meanU + call MPI_ALLREDUCE(myWvol,Wvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myW ,meanW,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanW=meanW/Wvol + where (fs%wmask.eq.0) resW=resW+Wbulk-meanW + end block forcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + call forcefile%write() + + ! Specialized post-processing + if (ppevt%occurs()) call postproc_vel() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,SR) + + end subroutine simulation_final + + + + + +end module simulation diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 29618aca0..84a9b75be 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -9,7 +9,7 @@ ny : 96 nz : 1 # Pipe properties -Target velocity : 1 +Bulk velocity : 1 Fluctuation amp : 0.2 # Time integration diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 2c25d3d6b..b18c7cd9a 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -30,7 +30,7 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi real(WP), dimension(:,:,:), allocatable :: G,VF - real(WP) :: target_velocity,Umean,Dpipe + real(WP) :: Ubulk,Umean,Dpipe contains @@ -96,17 +96,17 @@ subroutine simulation_init real(WP) :: amp ! Initial fields call param_read('Pipe diameter',Dpipe) - call param_read('Target velocity',target_velocity) + call param_read('Bulk velocity',Ubulk); Umean=Ubulk call param_read('Fluctuation amp',amp,default=0.0_WP) fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP ! For faster transition do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=target_velocity*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) - fs%V(i,j,k)=target_velocity*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) - fs%U(i,j,k)=fs%U(i,j,k)+amp*target_velocity*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) - fs%V(i,j,k)=fs%V(i,j,k)+amp*target_velocity*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%U(i,j,k)=Ubulk*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) + fs%V(i,j,k)=Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) + fs%U(i,j,k)=fs%U(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) end do end do end do @@ -156,7 +156,6 @@ subroutine simulation_init ! Prepare some info about fields call fs%get_cfl(time%dt,time%cfl) call fs%get_max() - call get_Umean ! Create simulation monitor mfile=monitor(fs%cfg%amRoot,'simulation') call mfile%add_column(time%n,'Timestep number') @@ -221,6 +220,27 @@ subroutine simulation_run resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + ! Add body forcing + forcing: block + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: myU,myUvol,Uvol,VFx + myU=0.0_WP; myUvol=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) + myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx + end do + end do + end do + call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myU ,Umean,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=Umean/Uvol + resU=resU+Ubulk-Umean + end block forcing + ! Form implicit residuals call fs%solve_implicit(time%dt,resU,resV,resW) @@ -252,23 +272,6 @@ subroutine simulation_run call fs%cfg%sync(VF) end block ibm_correction - ! Enforce constant mass flow rate - mfr_correction: block - integer :: i,j,k - real(WP) :: VFx - ! Add forcing - call get_Umean - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - fs%U(i,j,k)=fs%U(i,j,k)+Vfx*(target_velocity-Umean) - end do - end do - end do - call fs%cfg%sync(fs%U) - end block mfr_correction - ! Apply other boundary conditions on the resulting fields call fs%apply_bcond(time%t,time%dt) @@ -303,7 +306,6 @@ subroutine simulation_run if (ens_evt%occurs()) call ens_out%write_data(time%t) ! Perform and output monitoring - call get_Umean call fs%get_max() call mfile%write() call cflfile%write() @@ -343,27 +345,6 @@ function get_VF(i,j,k,dir) result(VF) VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta))) end function get_VF - - !> Calculate mean velocity - subroutine get_Umean - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - real(WP) :: VFx,myVol,vol - integer :: i,j,k,ierr - Umean=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - myVol=myVol+fs%cfg%vol(i,j,k)*VFx - Umean=Umean+fs%cfg%vol(i,j,k)*VFx*fs%U(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(myVol,vol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(Umean,myVol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=myVol/vol - end subroutine get_Umean - !> Finalize the NGA2 simulation subroutine simulation_final From 9ec1db7cefaf26289f568acb06f855c321bd93fa Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 7 Jan 2023 18:43:41 -0500 Subject: [PATCH 060/152] Channel update Channel compiles using new lin_sol stuff. --- examples/channel/GNUmakefile | 5 +---- examples/channel/src/simulation.f90 | 18 ++++++++++++------ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile index 6efcf30a0..4cdeaeb5f 100644 --- a/examples/channel/GNUmakefile +++ b/examples/channel/GNUmakefile @@ -23,10 +23,7 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -HYPRE_DIR = /opt/homebrew -#HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -#FFTW_DIR = /Users/desjardi/Builds/fftw -#LAPACK_DIR= /Users/desjardi/Builds/lapack +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/channel/src/simulation.f90 b/examples/channel/src/simulation.f90 index 9933b0715..7a9cd4137 100644 --- a/examples/channel/src/simulation.f90 +++ b/examples/channel/src/simulation.f90 @@ -2,6 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg + use hypre_str_class, only: hypre_str use incomp_class, only: incomp use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -13,6 +14,8 @@ module simulation !> Single-phase incompressible flow solver and corresponding time tracker type(incomp), public :: fs type(timetracker), public :: time + type(hypre_str), public :: ps + type(hypre_str), public :: vs !> Ensight postprocessing type(ensight) :: ens_out @@ -120,7 +123,7 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg,pcg_pfmg + use hypre_str_class, only: pcg_pfmg,gmres_pfmg use mathtools, only: twoPi integer :: i,j,k real(WP) :: amp,vel @@ -131,13 +134,16 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) ! Initialize velocity based on specified bulk call param_read('Ubulk',Ubulk) call param_read('Wbulk',Wbulk) From 0616fb549b7f2f204c5fe412e6a28e197a88c0c4 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 7 Jan 2023 19:08:56 -0500 Subject: [PATCH 061/152] Create GNUmakefile Makefile for ib_pipe --- examples/ib_pipe/GNUmakefile | 48 ++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 examples/ib_pipe/GNUmakefile diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile new file mode 100644 index 000000000..936d89562 --- /dev/null +++ b/examples/ib_pipe/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules From 19cc1c1e6aaae07e180e537af44e69e252aaa8db Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:27:29 -0500 Subject: [PATCH 062/152] Delete matm_class.f90 --- src/compressible/matm_class.f90 | 541 -------------------------------- 1 file changed, 541 deletions(-) delete mode 100644 src/compressible/matm_class.f90 diff --git a/src/compressible/matm_class.f90 b/src/compressible/matm_class.f90 deleted file mode 100644 index 6a9c783f4..000000000 --- a/src/compressible/matm_class.f90 +++ /dev/null @@ -1,541 +0,0 @@ -!> Single-phase material modeling class: -!> Provides equations of state and temperature-dependent properties -module matm_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - implicit none - private - - ! Expose type/constructor/methods - public :: matm - - ! Parameters for viscosity, and heat diffusion models - integer, parameter, public :: none =0 !< Sets the constant to 0 (for inviscid, isothermal, etc.). Careful, overwrites input values - integer, parameter, public :: constant =1 !< Assumes default value, available for all types, overwritten by input - integer, parameter, public :: water =2 !< Empirical models for water (mu, kappa, cv) - integer, parameter, public :: air =3 !< Empirical models for air (mu, kappa, cv) - ! More can be added for other materials, alongside functions that feature models - - !> Material modeling type intended for single-phase flows (gases or liquids) - type :: matm - - ! This is our config - class(config), pointer :: cfg !< This is the config the solver is build for - - ! This is the name of the structure - character(len=str_medium) :: name='UNNAMED_MATM' !< class name (default=UNNAMED_MATM) - - ! Flag for if things vary with temperature or not - logical :: const_prop - ! Flag for if temperature equil of multiphase cells is enforced - logical :: mult_iso - - ! Fluid properties - real(WP) :: gamm,Pref,b,q - - ! Pointers for local thermodynamic or flow variables - real(WP), dimension(:,:,:), pointer :: rho,U,V,W,rhoE,P - - ! Variables to store chosen diffusion & thermo models (defaults to constant model, M references "model") - integer :: M_mu = 1 - integer :: M_kappa = 1 - integer :: M_cv = 1 - - ! Defaults for constant diffusion & thermo parameters - real(WP) :: mu_0 = 1.81e-5_WP - real(WP) :: kappa_0 = 0.026_WP - real(WP) :: cv_0 = 717.6_WP - - ! Default temperature guess (for the sake of variable cv) upon initialization, can be overwritten - ! Also used by EOS_gas and EOS_liquid functions if temperature guess is not directly supplied - real(WP) :: Tdefault = 25.0_WP + 273.15_WP - - contains - procedure :: EOS_gas, EOS_liquid !< Output solver to the screen - procedure :: EOS_energy !< Calculates phase total energy from pressure and kinetic energy - procedure :: EOS_temp !< Calculates phase temperature from pressure directly - procedure :: EOS_density !< Calculates phase density from pressure and temperature directly - procedure :: EOS_pressure !< Calculates phase pressure from density and temperature directly - procedure :: EOS_all !< Calculates vol-avg pressure for entire domain from conserved variables - - procedure :: register_idealgas !< EOS available for gas-like fluids - procedure :: register_stiffenedgas !< EOS for liquid-like fluids - procedure :: register_NobleAbelstiffenedgas !< EOS for liquid-like fluids - - procedure :: register_diffusion_thermo_models !< Choose models or set parameters for viscosity, thermal conductivity, and specific heat - - procedure :: register_thermoflow_variables !< Creates pointers from material models to flow solver variables - - procedure :: update_temperature !< Updates entire array of mixture temperature as passed in - procedure :: get_local_temperature !< Calculates local mixture temperature - - procedure :: viscosity_water, viscosity_air !< Empirical models for temperature dependence of dynamic viscosity - procedure :: spec_heat_water, spec_heat_air !< Empirical models for temperature dependence of specific heat (cv) - procedure :: therm_cond_water, therm_cond_air !< Empirical models for temperature dependence of thermal conductivity - - procedure :: viscosity, spec_heat, therm_cond !< Provide diffusive/thermal parameters according to registered model - - end type matm - - - !> Declare compressible solver constructor - interface matm - procedure constructor - end interface matm - -contains - - - !> Default constructor for material modeling - function constructor(cfg,name) result(self) - implicit none - type(matm) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Zero EOS parameters - self%gamm = 0.0_WP; self%Pref = 0.0_WP; self%q = 0.0_WP; self%b = 0.0_WP - - end function constructor - - subroutine register_idealgas(this,gamm) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm - - this%gamm = gamm - - end subroutine register_idealgas - - subroutine register_stiffenedgas(this,gamm,Pref) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm,Pref - - this%gamm = gamm - this%Pref = Pref - - end subroutine register_stiffenedgas - - subroutine register_NobleAbelstiffenedgas(this,gamm,Pref,q,b) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: gamm,Pref,q,b - - this%gamm = gamm - this%Pref = Pref - this%q = q - this%b = b - - end subroutine register_NobleAbelstiffenedgas - - subroutine register_diffusion_thermo_models(this,viscmodel,hdffmodel,sphtmodel,viscconst,hdffconst,sphtconst) - use messager, only: die - implicit none - class(matm), intent(inout) :: this - integer , intent(in), optional :: viscmodel,hdffmodel,sphtmodel - real(WP), intent(in), optional :: viscconst,hdffconst,sphtconst - - ! If constants are supplied, replace default constants with provided constants - if (present(viscconst)) then - this%mu_0 = viscconst - end if - if (present(hdffconst)) then - this%kappa_0 = hdffconst - end if - if (present(sphtconst)) then - this%cv_0 = sphtconst - end if - - ! If models are supplied, replace default models (constant) with specified models - ! Specifying a non-constant model will override specifying a constant parameter above - if (present(viscmodel)) then - this%M_mu = viscmodel - ! Check allowed values - select case (this%M_mu) - case (none,constant,air,water); ! do nothing - case default; call die('[matm register_diffusion_thermo_models] Unknown viscosity model') - end select - end if - if (present(hdffmodel)) then - this%M_kappa = hdffmodel - ! Check allowed values - select case (this%M_kappa) - case (none,constant,air,water); ! do nothing - case default; call die('[matm register_diffusion_thermo_models] Unknown heat diffusivity model') - end select - end if - if (present(sphtmodel)) then - this%M_cv = sphtmodel - ! Check allowed values - select case (this%M_cv) - case (constant,air,water); ! do nothing - never zero, so none is not allowed - case default; call die('[matm register_diffusion_thermo_models] Unknown specific heat model') - end select - end if - - ! Set parameter values to zero if prescribed - if (this%M_mu .eq.none) this%mu_0 = 0.0_WP - if (this%M_kappa.eq.none) this%kappa_0 = 0.0_WP - - end subroutine register_diffusion_thermo_models - - subroutine register_thermoflow_variables(this,rho,u,v,w,rhoe,p) - implicit none - class(matm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), target, intent(in) :: rho,u,v,w,rhoE,p - - this%rho => rho - this%U => u - this%V => v - this%W => w - this%rhoE => rhoE - this%P => p - - end subroutine register_thermoflow_variables - - - function viscosity(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: mu - - select case(this%M_mu) - case(none,constant) - mu = this%mu_0 - case(air) - mu = this%viscosity_air(T) - case(water) - mu = this%viscosity_water(T) - end select - - return - end function viscosity - - function therm_cond(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: kappa - - select case(this%M_kappa) - case(none,constant) - kappa = this%kappa_0 - case(air) - kappa = this%therm_cond_air(T) - case(water) - kappa = this%therm_cond_water(T) - end select - - return - end function therm_cond - - function spec_heat(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: T ! Temperature - always supplied, not always used - real(WP) :: cv - - select case(this%M_cv) - case(none,constant) - cv = this%cv_0 - case(air) - cv = this%spec_heat_air(T) - case(water) - cv = this%spec_heat_water(T) - end select - - return - end function spec_heat - - subroutine update_temperature(this,phase,Temperature) - implicit none - class(matm), intent(inout) :: this - character(len=*),intent(in) :: phase - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: Temperature - integer :: i,j,k - - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - ! Get local temperature, use current temperature as first guess for cv - Temperature(i,j,k) = this%get_local_temperature(phase,i,j,k,Temperature(i,j,k)) - end do - end do - end do - - end subroutine update_temperature - - function get_local_temperature(this,phase,i,j,k,Tguess) result(T) - implicit none - class(matm), intent(inout) :: this - character(len=*),intent(in) :: phase - integer, intent(in) :: i,j,k - real(WP), intent(in) :: Tguess - real(WP) :: Tlast,delta_T,temp,T - real(WP) :: cv = 0.0_WP - integer :: n - real(WP), parameter :: T_cvg = 1e-1_WP - integer, parameter :: n_loop = 10 - - ! Initialize guess - temp = Tguess - select case(trim(adjustl(phase))) - case('gas') - ! Gas temperature - n = 0; delta_T = 1.0_WP + T_cvg - do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) - Tlast = temp - ! Calculate temperature with latest temperature in cv calculation - temp = this%EOS_gas(i,j,k,'T',temp) - ! Increment interation number - n = n+1 - ! Convergence residual - delta_T = abs(temp-Tlast) - ! Exit loop if constant model - if (this%M_cv.eq.constant) n = n_loop - ! Exit loop if not converging - if (temp.le.0.0_WP) then - n = n_loop - temp = Tlast ! hopefully last iteration had better value - end if - end do - ! Update cv value using current temperature value - cv = this%spec_heat(temp) - case('liquid') - ! Liquid temperature - n = 0; delta_T = 1.0_WP + T_cvg - do while ((delta_T.gt.T_cvg).and.(n.lt.n_loop)) - Tlast = temp - ! Calculate temperature with latest temperature in cv calculation - temp = this%EOS_liquid(i,j,k,'T',temp) - ! Increment interation number - n = n+1 - ! Convergence residual - delta_T = abs(temp-Tlast) - ! Exit loop if constant model - if (this%M_cv.eq.constant) n = n_loop - ! Exit loop if not converging - if (temp.le.0.0_WP) then - n = n_loop - temp = Tlast ! hopefully last iteration had better value - end if - end do - ! Update cv value using current temperature value - cv = this%spec_heat(temp) - end select - - ! Return temperature - T = temp - - return - end function get_local_temperature - - function EOS_liquid(this,i,j,k,flag,temp) result(property) - implicit none - class(matm), intent(inout) :: this - integer,intent(in) :: i,j,k - character(len=1),intent(in) :: flag - real(WP), intent(in), optional :: temp ! Just for getting cv - real(WP) :: property - - select case(flag) - case('p') ! Pressure - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& - (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& - (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - case('K') ! Bulk modulus - property = this%P(i,j,k)+this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property - case('T') ! Temperature - if (present(temp)) then; property = temp; else; property = this%Tdefault; end if - property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) - case('v') ! (1/rho)(dp/de), for viscous pressure term - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) - case('M') ! Bulk modulus calculated from conserved variables - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) - end select - - return - end function EOS_liquid - - function EOS_gas(this,i,j,k,flag,temp) result(property) - implicit none - class(matm), intent(inout) :: this - integer,intent(in) :: i,j,k - character(len=1),intent(in) :: flag - real(WP), intent(in), optional :: temp ! Just for getting cv - real(WP) :: property - - select case(flag) - case('p') ! Pressure - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*& - (this%rhoE(i,j,k)-0.5_WP*this%rho(i,j,k)*& - (this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - case('K') ! Bulk modulus - property = this%P(i,j,k)+this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*property - case('T') ! Temperature - if (present(temp)) then; property = temp; else; property = this%Tdefault; end if - property = (-(1.0_WP-this%rho(i,j,k)*this%b)*this%Pref+this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q) / (this%rho(i,j,k)*this%spec_heat(property)) - case('v') ! (1/rho)(dp/de), for viscous pressure term - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b) - case('M') ! Bulk modulus calculated from conserved variables - property = (this%gamm-1.0_WP)/(1.0_WP-this%rho(i,j,k)*this%b)*(this%rhoE(i,j,k) & - -0.5_WP*this%rho(i,j,k)*(this%U(i,j,k)**2+this%V(i,j,k)**2+this%W(i,j,k)**2) & - -this%rho(i,j,k)*this%q)-this%gamm*this%Pref - property = this%gamm/(1.0_WP-this%rho(i,j,k)*this%b)*(property+this%Pref) - end select - - return - end function EOS_gas - - function EOS_energy(this,pres,dens,uvel,vvel,wvel) result(energy) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,dens,uvel,vvel,wvel - real(WP) :: KE,energy - - KE = 0.5_WP*dens*(uvel**2+vvel**2+wvel**2) - energy = (pres + this%gamm*this%Pref)*(1.0_WP-dens*this%b)/(this%gamm-1.0_WP) + dens*this%q + KE - - return - end function EOS_energy - - function EOS_temp(this,pres,dens,cv) result(temp) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,dens,cv - real(WP) :: temp - - temp = (1.0_WP-dens*this%b)*(pres+this%Pref)/(this%gamm-1.0_WP)/(dens*cv) - - return - end function EOS_temp - - function EOS_pressure(this,temp,dens,cv) result(pres) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: temp,dens,cv - real(WP) :: pres - - pres = temp*(dens*cv)*(this%gamm-1.0_WP)/(1.0_WP-dens*this%b)-this%Pref - - return - end function EOS_pressure - - function EOS_density(this,pres,temp,cv) result(dens) - implicit none - class(matm), intent(inout) :: this - real(WP), intent(in) :: pres,temp,cv - real(WP) :: dens - - dens = (pres+this%Pref)/(cv*(this%gamm-1.0_WP)*temp+this%b*(pres+this%Pref)) - - return - end function EOS_density - - function EOS_all(this) result(buf_P) - implicit none - class(matm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: buf_P - - buf_P = (this%gamm-1.0_WP)/(1.0_WP-this%rho*this%b)*(this%rhoE-0.5_WP* & - this%rho*(this%U**2+this%V**2+this%W**2)-this%rho*this%q)-this%gamm*this%Pref - - return - end function EOS_all - - function viscosity_air(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,mu - - TC = max(100.0_WP,min(T,800.0_WP)) - mu = 1.716e-5_WP*(TC/273.15_WP)**1.5_WP*(273.15+110.4_WP)/(TC+110.4_WP) - ! mu = 2.5e-2_WP*(T/(1.488095e2/(1.4-1.0_WP)/717.6_WP))**0.75_WP - - return - end function viscosity_air - - function viscosity_water(this,T) result(mu) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,mu - - TC = max(276.15_WP,max(T,473.15_WP)) - mu = 2.414e-5_WP*10**(247.8_WP/(TC-140.0_WP)) - - return - end function viscosity_water - - function spec_heat_air(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,cv - - TC = max(173.15_WP,min(T,773.15_WP)) - cv = 717.8_WP+0.07075_WP*(TC-300_WP)+2.6125e-4_WP*(TC-300_WP)**2 - - return - end function spec_heat_air - - function spec_heat_water(this,T) result(cv) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,cv - - TC = max(3.0_WP,max(T-273.15_WP,200.0_WP)) - cv = (4209.0_WP-1.31_WP*TC+0.014_WP*TC**2)/this%gamm - - return - end function spec_heat_water - - function therm_cond_air(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,kappa - - TC = max(100.0_WP,min(T,1000.0_WP)) - kappa = 2.646e-3_WP*TC**1.5_WP/(TC+245.4_WP*10.0_WP**(-12.0_WP/TC)) - - return - end function therm_cond_air - - function therm_cond_water(this,T) result(kappa) - implicit none - class(matm), intent(inout) :: this - real(WP),intent(in) :: T - real(WP) :: TC,kappa - - TC = max(1.0_WP,min(T-273.15_WP,200.0_WP)) - kappa = 0.5706_WP+1.75e-3_WP*TC-6.46e-6_WP*TC**2 - - return - end function therm_cond_water - -end module matm_class - - From 42c6afb040430c92a31b2da4696b0676310732ff Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:39:51 -0500 Subject: [PATCH 063/152] Port new LPT routines to Master Fluidized bed example contains up-to-date changes to LPT. Implicit filtering works, particles feel fluid stress, LPT CFL bug fix, low Mach class has useful routines --- examples/fluidized_bed/GNUmakefile | 6 +- examples/fluidized_bed/input | 12 +- examples/fluidized_bed/src/simulation.f90 | 125 ++++++++-- src/particles/lpt_class.f90 | 290 ++++++++++------------ src/solver/diag_class.f90 | 21 +- src/variable_density/lowmach_class.f90 | 275 +++++++++++++++++++- 6 files changed, 524 insertions(+), 205 deletions(-) diff --git a/examples/fluidized_bed/GNUmakefile b/examples/fluidized_bed/GNUmakefile index 76671101d..818048416 100644 --- a/examples/fluidized_bed/GNUmakefile +++ b/examples/fluidized_bed/GNUmakefile @@ -23,10 +23,8 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/rgrawe/NGA2hypre -#IRL_DIR = /Users/desjardi/Builds/IRL +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 4902660bd..424988008 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -11,21 +11,23 @@ nz : 1 # Time integration Max timestep size : 1e-5 -Max cfl number : 1 -Max time : 10 +Max cfl number : 1 +Max time : 10 # Fluid properties Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 -Inlet velocity : 0.4 +Inlet velocity : 0.1 # Particle parameters Bed height : .0128 -Particle volume fraction : 0.4 +Particle volume fraction : 0.5 Coefficient of restitution : 0.8 +Friction coefficient : 0.1 Particle density : 2600 Particle diameter : 200e-6 +Collision timescale : 15e-5 # Pressure solver Pressure tolerance : 1e-5 @@ -36,4 +38,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 40e-5 \ No newline at end of file +Ensight output period : 80e-5 \ No newline at end of file diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index c077f9bec..8006e426f 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -21,19 +21,26 @@ module simulation type(partmesh) :: pmesh type(ensight) :: ens_out type(event) :: ens_evt - integer, dimension(:,:,:), allocatable :: cpu_rank !> Simulation monitor file - type(monitor) :: mfile,cflfile - type(monitor) :: lptfile + type(monitor) :: mfile,cflfile,lptfile,tfile public :: simulation_init,simulation_run,simulation_final !> Work arrays and fluid properties real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,dRHOdt + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp real(WP) :: visc,rho,inlet_velocity + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + contains @@ -71,11 +78,22 @@ subroutine simulation_init time=timetracker(amRoot=cfg%amRoot) call param_read('Max timestep size',time%dtmax) call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) time%dt=time%dtmax time%itmax=2 end block initialize_timetracker + ! Initialize timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + ! Create a low Mach flow solver with bconds create_flow_solver: block use ils_class, only: pcg_pfmg,pcg_amg @@ -109,19 +127,16 @@ subroutine simulation_init allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays - ! Store processor decomposition for visualization - store_cpu_rank: block - allocate(cpu_rank(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - cpu_rank=cfg%rank - end block store_cpu_rank - - ! Initialize our LPT solver initialize_lpt: block use random, only: random_uniform @@ -174,7 +189,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh @@ -188,11 +204,11 @@ subroutine simulation_init ! Get initial particle volume fraction call lp%update_VF() ! Set collision timescale - call param_read('Collision timescale',lp%tau_col,default=5.0_WP*time%dt) - lp%tau_col=5.0_WP*time%dt + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) ! Set coefficient of restitution call param_read('Coefficient of restitution',lp%e_n) call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) ! Set gravity call param_read('Gravity',lp%gravity) if (lp%cfg%amRoot) then @@ -206,13 +222,17 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh=partmesh(nvar=1,nvec=3,name='lpt') pmesh%varname(1)='diameter' pmesh%vecname(1)='velocity' + pmesh%vecname(2)='ang_vel' + pmesh%vecname(3)='Fcol' call lp%update_partmesh(pmesh) do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel + pmesh%vec(:,3,i)=lp%p(i)%Acol end do end block create_pmesh @@ -229,11 +249,12 @@ subroutine simulation_init call fs%get_bcond('inflow',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=inlet_velocity + fs%rhoU(i,j,k)=rho*inlet_velocity fs%U(i,j,k) =inlet_velocity end do - ! Set density from particle volume fraction + ! Set density from particle volume fraction and store initial density fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho ! Form momentum call fs%rho_multiply ! Apply all other boundary conditions @@ -244,7 +265,7 @@ subroutine simulation_init call fs%get_mfr() end block initialize_velocity - + ! Add Ensight output create_ensight: block ! Create Ensight output from cfg @@ -257,15 +278,16 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('epsp',lp%VF) call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('CPU',cpu_rank) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight - ! Create a monitor file + + ! Create monitor filea create_monitor: block ! Prepare some info about fields call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -292,6 +314,7 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') call cflfile%write() ! Create LPT monitor lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') @@ -309,6 +332,20 @@ subroutine simulation_init call lptfile%add_column(lp%dmin,'Particle dmin') call lptfile%add_column(lp%dmax,'Particle dmax') call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() end block create_monitor end subroutine simulation_init @@ -317,13 +354,18 @@ end subroutine simulation_init !> Perform an NGA2 simulation subroutine simulation_run use mathtools, only: twoPi + use parallel, only: parallel_time implicit none ! Perform time integration do while (.not.time%done()) + ! Initial wallclock time + wt_total%time_in=parallel_time() + ! Increment time call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() @@ -333,18 +375,25 @@ subroutine simulation_run fs%Vold=fs%V; fs%rhoVold=fs%rhoV fs%Wold=fs%W; fs%rhoWold=fs%rhoW + ! Get fluid stress + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + ! Collide and advance particles call lp%collide(dt=time%dtmid) - resU=rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in ! Perform sub-iterations do while (time%it.le.time%itmax) + wt_vel%time_in=parallel_time() + ! Build mid-time velocity and momentum fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) @@ -367,9 +416,9 @@ subroutine simulation_run do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*lp%srcU(i-1:i,j,k)) - resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*lp%srcV(i,j-1:j,k)) - resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*lp%srcW(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) end do end do end do @@ -396,12 +445,15 @@ subroutine simulation_run call fs%get_bcond('inflow',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=inlet_velocity + fs%rhoU(i,j,k)=rho*inlet_velocity fs%U(i,j,k) =inlet_velocity end do end block dirichlet_velocity + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + ! Solve Poisson equation + wt_pres%time_in=parallel_time() call fs%correct_mfr(drhodt=dRHOdt) call fs%get_div(drhodt=dRHOdt) fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid @@ -416,6 +468,7 @@ subroutine simulation_run fs%rhoV=fs%rhoV-time%dtmid*resV fs%rhoW=fs%rhoW-time%dtmid*resW call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in ! Increment sub-iteration counter time%it=time%it+1 @@ -423,8 +476,10 @@ subroutine simulation_run end do ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() call fs%interp_vel(Ui,Vi,Wi) call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in ! Output to ensight if (ens_evt%occurs()) then @@ -434,6 +489,8 @@ subroutine simulation_run do i=1,lp%np_ pmesh%var(1,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel + pmesh%vec(:,2,i)=lp%p(i)%angVel + pmesh%vec(:,3,i)=lp%p(i)%Acol end do end block update_pmesh call ens_out%write_data(time%t) @@ -446,6 +503,20 @@ subroutine simulation_run call cflfile%write() call lptfile%write() + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end do end subroutine simulation_run @@ -462,7 +533,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi,dRHOdt) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt) end subroutine simulation_final diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index cc3646fc6..4765b6fd3 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -30,7 +30,7 @@ module lpt_class real(WP), dimension(3) :: pos !< Particle center coordinates real(WP), dimension(3) :: vel !< Velocity of particle real(WP), dimension(3) :: angVel !< Angular velocity of particle - real(WP), dimension(3) :: col !< Normal collision force + real(WP), dimension(3) :: Acol !< Collision acceleration real(WP), dimension(3) :: Tcol !< Collision torque real(WP) :: T !< Temperature real(WP) :: dt !< Time step size for the particle @@ -115,12 +115,6 @@ module lpt_class ! Particle volume fraction real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcE !< E momentum source on mesh, cell-centered - ! Filtering operation logical :: implicit_filter !< Solve implicitly real(WP) :: filter_width !< Characteristic filter width @@ -144,7 +138,6 @@ module lpt_class procedure :: update_VF !< Compute particle volume fraction procedure :: filter !< Apply volume filtering to field procedure :: inject !< Inject particles at a prescribed boundary - !procedure :: get_vorticity !< Calculate vorticity end type lpt @@ -184,16 +177,12 @@ function constructor(cfg,name) result(self) ! Allocate VF and src arrays on cfg mesh allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - allocate(self%srcE(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcE=0.0_WP ! Set filter width to zero by default self%filter_width=0.0_WP - ! Solve explicitly by default - self%implicit_filter=.false. + ! Solve implicitly by default + self%implicit_filter=.true. ! Set default drag self%drag_model='Schiller-Naumann' @@ -359,7 +348,7 @@ function constructor(cfg,name) result(self) end block logging end function constructor - + !> Resolve collisional interaction between particles !> Requires tau_col, e_n, e_w and mu_f to be set beforehand @@ -374,7 +363,7 @@ subroutine collide(this,dt) zero_force: block integer :: i do i=1,this%np_ - this%p(i)%col=0.0_WP + this%p(i)%Acol=0.0_WP this%p(i)%Tcol=0.0_WP end do end block zero_force @@ -447,7 +436,10 @@ subroutine collide(this,dt) eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col ! Loop over all local particles - do i1=1,this%np_ + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision ! Store particle data r1=this%p(i1)%pos @@ -484,7 +476,7 @@ subroutine collide(this,dt) end if ! Calculate collision force f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%col=this%p(i1)%col+f_n+f_t + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) end if @@ -546,13 +538,13 @@ subroutine collide(this,dt) end if ! Calculate collision force f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%col=this%p(i1)%col+f_n+f_t + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) ! Add up the collisions this%ncol=this%ncol+1 end if - + end do end do @@ -560,11 +552,23 @@ subroutine collide(this,dt) end do ! Deal with dimensionality - if (this%cfg%nx.eq.1) this%p(i1)%col(1)=0.0_WP - if (this%cfg%ny.eq.1) this%p(i1)%col(2)=0.0_WP - if (this%cfg%nz.eq.1) this%p(i1)%col(3)=0.0_WP + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if - end do + end do collision ! Determine total number of collisions call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 @@ -575,78 +579,96 @@ end subroutine collide !> Advance the particle equations by a specified time step dt - subroutine advance(this,dt,U,V,W,rho,visc) + !> p%id=0 => no coll, no solve + !> p%id=-1=> no coll, no move + subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T,srcU,srcV,srcW,srcE) use mpi_f08, only : MPI_SUM,MPI_INTEGER use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcE !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom - type(part) :: pold + type(part) :: myp,pold ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - this%srcE=0.0_WP + if (present(srcU)) srcU=0.0_WP + if (present(srcV)) srcV=0.0_WP + if (present(srcW)) srcW=0.0_WP + if (present(srcE)) srcE=0.0_WP ! Zero out number of particles removed this%np_out=0 - ! Get fluid vorticity if needed - !if (this%use_torque) call get_vorticity(U,V,W,vort) - ! Advance the equations do i=1,this%np_ + ! Avoid particles with id=0 + if (this%p(i)%id.eq.0) cycle + ! Create local copy of particle + myp=this%p(i) ! Time-integrate until dt_done=dt dt_done=0.0_WP do while (dt_done.lt.dt) ! Decide the timestep size - mydt=min(this%p(i)%dt,dt-dt_done) + mydt=min(myp%dt,dt-dt_done) ! Remember the particle - pold=this%p(i) + pold=myp ! Particle moment of inertia per unit mass - Ip = 0.1_WP*this%p(i)%d**2 + Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+0.5_WP*mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+this%p(i)%col) - this%p(i)%angVel=pold%angVel+0.5_WP*mydt*(torque+this%p(i)%Tcol)/Ip + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) + myp%pos=pold%pos+0.5_WP*mydt*myp%vel + myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,p=this%p(i),acc=acc,torque=torque,opt_dt=this%p(i)%dt) - this%p(i)%pos=pold%pos+mydt*this%p(i)%vel - this%p(i)%vel=pold%vel+mydt*(acc+this%gravity+this%p(i)%col) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + myp%pos=pold%pos+mydt*myp%vel + myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip ! Relocalize - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) ! Send source term back to the mesh - dmom=mydt*acc*this%rho*Pi/6.0_WP*this%p(i)%d**3 - deng=sum(dmom*this%p(i)%vel) - if (this%cfg%nx.gt.1) call this%cfg%set_scalar(Sp=-dmom(1),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcU,bc='n') - if (this%cfg%ny.gt.1) call this%cfg%set_scalar(Sp=-dmom(2),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcV,bc='n') - if (this%cfg%nz.gt.1) call this%cfg%set_scalar(Sp=-dmom(3),pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcW,bc='n') - call this%cfg%set_scalar(Sp=-deng ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%srcE,bc='n') + dmom=mydt*acc*this%rho*Pi/6.0_WP*myp%d**3 + deng=sum(dmom*myp%vel) + if (this%cfg%nx.gt.1.and.present(srcU)) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcU,bc='n') + if (this%cfg%ny.gt.1.and.present(srcV)) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcV,bc='n') + if (this%cfg%nz.gt.1.and.present(srcW)) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcW,bc='n') + if (present(srcE)) call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcE,bc='n') ! Increment dt_done=dt_done+mydt end do ! Correct the position to take into account periodicity - if (this%cfg%xper) this%p(i)%pos(1)=this%cfg%x(this%cfg%imin)+modulo(this%p(i)%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) - if (this%cfg%yper) this%p(i)%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(this%p(i)%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) - if (this%cfg%zper) this%p(i)%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(this%p(i)%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) + if (this%cfg%xper) myp%pos(1)=this%cfg%x(this%cfg%imin)+modulo(myp%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) + if (this%cfg%yper) myp%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(myp%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) + if (this%cfg%zper) myp%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(myp%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) ! Handle particles that have left the domain - if (this%p(i)%pos(1).lt.this%cfg%x(this%cfg%imin).or.this%p(i)%pos(1).gt.this%cfg%x(this%cfg%imax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(2).lt.this%cfg%y(this%cfg%jmin).or.this%p(i)%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) this%p(i)%flag=1 - if (this%p(i)%pos(3).lt.this%cfg%z(this%cfg%kmin).or.this%p(i)%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) this%p(i)%flag=1 + if (myp%pos(1).lt.this%cfg%x(this%cfg%imin).or.myp%pos(1).gt.this%cfg%x(this%cfg%imax+1)) myp%flag=1 + if (myp%pos(2).lt.this%cfg%y(this%cfg%jmin).or.myp%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) myp%flag=1 + if (myp%pos(3).lt.this%cfg%z(this%cfg%kmin).or.myp%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) myp%flag=1 ! Relocalize the particle - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) ! Count number of particles removed - if (this%p(i)%flag.eq.1) this%np_out=this%np_out+1 + if (myp%flag.eq.1) this%np_out=this%np_out+1 + ! Copy back to particle + if (myp%id.ne.-1) this%p(i)=myp end do ! Communicate particles @@ -655,11 +677,19 @@ subroutine advance(this,dt,U,V,W,rho,visc) ! Sum up particles removed call MPI_ALLREDUCE(this%np_out,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_out=i - ! Divide source arrays by volume, sum at boundaries, and volume filter - this%srcU=this%srcU/this%cfg%vol; call this%cfg%syncsum(this%srcU); call this%filter(this%srcU) - this%srcV=this%srcV/this%cfg%vol; call this%cfg%syncsum(this%srcV); call this%filter(this%srcV) - this%srcW=this%srcW/this%cfg%vol; call this%cfg%syncsum(this%srcW); call this%filter(this%srcW) - this%srcE=this%srcE/this%cfg%vol; call this%cfg%syncsum(this%srcE); call this%filter(this%srcE) + ! Divide source arrays by volume, sum at boundaries, and volume filter if present + if (present(srcU)) then + srcU=srcU/this%cfg%vol; call this%cfg%syncsum(srcU); call this%filter(srcU) + end if + if (present(srcV)) then + srcV=srcV/this%cfg%vol; call this%cfg%syncsum(srcV); call this%filter(srcV) + end if + if (present(srcW)) then + srcW=srcW/this%cfg%vol; call this%cfg%syncsum(srcW); call this%filter(srcW) + end if + if (present(srcE)) then + srcE=srcE/this%cfg%vol; call this%cfg%syncsum(srcE); call this%filter(srcE) + end if ! Recompute volume fraction call this%update_VF() @@ -682,25 +712,30 @@ end subroutine advance !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) + subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque,opt_dt) implicit none class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(part), intent(in) :: p real(WP), dimension(3), intent(out) :: acc,torque real(WP), intent(out) :: opt_dt real(WP) :: fvisc,frho,pVF,fVF,fT - real(WP), dimension(3) :: fvel,fvort + real(WP), dimension(3) :: fvel,fstress,fvort ! Interpolate fluid quantities to particle location interpolate: block ! Interpolate the fluid phase velocity to the particle location fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + ! Interpolate the fluid phase stress to the particle location + fstress=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=stress_x,V=stress_y,W=stress_z) ! Interpolate the fluid phase viscosity to the particle location fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') fvisc=fvisc+epsilon(1.0_WP) @@ -712,7 +747,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') ! Interpolate the fluid vorticity to the particle location if needed - if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) end block interpolate ! Compute acceleration due to drag @@ -741,7 +776,7 @@ subroutine get_rhs(this,U,V,W,rho,visc,T,p,acc,torque,opt_dt) ! Particle response time tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) ! Return acceleration and optimal timestep size - acc=(fvel-p%vel)/tau + acc=(fvel-p%vel)/tau+fstress/this%rho opt_dt=tau/real(this%nstep,WP) end block compute_drag @@ -820,7 +855,7 @@ subroutine filter(this,A) this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) - this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(i+1,i,j,k) + this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(0,i+1,j,k) this%tridiag%Rx(j,k,i) = A(i,j,k) end do end do @@ -832,7 +867,7 @@ subroutine filter(this,A) do i=this%cfg%imin_,this%cfg%imax_ this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & - + this%div_y(1,i,j,k)* filter_coeff * this%grd_y(-1,i,j+1,k)) + + this%div_y(1,i,j,k) * filter_coeff * this%grd_y(-1,i,j+1,k)) this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) end do @@ -847,7 +882,7 @@ subroutine filter(this,A) this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) - this%tridiag% Rz(i,j,k) = this%tridiag%Ry(i,k,j) + this%tridiag%Rz(i,j,k) = this%tridiag%Ry(i,k,j) end do end do end do @@ -860,8 +895,6 @@ subroutine filter(this,A) end do end do end do - ! Sync A - call this%cfg%sync(A) else !< Apply filter explicitly ! Allocate flux arrays allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) @@ -888,84 +921,15 @@ subroutine filter(this,A) end do end do end do - ! Sync A - call this%cfg%sync(A) end do ! Deallocate flux arrays deallocate(FX,FY,FZ) end if - end subroutine filter - + ! Sync A + call this%cfg%sync(A) -!!$ !> Calculate vorticity -!!$ subroutine get_vorticity(this,U,V,W,vort) -!!$ use messager, only: die -!!$ implicit none -!!$ class(lowmach), intent(inout) :: this -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) -!!$ integer :: i,j,k -!!$ real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp -!!$ real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp -!!$ real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp -!!$ real(WP), dimension(3,3) :: dUdx -!!$ -!!$ ! Check vort's first dimension -!!$ if (size(vort,dim=1).ne.3) call die('[lpt get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') -!!$ -!!$ ! Calculate inside -!!$ do k=this%cfg%kmin_,this%cfg%kmax_ -!!$ do j=this%cfg%jmin_,this%cfg%jmax_ -!!$ do i=this%cfg%imin_,this%cfg%imax_ -!!$ ! Rebuild face velocities from interpolated velocities -!!$ Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) -!!$ Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) -!!$ Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) -!!$ ! Get velocity gradient tensor -!!$ dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) -!!$ dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) -!!$ dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) -!!$ ! Assemble the strain rate -!!$ SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP -!!$ SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) -!!$ SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) -!!$ SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) -!!$ end do -!!$ end do -!!$ end do -!!$ -!!$ ! Apply a Neumann condition in non-periodic directions -!!$ if (.not.this%cfg%xper) then -!!$ if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) -!!$ if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) -!!$ end if -!!$ if (.not.this%cfg%yper) then -!!$ if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) -!!$ if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) -!!$ end if -!!$ if (.not.this%cfg%zper) then -!!$ if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) -!!$ if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) -!!$ end if -!!$ -!!$ ! Ensure zero in walls -!!$ do k=this%cfg%kmino_,this%cfg%kmaxo_ -!!$ do j=this%cfg%jmino_,this%cfg%jmaxo_ -!!$ do i=this%cfg%imino_,this%cfg%imaxo_ -!!$ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP -!!$ end do -!!$ end do -!!$ end do -!!$ -!!$ ! Sync it -!!$ call this%cfg%sync(SR) -!!$ -!!$ end subroutine get_vorticity + end subroutine filter !> Inject particles from a prescribed location with given mass flowrate @@ -1007,7 +971,7 @@ subroutine inject(this,dt) allocate(nrecv(this%cfg%nproc)) count=0 inj_min(1)=this%cfg%x(this%cfg%imino) - inj_max(1)=this%cfg%x(this%cfg%imin+1)+this%inj_dmax + inj_max(1)=this%inj_pos(1)+this%inj_dmax inj_min(2)=this%inj_pos(2)-0.5_WP*this%inj_d-this%inj_dmax inj_max(2)=this%inj_pos(2)+0.5_WP*this%inj_d+this%inj_dmax inj_min(3)=this%inj_pos(3)-0.5_WP*this%inj_d-this%inj_dmax @@ -1064,11 +1028,12 @@ subroutine inject(this,dt) ! Set various parameters for the particle this%p(count)%id =maxid+int(np_tmp,8) this%p(count)%dt =0.0_WP - this%p(count)%col =0.0_WP + this%p(count)%Acol =0.0_WP + this%p(count)%Tcol =0.0_WP this%p(count)%T =this%inj_T this%p(count)%angVel=0.0_WP ! Give a position at the injector to the particle - this%p(count)%pos=get_position(0.6_WP*this%p(count)%d) + this%p(count)%pos=get_position() overlap=.false. ! Check overlap with particles recently injected if (this%use_col) then @@ -1147,16 +1112,15 @@ function get_diameter() result(dp) end function get_diameter ! Position for bulk injection of particles - function get_position(mind) result(pos) + function get_position() result(pos) use random, only: random_uniform use mathtools, only: twoPi implicit none - real(WP), intent(in) :: mind real(WP), dimension(3) :: pos real(WP) :: rand,r,theta integer :: ip,jp,kp ! Set x position - pos(1) = this%cfg%x(this%cfg%imin)+mind + pos(1) = this%inj_pos(1) ! Random y & z position within a circular region if (this%cfg%nz.eq.1) then pos(2)=random_uniform(lo=this%inj_pos(2)-0.5_WP*this%inj_d,hi=this%inj_pos(3)+0.5_WP*this%inj_d) @@ -1188,9 +1152,9 @@ subroutine get_cfl(this,dt,cfl) ! Set the CFLs to zero my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP; my_CFL_col=0.0_WP do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxmi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dymi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzmi(this%p(i)%ind(3))) + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) my_CFL_col=max(my_CFL_col,sqrt(sum(this%p(i)%vel**2))/this%p(i)%d) end do my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index 3bb6e1f98..b671d7f84 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -201,6 +201,7 @@ subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) real(WP), dimension(:,:,:), allocatable :: recvbuf1 real(WP), dimension(:,:), allocatable :: recvbuf2 integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 ! Stuff integer :: i,igroup integer :: k1,L,k2,nk @@ -316,10 +317,22 @@ subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) ! Solve reduced systems if (.not.nper) then - call pentadiagonal_serial(& - recvbuf1(:,1,2:2*proc-1),recvbuf1(:,2,2:2*proc-1),recvbuf1(:,3,2:2*proc-1),& - recvbuf1(:,4,2:2*proc-1),recvbuf1(:,5,2:2*proc-1),recvbuf1(:,6,2:2*proc-1),& - 2*proc-2,nlot) + ! Store in buf to avoid creating a temporary array (there must be a better way to do this) + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,2:2*proc-1) + buf2=recvbuf1(:,2,2:2*proc-1) + buf3=recvbuf1(:,3,2:2*proc-1) + buf4=recvbuf1(:,4,2:2*proc-1) + buf5=recvbuf1(:,5,2:2*proc-1) + buf6=recvbuf1(:,6,2:2*proc-1) + call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) + recvbuf1(:,1,2:2*proc-1)=buf1 + recvbuf1(:,2,2:2*proc-1)=buf2 + recvbuf1(:,3,2:2*proc-1)=buf3 + recvbuf1(:,4,2:2*proc-1)=buf4 + recvbuf1(:,5,2:2*proc-1)=buf5 + recvbuf1(:,6,2:2*proc-1)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) else call pentadiagonal_periodic_serial(& recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index b6653a3c5..0325bc59e 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -122,6 +122,9 @@ module lowmach_class procedure :: get_dmomdt !< Calculate dmom/dt procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient + procedure :: get_div_stress !< Calculate divergence of stress + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_vorticity !< Calculate vorticity tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL @@ -1242,6 +1245,274 @@ subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) call this%cfg%sync(Pgrady) call this%cfg%sync(Pgradz) end subroutine get_pgrad + + + !> Calculate divergence of stress based on U/V/W/P (needed by LPT class) + subroutine get_div_stress(this,divx,divy,divz) + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divy !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ii,jj,kk + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Stress tensor in X + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii-1; j=jj-1; k=kk-1 + FX(i,j,k)=+this%visc(i,j,k)*(sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))+sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))+sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))) + end do + end do + end do + ! Divergence of X stress + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divx(i,j,k)=sum(this%divu_x(:,i,j,k)*FX(i-1:i,j,k))+& + & sum(this%divu_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divu_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divx) + + ! Stress tensor in Y + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))+sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))) + ! Fluxes on y-face + i=ii-1; j=jj-1; k=kk-1 + FY(i,j,k)=+this%visc(i,j,k)*(sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))+sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))) + end do + end do + end do + ! Divergence of Y stress + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divy(i,j,k)=sum(this%divv_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divv_y(:,i,j,k)*FY(i,j-1:j,k))+& + & sum(this%divv_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divy) + + ! Stress tensor in Z + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))+sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))+sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))) + ! Fluxes on z-face + i=ii-1; j=jj-1; k=kk-1 + FZ(i,j,k)=+this%visc(i,j,k)*(sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))+sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) & + & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & + & -this%P(i,j,k) + end do + end do + end do + ! Divergence in Z + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + divz(i,j,k)=sum(this%divw_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divw_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divw_z(:,i,j,k)*FZ(i,j,k-1:k)) + end do + end do + end do + ! Sync it + call this%cfg%sync(divz) + + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + + end subroutine get_div_stress + + + !> Calculate velocity gradient tensor + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[lowmach get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + + !> Calculate vorticity vector + subroutine get_vorticity(this,vort) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check vort's first two dimensions + if (size(vort,dim=1).ne.3) call die('[lowmach get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + vort(1,i,j,k)=0.25_WP*(sum(dwdy(i,j:j+1,k:k+1))-sum(dvdz(i,j:j+1,k:k+1))) + vort(2,i,j,k)=0.25_WP*(sum(dudz(i:i+1,j,k:k+1))-sum(dwdx(i:i+1,j,k:k+1))) + vort(3,i,j,k)=0.25_WP*(sum(dvdx(i:i+1,j:j+1,k))-sum(dudy(i:i+1,j:j+1,k))) + end do + end do + end do + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(vort) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_vorticity !> Divide momentum by rho to form velocity @@ -1344,7 +1615,7 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) real(WP), dimension(3,3) :: dUdx ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + if (size(SR,dim=1).ne.6) call die('[lowmach get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') ! Calculate inside do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1872,7 +2143,7 @@ subroutine addsrc_gravity(this,resU,resV,resW) end subroutine addsrc_gravity - !> Print out info for incompressible flow solver + !> Print out info for low-Mach flow solver subroutine lowmach_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none From b533e73cbb1bb13dbb8a4ea62e1aa306a009b5cf Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:43:23 -0500 Subject: [PATCH 064/152] Simple IB pipe case Simple IB pipe case. Does not rely on an IBM solver. --- .gitignore | 2 +- examples/ib_pipe/GNUmakefile | 48 ++++ examples/ib_pipe/README | 2 + examples/ib_pipe/input | 33 +++ examples/ib_pipe/src/Make.package | 2 + examples/ib_pipe/src/geometry.f90 | 91 +++++++ examples/ib_pipe/src/simulation.f90 | 363 ++++++++++++++++++++++++++++ 7 files changed, 540 insertions(+), 1 deletion(-) create mode 100644 examples/ib_pipe/GNUmakefile create mode 100644 examples/ib_pipe/README create mode 100644 examples/ib_pipe/input create mode 100644 examples/ib_pipe/src/Make.package create mode 100644 examples/ib_pipe/src/geometry.f90 create mode 100644 examples/ib_pipe/src/simulation.f90 diff --git a/.gitignore b/.gitignore index 48d591885..31ec775b7 100644 --- a/.gitignore +++ b/.gitignore @@ -39,7 +39,7 @@ stat/ # Ignore all content of examples examples/*/* -examples/*/GNUmakefile +!examples/*/GNUmakefile !examples/*/input* examples/*/input*~ !examples/*/README diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile new file mode 100644 index 000000000..936d89562 --- /dev/null +++ b/examples/ib_pipe/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/ib_pipe/README b/examples/ib_pipe/README new file mode 100644 index 000000000..ba28b9a69 --- /dev/null +++ b/examples/ib_pipe/README @@ -0,0 +1,2 @@ +Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: +Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input new file mode 100644 index 000000000..84a9b75be --- /dev/null +++ b/examples/ib_pipe/input @@ -0,0 +1,33 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Pipe diameter : 1 +Pipe length : 4 +nx : 256 +ny : 96 +nz : 1 + +# Pipe properties +Bulk velocity : 1 +Fluctuation amp : 0.2 + +# Time integration +Max timestep size : 0.008 +Max cfl number : 0.9 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : .001 +Density : 1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 \ No newline at end of file diff --git a/examples/ib_pipe/src/Make.package b/examples/ib_pipe/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_pipe/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 new file mode 100644 index 000000000..27a956cad --- /dev/null +++ b/examples/ib_pipe/src/geometry.f90 @@ -0,0 +1,91 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,D,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 new file mode 100644 index 000000000..b18c7cd9a --- /dev/null +++ b/examples/ib_pipe/src/simulation.f90 @@ -0,0 +1,363 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G,VF + real(WP) :: Ubulk,Umean,Dpipe + +contains + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + real(WP) :: visc + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: amp + ! Initial fields + call param_read('Pipe diameter',Dpipe) + call param_read('Bulk velocity',Ubulk); Umean=Ubulk + call param_read('Fluctuation amp',amp,default=0.0_WP) + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=Ubulk*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) + fs%V(i,j,k)=Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) + fs%U(i,j,k)=fs%U(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + call fs%cfg%sync(VF) + call fs%cfg%sync(G) + end block initialize_ibm + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',VF) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(Umean,'Umean') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + forcing: block + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: myU,myUvol,Uvol,VFx + myU=0.0_WP; myUvol=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) + myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx + end do + end do + end do + call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myU ,Umean,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=Umean/Uvol + resU=resU+Ubulk-Umean + end block forcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + VFx =get_VF(i,j,k,'U') + VFy =get_VF(i,j,k,'V') + VFz =get_VF(i,j,k,'W') + fs%U(i,j,k)=VFx*fs%U(i,j,k) + fs%V(i,j,k)=VFy*fs%V(i,j,k) + fs%W(i,j,k)=VFz*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + call fs%cfg%sync(VF) + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + case('V') + delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r + case('W') + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r + case default + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta))) + end function get_VF + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation From ec6fad52022afd1741741b691a0dfdaf29c4eb0e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:45:05 -0500 Subject: [PATCH 065/152] Channel case added Olivier's channel case (without non-Newtonian visc part) --- examples/channel/GNUmakefile | 47 ++++ examples/channel/README | 1 + examples/channel/input | 34 +++ examples/channel/src/Make.package | 2 + examples/channel/src/geometry.f90 | 67 +++++ examples/channel/src/simulation.f90 | 375 ++++++++++++++++++++++++++++ 6 files changed, 526 insertions(+) create mode 100644 examples/channel/GNUmakefile create mode 100644 examples/channel/README create mode 100644 examples/channel/input create mode 100644 examples/channel/src/Make.package create mode 100644 examples/channel/src/geometry.f90 create mode 100644 examples/channel/src/simulation.f90 diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile new file mode 100644 index 000000000..4cdeaeb5f --- /dev/null +++ b/examples/channel/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = #TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core constant_density data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/channel/README b/examples/channel/README new file mode 100644 index 000000000..b3393d325 --- /dev/null +++ b/examples/channel/README @@ -0,0 +1 @@ +Periodic channel flow with forcing. diff --git a/examples/channel/input b/examples/channel/input new file mode 100644 index 000000000..8ded82286 --- /dev/null +++ b/examples/channel/input @@ -0,0 +1,34 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 5 +Ly : 1 +Lz : 0.04 +nx : 128 +ny : 40 +nz : 1 +Stretching : 2.1 + +# Fluid properties and velocity +Dynamic viscosity : 0.01 +Density : 1 +Ubulk : 1 +Wbulk : 0 +Perturbation : 0 + +# Time integration +Max timestep size : 2e-2 +Max cfl number : 0.9 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 +Postproc output period : 10 diff --git a/examples/channel/src/Make.package b/examples/channel/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/channel/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/channel/src/geometry.f90 b/examples/channel/src/geometry.f90 new file mode 100644 index 000000000..fdd61597f --- /dev/null +++ b/examples/channel/src/geometry.f90 @@ -0,0 +1,67 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz,stretch + real(WP), dimension(:), allocatable :: x,y,z + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)); call param_read('Stretching',stretch) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + ! Create simple rectilinear grid in x and z, tanh-stretched grid in y + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=0.5_WP*Ly*tanh(stretch*(2.0_WP*real(j-1,WP)/real(ny,WP)-1.0_WP))/tanh(stretch) + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + ! General serial grid object + grid=sgrid(coord=cartesian,no=1,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='channel') + end block create_grid + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=0.0_WP + cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP + call cfg%sync(cfg%VF) + end block create_walls + + end subroutine geometry_init + + +end module geometry diff --git a/examples/channel/src/simulation.f90 b/examples/channel/src/simulation.f90 new file mode 100644 index 000000000..7a9cd4137 --- /dev/null +++ b/examples/channel/src/simulation.f90 @@ -0,0 +1,375 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver and corresponding time tracker + type(incomp), public :: fs + type(timetracker), public :: time + type(hypre_str), public :: ps + type(hypre_str), public :: vs + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,forcefile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:,:), allocatable :: SR + + !> Fluid viscosity + real(WP) :: visc + + !> Channel forcing + real(WP) :: Ubulk,Wbulk + real(WP) :: meanU,meanW + + !> Event for post-processing + type(event) :: ppevt + +contains + + + !> Specialized subroutine that outputs the velocity distribution + subroutine postproc_vel() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp + ! Allocate vertical line storage + allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP + allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP + allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP + allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP + ! Integrate all data over x and z + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) + Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) + end do + end do + end do + ! All-reduce the data + call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + do j=fs%cfg%jmin,fs%cfg%jmax + if (vol(j).gt.0.0_WP) then + Uavg(j)=Uavg(j)/vol(j) + else + Uavg(j)=0.0_WP + end if + end do + ! If root, print it out + if (fs%cfg%amRoot) then + filename='Uavg_' + write(timestamp,'(es12.5)') time%t + open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) + write(iunit,'(a12,3x,a12)') 'Height','Uavg' + do j=fs%cfg%jmin,fs%cfg%jmax + write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) + end do + close(iunit) + end if + ! Deallocate work arrays + deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc_vel + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + use mathtools, only: twoPi + integer :: i,j,k + real(WP) :: amp,vel + ! Create flow solver + fs=incomp(cfg=cfg,name='NS solver') + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign constant density + call param_read('Density',fs%rho) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + ! Initialize velocity based on specified bulk + call param_read('Ubulk',Ubulk) + call param_read('Wbulk',Wbulk) + where (fs%umask.eq.0) fs%U=Ubulk + where (fs%wmask.eq.0) fs%W=Wbulk + meanU=Ubulk + meanW=Wbulk + ! To facilitate transition + call param_read('Perturbation',amp) + vel=sqrt(Ubulk**2+Wbulk**2) + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (fs%umask(i,j,k).eq.0) fs%U(i,j,k)=fs%U(i,j,k)+amp*vel*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL) + if (fs%wmask(i,j,k).eq.0) fs%W(i,j,k)=fs%W(i,j,k)+amp*vel*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='channel') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('viscosity',fs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create forcing monitor + forcefile=monitor(fs%cfg%amRoot,'forcing') + call forcefile%add_column(time%n,'Timestep number') + call forcefile%add_column(time%t,'Time') + call forcefile%add_column(meanU,'Bulk U') + call forcefile%add_column(meanW,'Bulk W') + call forcefile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc_vel() + end block create_postproc + + + end subroutine simulation_init + + + !> Time integrate our problem + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + forcing: block + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: myU,myUvol,myW,myWvol,Uvol,Wvol + myU=0.0_WP; myUvol=0.0_WP; myW=0.0_WP; myWvol=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + if (fs%umask(i,j,k).eq.0) then + myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) + myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k) + end if + if (fs%wmask(i,j,k).eq.0) then + myW =myW +fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k)*(2.0_WP*fs%W(i,j,k)-fs%Wold(i,j,k)) + myWvol=myWvol+fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k) + end if + end do + end do + end do + call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myU ,meanU,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanU=meanU/Uvol + where (fs%umask.eq.0) resU=resU+Ubulk-meanU + call MPI_ALLREDUCE(myWvol,Wvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myW ,meanW,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanW=meanW/Wvol + where (fs%wmask.eq.0) resW=resW+Wbulk-meanW + end block forcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + call forcefile%write() + + ! Specialized post-processing + if (ppevt%occurs()) call postproc_vel() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,SR) + + end subroutine simulation_final + + + + + +end module simulation From 4d62407694b314bf2690fd0dbe83385a44c6b3c3 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:51:15 -0500 Subject: [PATCH 066/152] Direct forcing solver added Direct forcing IBM solver with example. Still needs updates to allow for moving IBs but that is not difficult. --- examples/ib_tester/GNUmakefile | 48 ++ examples/ib_tester/README | 1 + examples/ib_tester/input | 38 ++ examples/ib_tester/src/Make.package | 2 + examples/ib_tester/src/geometry.f90 | 76 +++ examples/ib_tester/src/simulation.f90 | 434 +++++++++++++ src/immersed/Make.package | 4 + src/immersed/df_class.f90 | 849 ++++++++++++++++++++++++++ src/libraries/mathtools.f90 | 21 +- 9 files changed, 1472 insertions(+), 1 deletion(-) create mode 100644 examples/ib_tester/GNUmakefile create mode 100644 examples/ib_tester/README create mode 100644 examples/ib_tester/input create mode 100644 examples/ib_tester/src/Make.package create mode 100644 examples/ib_tester/src/geometry.f90 create mode 100644 examples/ib_tester/src/simulation.f90 create mode 100644 src/immersed/Make.package create mode 100644 src/immersed/df_class.f90 diff --git a/examples/ib_tester/GNUmakefile b/examples/ib_tester/GNUmakefile new file mode 100644 index 000000000..ac96a691d --- /dev/null +++ b/examples/ib_tester/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := constant_density immersed core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/ib_tester/README b/examples/ib_tester/README new file mode 100644 index 000000000..8f62622e1 --- /dev/null +++ b/examples/ib_tester/README @@ -0,0 +1 @@ +This is a basic IBM case, intended as a test of the direct forcing IBM with the incompressible solver. It solves flow past a bumpy cylinder. diff --git a/examples/ib_tester/input b/examples/ib_tester/input new file mode 100644 index 000000000..c3fab0f5b --- /dev/null +++ b/examples/ib_tester/input @@ -0,0 +1,38 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 8 +Ly : 4 +Lz : 0.125 +nx : 128 +ny : 64 +nz : 1 + +# IBM properties +Number of markers : 100 +Diameter : 1 +Position : 2 +Perturbation amp : .05 +Perturbation freq : 6 + +# Time integration +Max timestep size : 0.02 +Max cfl number : 1 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : .002 +Density : 1 +Inlet velocity : 1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 \ No newline at end of file diff --git a/examples/ib_tester/src/Make.package b/examples/ib_tester/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_tester/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_tester/src/geometry.f90 b/examples/ib_tester/src/geometry.f90 new file mode 100644 index 000000000..bbad77ef3 --- /dev/null +++ b/examples/ib_tester/src/geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='IBM') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_tester/src/simulation.f90 b/examples/ib_tester/src/simulation.f90 new file mode 100644 index 000000000..4b781948d --- /dev/null +++ b/examples/ib_tester/src/simulation.f90 @@ -0,0 +1,434 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use df_class, only: dfibm + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(dfibm), public :: df + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP) :: inlet_velocity + +contains + + + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_of_domain + + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + use incomp_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define boundary conditions + call fs%add_bcond(name='inflow', type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi,arctan + integer :: i,j,k,np + real(WP) :: Dcyl,Xcyl,amp,freq,theta,r + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + ! Read cylinder properties + call param_read('Number of markers',np) + call param_read('Diameter',Dcyl) + call param_read('Position',Xcyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =1 + df%p(i)%vel =0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm = df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(1)=df%p(i)%pos(1)+Xcyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%G(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r + end do + end do + end do + call df%cfg%sync(df%G) + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%xL*real(df%cfg%nx,WP) + end if + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + ! Initial fields + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! Set inflow velocity/momentum + call param_read('Inlet velocity',inlet_velocity) + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ibm') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('markers',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VF',df%VF) + call ens_out%add_scalar('levelset',df%G) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + resU=fs%rho + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+sum(fs%itpi_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + fs%V(i,j,k)=fs%V(i,j,k)+sum(fs%itpi_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + fs%W(i,j,k)=fs%W(i,j,k)+sum(fs%itpi_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + end block dirichlet_velocity + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation diff --git a/src/immersed/Make.package b/src/immersed/Make.package new file mode 100644 index 000000000..246e3ea51 --- /dev/null +++ b/src/immersed/Make.package @@ -0,0 +1,4 @@ +f90EXE_sources += df_class.f90 + +INCLUDE_LOCATIONS += $(NGA_HOME)/src/immersed +VPATH_LOCATIONS += $(NGA_HOME)/src/immersed diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 new file mode 100644 index 000000000..36d6b4ae1 --- /dev/null +++ b/src/immersed/df_class.f90 @@ -0,0 +1,849 @@ +!> Basic direct forcing IBM class: +!> Provides support for Lagrangian marker particles +module df_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: dfibm + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic marker particle definition + type :: part + !> MPI_DOUBLE_PRECISION data + real(WP) :: dA !< Element area + real(WP), dimension(3) :: norm !< Outward normal vector + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + !> MPI_INTEGER data + integer :: id !< ID the object is associated with + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=2 + integer , dimension(part_nblock) :: part_lblock=[10,5] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Basic ibm object definition + type :: obj + !> MPI_DOUBLE_PRECISION data + real(WP) :: vol !< Object volume + real(WP), dimension(3) :: pos !< Center of mass + real(WP), dimension(3) :: vel !< Translational velocity of the object + real(WP), dimension(3) :: angVel !< Angular velocity of the object + real(WP), dimension(3) :: F !< Hydrodynamic force + end type obj + + !> Direct forcing IBM solver object definition + type :: dfibm + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM + + ! Marker particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Object data + integer :: nobj !< Global number of objects + type(obj), dimension(:), allocatable :: o !< Array of objects of type obj + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + logical :: can_move !< Flag to allow moving IBM objects + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info + real(WP) :: Umin,Umax,Umean !< U velocity info + real(WP) :: Vmin,Vmax,Vmean !< V velocity info + real(WP) :: Wmin,Wmax,Wmean !< W velocity info + real(WP) :: Fx,Fy,Fz !< Total force + + ! Volume fraction associated with IBM projection + real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + + ! Distance levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered + + contains + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: setup_obj !< Setup IBM object + procedure :: get_source !< Compute direct forcing source + procedure :: resize !< Resize particle array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute volume fraction + procedure :: get_delta !< Compute regularized delta function + procedure :: interpolate !< Interpolation routine from mesh=>marker + procedure :: extrapolate !< Extrapolation routine from marker=>mesh + end type dfibm + + + !> Declare df solver constructor + interface dfibm + procedure constructor + end interface dfibm + +contains + + + !> Default constructor for direct forcing solver + function constructor(cfg,name) result(self) + implicit none + type(dfibm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate levelset, VF and src arrays on cfg mesh + allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + + ! Initialize object + self%can_move=.false. + self%nobj=0 + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Setup IBM objects, each processors own all objects + subroutine setup_obj(this) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i,j,n,ibuf,ierr + real(WP) :: myVol,dV,fac + real(WP), dimension(3) :: pos0,dist + ! Determine number of objects based on marker ID + n=1 + do i=1,this%np_ + n=max(n,this%p(i)%id) + end do + call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + ! Allocate and zero out the object array + allocate(this%o(1:this%nobj)) + if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then + fac=1.0_WP/3.0_WP + else + fac=1.0_WP/2.0_WP + end if + do i=1,this%nobj + ! Zero-out object properties + this%o(i)%pos=0.0_WP + this%o(i)%vel=0.0_WP + this%o(i)%angVel=0.0_WP + this%o(i)%F=0.0_WP + ! Compute center of mass + myVol=0.0_WP + do j=1,this%np_ + ! Determine particle associated with object + if (this%p(j)%id.eq.i) then + myVol=myVol+this%p(j)%dA + this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV + ! Determine object volume + myVol=0.0_WP + do j=1,this%np_ + if (this%p(j)%id.eq.i) then + dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) + if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) + if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) + if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) + myVol=myVol+fac*sum(dist)*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV + end do + end subroutine setup_obj + + + !> Compute direct forcing source by a specified time step dt + subroutine get_source(this,dt,U,V,W,rho) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: dti,rho_,dV + real(WP), dimension(3) :: vel,src + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + + ! Zero-out forces on objects + do i=1,this%nobj + this%o(i)%F=0.0_WP + end do + + ! Advance the equations + dti=1.0_WP/dt + do i=1,this%np_ + ! Interpolate the velocity to the particle location + vel=0.0_WP + if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') + if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') + if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') + rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') + ! Compute the source term + src=(this%p(i)%vel-vel) + ! Get element volume + dV = this%p(i)%dA * sqrt( & + (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + ! Send source term back to the mesh + if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') + ! Sum up force on object (Newton's 3rd law) + j=max(this%p(i)%id,1) + this%o(j)%F=this%o(j)%F-rho_*src*dV*dti + end do + + ! Sum at boundaries + call this%cfg%syncsum(this%srcU) + call this%cfg%syncsum(this%srcV) + call this%cfg%syncsum(this%srcW) + + ! Sum over each object + do j=1,this%nobj + call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src + end do + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end subroutine get_source + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i + real(WP) :: dV + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Get element volume + dV = this%p(i)%dA * sqrt( & + (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & + (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & + (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) + ! Transfer volume to mesh + call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') + end do + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + end subroutine update_VF + + + !> Compute regularized delta function + subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(out) :: delta !< Return delta function + integer, intent(in) :: ic,jc,kc !< Cell index + real(WP), intent(in) :: xp,yp,zp !< Position of marker + character(len=*) :: dir + real(WP) :: deltax,deltay,deltaz,r + + ! Compute in X + if (trim(adjustl(dir)).eq.'U') then + r = (xp-this%cfg%x(ic))*this%cfg%dxmi(ic) + deltax = roma_kernel(r)*this%cfg%dxmi(ic) + else + r = (xp-this%cfg%xm(ic))*this%cfg%dxi(ic) + deltax = roma_kernel(r)*this%cfg%dxi(ic) + end if + + ! Compute in Y + if (trim(adjustl(dir)).eq.'V') then + r = (yp-this%cfg%y(jc))*this%cfg%dymi(jc) + deltay = roma_kernel(r)*this%cfg%dymi(jc) + else + r = (yp-this%cfg%ym(jc))*this%cfg%dyi(jc) + deltay = roma_kernel(r)*this%cfg%dyi(jc) + end if + + ! Compute in Z + if (trim(adjustl(dir)).eq.'W') then + r = (zp-this%cfg%z(kc))*this%cfg%dzmi(kc) + deltaz = roma_kernel(r)*this%cfg%dzmi(kc) + else + r = (zp-this%cfg%zm(kc))*this%cfg%dzi(kc) + deltaz = roma_kernel(r)*this%cfg%dzi(kc) + end if + + ! Put it all together + delta=deltax*deltay*deltaz + + contains + ! Mollification kernel + ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 + function roma_kernel(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + if (abs(r).le.0.5_WP) then + phi = 1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) + else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then + phi = 1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + else + phi = 0.0_WP + end if + end function roma_kernel + + end subroutine get_delta + + + !> Interpolation routine + function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + character(len=*) :: dir + real(WP) :: Ap + integer :: di,dj,dk + integer :: i1,i2,j1,j2,k1,k2 + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + ! Get the interpolation points + i1=ip-2; i2=ip+2 + j1=jp-2; j2=jp+2 + k1=kp-2; k2=kp+2 + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual interpolation on Ap + Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) + end function interpolate + + + !> Extrapolation routine + subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) + use messager, only: die + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(in) :: Ap + character(len=*) :: dir + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + integer :: di,dj,dk + ! If particle has left processor domain or reached last ghost cell, kill job + if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& + jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& + kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then + write(*,*) ip,jp,kp,xp,yp,zp + call die('[df extrapolate] Particle has left the domain') + end if + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual extrapolation on A + A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap + end subroutine extrapolate + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z + + ! Return if not used + if (.not.this%can_move) then + cfl=0.0_WP + return + end if + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Get mean, max, and min volume fraction and total force + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) + this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) + this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(dfibm), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(dfibm), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(dfibm), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if + end if + end subroutine resize + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(dfibm), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do + end if + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header + if (this%cfg%amRoot) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) + end if + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + +end module df_class diff --git a/src/libraries/mathtools.f90 b/src/libraries/mathtools.f90 index 2b18578e1..94c11b56e 100644 --- a/src/libraries/mathtools.f90 +++ b/src/libraries/mathtools.f90 @@ -10,6 +10,7 @@ module mathtools public :: cross_product public :: normalize public :: qrotate + public :: arctan ! Trigonometric parameters real(WP), parameter :: Pi =3.1415926535897932385_WP @@ -146,7 +147,25 @@ pure function qrotate(v,q) result(w) w(3)= 2.0_WP*(q(2)*q(4)-q(1)*q(3)) *v(1)+& & 2.0_WP*(q(3)*q(4)+q(1)*q(2)) *v(2)+& & (2.0_WP*(q(1)*q(1)+q(4)*q(4))-1.0_WP)*v(3) - end function + end function qrotate + + + ! Safe arctan + function arctan(dx,dy) + implicit none + real(WP), intent(in) :: dx,dy + real(WP) :: arctan + if (abs(dx)+abs(dy).lt.1.0e-9_WP) then + arctan = 0.0_WP + else + arctan = atan(dy/dx) + end if + if (dx.le.0.0_WP) then + arctan = Pi+arctan + elseif (dy.le.0.0_WP .and. dx.gt.0.0_WP) then + arctan = twoPi+arctan + end if + end function arctan end module mathtools From 8e5df3b717550cb4b8de88019868f8ae154f7922 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:53:24 -0500 Subject: [PATCH 067/152] Update sgsmodel_class.f90 Separate out different SGS models. Currently includes constant coeff Smagornisky, Vreman, and dynamic smag. Dynamic smag still has a bug. --- src/subgrid/sgsmodel_class.f90 | 162 ++++++++++++++++++++++++++++----- 1 file changed, 137 insertions(+), 25 deletions(-) diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index 93d3faf27..d74b623ae 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -10,8 +10,10 @@ module sgsmodel_class ! Expose type/constructor/methods public :: sgsmodel - ! Some clipping parameters - real(WP), parameter :: Cs_ref=0.1_WP + ! List of SGS LES models available + integer, parameter, public :: dynamic_smag =1 !< Dynamic Smagorinsky -- BROKEN + integer, parameter, public :: constant_smag=2 !< Constant Smagorinsky + integer, parameter, public :: vreman =3 !< Vreman 2004 !> SGS model object definition type :: sgsmodel @@ -22,6 +24,9 @@ module sgsmodel_class ! Safe index bounds integer :: imin_in,jmin_in,kmin_in !< Safe min in each direction integer :: imax_in,jmax_in,kmax_in !< Safe max in each direction + + ! Some clipping parameters + real(WP) :: Cs_ref=0.1_WP ! LM and MM tensor norms and eddy viscosity real(WP), dimension(:,:,:), allocatable :: LM,MM !< LM and MM tensor norms @@ -41,8 +46,11 @@ module sgsmodel_class procedure :: log=>sgs_log !< Log SGS info procedure :: print=>sgs_print !< Output SGS info to the screen - procedure :: get_visc !< Calculate the SGS viscosity - + procedure :: get_visc !< Calls appropriate eddy viscosity subroutine + procedure :: visc_dynamic !< Calculate the SGS viscosity (Dynamic Smag) + procedure :: visc_cst !< Calculate the SGS viscosity (Constant Smag) + procedure :: visc_vreman !< Calculate the SGS viscosity (Vreman 2004) + procedure, private :: interpolate !< Helper function that interpolates a field to a point end type sgsmodel @@ -58,7 +66,6 @@ module sgsmodel_class !> Default constructor for model function constructor(cfg,umask,vmask,wmask) result(self) - use messager, only: die implicit none type(sgsmodel) :: self class(config), target, intent(in) :: cfg @@ -249,10 +256,51 @@ function constructor(cfg,umask,vmask,wmask) result(self) end function constructor - - !> Get subgrid scale dynamic viscosity - subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) - use param, only: verbose + !> Calls appropriate eddy viscosity subroutine according to SGSmodel%type + subroutine get_visc(this,type,dt,rho,Ui,Vi,Wi,SR,gradu) + use messager, only: die + use param, only: verbose + implicit none + class(sgsmodel), intent(inout) :: this + integer, intent(in) :: type !< Model type + real(WP), intent(in) :: dt !< dt since the last call to the model + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Ui !< Interpolated velocities including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Vi !< Interpolated velocities including all ghosts + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: Wi !< Interpolated velocities including all ghosts + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: SR !< Strain rate tensor + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: gradu !< Velocity gradient tensor + + select case(type) + case(dynamic_smag) + if (.not.present(Ui).or..not.(present(Vi)).or..not.present(Wi).or..not.present(SR)) & + call die('[sgs get_visc] Dynamic Smagorinsky model requires Ui, Vi, Wi, and SR') + call this%visc_dynamic(dt,rho,Ui,Vi,Wi,SR,gradu) + case(constant_smag) + if (.not.present(SR)) call die('[sgs get_visc] Constant Smagorinsky model requires SR') + call this%visc_cst(rho,SR) + case(vreman) + if (.not.present(gradu)) call die('[sgs get_visc] Vreman model requires gradu') + call this%visc_vreman(rho,gradu) + end select + + ! Calculate some info on the model + calc_info: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN + use parallel, only: MPI_REAL_WP + integer :: ierr + call MPI_ALLREDUCE(maxval(this%visc),this%max_visc,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(minval(this%visc),this%min_visc,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + end block calc_info + + ! Output info about model + if (verbose.gt.0) call this%log() + if (verbose.gt.1) call this%print() + + end subroutine get_visc + + !> Get subgrid scale dynamic viscosity - Dynamic + subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) implicit none class(sgsmodel), intent(inout) :: this real(WP), intent(in) :: dt !< dt since the last call to the model @@ -261,6 +309,7 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: Vi !< Interpolated velocities including all ghosts real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: Wi !< Interpolated velocities including all ghosts real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SR !< Strain rate tensor + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient tensor integer :: i,j,k real(WP) :: Frho,FU,FV,FW,FS_ real(WP) :: Cs,tau,alpha @@ -329,7 +378,6 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) end do end do end do - ! Synchronize LM and MM call this%cfg%sync(this%LM) call this%cfg%sync(this%MM) @@ -349,7 +397,7 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) this%MM(i,j,k)=alpha*this%MM(i,j,k)+(1.0_WP-alpha)*this%interpolate(pos,i,j,k,MMold) ! Safe limits this%LM(i,j,k)=max(this%LM(i,j,k),100.0_WP*epsilon(1.0_WP)) - this%MM(i,j,k)=max(this%MM(i,j,k),100.0_WP*epsilon(1.0_WP)/Cs_ref**2) + this%MM(i,j,k)=max(this%MM(i,j,k),100.0_WP*epsilon(1.0_WP)/this%Cs_ref**2) end do end do end do @@ -363,33 +411,97 @@ subroutine get_visc(this,dt,rho,Ui,Vi,Wi,SR) else Cs=0.0_WP end if - Cs=Cs_ref + Cs = this%Cs_ref this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*Cs*this%delta(i,j,k)**2 end do end do end do - ! Synchronize visc call this%cfg%sync(this%visc) ! Deallocate work arrays deallocate(LMold,MMold,S_) - ! Calculate some info on the model - calc_info: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN - use parallel, only: MPI_REAL_WP - integer :: ierr - call MPI_ALLREDUCE(maxval(this%visc),this%max_visc,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(minval(this%visc),this%min_visc,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) - end block calc_info + end subroutine visc_dynamic + + + !> Get subgrid scale dynamic viscosity - Constant + subroutine visc_cst(this,rho,SR) + implicit none + class(sgsmodel), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SR !< Strain rate tensor + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: S_ - ! Output info about model - if (verbose.gt.0) call this%log() - if (verbose.gt.1) call this%print() + ! Prepare magnitude of SR tensor + allocate(S_(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + S_=sqrt(SR(1,:,:,:)**2+SR(2,:,:,:)**2+SR(3,:,:,:)**2+2.0_WP*(SR(4,:,:,:)**2+SR(5,:,:,:)**2+SR(6,:,:,:)**2)) - end subroutine get_visc + ! Compute the eddy viscosity + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref*this%delta(i,j,k)**2 + end do + end do + end do + + ! Synchronize visc + call this%cfg%sync(this%visc) + + ! Deallocate work arrays + deallocate(S_) + + end subroutine visc_cst + + !> Get subgrid scale dynamic viscosity - Vreman + subroutine visc_vreman(this,rho,gradu) + implicit none + class(sgsmodel), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient + real(WP), dimension(:,:,:), allocatable :: alph2 !< velocity gradient tensor squared + real(WP) :: C,B,beta11,beta22,beta33,beta12,beta13,beta23 + integer :: i,j,k + + allocate(alph2(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + alph2 = gradu(1,1,:,:,:)**2 + gradu(1,2,:,:,:)**2 + gradu(1,3,:,:,:)**2 + & + gradu(2,1,:,:,:)**2 + gradu(2,2,:,:,:)**2 + gradu(2,3,:,:,:)**2 + & + gradu(3,1,:,:,:)**2 + gradu(3,2,:,:,:)**2 + gradu(3,3,:,:,:)**2 + + ! Model constant - FOR HIT c \approx 0.07 + ! For complex flows c = 2.5*Cs**2 + C = 2.5*this%Cs_ref**2 + + ! Compute the eddy viscosity + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + beta11 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)**2 + gradu(2,1,i,j,k)**2 + gradu(3,1,i,j,k)**2) + beta22 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)**2 + gradu(2,2,i,j,k)**2 + gradu(3,2,i,j,k)**2) + beta33 = this%delta(i,j,k)**2*(gradu(1,3,i,j,k)**2 + gradu(2,3,i,j,k)**2 + gradu(3,3,i,j,k)**2) + beta12 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,2,i,j,k) + gradu(2,1,i,j,k)*gradu(2,2,i,j,k) + & + gradu(3,1,i,j,k)*gradu(3,2,i,j,k)) + beta13 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,3,i,j,k) + gradu(2,1,i,j,k)*gradu(2,3,i,j,k) + & + gradu(3,1,i,j,k)*gradu(3,3,i,j,k)) + beta23 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)*gradu(1,3,i,j,k) + gradu(2,2,i,j,k)*gradu(2,3,i,j,k) + & + gradu(3,2,i,j,k)*gradu(3,3,i,j,k)) + + B = beta11*beta22 - beta12**2 + beta11*beta33 - beta13**2 + beta22*beta33 - beta23**2 + this%visc(i,j,k) = C*sqrt(B/alph2(i,j,k)) + end do + end do + end do + + ! Synchronize visc + call this%cfg%sync(this%visc) + + ! Deallocate work arrays + deallocate(alph2) + + end subroutine visc_vreman !> Private function that performs an trilinear interpolation of a cell-centered !> field A to the provided position pos in the vicinity of cell i0,j0,k0 From 0e80a30f2ed25a8c39631c8e2fc7c001634239fd Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sun, 8 Jan 2023 11:56:35 -0500 Subject: [PATCH 068/152] Part inject Particle injection example --- examples/part_inject/GNUmakefile | 48 +++++++++++++++++++++++++ examples/part_inject/input | 14 ++++---- examples/part_inject/src/simulation.f90 | 19 ++++++---- 3 files changed, 67 insertions(+), 14 deletions(-) create mode 100644 examples/part_inject/GNUmakefile diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile new file mode 100644 index 000000000..c66736380 --- /dev/null +++ b/examples/part_inject/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = TRUE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/part_inject/input b/examples/part_inject/input index 6c23990d9..ce0325099 100644 --- a/examples/part_inject/input +++ b/examples/part_inject/input @@ -5,9 +5,9 @@ Partition : 1 2 2 Lx : 0.007 Ly : 0.01792 Lz : 0.01792 -nx : 50 -ny : 128 -nz : 128 +nx : 70 +ny : 180 +nz : 180 # Time integration Max timestep size : 1e-5 @@ -20,20 +20,20 @@ Density : 1 # Particle parameters Particle mean diameter : 37.515e-6 -Particle standard deviation : 1.7894e-5 -Particle min diameter : 8.1e-6 +Particle standard deviation : 17.894e-6 +Particle min diameter : 10e-6 Particle max diameter : 139.1e-6 Particle diameter shift : 0 Particle density : 2250 # Particle collisions -Coefficient of restitution : 0.85 +Coefficient of restitution : 0.5 Wall restitution : 0.1 Friction coefficient : 0.5 # Particle injection Particle inject diameter: 0.00127 -Particle mass flow rate: 0.00001 +Particle mass flow rate: 0.00002 Particle velocity: 0.18 0 0 # Ensight output diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index cce52c896..09d75af36 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -84,7 +84,8 @@ subroutine simulation_init lp%inj_dmax=lp%inj_dmean end if call param_read('Particle inject diameter',lp%inj_d) - lp%inj_pos=0.0_WP + lp%inj_pos(1)=lp%cfg%x(lp%cfg%imin)+lp%inj_dmax + lp%inj_pos(2:3)=0.0_WP lp%inj_T=300.0_WP end block initialize_lpt @@ -110,13 +111,15 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block integer :: i - pmesh=partmesh(nvar=1,nvec=2,name='lpt') - pmesh%varname(1)='diameter' + pmesh=partmesh(nvar=2,nvec=2,name='lpt') + pmesh%varname(1)='id' + pmesh%varname(2)='diameter' pmesh%vecname(1)='velocity' pmesh%vecname(2)='ang_vel' call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d + pmesh%var(1,i)=real(lp%p(i)%id,WP) + pmesh%var(2,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel pmesh%vec(:,2,i)=lp%p(i)%angVel end do @@ -153,7 +156,7 @@ subroutine simulation_init call mfile%add_column(lp%np_new,'Npart new') call mfile%add_column(lp%np_out,'Npart removed') call mfile%add_column(lp%ncol,'Particle collisions') - call mfile%add_column(lp%VFmean,'Mean VF') + call mfile%add_column(lp%VFmax,'Max VF') call mfile%add_column(lp%Umin,'Particle Umin') call mfile%add_column(lp%Umax,'Particle Umax') call mfile%add_column(lp%Vmin,'Particle Vmin') @@ -196,7 +199,8 @@ subroutine simulation_run call lp%collide(dt=time%dt) ! Advance particles by dt - call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc) + U=0.0_WP; V=0.0_WP; W=0.0_WP + call lp%advance(dt=time%dt,U=U,V=V,W=W,rho=rho,visc=visc,stress_x=U,stress_y=V,stress_z=W) ! Output to ensight if (ens_evt%occurs()) then @@ -204,7 +208,8 @@ subroutine simulation_run integer :: i call lp%update_partmesh(pmesh) do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d + pmesh%var(1,i)=real(lp%p(i)%id,WP) + pmesh%var(2,i)=lp%p(i)%d pmesh%vec(:,1,i)=lp%p(i)%vel pmesh%vec(:,2,i)=lp%p(i)%angVel end do From 49fc8e8e32095cd8edb264afcf76a13ecc0ace04 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 9 Jan 2023 15:46:23 -0500 Subject: [PATCH 069/152] Update simulation.f90 Avoid division by 0 --- examples/ib_pipe/src/simulation.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index b18c7cd9a..56c68aa1b 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -326,15 +326,15 @@ function get_VF(i,j,k,dir) result(VF) select case(trim(dir)) case('U') delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r case('V') delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2) + r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r case('W') delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r case default delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) @@ -342,7 +342,7 @@ function get_VF(i,j,k,dir) result(VF) norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r end select lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta))) + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) end function get_VF From 8420943006b7b58e9ec1bb8e947796ef476d4c8e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 13 Jan 2023 12:57:56 -0500 Subject: [PATCH 070/152] Update diag_class.f90 Added buffers to avoid warning messages printed to the screen --- src/solver/diag_class.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index b671d7f84..f8b7b9975 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -334,10 +334,22 @@ subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) recvbuf1(:,6,2:2*proc-1)=buf6 deallocate(buf1,buf2,buf3,buf4,buf5,buf6) else - call pentadiagonal_periodic_serial(& - recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& - recvbuf1(:,4,:),recvbuf1(:,5,:),recvbuf1(:,6,:),& + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,:) + buf2=recvbuf1(:,2,:) + buf3=recvbuf1(:,3,:) + buf4=recvbuf1(:,4,:) + buf5=recvbuf1(:,5,:) + buf6=recvbuf1(:,6,:) + call pentadiagonal_periodic_serial(buf1,buf2,buf3,buf4,buf5,buf6,& 2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) + recvbuf1(:,1,:)=buf1 + recvbuf1(:,2,:)=buf2 + recvbuf1(:,3,:)=buf3 + recvbuf1(:,4,:)=buf4 + recvbuf1(:,5,:)=buf5 + recvbuf1(:,6,:)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) end if ! Move solution to first slot From 2224e252d5a95fed5ec50a95fae3e23c684330a2 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 14 Jan 2023 14:09:52 -0500 Subject: [PATCH 071/152] Remove case More work needs to be done before we can simulate shock-particle interactions in NGA2 --- examples/shock_particle/GNUmakefile | 49 -- examples/shock_particle/README | 1 - examples/shock_particle/input | 44 -- examples/shock_particle/src/Make.package | 2 - examples/shock_particle/src/geometry.f90 | 81 --- examples/shock_particle/src/simulation.f90 | 593 --------------------- 6 files changed, 770 deletions(-) delete mode 100644 examples/shock_particle/GNUmakefile delete mode 100644 examples/shock_particle/README delete mode 100644 examples/shock_particle/input delete mode 100644 examples/shock_particle/src/Make.package delete mode 100644 examples/shock_particle/src/geometry.f90 delete mode 100644 examples/shock_particle/src/simulation.f90 diff --git a/examples/shock_particle/GNUmakefile b/examples/shock_particle/GNUmakefile deleted file mode 100644 index 676358efc..000000000 --- a/examples/shock_particle/GNUmakefile +++ /dev/null @@ -1,49 +0,0 @@ -# NGA location if not yet defined -NGA_HOME ?= ../.. - -# Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_HYPRE = TRUE -USE_LAPACK= TRUE -USE_IRL = TRUE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga - -# Directories that contain user-defined code -Udirs := src - -# Include user-defined sources -Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) -Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) -include $(Upack) -INCLUDE_LOCATIONS += $(Ulocs) -VPATH_LOCATIONS += $(Ulocs) - -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre -IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ - -# NGA compilation definitions -include $(NGA_HOME)/tools/GNUMake/Make.defs - -# Include NGA base code -Bdirs := core two_phase particles data solver config grid libraries -Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) -include $(Bpack) - -# Inform user of Make.packages used -ifdef Ulocs - $(info Taking user code from: $(Ulocs)) -endif -$(info Taking base code from: $(Bdirs)) - -# Target definition -all: $(executable) - @echo COMPILATION SUCCESSFUL - -# NGA compilation rules -include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/shock_particle/README b/examples/shock_particle/README deleted file mode 100644 index 098c2471d..000000000 --- a/examples/shock_particle/README +++ /dev/null @@ -1 +0,0 @@ -This is a test case for a shock wave interacting with Lagrangian particles. Uses multiphase solver and hard-codes VF to 0 or 1 based on chosen phase. diff --git a/examples/shock_particle/input b/examples/shock_particle/input deleted file mode 100644 index b359f094b..000000000 --- a/examples/shock_particle/input +++ /dev/null @@ -1,44 +0,0 @@ -# Parallelization -Partition : 3 1 1 - -# Mesh definition -Lx : 0.2048 -nx : 512 -Ly : 0.0256 -ny : 64 - -# Flow setup -Shock location : 0.08 -Mach number of shock : 1.47 -Pre-shock density : 1.204 -Pre-shock pressure : 1.01325e5 -Particle volume fraction : 0.2 -Particle curtain width : 0.0034 - -# Fluid properties -Phase : gas -Dynamic viscosity : 1.8e-5 -Thermal conductivity : 0 -Gamma : 1.4 - -# Particle parameters -Particle density : 1000 -Particle diameter : 200e-6 -Drag model : Tenneti - -# Time integration -Max timestep size : 8e-7 -Max cfl number : 0.9 -Max time : 100000 -Max steps : 100000 - -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 10e-6 diff --git a/examples/shock_particle/src/Make.package b/examples/shock_particle/src/Make.package deleted file mode 100644 index a7a927853..000000000 --- a/examples/shock_particle/src/Make.package +++ /dev/null @@ -1,2 +0,0 @@ -# List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/shock_particle/src/geometry.f90 b/examples/shock_particle/src/geometry.f90 deleted file mode 100644 index 736845194..000000000 --- a/examples/shock_particle/src/geometry.f90 +++ /dev/null @@ -1,81 +0,0 @@ -!> Various definitions and tools for initializing NGA2 config -module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - -contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read, param_exists - use parallel, only: amRoot - use messager, only: die - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz,dx - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - dx = Lx/nx - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nz',nz,default=1); allocate(z(nz+1)) - - if (nz.eq.1) then - Lz = dx - else - call param_read('Lz',Lz) - end if - - ! Uniform grid - do i=1,nx+1 - x(i) = real(i-1,WP)*dx - end do - do j=1,ny+1 - y(j) = real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly - end do - - ! z is always uniform - do k=1,nz+1 - z(k) = real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='ShockTube') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition',partition,short='p') - - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - - end block create_cfg - - - end subroutine geometry_init - - -end module geometry diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 deleted file mode 100644 index 53a91f348..000000000 --- a/examples/shock_particle/src/simulation.f90 +++ /dev/null @@ -1,593 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use mast_class, only: mast - use vfs_class, only: vfs - use matm_class, only: matm - use lpt_class, only: lpt - use partmesh_class, only: partmesh - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - use string, only: str_medium - implicit none - private - - !> Single two-phase flow solver, volume fraction solver, material model, and LPT solver set - !> With corresponding time tracker - type(mast), public :: fs - type(vfs), public :: vf - type(matm), public :: matmod - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,cvgfile - type(monitor) :: lptfile - - public :: simulation_init,simulation_run,simulation_final - - !> Problem definition - character(len=str_medium) :: phase - integer :: relax_model - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resE - real(WP), dimension(:,:,:), allocatable :: dRHOdt - - contains - - !> Function that localizes the left (x-) of the domain - function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. - end function left_of_domain - - !> Function that localizes the right (x+) of the domain - function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. - end function right_of_domain - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - call param_read('Max steps',time%nmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resE (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT - initialize_lpt: block - use random, only: random_uniform - use mathtools, only: Pi - use parallel, only: amRoot - use lpt_class, only: drag_model - real(WP) :: dp,VFp,L,x0,vol,volp - integer :: i,np - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get drag model from the inpit - call param_read('Drag model',drag_model,default='Tenneti') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle diameter',dp) - ! Get particle volume fraction from the input - call param_read('Particle volume fraction',VFp) - ! Get curtain width from the input - call param_read('Particle curtain width',L) - ! Get starting position - x0=0.5_WP*(lp%cfg%x(lp%cfg%imax+1)-lp%cfg%x(lp%cfg%imin)-L) - ! Get number of particles - vol=L*lp%cfg%yL*lp%cfg%zL - volp=Pi*dp**3/6.0_WP - np=int(VFp * vol / volp) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(x0,x0+L),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin) - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero collision force - lp%p(i)%col=0.0_WP - ! Give it temperature - lp%p(i)%T=293.15_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do - end if - ! Distribute particles - call lp%sync() - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - if (amRoot) then - print*,"===== Particle Setup Description =====" - print*,'Number of particles', np - print*,'Mean volume fraction',vfp - end if - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') - call lp%update_partmesh(pmesh) - end block create_pmesh - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver with lvira reconstruction - vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') - call param_read('Phase',phase) - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - select case(trim(phase)) - case('gas') - vf%VF(i,j,k)=0.0_WP - case('liquid') - vf%VF(i,j,k)=1.0_WP - case default - end select - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end do - end do - end do - ! Boundary conditions on VF are built into the mast solver - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Set initial interface at the boundaries - call vf%set_full_bcond() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a compressible two-phase flow solver - create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz - use matm_class, only : air - use ils_class, only: pcg_bbox,gmres_smg - use mathtools, only: Pi - use parallel, only: amRoot - integer :: i,j,k,n - real(WP), dimension(3) :: xyz - real(WP) :: gamm,Pref,visc,hdff - real(WP) :: xshock,vshock,relshockvel - real(WP) :: rho0, P0, rho1, P1, Ma1, Ma, rho, P, U - type(bcond), pointer :: mybc - ! Create material model class - matmod=matm(cfg=cfg,name='Liquid-gas models') - ! Get EOS parameters from input - call param_read('Gamma',gamm) - ! Register equations of state - select case(trim(phase)) - case('gas') - call matmod%register_idealgas('gas',gamm) - case('liquid') - call param_read('Pref', Pref) - call matmod%register_stiffenedgas('liquid',gamm,Pref) - end select - ! Create flow solver - fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) - ! Register flow solver variables with material models - call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) - call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity, also heat diffusion - call param_read('Dynamic viscosity',visc) - call param_read('Thermal conductivity',hdff) - select case(trim(phase)) - case('gas') - call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscconst_gas=visc, & - viscconst_liquid=0.0_WP, hdffconst_gas=hdff, hdffconst_liquid=0.0_WP) - fs%Lrho = 0.0_WP - fs%LrhoE= 0.0_WP - case('liquid') - call matmod%register_diffusion_thermo_models(viscconst_gas=0.0_WP, viscconst_liquid=visc, & - hdffconst_gas=0.0_WP, hdffconst_liquid=hdff) - fs%Grho = 0.0_WP - end select - ! Read in surface tension coefficient - fs%sigma=0.0_WP - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit momentum solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) - ! Initially 0 velocity in y and z - fs%Vi = 0.0_WP; fs%Wi = 0.0_WP - ! Zero face velocities as well for the sake of dirichlet boundaries - fs%V = 0.0_WP; fs%W = 0.0_WP - ! Set up initial thermo properties (0) - ! Default is from Meng & Colonius (2015), - ! which is basically the same as Igra & Takayama and Terashima & Tryggvason - call param_read('Pre-shock density',rho0,default=1.204_WP) - call param_read('Pre-shock pressure',P0,default=1.01325e5_WP) - call param_read('Mach number of shock',Ma,default=1.47_WP) - call param_read('Shock location',xshock) - ! Use shock relations to get post-shock numbers (1) - P1 = P0 * (2.0_WP*gamm*Ma**2 - (gamm-1.0_WP)) / (gamm+1.0_WP) - rho1 = rho0 * (Ma**2 * (gamm+1.0_WP) / ((gamm-1.0_WP)*Ma**2 + 2.0_WP)) - ! Calculate post-shock Mach number - Ma1 = sqrt(((gamm-1.0_WP)*(Ma**2)+2.0_WP)/(2.0_WP*gamm*(Ma**2)-(gamm-1.0_WP))) - ! Calculate post-shock velocity - vshock = -Ma1 * sqrt(gamm*P1/rho1) + Ma*sqrt(gamm*P0/rho0) - ! Velocity at which shock moves - relshockvel = -rho1*vshock/(rho0-rho1) - - if (amRoot) then - print*,"===== Fluid Setup Description =====" - print*,'Mach number', Ma - print*,'Pre-shock: Density',rho0,'Pressure',P0 - print*,'Post-shock: Density',rho1,'Pressure',P1,'Velocity',vshock - print*,'Shock velocity', relshockvel - end if - - ! Initialize gas phase quantities - do i=fs%cfg%imino_,fs%cfg%imaxo_ - ! pressure, velocity, use matmod for energy - if (fs%cfg%x(i).lt.xshock) then - rho = rho1 - U = vshock - P = P1 - else - rho = rho0 - U = 0.0_WP - P = P0 - end if - select case(trim(phase)) - case('gas') - fs%Grho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%GrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'gas') - case('liquid') - fs%Lrho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%LrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'liquid') - end select - end do - - ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers - call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1) - - ! Calculate face velocities - call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) - ! Apply face BC - inflow - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%n_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=vshock - end do - ! Apply face BC - outflow - bc_scope = 'velocity' - call fs%apply_bcond(time%dt,bc_scope) - - ! Calculate mixture density and momenta - fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho - fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi - ! Perform initial pressure relax - relax_model = mech_egy_mech_hhz - call fs%pressure_relax(vf,matmod,relax_model) - ! Calculate initial phase and bulk moduli - call fs%init_phase_bulkmod(vf,matmod) - call fs%reinit_phase_pressure(vf,matmod) - call fs%harmonize_advpressure_bulkmod(vf,matmod) - ! Set initial pressure to harmonized field based on internal energy - fs%P = fs%PA - - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ShockTube') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) - call ens_out%add_scalar('T',fs%Tmptr) - call ens_out%add_scalar('P',fs%P) - call ens_out%add_scalar('PA',fs%PA) - call ens_out%add_scalar('Density',fs%RHO) - call ens_out%add_scalar('Bulkmod',fs%RHOSS2) - call ens_out%add_scalar('divU',fs%divU) - call ens_out%add_scalar('Viscosity',fs%visc) - call ens_out%add_scalar('Mach',fs%Mach) - call ens_out%add_particle('particles',pmesh) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%RHOmin,'RHOmin') - call mfile%add_column(fs%RHOmax,'RHOmax') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%Tmax,'Tmax') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLa_x,'Acoustic xCFL') - call cflfile%add_column(fs%CFLa_y,'Acoustic yCFL') - call cflfile%add_column(fs%CFLa_z,'Acoustic zCFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create convergence monitor - cvgfile=monitor(fs%cfg%amRoot,'cvg') - call cvgfile%add_column(time%n,'Timestep number') - call cvgfile%add_column(time%it,'Iteration') - call cvgfile%add_column(time%t,'Time') - call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') - call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') - call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') - call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') - call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') - call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') - call cvgfile%add_column(fs%psolv%it,'Pressure iteration') - call cvgfile%add_column(fs%psolv%rerr,'Pressure error') - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%VFmean,'VFp_mean') - call lptfile%add_column(lp%VFmax,'VFp_max') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - use messager, only: die - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Reinitialize phase pressure by syncing it with conserved phase energy - call fs%reinit_phase_pressure(vf,matmod) - fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi - fs%RHOold = fs%RHO - ! Remember old flow variables (phase) - fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho - fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE - fs%GPold = fs%GP; fs%LPold = fs%LP - - ! Remember old interface, including VF and barycenters - call vf%copy_interface_to_old() - - ! Create in-cell reconstruction - call fs%flow_reconstruct(vf) - - ! Zero variables that will change during subiterations - fs%P = 0.0_WP - fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP - fs%Hpjump = 0.0_WP - - ! Determine semi-Lagrangian advection flag - call fs%flag_sl(time%dt,vf) - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - resU=fs%rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) - - ! Update density based on particle volume fraction - fs%rho=resU*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Add momentum source term from lpt (cell-centered) - add_lpt_src: block - integer :: i,j,k - resU=0.0_WP; resV=0.0_WP; resW=0.0_WP; resE=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+lp%srcU(i,j,k) - resV(i,j,k)=resV(i,j,k)+lp%srcV(i,j,k) - resW(i,j,k)=resW(i,j,k)+lp%srcW(i,j,k) - resE(i,j,k)=resE(i,j,k)+lp%srcE(i,j,k) - end do - end do - end do - end block add_lpt_src - - ! Predictor step, involving advection and pressure terms - call fs%advection_step(time%dt,vf,matmod) - - ! Viscous step - call fs%diffusion_src_explicit_step(time%dt,vf,matmod,srcU=resU,srcV=resV,srcW=resW,srcE=resE) - - ! Prepare pressure projection - call fs%pressureproj_prepare(time%dt,vf,matmod) - ! Initialize and solve Helmholtz equation - call fs%psolv%setup() - fs%psolv%sol=fs%PA-fs%P - call fs%psolv%solve() - call fs%cfg%sync(fs%psolv%sol) - ! Perform corrector step using solution - fs%P=fs%P+fs%psolv%sol - call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) - - ! Record convergence monitor - call cvgfile%write() - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Pressure relaxation - call fs%pressure_relax(vf,matmod,relax_model) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block update_pmesh - call fs%get_viz() - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,resE,dRHOdt) - - end subroutine simulation_final - -end module simulation From c8761dbd7fadb1997d922de21faca3639248a599 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 24 Jan 2023 14:18:38 -0500 Subject: [PATCH 072/152] Update lpt_class.f90 Make stress and src terms in LPT optional --- src/particles/lpt_class.f90 | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 4765b6fd3..8a8b24021 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -592,9 +592,9 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) @@ -606,6 +606,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo) :: sx,sy,sz type(part) :: myp,pold ! Zero out source term arrays @@ -613,6 +614,23 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty if (present(srcV)) srcV=0.0_WP if (present(srcW)) srcW=0.0_WP if (present(srcE)) srcE=0.0_WP + + ! Get fluid stress + if (present(stress_x)) then + sx=stress_x + else + sx=0.0_WP + end if + if (present(stress_y)) then + sy=stress_y + else + sy=0.0_WP + end if + if (present(stress_z)) then + sz=stress_z + else + sz=0.0_WP + end if ! Zero out number of particles removed this%np_out=0 @@ -633,13 +651,13 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Particle moment of inertia per unit mass Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) myp%pos=pold%pos+0.5_WP*mydt*myp%vel myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) myp%pos=pold%pos+mydt*myp%vel myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip From 30c26b79bceb41dc0d7fdac101389bd4c68263a3 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Wed, 25 Jan 2023 12:07:52 -0500 Subject: [PATCH 073/152] current (not working) p3dfft class; same error as library example when run with valgrind --- examples/hit/GNUmakefile | 28 +- examples/hit/input | 6 +- examples/hit/src/simulation.f90 | 20 +- src/particles/lpt_class.f90 | 6 +- src/solver/Make.package | 6 +- src/solver/pfft3d_class.f90 | 1388 +++++++--------------------- tools/GNUMake/Make.defs | 4 + tools/GNUMake/Make.local | 10 +- tools/GNUMake/comps/gnu.mak | 5 +- tools/GNUMake/packages/Make.p3dfft | 12 + 10 files changed, 382 insertions(+), 1103 deletions(-) create mode 100644 tools/GNUMake/packages/Make.p3dfft diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f61dc7ef2..3363e6b2d 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -2,15 +2,16 @@ NGA_HOME ?= ../.. # Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_FFTW = TRUE -USE_HYPRE = TRUE -USE_LAPACK= TRUE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = TRUE +USE_P3DFFT = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga # Directories that contain user-defined code Udirs := src @@ -23,9 +24,11 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/rgrawe/NGA2hypre -FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 +P3DFFT_DIR = /opt/p3dfft-3/build # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs @@ -47,3 +50,4 @@ all: $(executable) # NGA compilation rules include $(NGA_HOME)/tools/GNUMake/Make.rules + diff --git a/examples/hit/input b/examples/hit/input index 0c376b4a8..c6312645e 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 1 4 +Partition : 1 1 1 # Mesh definition Lx : 1 @@ -20,10 +20,6 @@ Number of particles : 100000 Max timestep size : 1e-3 Max cfl number : 0.9 -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - # Implicit velocity solver Implicit tolerance : 1e-6 Implicit iteration : 100 diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index c906814b1..efb92a5d0 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -3,7 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg use pfft3d_class, only: pfft3d - use hypre_str_class, only: hypre_str + !use hypre_str_class, only: hypre_str use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +15,8 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - !type(pfft3d), public :: ps - type(hypre_str), public :: ps + type(pfft3d), public :: ps + !type(hypre_str), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -72,7 +72,7 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block - use hypre_str_class, only: pcg_pfmg + !use hypre_str_class, only: pcg_pfmg ! Create flow solver fs=incomp(cfg=cfg,name='NS solver') ! Assign constant viscosity @@ -80,11 +80,11 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=pfft3d(cfg=cfg,name='Pressure') - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps=pfft3d(cfg, 'Pressure Solver', 7) + !ps%maxlevel=10 <- uncomment for other solvers + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -185,7 +185,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,name='lpt',nvec=0) call lp%update_partmesh(pmesh) end block create_pmesh diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 4765b6fd3..3ae41ba1c 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -592,9 +592,9 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) diff --git a/src/solver/Make.package b/src/solver/Make.package index 6fc6cc525..55d909dc8 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -1,8 +1,8 @@ -f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 +f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 ils_class.f90 ifeq ($(USE_HYPRE),TRUE) - f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 + f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 endif -ifeq ($(USE_FFTW),TRUE) +ifeq ($(USE_P3DFFT),TRUE) f90EXE_sources += pfft3d_class.f90 endif diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 85605ba08..ea8c8b340 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -1,1070 +1,332 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -! Based on serial FFTW here, and manual transpose. It'd be nice to switch to a library +!> Makes use of the P3DFFT++ module pfft3d_class - use precision, only: WP - use config_class, only: config - use string, only: str_short - use linsol_class, only: linsol - use, intrinsic :: iso_c_binding - implicit none - private - - - ! Expose type/constructor/methods - public :: pfft3d - - - !> pfft3d object definition - type, extends(linsol) :: pfft3d - - ! FFT's oddball - logical :: oddball - - ! Data storage for FFTW plans - real(C_DOUBLE), dimension(:), allocatable :: in_x,out_x - real(C_DOUBLE), dimension(:), allocatable :: in_y,out_y - real(C_DOUBLE), dimension(:), allocatable :: in_z,out_z - - ! FFTW plans - type(C_PTR) :: fplan_x,bplan_x - type(C_PTR) :: fplan_y,bplan_y - type(C_PTR) :: fplan_z,bplan_z - - ! Storage for transposed data - real(WP), dimension(:,:,:), allocatable :: xtrans - real(WP), dimension(:,:,:), allocatable :: ytrans - real(WP), dimension(:,:,:), allocatable :: ztrans - - ! Transpose partition - X - integer, dimension(:), allocatable :: imin_x,imax_x - integer, dimension(:), allocatable :: jmin_x,jmax_x - integer, dimension(:), allocatable :: kmin_x,kmax_x - integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x - integer :: sendcount_x,recvcount_x - character(len=str_short) :: xdir - - ! Transpose partition - Y - integer, dimension(:), allocatable :: imin_y,imax_y - integer, dimension(:), allocatable :: jmin_y,jmax_y - integer, dimension(:), allocatable :: kmin_y,kmax_y - integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y - integer :: sendcount_y,recvcount_y - character(len=str_short) :: ydir - - ! Transpose partition - Z - integer, dimension(:), allocatable :: imin_z,imax_z - integer, dimension(:), allocatable :: jmin_z,jmax_z - integer, dimension(:), allocatable :: kmin_z,kmax_z - integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z - integer :: sendcount_z,recvcount_z - character(len=str_short) :: zdir - - contains - - procedure :: print_short=>pfft3d_print_short !< One-line printing of solver status - procedure :: print=>pfft3d_print !< Long-form printing of solver status - procedure :: log=>pfft3d_log !< Long-form logging of solver status - procedure :: init=>pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup=>pfft3d_setup !< Solver setup (every time the operator changes) - procedure :: solve=>pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy=>pfft3d_destroy !< Solver destruction (every time the operator changes) - - procedure, private :: pfft3d_xtranspose_init - procedure, private :: pfft3d_ytranspose_init - procedure, private :: pfft3d_ztranspose_init - - procedure, private :: pfft3d_xtranspose_forward - procedure, private :: pfft3d_ytranspose_forward - procedure, private :: pfft3d_ztranspose_forward - - procedure, private :: pfft3d_xtranspose_backward - procedure, private :: pfft3d_ytranspose_backward - procedure, private :: pfft3d_ztranspose_backward - - end type pfft3d - - - !> Declare pfft3d constructor - interface pfft3d - procedure pfft3d_from_args - end interface pfft3d - - + use p3dfft_plus_plus + use precision, only: WP + use config_class, only: config + use linsol_class, only: linsol + implicit none + private + + ! Expose type/constructor/methods + public :: pfft3d + + !> pfft3d object definition + type, extends(linsol) :: pfft3d + + logical :: oddball + integer :: trans_f, trans_b + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs + real(C_DOUBLE), dimension(:,:,:), allocatable :: unstrided_rhs, unstrided_sol + + contains + + procedure :: log => pfft3d_log !< Long-form logging of solver status + procedure :: print => pfft3d_print !< Long-form printing of solver status + procedure :: print_short => pfft3d_print_short !< One-line printing of solver status + procedure :: init => pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup => pfft3d_setup !< Solver setup (every time the operator changes) + procedure :: solve => pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy => pfft3d_destroy !< Solver destruction (every time the operator changes) + + end type pfft3d + + !> Declare pfft3d constructor + interface pfft3d; procedure pfft3d_from_args; end interface pfft3d; + contains - - - !> Constructor for an pfft3d object - function pfft3d_from_args(cfg,name) result(self) - use messager, only: die - implicit none - type(pfft3d) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - - ! Link the config and store the name - self%cfg=>cfg - self%name=trim(adjustl(name)) - - ! Set solution method - not used - self%method=0 - - ! Set up stencil size and map - self%nst=7 - allocate(self%stc(1:self%nst,1:3)) - self%stc=0 - - ! Allocate operator, rhs, and sol arrays - allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP - allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP - allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP - - ! Zero out some info - self%it=0 - self%aerr=0.0_WP - self%rerr=0.0_WP - - ! Setup is not done - self%setup_done=.false. - - ! Various checks to ensure we can use this solver - check_solver_is_useable: block - integer :: ndim,ndcp - ! Periodicity and uniformity of mesh - if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') - if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') - if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') - ! Ensure that we have at least one non-decomposed direction - ndim=0 - if (self%cfg%nx.gt.1) ndim=ndim+1 - if (self%cfg%ny.gt.1) ndim=ndim+1 - if (self%cfg%nz.gt.1) ndim=ndim+1 - ndcp=0 - if (self%cfg%npx.gt.1) ndcp=ndcp+1 - if (self%cfg%npy.gt.1) ndcp=ndcp+1 - if (self%cfg%npz.gt.1) ndcp=ndcp+1 - if (ndcp.ge.ndim) call die('[pfft3d constructor] Need at least one NON-decomposed direction') - end block check_solver_is_useable - - end function pfft3d_from_args - - - !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change - !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver - !> Only the stencil needs to be defined at this point - subroutine pfft3d_init(this) - use messager, only: die - implicit none - class(pfft3d), intent(inout) :: this - integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 - integer, dimension(3) :: periodicity,offset - include 'fftw3.f03' - - ! From the provided stencil, generate an inverse map - stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) - sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) - stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) - allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 - do st=1,this%nst - this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + + !> Log pfft3d info + subroutine pfft3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(pfft3d), intent(in) :: this + character(len=str_long) :: message + + if (this%cfg%amRoot) then + write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') & + trim(this%name), trim(this%cfg%name) + call log(message) + end if + + end subroutine pfft3d_log + + !> Print pfft3d info to the screen + subroutine pfft3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + + class(pfft3d), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') & + trim(this%name), trim(this%cfg%name) + end if + + end subroutine pfft3d_print + + !> Short print of pfft3d info to the screen + subroutine pfft3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(pfft3d), intent(in) :: this + + if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for & + config [",a16,"]")') trim(this%name), trim(this%cfg%name) + + end subroutine pfft3d_print_short + + !> Constructor for an pfft3d object + function pfft3d_from_args(cfg, name, nst) result(self) + use messager, only: die + implicit none + type(pfft3d) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: nst + integer :: imn_, imx_, jmn_, jmx_, kmn_, kmx_, imno_, imxo_, jmno_, jmxo_,& + kmno_, kmxo_ + + ! Link the config and store the name + self%cfg => cfg + self%name = trim(adjustl(name)) + + imn_ = self%cfg%imin_; imx_ = self%cfg%imax_; + jmn_ = self%cfg%jmin_; jmx_ = self%cfg%jmax_; + kmn_ = self%cfg%kmin_; kmx_ = self%cfg%kmax_; + imno_ = self%cfg%imino_; imxo_ = self%cfg%imaxo_; + jmno_ = self%cfg%jmino_; jmxo_ = self%cfg%jmaxo_; + kmno_ = self%cfg%kmino_; kmxo_ = self%cfg%kmaxo_; + + ! Set up stencil size and map + self%nst = nst; allocate(self%stc(self%nst,3)); + + ! Allocate rhs, operator, transformed operator diagonal, and solution + allocate(self%factored_operator(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) + allocate(self%transformed_rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) + allocate(self%unstrided_rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) + allocate(self%unstrided_sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) + allocate(self%opr(self%nst,imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) + allocate(self%rhs(imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) + allocate(self%sol(imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) + + ! Zero out some info + self%method = 0; self%it = 0; self%aerr = 0.0_WP; self%rerr = 0.0_WP; + + ! Setup is not done + self%setup_done = .false. + + end function pfft3d_from_args + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine pfft3d_init(this) + !use mpi_f08, only: MPI_COMM_WORLD + use messager, only: die + implicit none + include "mpif.h" + class(pfft3d), intent(inout) :: this + integer :: type_ccr, type_rcc, trans_f_tmp, trans_b_tmp + integer(C_INT) :: p3dfft_grid, grid_real, grid_fourier + integer, dimension(3) :: type_ids_f, type_ids_b, & + glob_start_real, glob_start_fourier + integer(C_INT), dimension(3) :: pdims, ldims_real, ldims_fourier, & + mem_order_real, mem_order_fourier, dmap_real, dmap_fourier, gdims_real, & + gdims_fourier + + ! Set up global dimensions of the grid + gdims_real(:) = (/ this%cfg%nx, this%cfg%ny, this%cfg%nz /) + + ! Define the initial processor grid + pdims(:) = (/ this%cfg%npx, this%cfg%npy, this%cfg%npz /) + + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + integer :: ndcp, ndims + + ! Periodicity and uniformity of mesh + if (.not.(this%cfg%xper.and.this%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') + if (.not.(this%cfg%yper.and.this%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') + if (.not.(this%cfg%zper.and.this%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') + + ! Ensure that we have at least one non-decomposed direction + ndims = count(gdims_real .gt. 1); ndcp = count(pdims .gt. 1); + if (ndcp .ge. ndims) call die('[pdfft3 constructor] Need at least one NON-decomposed direction') + + end block check_solver_is_useable + + ! Set up work structures for P3DFFT + call p3dfft_setup + + ! Set up 2 transform types for 3D transforms + type_ids_f(:) = (/ P3DFFT_R2CFFT_D, P3DFFT_CFFT_FORWARD_D, P3DFFT_CFFT_FORWARD_D /) + type_ids_b(:) = (/ P3DFFT_C2RFFT_D, P3DFFT_CFFT_BACKWARD_D, P3DFFT_CFFT_BACKWARD_D /) + + ! Now initialize 3D transforms (forward and backward) with these types + call p3dfft_init_3Dtype(type_rcc, type_ids_f) + call p3dfft_init_3Dtype(type_ccr, type_ids_b) + + ! Set up processor order and memory ordering, as well as the final global + ! grid dimensions. These will be different from the original dimensions in + ! one dimension due to conjugate symmetry, since we are doing + ! real-to-complex transform. + gdims_fourier(:) = gdims_real(:) + gdims_fourier(1) = gdims_fourier(1) / 2 + 1 + mem_order_real(:) = (/ 0, 1, 2 /) + + ! Set up memory order for the final grid layout (for complex array in + ! Fourier space). It is more convenient to have the storage order of + ! the array reversed, this helps save on memory access bandwidth, and + ! shouldn't affect the operations in the Fourier space very much, + ! requiring basically a change in the loop order. However it is possible + ! to define the memory ordering the same as default (0,1,2). Note that + ! the memory ordering is specified in C indices, i.e. starting from 0. + mem_order_fourier(:) = (/ 1, 2, 0 /) + dmap_real(:) = (/ 0, 1, 2 /); dmap_fourier(:) = (/ 1, 2, 0 /); + + ! Specify the default communicator for P3DFFT++. This can be different + ! from your program default communicator. + p3dfft_grid = p3dfft_init_proc_grid(pdims, MPI_COMM_WORLD) + + ! Initialize initial grid, no conjugate symmetry (-1) + call p3dfft_init_data_grid(grid_real, ldims_real, glob_start_real, & + gdims_real, -1, p3dfft_grid, dmap_real, mem_order_real) + + ! Check ldims_real against pgrid + if (.not. all((/ this%cfg%nx_, this%cfg%ny_, this%cfg%nz_ /) .eq. & + ldims_real)) then + call die("[pfftd3] parallel fft decomposition does not match cfg") + end if + + ! Final grid has conjugate symmetry in X dimension (0) + call p3dfft_init_data_grid(grid_fourier, ldims_fourier, glob_start_fourier,& + gdims_fourier, 0, p3dfft_grid, dmap_fourier, mem_order_fourier) + + ! Plan transforms + trans_f_tmp = this%trans_f + write(*,*) this%trans_f + write(*,*) grid_real + write(*,*) grid_fourier + write(*,*) type_rcc + call p3dfft_plan_3Dtrans(trans_f_tmp, grid_real, grid_fourier, type_rcc) + write(*,*) "============" + write(*,*) this%trans_f + write(*,*) grid_real + write(*,*) grid_fourier + write(*,*) type_rcc + this%trans_f = trans_f_tmp + call p3dfft_plan_3Dtrans(this%trans_b, grid_fourier, grid_real, type_ccr) + + ! tag process with zero wavenumber + this%oddball = all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1) + + end subroutine pfft3d_init + + !> Setup solver - done everytime the operator changes + subroutine pfft3d_setup(this) + use messager, only: die + implicit none + integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2 + class(pfft3d), intent(inout) :: this + logical :: circulent + real(WP), dimension(this%nst) :: ref_stencil + real(C_DOUBLE), dimension(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_: & + this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col + + ! compute stencil inverse + stx1 = minval(this%stc(:,1)); stx2 = maxval(this%stc(:,1)); + sty1 = minval(this%stc(:,2)); sty2 = maxval(this%stc(:,2)); + stz1 = minval(this%stc(:,3)); stz2 = maxval(this%stc(:,3)); + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)) + do n = 1, this%nst + this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3)) = n + end do + + ! check circulent operator + ref_stencil = this%opr(:,1,1,1) + circulent = .true. + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + if (any(this%opr(:,i,j,k) .ne. ref_stencil(:))) circulent = .false. + end do end do - - ! Initialize transpose and FFTW plans in x - if (this%cfg%nx.gt.1) then - call this%pfft3d_xtranspose_init() - allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) - this%fplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_R2HC,FFTW_MEASURE) - this%bplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_HC2R,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in y - if (this%cfg%ny.gt.1) then - call this%pfft3d_ytranspose_init() - allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) - this%fplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_R2HC,FFTW_MEASURE) - this%bplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_HC2R,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in z - if (this%cfg%nz.gt.1) then - call this%pfft3d_ztranspose_init() - allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) - this%fplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_R2HC,FFTW_MEASURE) - this%bplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_HC2R,FFTW_MEASURE) - end if - - ! Find who owns the oddball - this%oddball=.false. - if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. - - end subroutine pfft3d_init - - - !> Initialize transpose tool in x - subroutine pfft3d_xtranspose_init(this) - use mpi_f08 - implicit none - class(pfft3d), intent(inout) :: this - integer :: ierr,ip,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%xdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%xdir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%xdir='z' - end if - - ! Allocate global partitions - allocate( this%nx_x(this%cfg%npx)) - allocate( this%ny_x(this%cfg%npx)) - allocate( this%nz_x(this%cfg%npx)) - allocate(this%imin_x(this%cfg%npx)) - allocate(this%imax_x(this%cfg%npx)) - allocate(this%jmin_x(this%cfg%npx)) - allocate(this%jmax_x(this%cfg%npx)) - allocate(this%kmin_x(this%cfg%npx)) - allocate(this%kmax_x(this%cfg%npx)) - - ! Partition - select case (trim(this%xdir)) - case ('x') - - ! No transpose required, use local partition - this%nx_x=this%cfg%nx_ - this%ny_x=this%cfg%ny_ - this%nz_x=this%cfg%nz_ - this%imin_x=this%cfg%imin_ - this%imax_x=this%cfg%imax_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%ny/this%cfg%npx - r=mod(this%cfg%ny,this%cfg%npx) - if (ip.le.r) then - this%ny_x(ip) =q+1 - this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) - else - this%ny_x(ip) =q - this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q - end if - this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 - end do - this%nz_x=this%cfg%nz_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%nz/this%cfg%npx - r=mod(this%cfg%nz,this%cfg%npx) - if (ip.le.r) then - this%nz_x(ip) =q+1 - this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) - else - this%nz_x(ip) =q - this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q - end if - this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 - end do - this%ny_x=this%cfg%ny_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - end select - - ! Allocate storage - allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - - end subroutine pfft3d_xtranspose_init - - - !> Initialize transpose tool in y - subroutine pfft3d_ytranspose_init(this) - use mpi_f08 - implicit none - class(pfft3d), intent(inout) :: this - integer :: ierr,jp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%ydir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%ydir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%ydir='x' - end if - - ! Allocate global partitions - allocate( this%nx_y(this%cfg%npy)) - allocate( this%ny_y(this%cfg%npy)) - allocate( this%nz_y(this%cfg%npy)) - allocate(this%imin_y(this%cfg%npy)) - allocate(this%imax_y(this%cfg%npy)) - allocate(this%jmin_y(this%cfg%npy)) - allocate(this%jmax_y(this%cfg%npy)) - allocate(this%kmin_y(this%cfg%npy)) - allocate(this%kmax_y(this%cfg%npy)) - - ! Partition - select case (trim(this%ydir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nx/this%cfg%npy - r=mod(this%cfg%nx,this%cfg%npy) - if (jp.le.r) then - this%nx_y(jp) =q+1 - this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) - else - this%nx_y(jp) =q - this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q - end if - this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 - end do - this%nz_y=this%cfg%nz_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - case ('y') - - ! No transpose required, use local partition - this%nx_y=this%cfg%nx_ - this%ny_y=this%cfg%ny_ - this%nz_y=this%cfg%nz_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - this%jmin_y=this%cfg%jmin_ - this%jmax_y=this%cfg%jmax_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nz/this%cfg%npy - r=mod(this%cfg%nz,this%cfg%npy) - if (jp.le.r) then - this%nz_y(jp) =q+1 - this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) - else - this%nz_y(jp) =q - this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q - end if - this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 - end do - this%nx_y=this%cfg%nx_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - end select - - ! Allocate storage - allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - - end subroutine pfft3d_ytranspose_init - - - !> Initialize transpose tool in z - subroutine pfft3d_ztranspose_init(this) - use mpi_f08 - implicit none - class(pfft3d), intent(inout) :: this - integer :: ierr,kp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%zdir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%zdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%zdir='y' - end if - - ! Allocate global partitions - allocate( this%nx_z(this%cfg%npz)) - allocate( this%ny_z(this%cfg%npz)) - allocate( this%nz_z(this%cfg%npz)) - allocate(this%imin_z(this%cfg%npz)) - allocate(this%imax_z(this%cfg%npz)) - allocate(this%jmin_z(this%cfg%npz)) - allocate(this%jmax_z(this%cfg%npz)) - allocate(this%kmin_z(this%cfg%npz)) - allocate(this%kmax_z(this%cfg%npz)) - - ! Partition - select case (trim(this%zdir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%nx/this%cfg%npz - r=mod(this%cfg%nx,this%cfg%npz) - if (kp.le.r) then - this%nx_z(kp) =q+1 - this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) - else - this%nx_z(kp) =q - this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q - end if - this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 - end do - this%ny_z=this%cfg%ny_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%ny/this%cfg%npz - r=mod(this%cfg%ny,this%cfg%npz) - if (kp.le.r) then - this%ny_z(kp) =q+1 - this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) - else - this%ny_z(kp) =q - this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q - end if - this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 - end do - this%nx_z=this%cfg%nx_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('z') - - ! No transpose required, use local partition - this%nx_z=this%cfg%nx_ - this%ny_z=this%cfg%ny_ - this%nz_z=this%cfg%nz_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - this%kmin_z=this%cfg%kmin_ - this%kmax_z=this%cfg%kmax_ - - end select - - ! Allocate storage - allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - - end subroutine pfft3d_ztranspose_init - - - !> Perform forward transpose in x - subroutine pfft3d_xtranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - At=A - case ('y') - ! Transpose x=>y - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do - end do - end do - case ('z') - ! Transpose x=>z - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do - end do - end do - end select - - end subroutine pfft3d_xtranspose_forward - - - !> Perform forward transpose in y - subroutine pfft3d_ytranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose y=>x - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do - end do - end do - case ('y') - ! No transpose required - At=A - case ('z') - ! Transpose y=>z - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do - end do - end do - end select - - end subroutine pfft3d_ytranspose_forward - - - !> Perform forward transpose in z - subroutine pfft3d_ztranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose z=>x - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do - end do - end do - case ('y') - ! Transpose z=>y - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do - end do - end do - case ('z') - ! No transpose required - At=A - end select - - end subroutine pfft3d_ztranspose_forward - - - !> Perform backward transpose in x - subroutine pfft3d_xtranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - A=At - case ('y') - ! Transpose y=>x - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - jj=j-this%jmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do - end do - end do - case ('z') - ! Transpose z=>x - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - kk=k-this%kmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do - end do - end do - end select - - end subroutine pfft3d_xtranspose_backward - - - !> Perform backward transpose in y - subroutine pfft3d_ytranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose x=>y - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do - end do - end do - case ('y') - ! No transpose required - A=At - case ('z') - ! Transpose z=>y - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do - end do - end do - end select - - end subroutine pfft3d_ytranspose_backward - - - !> Perform backward transpose in z - subroutine pfft3d_ztranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose x=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do - end do - end do - case ('y') - ! Transpose y=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do - end do - end do - case ('z') - ! No transpose required - A=At - end select - - end subroutine pfft3d_ztranspose_backward - - - !> Setup solver - done everytime the operator changes - subroutine pfft3d_setup(this) - use messager, only: die - implicit none - class(pfft3d), intent(inout) :: this - integer :: i,j,k,st,ierr - integer, dimension(:), allocatable :: row - real(WP), dimension(:), allocatable :: val - - ! If the solver has already been setup, destroy it first - if (this%setup_done) call this%destroy() - - - - ! Set setup-flag to true - this%setup_done=.true. - - end subroutine pfft3d_setup - - - !> Solve the linear system iteratively - subroutine pfft3d_solve(this) - use messager, only: die - use param, only: verbose - implicit none - class(pfft3d), intent(inout) :: this - integer :: i,j,k,ierr - - ! Check that setup was done - if (.not.this%setup_done) call die('[pfft3d solve] Solver has not been setup.') - - ! Set solver it and err to standard values - this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) - - - - ! Sync the solution vector - call this%cfg%sync(this%sol) - - ! If verbose run, log and or print info - if (verbose.gt.0) call this%log - if (verbose.gt.1) call this%print_short - - end subroutine pfft3d_solve - - - !> Destroy solver - done everytime the operator changes - subroutine pfft3d_destroy(this) - use messager, only: die - implicit none - class(pfft3d), intent(inout) :: this - integer :: ierr - - ! Destroy solver, operator, and rhs/sol vectors - - - ! Set setup-flag to false - this%setup_done=.false. - - end subroutine pfft3d_destroy - - - !> Log pfft3d info - subroutine pfft3d_log(this) - use string, only: str_long - use messager, only: log - implicit none - class(pfft3d), intent(in) :: this - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) - end if - end subroutine pfft3d_log - - - !> Print pfft3d info to the screen - subroutine pfft3d_print(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) then - write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) - end if - end subroutine pfft3d_print - - - !> Short print of pfft3d info to the screen - subroutine pfft3d_print_short(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - end subroutine pfft3d_print_short - - + end do + if (.not. circulent) then + call die("[pf3dft] stencil must be uniform in space") + end if + + ! build + opr_col(:,:,:) = 0.0_C_DOUBLE + do n = 1, this%nst + i = modulo(this%stc(n,1) - this%cfg%imin_ + 1, this%cfg%nx_) + this%cfg%imin_ + j = modulo(this%stc(n,2) - this%cfg%jmin_ + 1, this%cfg%ny_) + this%cfg%jmin_ + k = modulo(this%stc(n,3) - this%cfg%kmin_ + 1, this%cfg%nz_) + this%cfg%kmin_ + opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) + end do + + ! take transform of operator + call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) + this%factored_operator = 1.0_C_DOUBLE / this%factored_operator + + ! make zero wavenumber not zero + if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_, & + this%cfg%kmin_) = 1.0_WP + + ! Set setup-flag to true + this%setup_done = .true. + + end subroutine pfft3d_setup + + !> do the solve + subroutine pfft3d_solve(this) + use param, only: verbose + implicit none + class(pfft3d), intent(inout) :: this + integer :: imn, imx, jmn, jmx, kmn, kmx + + imn = this%cfg%imin_; imx = this%cfg%imax_; + jmn = this%cfg%jmin_; jmx = this%cfg%jmax_; + kmn = this%cfg%kmin_; kmx = this%cfg%kmax_; + + ! copy to unstrided array + this%unstrided_rhs(:,:,:) = this%rhs(imn:imx,jmn:jmx,kmn:kmx) + + ! do forward transform + call p3dfft_3Dtrans_double(this%trans_f, this%unstrided_rhs, this%transformed_rhs, 0) + + ! divide + this%transformed_rhs = this%transformed_rhs * this%factored_operator + + ! fix zero wavenumber + if (this%oddball) this%transformed_rhs(imn,jmn,kmn) = (0.0_WP, 0.0_WP) + + ! do backward transform + call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) + + ! copy to strided output + this%sol(:,:,:) = this%unstrided_sol(imn:imx,jmn:jmx,kmn:kmx) + + ! sync + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine pfft3d_solve + + subroutine pfft3d_destroy(this) + implicit none + class(pfft3d), intent(inout) :: this + + ! do nothing; included for consistency with other methods + this%setup_done = .false. + + end subroutine pfft3d_destroy + end module pfft3d_class + diff --git a/tools/GNUMake/Make.defs b/tools/GNUMake/Make.defs index 2ff6b8a48..3c76ff074 100644 --- a/tools/GNUMake/Make.defs +++ b/tools/GNUMake/Make.defs @@ -270,6 +270,10 @@ ifeq ($(USE_FFTW),TRUE) $(info Loading $(NGA_HOME)/tools/GNUMake/packages/Make.fftw...) include $(NGA_HOME)/tools/GNUMake/packages/Make.fftw endif +ifeq ($(USE_P3DFFT),TRUE) + $(info Loading $(NGA_HOME)/tools/GNUMake/packages/Make.p3dfft...) + include $(NGA_HOME)/tools/GNUMake/packages/Make.p3dfft +endif ############################################################### diff --git a/tools/GNUMake/Make.local b/tools/GNUMake/Make.local index e0b436202..83604cb94 100644 --- a/tools/GNUMake/Make.local +++ b/tools/GNUMake/Make.local @@ -30,18 +30,18 @@ VERBOSE=TRUE # But I want the opposite. That is ccache is used by default unless # USE_CCACHE is FALSE. But if I am using UPC++, I would like to turn # ccache off. -ifeq ($(USE_CCACHE),FALSE) - CCACHE = +ifeq ($(USE_CCACHE),TRUE) + CCACHE = ccache else ifeq ($(USE_UPCXX),TRUE) CCACHE = else - CCACHE = ccache + CCACHE = endif # When I run on my local desktop, I like to add this gfortran flag. -FFLAGS += -fcheck=array-temps -F90FLAGS += -fcheck=array-temps +FFLAGS += -fcheck=array-temps -fallow-argument-mismatch +F90FLAGS += -fcheck=array-temps -fallow-argument-mismatch # Instead of linking to static gfortran library, I like to use shared libraries. diff --git a/tools/GNUMake/comps/gnu.mak b/tools/GNUMake/comps/gnu.mak index fa254a9e3..844aec3f0 100644 --- a/tools/GNUMake/comps/gnu.mak +++ b/tools/GNUMake/comps/gnu.mak @@ -40,8 +40,9 @@ ifeq ($(DEBUG),TRUE) CXXFLAGS += -Og -fno-inline -ggdb -Wshadow -Wall -Wno-sign-compare -ftrapv -Wno-unused-but-set-variable CFLAGS += -Og -fno-inline -ggdb -Wshadow -Wall -Wno-sign-compare -ftrapv - FFLAGS += -Og -ggdb -pedantic -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv - F90FLAGS += -Og -ggdb -pedantic -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv + # TODO I don't like removing -pedantic from these, but it's needed to get p3dfft to compile + FFLAGS += -Og -ggdb -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv + F90FLAGS += -Og -ggdb -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv ifneq ($(gcc_major_version),$(filter $(gcc_major_version),4 5)) CXXFLAGS += -Wnull-dereference diff --git a/tools/GNUMake/packages/Make.p3dfft b/tools/GNUMake/packages/Make.p3dfft new file mode 100644 index 000000000..a8f2f5352 --- /dev/null +++ b/tools/GNUMake/packages/Make.p3dfft @@ -0,0 +1,12 @@ +# Add appropriate P3DFFT includes and libraries +ifdef P3DFFT_DIR + ifndef FFTW_DIR + $(error FFTW required for P3DFFT) + endif + INCLUDE_LOCATIONS += $(P3DFFT_DIR) + LIBRARY_LOCATIONS += $(P3DFFT_DIR) + LIBRARIES += -lp3dfft.3 -lfftw3 -lfftw3f -lmpi_cxx -lstdc++ +else + $(error P3DFFT_DIR not defined, but it is currently required by NGA2) +endif + From b0d6e7bc5e8b174113e6cf3db1ac975f5ee6927f Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Wed, 25 Jan 2023 14:30:58 -0500 Subject: [PATCH 074/152] fixed ref_stencil for non-root processes --- examples/hit/input | 2 +- src/solver/pfft3d_class.f90 | 24 +++++++++--------------- 2 files changed, 10 insertions(+), 16 deletions(-) diff --git a/examples/hit/input b/examples/hit/input index c6312645e..57effed30 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 1 1 +Partition : 1 2 2 # Mesh definition Lx : 1 diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index ea8c8b340..d1eafd7e0 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -129,7 +129,7 @@ subroutine pfft3d_init(this) implicit none include "mpif.h" class(pfft3d), intent(inout) :: this - integer :: type_ccr, type_rcc, trans_f_tmp, trans_b_tmp + integer :: type_ccr, type_rcc integer(C_INT) :: p3dfft_grid, grid_real, grid_fourier integer, dimension(3) :: type_ids_f, type_ids_b, & glob_start_real, glob_start_fourier @@ -206,18 +206,7 @@ subroutine pfft3d_init(this) gdims_fourier, 0, p3dfft_grid, dmap_fourier, mem_order_fourier) ! Plan transforms - trans_f_tmp = this%trans_f - write(*,*) this%trans_f - write(*,*) grid_real - write(*,*) grid_fourier - write(*,*) type_rcc - call p3dfft_plan_3Dtrans(trans_f_tmp, grid_real, grid_fourier, type_rcc) - write(*,*) "============" - write(*,*) this%trans_f - write(*,*) grid_real - write(*,*) grid_fourier - write(*,*) type_rcc - this%trans_f = trans_f_tmp + call p3dfft_plan_3Dtrans(this%trans_f, grid_real, grid_fourier, type_rcc) call p3dfft_plan_3Dtrans(this%trans_b, grid_fourier, grid_real, type_ccr) ! tag process with zero wavenumber @@ -227,9 +216,11 @@ end subroutine pfft3d_init !> Setup solver - done everytime the operator changes subroutine pfft3d_setup(this) + use mpi_f08, only: MPI_BCAST + use parallel, only: MPI_REAL_WP, rank use messager, only: die implicit none - integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2 + integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2, ierr class(pfft3d), intent(inout) :: this logical :: circulent real(WP), dimension(this%nst) :: ref_stencil @@ -246,7 +237,10 @@ subroutine pfft3d_setup(this) end do ! check circulent operator - ref_stencil = this%opr(:,1,1,1) + if (this%cfg%amRoot) ref_stencil = this%opr(:,1,1,1) + call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) + write(*,*) rank, ": ", ref_stencil + !TODO if (ierr .ne. 0) call die("[p circulent = .true. do k = this%cfg%kmin_, this%cfg%kmax_ do j = this%cfg%jmin_, this%cfg%jmax_ From 53a06cfeb169b66d6745bedf63f97444de835d3b Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Wed, 25 Jan 2023 16:33:23 -0500 Subject: [PATCH 075/152] fixed processor-local indices in fourier space --- examples/hit/input | 7 +++-- src/solver/pfft3d_class.f90 | 63 ++++++++++++++++++++++++------------- 2 files changed, 45 insertions(+), 25 deletions(-) diff --git a/examples/hit/input b/examples/hit/input index 57effed30..6860a4dd7 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,9 +1,9 @@ # Parallelization -Partition : 1 2 2 +Partition : 1 2 1 # Mesh definition Lx : 1 -nx : 64 +nx : 4 # Fluid properties Dynamic viscosity : 0.01 @@ -14,7 +14,7 @@ Eddy turnover time : 0.1 # Particle properties Particle density : 0.018 Particle diameter : 1 -Number of particles : 100000 +Number of particles : 0 # Time integration Max timestep size : 1e-3 @@ -26,3 +26,4 @@ Implicit iteration : 100 # Ensight output Ensight output period : 0.01 + diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index d1eafd7e0..cd4c2cbc7 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -103,9 +103,7 @@ function pfft3d_from_args(cfg, name, nst) result(self) ! Set up stencil size and map self%nst = nst; allocate(self%stc(self%nst,3)); - ! Allocate rhs, operator, transformed operator diagonal, and solution - allocate(self%factored_operator(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) - allocate(self%transformed_rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) + ! Allocate rhs, operator and solution allocate(self%unstrided_rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) allocate(self%unstrided_sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) allocate(self%opr(self%nst,imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) @@ -212,13 +210,17 @@ subroutine pfft3d_init(this) ! tag process with zero wavenumber this%oddball = all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1) + ! allocate fourier space arrays + allocate(this%factored_operator(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) + allocate(this%transformed_rhs(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) + end subroutine pfft3d_init !> Setup solver - done everytime the operator changes subroutine pfft3d_setup(this) - use mpi_f08, only: MPI_BCAST - use parallel, only: MPI_REAL_WP, rank - use messager, only: die + use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM + use parallel, only: MPI_REAL_WP + use messager, only: die implicit none integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2, ierr class(pfft3d), intent(inout) :: this @@ -239,7 +241,6 @@ subroutine pfft3d_setup(this) ! check circulent operator if (this%cfg%amRoot) ref_stencil = this%opr(:,1,1,1) call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) - write(*,*) rank, ": ", ref_stencil !TODO if (ierr .ne. 0) call die("[p circulent = .true. do k = this%cfg%kmin_, this%cfg%kmax_ @@ -256,19 +257,34 @@ subroutine pfft3d_setup(this) ! build opr_col(:,:,:) = 0.0_C_DOUBLE do n = 1, this%nst - i = modulo(this%stc(n,1) - this%cfg%imin_ + 1, this%cfg%nx_) + this%cfg%imin_ - j = modulo(this%stc(n,2) - this%cfg%jmin_ + 1, this%cfg%ny_) + this%cfg%jmin_ - k = modulo(this%stc(n,3) - this%cfg%kmin_ + 1, this%cfg%nz_) + this%cfg%kmin_ - opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) + i = modulo(this%stc(n,1) - this%cfg%imin, this%cfg%nx) + this%cfg%imin + j = modulo(this%stc(n,2) - this%cfg%jmin, this%cfg%ny) + this%cfg%jmin + k = modulo(this%stc(n,3) - this%cfg%kmin, this%cfg%nz) + this%cfg%kmin + if ( & + this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & + this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & + this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & + ) opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) end do - + ! take transform of operator call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) - this%factored_operator = 1.0_C_DOUBLE / this%factored_operator ! make zero wavenumber not zero - if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_, & - this%cfg%kmin_) = 1.0_WP + if (this%oddball) this%factored_operator(1,1,1) = 1.0_C_DOUBLE + + ! make sure other wavenumbers not close to zero + i = count(abs(this%factored_operator) .lt. 1000 * epsilon(1.0_C_DOUBLE)) + call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) + if (j .gt. 0) call die("[pf3dft] elements of transformed operator near zero") + + ! divide now instead of later + this%factored_operator = 1.0_C_DOUBLE / this%factored_operator + + ! check for division issues + i = count(isnan(abs(this%factored_operator))) + call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) + if (j .gt. 0) call die("[pf3dft] elements of transformed operator are nan") ! Set setup-flag to true this%setup_done = .true. @@ -277,17 +293,20 @@ end subroutine pfft3d_setup !> do the solve subroutine pfft3d_solve(this) + use messager, only: die use param, only: verbose implicit none class(pfft3d), intent(inout) :: this - integer :: imn, imx, jmn, jmx, kmn, kmx + integer :: imn_, imx_, jmn_, jmx_, kmn_, kmx_ + + if (.not. this%setup_done) call die("[pfftd3] solve called before setup") - imn = this%cfg%imin_; imx = this%cfg%imax_; - jmn = this%cfg%jmin_; jmx = this%cfg%jmax_; - kmn = this%cfg%kmin_; kmx = this%cfg%kmax_; + imn_ = this%cfg%imin_; imx_ = this%cfg%imax_; + jmn_ = this%cfg%jmin_; jmx_ = this%cfg%jmax_; + kmn_ = this%cfg%kmin_; kmx_ = this%cfg%kmax_; ! copy to unstrided array - this%unstrided_rhs(:,:,:) = this%rhs(imn:imx,jmn:jmx,kmn:kmx) + this%unstrided_rhs(:,:,:) = this%rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_) ! do forward transform call p3dfft_3Dtrans_double(this%trans_f, this%unstrided_rhs, this%transformed_rhs, 0) @@ -296,13 +315,13 @@ subroutine pfft3d_solve(this) this%transformed_rhs = this%transformed_rhs * this%factored_operator ! fix zero wavenumber - if (this%oddball) this%transformed_rhs(imn,jmn,kmn) = (0.0_WP, 0.0_WP) + if (this%oddball) this%transformed_rhs(1,1,1) = (0.0_WP, 0.0_WP) ! do backward transform call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) ! copy to strided output - this%sol(:,:,:) = this%unstrided_sol(imn:imx,jmn:jmx,kmn:kmx) + this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%unstrided_sol(:,:,:) ! sync call this%cfg%sync(this%sol) From 8a3d5a9b4676bce1dc36ae214c2ca9bb2c1e2a81 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 25 Jan 2023 17:56:14 -0500 Subject: [PATCH 076/152] New riser case New riser case that solves particles in a periodic pipe. Uses a simple IBM for pipe and body forcing. Includes restart capabilities and wallclock timing. TODO: LPT collisions with pipe walls --- examples/riser/GNUmakefile | 48 ++ examples/riser/README | 1 + examples/riser/input | 50 ++ examples/riser/src/Make.package | 2 + examples/riser/src/geometry.f90 | 91 ++++ examples/riser/src/simulation.f90 | 806 ++++++++++++++++++++++++++++++ 6 files changed, 998 insertions(+) create mode 100644 examples/riser/GNUmakefile create mode 100644 examples/riser/README create mode 100644 examples/riser/input create mode 100644 examples/riser/src/Make.package create mode 100644 examples/riser/src/geometry.f90 create mode 100644 examples/riser/src/simulation.f90 diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile new file mode 100644 index 000000000..818048416 --- /dev/null +++ b/examples/riser/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := variable_density particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/riser/README b/examples/riser/README new file mode 100644 index 000000000..772f09724 --- /dev/null +++ b/examples/riser/README @@ -0,0 +1 @@ +Periodic pipe with particles. diff --git a/examples/riser/input b/examples/riser/input new file mode 100644 index 000000000..7320f4009 --- /dev/null +++ b/examples/riser/input @@ -0,0 +1,50 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Pipe diameter : .01 +Pipe length : 0.05 +nx : 128 +ny : 32 +nz : 32 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 +Max time : 10 + +# Fluid properties +Bulk velocity : 0.2 +Dynamic viscosity : 1.8e-5 +Density : 1.2 +Gravity : -9.81 0 0 + +# Particle properties +Particle volume fraction : 0.01 +Particle mean diameter : 58e-6 +Particle standard deviation : 25-6 +Particle min diameter : 21e-6 +Particle max diameter : 140e-6 +Particle diameter shift : 8e-6 +Particle density : 2250 +Collision timescale : 15e-5 +Coefficient of restitution : 0.8 +Friction coefficient : 0.1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 40e-5 + +# Postprocessing output +Postproc output period : 100e-5 + +# Restart files +Restart output period : 20e-5 +!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/Make.package b/examples/riser/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/riser/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 new file mode 100644 index 000000000..27a956cad --- /dev/null +++ b/examples/riser/src/geometry.f90 @@ -0,0 +1,91 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,D,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 new file mode 100644 index 000000000..82dbb12f7 --- /dev/null +++ b/examples/riser/src/simulation.f90 @@ -0,0 +1,806 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg + use lowmach_class, only: lowmach + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker + type(lowmach), public :: fs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Provide a datafile and an event tracker for saving restarts + type(event) :: save_evt + type(datafile) :: df + logical :: restarted + + !> Ensight postprocessing + type(ensight) :: ens_out + type(partmesh) :: pmesh + type(event) :: ens_evt + + !> Event for post-processing + type(event) :: ppevt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,lptfile,tfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: G,VF + real(WP) :: visc,rho,Dpipe,mfr,mfr_target,bforce + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + +contains + + + !> Specialized subroutine that outputs mean statistics + subroutine postproc() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp +!!$ ! Allocate radial line storage +!!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP +!!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP +!!$ allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP +!!$ allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP +!!$ ! Integrate all data over x and z +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) +!!$ Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) +!!$ end do +!!$ end do +!!$ end do +!!$ ! All-reduce the data +!!$ call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ if (vol(j).gt.0.0_WP) then +!!$ Uavg(j)=Uavg(j)/vol(j) +!!$ else +!!$ Uavg(j)=0.0_WP +!!$ end if +!!$ end do +!!$ ! If root, print it out +!!$ if (fs%cfg%amRoot) then +!!$ filename='Uavg_' +!!$ write(timestamp,'(es12.5)') time%t +!!$ open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) +!!$ write(iunit,'(a12,3x,a12)') 'Height','Uavg' +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) +!!$ end do +!!$ close(iunit) +!!$ end if +!!$ ! Deallocate work arrays +!!$ deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc + + + !> Compute massflow rate + subroutine bodyforce_mfr(srcU) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol + myRhoU=0.0_WP; myUvol=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*(2.0_WP*fs%rhoU(i,j,k)-fs%rhoUold(i,j,k)) + if (present(srcU)) myRhoU=myRhoU+vol*srcU(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end subroutine bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Handle restart/saves here + restart_and_save: block + character(len=str_medium) :: timestamp + ! Create event for saving restart files + save_evt=event(time,'Restart output') + call param_read('Restart output period',save_evt%tper) + ! Check if we are restarting + call param_read(tag='Restart from',val=timestamp,short='r',default='') + restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. + if (restarted) then + ! If we are, read the name of the directory + call param_read('Restart from',timestamp,'r') + ! Read the datafile + df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) + else + ! If we are not restarting, we will still need a datafile for saving restart files + df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) + df%valname(1)='t' + df%valname(2)='dt' + df%valname(3)='mfr' + df%valname(4)='bforce' + df%varname(1)='U' + df%varname(2)='V' + df%varname(3)='W' + df%varname(4)='P' + end if + end block restart_and_save + + + ! Revisit timetracker to adjust time and time step values if this is a restart + update_timetracker: block + if (restarted) then + call df%pullval(name='t' ,val=time%t ) + call df%pullval(name='dt',val=time%dt) + time%told=time%t-time%dt + end if + end block update_timetracker + + + ! Initialize wallclock timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use ils_class, only: pcg_pfmg,pcg_amg + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_pfmg) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_lognormal,random_uniform + use mathtools, only: Pi,twoPi + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER + use parallel, only: MPI_REAL_WP + real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf + real(WP) :: dmean,dsd,dmin,dmax,dshift + real(WP), dimension(:), allocatable :: dp + integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + character(len=str_medium) :: timestamp + logical :: overlap + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get pipe diameter from input + call param_read('Pipe diameter',Dpipe) + ! Get mean volume fraction from input + call param_read('Particle volume fraction',VFavg) + ! Get drag model from input + call param_read('Drag model',lp%drag_model,default='Tenneti') + ! Get particle density from input + call param_read('Particle density',lp%rho) + ! Get particle diameter from input + call param_read('Particle mean diameter',dmean) + call param_read('Particle standard deviation',dsd,default=0.0_WP) + call param_read('Particle min diameter',dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',dshift,default=0.0_WP) + if (dsd.le.epsilon(1.0_WP)) then + dmin=dmean + dmax=dmean + end if + ! Get particle temperature from input + call param_read('Particle temperature',Tp,default=298.15_WP) + ! Set collision timescale + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Initialize particles + if (restarted) then + call param_read('Restart from',timestamp,'r') + ! Read the part file + call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) + else + ! Get volume of domain belonging to this proc + Vol_=0.0_WP + do k=lp%cfg%kmin_,lp%cfg%kmax_ + do j=lp%cfg%jmin_,lp%cfg%jmax_ + do i=lp%cfg%imin_,fs%cfg%imax_ + Vol_=Vol_+lp%cfg%dx(i)*lp%cfg%dy(j)*lp%cfg%dz(k) + end do + end do + end do + ! Get particle diameters + np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) + allocate(dp(np)) + sumVolp=0.0_WP; np=0 + do while(sumVolp.lt.VFavg*Vol_) + np=np+1 + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + do while (dp(np).gt.dmax+epsilon(1.0_WP).or.dp(np).lt.dmin-epsilon(1.0_WP)) + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + end do + sumVolp=sumVolp+Pi/6.0_WP*dp(np)**3 + end do + call lp%resize(np) + ! Allocate particle in cell arrays + allocate(npic( lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); npic=0 + allocate(ipic(1:40,lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); ipic=0 + ! Distribute particles + sumVolp=0.0_WP; meand=0.0_WP + do i=1,np + ! Set the diameter + lp%p(i)%d=dp(i) + ! Give position (avoid overlap) + overlap=.true. + do while (overlap) + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin_),lp%cfg%x(lp%cfg%imax_+1)-dmax),& + & random_uniform(lp%cfg%y(lp%cfg%jmin_),lp%cfg%y(lp%cfg%jmax_+1)-dmax),& + & random_uniform(lp%cfg%z(lp%cfg%kmin_),lp%cfg%z(lp%cfg%kmax_+1)-dmax)] + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + overlap=.false. + do kk=lp%p(i)%ind(3)-1,lp%p(i)%ind(3)+1 + do jj=lp%p(i)%ind(2)-1,lp%p(i)%ind(2)+1 + do ii=lp%p(i)%ind(1)-1,lp%p(i)%ind(1)+1 + do nn=1,npic(ii,jj,kk) + j=ipic(nn,ii,jj,kk) + if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) overlap=.true. + end do + end do + end do + end do + end do + ! Check if particle is within the pipe + r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) + if (r.le.0.5_WP*(Dpipe-lp%p(i)%d)) then + ! Activate the particle + lp%p(i)%flag=0 + ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + ! Set the temperature + lp%p(i)%T=Tp + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Sum up volume + sumVolp=sumVolp+Pi/6.0_WP*lp%p(i)%d**3 + meand=meand+lp%p(i)%d + else + lp%p(i)%flag=1 + end if + end do + deallocate(dp,npic,ipic) + call lp%sync() + ! Set ID + offset=0 + do i=1,lp%cfg%rank + offset=offset+lp%np_proc(i) + end do + do i=1,lp%np_ + lp%p(i)%id=int(i+offset,8) + end do + ! Get mean diameter and volume fraction + call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) + call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*Dpipe**2/4.0_WP*lp%cfg%xL) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', lp%np + print*,'Mean diameter', meand + print*,'Mean volume fraction',VFavg + end if + end if + ! Get initial particle volume fraction + call lp%update_VF() + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + real(WP) :: Ubulk + if (restarted) then + call df%pullvar(name='U',var=fs%U) + call df%pullvar(name='V',var=fs%V) + call df%pullvar(name='W',var=fs%W) + call df%pullvar(name='P',var=fs%P) + else + ! Initial velocity + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + end if + ! Set density from particle volume fraction and store initial density + fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho + ! Form momentum + call fs%rho_multiply + fs%rhoUold=fs%rhoU + ! Apply all other boundary conditions + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Set initial MFR and body force + if (restarted) then + call df%pullval(name='mfr',val=mfr) + call df%pullval(name='bforce',val=bforce) + else + call bodyforce_mfr() + bforce=0.0_WP + end if + mfr_target=mfr + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + call fs%cfg%sync(VF) + call fs%cfg%sync(G) + end block initialize_ibm + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='riser') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create monitor filea + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%ncol,'Collision number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc() + end block create_postproc + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use parallel, only: parallel_time + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Initial wallclock time + wt_total%time_in=parallel_time() + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Get fluid stress (include mean body force from mfr forcing) + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + resU=resU+bforce + + ! Collide and advance particles + call lp%collide(dt=time%dtmid) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) + end do + end do + end do + end block add_lpt_src + + ! Add body forcing + call bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dtmid*bforce + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VF(i,j,k)=get_VF(i,j,k,'SC') + VFx =get_VF(i,j,k,'U') + VFy =get_VF(i,j,k,'V') + VFz =get_VF(i,j,k,'W') + fs%U(i,j,k)=VFx*fs%U(i,j,k) + fs%V(i,j,k)=VFy*fs%V(i,j,k) + fs%W(i,j,k)=VFz*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + call fs%cfg%sync(VF) + end block ibm_correction + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Solve Poisson equation + wt_pres%time_in=parallel_time() + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Specialized post-processing + if (ppevt%occurs()) call postproc() + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + ! Finally, see if it's time to save restart files + if (save_evt%occurs()) then + save_restart: block + character(len=str_medium) :: timestamp + ! Prefix for files + write(timestamp,'(es12.5)') time%t + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Populate df and write it + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt ) + call df%pushval(name='mfr',val=mfr_target) + call df%pushval(name='bforce',val=bforce ) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) + call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) + ! Write particle file + call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) + end block save_restart + end if + + end do + + end subroutine simulation_run + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + case('V') + delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r + case('W') + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r + case default + delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,VF) + + end subroutine simulation_final + +end module simulation From dd5fb99b91c540a9190d8b24b44590d0934591a5 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 25 Jan 2023 18:07:45 -0500 Subject: [PATCH 077/152] Update lowmach_class.f90 cosmetic --- src/variable_density/lowmach_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index f30abfbed..5b5ca5ce8 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -1607,7 +1607,7 @@ subroutine get_strainrate(this,SR) end do ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) From f805f3d6e002b9ac1a6a2a071c20b3f9f9426de1 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 25 Jan 2023 18:16:31 -0500 Subject: [PATCH 078/152] Resolve issues from previous merge Resolve issues from previous merge --- examples/hit/GNUmakefile | 6 +- examples/hit/src/simulation.f90 | 2 +- examples/shock_particle/GNUmakefile | 49 -- examples/shock_particle/README | 1 - examples/shock_particle/input | 44 -- examples/shock_particle/src/Make.package | 2 - examples/shock_particle/src/geometry.f90 | 81 --- examples/shock_particle/src/simulation.f90 | 593 --------------------- src/variable_density/lowmach_class.f90 | 92 ---- 9 files changed, 4 insertions(+), 866 deletions(-) delete mode 100644 examples/shock_particle/GNUmakefile delete mode 100644 examples/shock_particle/README delete mode 100644 examples/shock_particle/input delete mode 100644 examples/shock_particle/src/Make.package delete mode 100644 examples/shock_particle/src/geometry.f90 delete mode 100644 examples/shock_particle/src/simulation.f90 diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f61dc7ef2..c920c5d0d 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -23,9 +23,9 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/rgrawe/NGA2hypre -FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 +LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR = /opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index c906814b1..e85d2dfa5 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -185,7 +185,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,nvec=0,name='lpt') call lp%update_partmesh(pmesh) end block create_pmesh diff --git a/examples/shock_particle/GNUmakefile b/examples/shock_particle/GNUmakefile deleted file mode 100644 index 676358efc..000000000 --- a/examples/shock_particle/GNUmakefile +++ /dev/null @@ -1,49 +0,0 @@ -# NGA location if not yet defined -NGA_HOME ?= ../.. - -# Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_HYPRE = TRUE -USE_LAPACK= TRUE -USE_IRL = TRUE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga - -# Directories that contain user-defined code -Udirs := src - -# Include user-defined sources -Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) -Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) -include $(Upack) -INCLUDE_LOCATIONS += $(Ulocs) -VPATH_LOCATIONS += $(Ulocs) - -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre -IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ - -# NGA compilation definitions -include $(NGA_HOME)/tools/GNUMake/Make.defs - -# Include NGA base code -Bdirs := core two_phase particles data solver config grid libraries -Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) -include $(Bpack) - -# Inform user of Make.packages used -ifdef Ulocs - $(info Taking user code from: $(Ulocs)) -endif -$(info Taking base code from: $(Bdirs)) - -# Target definition -all: $(executable) - @echo COMPILATION SUCCESSFUL - -# NGA compilation rules -include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/shock_particle/README b/examples/shock_particle/README deleted file mode 100644 index 098c2471d..000000000 --- a/examples/shock_particle/README +++ /dev/null @@ -1 +0,0 @@ -This is a test case for a shock wave interacting with Lagrangian particles. Uses multiphase solver and hard-codes VF to 0 or 1 based on chosen phase. diff --git a/examples/shock_particle/input b/examples/shock_particle/input deleted file mode 100644 index b359f094b..000000000 --- a/examples/shock_particle/input +++ /dev/null @@ -1,44 +0,0 @@ -# Parallelization -Partition : 3 1 1 - -# Mesh definition -Lx : 0.2048 -nx : 512 -Ly : 0.0256 -ny : 64 - -# Flow setup -Shock location : 0.08 -Mach number of shock : 1.47 -Pre-shock density : 1.204 -Pre-shock pressure : 1.01325e5 -Particle volume fraction : 0.2 -Particle curtain width : 0.0034 - -# Fluid properties -Phase : gas -Dynamic viscosity : 1.8e-5 -Thermal conductivity : 0 -Gamma : 1.4 - -# Particle parameters -Particle density : 1000 -Particle diameter : 200e-6 -Drag model : Tenneti - -# Time integration -Max timestep size : 8e-7 -Max cfl number : 0.9 -Max time : 100000 -Max steps : 100000 - -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 10e-6 diff --git a/examples/shock_particle/src/Make.package b/examples/shock_particle/src/Make.package deleted file mode 100644 index a7a927853..000000000 --- a/examples/shock_particle/src/Make.package +++ /dev/null @@ -1,2 +0,0 @@ -# List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/shock_particle/src/geometry.f90 b/examples/shock_particle/src/geometry.f90 deleted file mode 100644 index 736845194..000000000 --- a/examples/shock_particle/src/geometry.f90 +++ /dev/null @@ -1,81 +0,0 @@ -!> Various definitions and tools for initializing NGA2 config -module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - -contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read, param_exists - use parallel, only: amRoot - use messager, only: die - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz,dx - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - dx = Lx/nx - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nz',nz,default=1); allocate(z(nz+1)) - - if (nz.eq.1) then - Lz = dx - else - call param_read('Lz',Lz) - end if - - ! Uniform grid - do i=1,nx+1 - x(i) = real(i-1,WP)*dx - end do - do j=1,ny+1 - y(j) = real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly - end do - - ! z is always uniform - do k=1,nz+1 - z(k) = real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='ShockTube') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition',partition,short='p') - - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - - end block create_cfg - - - end subroutine geometry_init - - -end module geometry diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 deleted file mode 100644 index 53a91f348..000000000 --- a/examples/shock_particle/src/simulation.f90 +++ /dev/null @@ -1,593 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use mast_class, only: mast - use vfs_class, only: vfs - use matm_class, only: matm - use lpt_class, only: lpt - use partmesh_class, only: partmesh - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - use string, only: str_medium - implicit none - private - - !> Single two-phase flow solver, volume fraction solver, material model, and LPT solver set - !> With corresponding time tracker - type(mast), public :: fs - type(vfs), public :: vf - type(matm), public :: matmod - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,cvgfile - type(monitor) :: lptfile - - public :: simulation_init,simulation_run,simulation_final - - !> Problem definition - character(len=str_medium) :: phase - integer :: relax_model - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resE - real(WP), dimension(:,:,:), allocatable :: dRHOdt - - contains - - !> Function that localizes the left (x-) of the domain - function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. - end function left_of_domain - - !> Function that localizes the right (x+) of the domain - function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. - end function right_of_domain - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - call param_read('Max steps',time%nmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resE (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT - initialize_lpt: block - use random, only: random_uniform - use mathtools, only: Pi - use parallel, only: amRoot - use lpt_class, only: drag_model - real(WP) :: dp,VFp,L,x0,vol,volp - integer :: i,np - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get drag model from the inpit - call param_read('Drag model',drag_model,default='Tenneti') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle diameter',dp) - ! Get particle volume fraction from the input - call param_read('Particle volume fraction',VFp) - ! Get curtain width from the input - call param_read('Particle curtain width',L) - ! Get starting position - x0=0.5_WP*(lp%cfg%x(lp%cfg%imax+1)-lp%cfg%x(lp%cfg%imin)-L) - ! Get number of particles - vol=L*lp%cfg%yL*lp%cfg%zL - volp=Pi*dp**3/6.0_WP - np=int(VFp * vol / volp) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(x0,x0+L),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin) - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero collision force - lp%p(i)%col=0.0_WP - ! Give it temperature - lp%p(i)%T=293.15_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do - end if - ! Distribute particles - call lp%sync() - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - if (amRoot) then - print*,"===== Particle Setup Description =====" - print*,'Number of particles', np - print*,'Mean volume fraction',vfp - end if - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') - call lp%update_partmesh(pmesh) - end block create_pmesh - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver with lvira reconstruction - vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') - call param_read('Phase',phase) - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - select case(trim(phase)) - case('gas') - vf%VF(i,j,k)=0.0_WP - case('liquid') - vf%VF(i,j,k)=1.0_WP - case default - end select - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end do - end do - end do - ! Boundary conditions on VF are built into the mast solver - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Set initial interface at the boundaries - call vf%set_full_bcond() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a compressible two-phase flow solver - create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz - use matm_class, only : air - use ils_class, only: pcg_bbox,gmres_smg - use mathtools, only: Pi - use parallel, only: amRoot - integer :: i,j,k,n - real(WP), dimension(3) :: xyz - real(WP) :: gamm,Pref,visc,hdff - real(WP) :: xshock,vshock,relshockvel - real(WP) :: rho0, P0, rho1, P1, Ma1, Ma, rho, P, U - type(bcond), pointer :: mybc - ! Create material model class - matmod=matm(cfg=cfg,name='Liquid-gas models') - ! Get EOS parameters from input - call param_read('Gamma',gamm) - ! Register equations of state - select case(trim(phase)) - case('gas') - call matmod%register_idealgas('gas',gamm) - case('liquid') - call param_read('Pref', Pref) - call matmod%register_stiffenedgas('liquid',gamm,Pref) - end select - ! Create flow solver - fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) - ! Register flow solver variables with material models - call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) - call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity, also heat diffusion - call param_read('Dynamic viscosity',visc) - call param_read('Thermal conductivity',hdff) - select case(trim(phase)) - case('gas') - call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscconst_gas=visc, & - viscconst_liquid=0.0_WP, hdffconst_gas=hdff, hdffconst_liquid=0.0_WP) - fs%Lrho = 0.0_WP - fs%LrhoE= 0.0_WP - case('liquid') - call matmod%register_diffusion_thermo_models(viscconst_gas=0.0_WP, viscconst_liquid=visc, & - hdffconst_gas=0.0_WP, hdffconst_liquid=hdff) - fs%Grho = 0.0_WP - end select - ! Read in surface tension coefficient - fs%sigma=0.0_WP - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit momentum solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) - ! Initially 0 velocity in y and z - fs%Vi = 0.0_WP; fs%Wi = 0.0_WP - ! Zero face velocities as well for the sake of dirichlet boundaries - fs%V = 0.0_WP; fs%W = 0.0_WP - ! Set up initial thermo properties (0) - ! Default is from Meng & Colonius (2015), - ! which is basically the same as Igra & Takayama and Terashima & Tryggvason - call param_read('Pre-shock density',rho0,default=1.204_WP) - call param_read('Pre-shock pressure',P0,default=1.01325e5_WP) - call param_read('Mach number of shock',Ma,default=1.47_WP) - call param_read('Shock location',xshock) - ! Use shock relations to get post-shock numbers (1) - P1 = P0 * (2.0_WP*gamm*Ma**2 - (gamm-1.0_WP)) / (gamm+1.0_WP) - rho1 = rho0 * (Ma**2 * (gamm+1.0_WP) / ((gamm-1.0_WP)*Ma**2 + 2.0_WP)) - ! Calculate post-shock Mach number - Ma1 = sqrt(((gamm-1.0_WP)*(Ma**2)+2.0_WP)/(2.0_WP*gamm*(Ma**2)-(gamm-1.0_WP))) - ! Calculate post-shock velocity - vshock = -Ma1 * sqrt(gamm*P1/rho1) + Ma*sqrt(gamm*P0/rho0) - ! Velocity at which shock moves - relshockvel = -rho1*vshock/(rho0-rho1) - - if (amRoot) then - print*,"===== Fluid Setup Description =====" - print*,'Mach number', Ma - print*,'Pre-shock: Density',rho0,'Pressure',P0 - print*,'Post-shock: Density',rho1,'Pressure',P1,'Velocity',vshock - print*,'Shock velocity', relshockvel - end if - - ! Initialize gas phase quantities - do i=fs%cfg%imino_,fs%cfg%imaxo_ - ! pressure, velocity, use matmod for energy - if (fs%cfg%x(i).lt.xshock) then - rho = rho1 - U = vshock - P = P1 - else - rho = rho0 - U = 0.0_WP - P = P0 - end if - select case(trim(phase)) - case('gas') - fs%Grho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%GrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'gas') - case('liquid') - fs%Lrho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%LrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'liquid') - end select - end do - - ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers - call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1) - - ! Calculate face velocities - call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) - ! Apply face BC - inflow - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%n_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=vshock - end do - ! Apply face BC - outflow - bc_scope = 'velocity' - call fs%apply_bcond(time%dt,bc_scope) - - ! Calculate mixture density and momenta - fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho - fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi - ! Perform initial pressure relax - relax_model = mech_egy_mech_hhz - call fs%pressure_relax(vf,matmod,relax_model) - ! Calculate initial phase and bulk moduli - call fs%init_phase_bulkmod(vf,matmod) - call fs%reinit_phase_pressure(vf,matmod) - call fs%harmonize_advpressure_bulkmod(vf,matmod) - ! Set initial pressure to harmonized field based on internal energy - fs%P = fs%PA - - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ShockTube') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) - call ens_out%add_scalar('T',fs%Tmptr) - call ens_out%add_scalar('P',fs%P) - call ens_out%add_scalar('PA',fs%PA) - call ens_out%add_scalar('Density',fs%RHO) - call ens_out%add_scalar('Bulkmod',fs%RHOSS2) - call ens_out%add_scalar('divU',fs%divU) - call ens_out%add_scalar('Viscosity',fs%visc) - call ens_out%add_scalar('Mach',fs%Mach) - call ens_out%add_particle('particles',pmesh) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%RHOmin,'RHOmin') - call mfile%add_column(fs%RHOmax,'RHOmax') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%Tmax,'Tmax') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLa_x,'Acoustic xCFL') - call cflfile%add_column(fs%CFLa_y,'Acoustic yCFL') - call cflfile%add_column(fs%CFLa_z,'Acoustic zCFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create convergence monitor - cvgfile=monitor(fs%cfg%amRoot,'cvg') - call cvgfile%add_column(time%n,'Timestep number') - call cvgfile%add_column(time%it,'Iteration') - call cvgfile%add_column(time%t,'Time') - call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') - call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') - call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') - call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') - call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') - call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') - call cvgfile%add_column(fs%psolv%it,'Pressure iteration') - call cvgfile%add_column(fs%psolv%rerr,'Pressure error') - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%VFmean,'VFp_mean') - call lptfile%add_column(lp%VFmax,'VFp_max') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - use messager, only: die - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Reinitialize phase pressure by syncing it with conserved phase energy - call fs%reinit_phase_pressure(vf,matmod) - fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi - fs%RHOold = fs%RHO - ! Remember old flow variables (phase) - fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho - fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE - fs%GPold = fs%GP; fs%LPold = fs%LP - - ! Remember old interface, including VF and barycenters - call vf%copy_interface_to_old() - - ! Create in-cell reconstruction - call fs%flow_reconstruct(vf) - - ! Zero variables that will change during subiterations - fs%P = 0.0_WP - fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP - fs%Hpjump = 0.0_WP - - ! Determine semi-Lagrangian advection flag - call fs%flag_sl(time%dt,vf) - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - resU=fs%rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) - - ! Update density based on particle volume fraction - fs%rho=resU*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Add momentum source term from lpt (cell-centered) - add_lpt_src: block - integer :: i,j,k - resU=0.0_WP; resV=0.0_WP; resW=0.0_WP; resE=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+lp%srcU(i,j,k) - resV(i,j,k)=resV(i,j,k)+lp%srcV(i,j,k) - resW(i,j,k)=resW(i,j,k)+lp%srcW(i,j,k) - resE(i,j,k)=resE(i,j,k)+lp%srcE(i,j,k) - end do - end do - end do - end block add_lpt_src - - ! Predictor step, involving advection and pressure terms - call fs%advection_step(time%dt,vf,matmod) - - ! Viscous step - call fs%diffusion_src_explicit_step(time%dt,vf,matmod,srcU=resU,srcV=resV,srcW=resW,srcE=resE) - - ! Prepare pressure projection - call fs%pressureproj_prepare(time%dt,vf,matmod) - ! Initialize and solve Helmholtz equation - call fs%psolv%setup() - fs%psolv%sol=fs%PA-fs%P - call fs%psolv%solve() - call fs%cfg%sync(fs%psolv%sol) - ! Perform corrector step using solution - fs%P=fs%P+fs%psolv%sol - call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) - - ! Record convergence monitor - call cvgfile%write() - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Pressure relaxation - call fs%pressure_relax(vf,matmod,relax_model) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block update_pmesh - call fs%get_viz() - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,resE,dRHOdt) - - end subroutine simulation_final - -end module simulation diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 5b5ca5ce8..b8e56a8b0 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -122,7 +122,6 @@ module lowmach_class procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient procedure :: get_div_stress !< Calculate divergence of stress - procedure :: get_gradu !< Calculate velocity gradient tensor procedure :: get_vorticity !< Calculate vorticity tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U @@ -1335,97 +1334,6 @@ subroutine get_div_stress(this,divx,divy,divz) end subroutine get_div_stress - !> Calculate velocity gradient tensor - subroutine get_gradu(this,gradu) - use messager, only: die - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - - ! Check gradu's first two dimensions - if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[lowmach get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - - ! Compute dudx, dvdy, and dwdz first - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) - gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) - gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) - end do - end do - end do - - ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) - dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) - dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) - dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) - dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) - dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) - end do - end do - end do - - ! Interpolate off-diagonal components of the velocity gradient to the cell center - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) - gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) - gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) - gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) - gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) - gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) - end do - end do - end do - - ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then - if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) - if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) - end if - if (.not.this%cfg%yper) then - if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) - if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) - end if - if (.not.this%cfg%zper) then - if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) - if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) - end if - - ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP - end do - end do - end do - - ! Sync it - call this%cfg%sync(gradu) - - ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - - end subroutine get_gradu - - !> Calculate vorticity vector subroutine get_vorticity(this,vort) use messager, only: die From 90ca7e4003ce44670f36539f040f611fc70fe0ca Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 25 Jan 2023 21:43:07 -0500 Subject: [PATCH 079/152] Remove old example case --- examples/ibm_tester/README | 1 - examples/ibm_tester/input | 38 --- examples/ibm_tester/src/Make.package | 2 - examples/ibm_tester/src/geometry.f90 | 76 ----- examples/ibm_tester/src/simulation.f90 | 434 ------------------------- 5 files changed, 551 deletions(-) delete mode 100644 examples/ibm_tester/README delete mode 100644 examples/ibm_tester/input delete mode 100644 examples/ibm_tester/src/Make.package delete mode 100644 examples/ibm_tester/src/geometry.f90 delete mode 100644 examples/ibm_tester/src/simulation.f90 diff --git a/examples/ibm_tester/README b/examples/ibm_tester/README deleted file mode 100644 index 8f62622e1..000000000 --- a/examples/ibm_tester/README +++ /dev/null @@ -1 +0,0 @@ -This is a basic IBM case, intended as a test of the direct forcing IBM with the incompressible solver. It solves flow past a bumpy cylinder. diff --git a/examples/ibm_tester/input b/examples/ibm_tester/input deleted file mode 100644 index 2908ecf91..000000000 --- a/examples/ibm_tester/input +++ /dev/null @@ -1,38 +0,0 @@ -# Parallelization -Partition : 2 2 1 - -# Mesh definition -Lx : 8 -Ly : 4 -Lz : 0.125 -nx : 128 -ny : 64 -nz : 1 - -# IBM properties -Number of particles : 100 -Diameter : 1 -Position : 2 -Perturbation amp : .05 -Perturbation freq : 6 - -# Time integration -Max timestep size : 0.02 -Max cfl number : 1 -Max time : 1000 - -# Fluid properties -Dynamic viscosity : .002 -Density : 1 -Inlet velocity : 1 - -# Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 1 \ No newline at end of file diff --git a/examples/ibm_tester/src/Make.package b/examples/ibm_tester/src/Make.package deleted file mode 100644 index a7a927853..000000000 --- a/examples/ibm_tester/src/Make.package +++ /dev/null @@ -1,2 +0,0 @@ -# List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ibm_tester/src/geometry.f90 b/examples/ibm_tester/src/geometry.f90 deleted file mode 100644 index bbad77ef3..000000000 --- a/examples/ibm_tester/src/geometry.f90 +++ /dev/null @@ -1,76 +0,0 @@ -!> Various definitions and tools for initializing NGA2 config -module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - -contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) - - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx - end do - do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly - end do - do k=1,nz+1 - z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='IBM') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition',partition,short='p') - - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - - end block create_cfg - - - ! Create masks for this config - create_walls: block - cfg%VF=1.0_WP - end block create_walls - - - end subroutine geometry_init - - -end module geometry diff --git a/examples/ibm_tester/src/simulation.f90 b/examples/ibm_tester/src/simulation.f90 deleted file mode 100644 index 75e95fa38..000000000 --- a/examples/ibm_tester/src/simulation.f90 +++ /dev/null @@ -1,434 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use hypre_str_class, only: hypre_str - use df_class, only: dfibm - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get a direct forcing solver, an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(dfibm), public :: df - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,ibmfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP) :: inlet_velocity - -contains - - - !> Function that localizes the left (x-) of the domain - function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. - end function left_of_domain - - !> Function that localizes the right (x+) of the domain - function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. - end function right_of_domain - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create an incompressible flow solver with bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg - use incomp_class, only: dirichlet,clipped_neumann - real(WP) :: visc - ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Define boundary conditions - call fs%add_bcond(name='inflow', type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our direct forcing solver - initialize_df: block - use mathtools, only: twoPi,arctan - integer :: i,j,k,np - real(WP) :: Dcyl,Xcyl,amp,freq,theta,r - ! Create solver - df=dfibm(cfg=cfg,name='IBM') - ! Read cylinder properties - call param_read('Number of particles',np) - call param_read('Diameter',Dcyl) - call param_read('Position',Xcyl) - call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) - call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) - ! Root process initializes marker particles - if (df%cfg%amRoot) then - call df%resize(np) - ! Distribute marker particles - do i=1,np - ! Set various parameters for the marker - df%p(i)%id =1 - df%p(i)%vel =0.0_WP - ! Set position - theta=real(i-1,WP)*twoPi/real(np,WP) - r=0.5_WP*Dcyl+amp*sin(freq*theta) - df%p(i)%pos(1)=r*cos(theta) - df%p(i)%pos(2)=r*sin(theta) - df%p(i)%pos(3)=0.0_WP - ! Assign element area - df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL - ! Assign outward normal vector - df%p(i)%norm = df%p(i)%pos/r - ! Shift cylinder - df%p(i)%pos(1)=df%p(i)%pos(1)+Xcyl - ! Locate the particle on the mesh - df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) - ! Activate the particle - df%p(i)%flag=0 - end do - end if - call df%sync() - - ! Get initial volume fraction - call df%update_VF() - - ! All processes initialize IBM objects - call df%setup_obj() - - ! Define levelset (only used for visualization) - do k=df%cfg%kmin_,df%cfg%kmax_ - do j=df%cfg%jmin_,df%cfg%jmax_ - do i=df%cfg%imin_,df%cfg%imax_ - theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) - r=0.5_WP*Dcyl+amp*sin(freq*theta) - df%F(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r - end do - end do - end do - call df%cfg%sync(df%G) - - if (df%cfg%amRoot) then - print*,"===== Direct Forcing Setup Description =====" - print*,'Number of marker particles', df%np - print*,'Number of IBM objects', df%nobj - print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%xL*real(df%cfg%nx,WP) - end if - end block initialize_df - - - ! Create partmesh object for marker particle output - create_pmesh: block - integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='ibm') - pmesh%varname(1)='area' - pmesh%vecname(1)='velocity' - call df%update_partmesh(pmesh) - do i=1,df%np_ - pmesh%var(1,i)=df%p(i)%dA - pmesh%vec(:,1,i)=df%p(i)%vel - end do - end block create_pmesh - - - ! Initialize our velocity field - initialize_velocity: block - use incomp_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - ! Initial fields - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! Set inflow velocity/momentum - call param_read('Inlet velocity',inlet_velocity) - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=inlet_velocity - end do - ! Compute MFR through all boundary conditions - call fs%get_mfr() - ! Adjust MFR for global mass balance - call fs%correct_mfr() - ! Compute cell-centered velocity - call fs%interp_vel(Ui,Vi,Wi) - ! Compute divergence - call fs%get_div() - end block initialize_velocity - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ibm') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_particle('markers',pmesh) - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VF',df%VF) - call ens_out%add_scalar('levelset',df%G) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call df%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create IBM monitor - ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') - call ibmfile%add_column(time%n,'Timestep number') - call ibmfile%add_column(time%t,'Time') - call ibmfile%add_column(df%VFmin,'VF min') - call ibmfile%add_column(df%VFmax,'VF max') - call ibmfile%add_column(df%Fx,'Fx') - call ibmfile%add_column(df%Fy,'Fy') - call ibmfile%add_column(df%Fz,'Fz') - call ibmfile%add_column(df%np,'Marker number') - call ibmfile%add_column(df%Umin,'Marker Umin') - call ibmfile%add_column(df%Umax,'Marker Umax') - call ibmfile%add_column(df%Vmin,'Marker Vmin') - call ibmfile%add_column(df%Vmax,'Marker Vmax') - call ibmfile%add_column(df%Wmin,'Marker Wmin') - call ibmfile%add_column(df%Wmax,'Marker Wmax') - call ibmfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Add momentum source term from direct forcing - ibm_correction: block - integer :: i,j,k - resU=fs%rho - call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=fs%U(i,j,k)+sum(fs%itpi_x(:,i,j,k)*df%srcU(i-1:i,j,k)) - fs%V(i,j,k)=fs%V(i,j,k)+sum(fs%itpi_y(:,i,j,k)*df%srcV(i,j-1:j,k)) - fs%W(i,j,k)=fs%W(i,j,k)+sum(fs%itpi_z(:,i,j,k)*df%srcW(i,j,k-1:k)) - end do - end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibm_correction - - ! Apply other boundary conditions on the resulting fields - call fs%apply_bcond(time%t,time%dt) - - ! Reset Dirichlet BCs - dirichlet_velocity: block - use incomp_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=inlet_velocity - end do - end block dirichlet_velocity - - ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call df%update_partmesh(pmesh) - do i=1,df%np_ - pmesh%var(1,i)=df%p(i)%dA - pmesh%vec(:,1,i)=df%p(i)%vel - end do - end block update_pmesh - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call df%get_max() - call mfile%write() - call cflfile%write() - call ibmfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - -end module simulation From 82f803fa0faf4416c25e28f65f4b86e64be5726c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 25 Jan 2023 22:26:45 -0500 Subject: [PATCH 080/152] Update incomp_class.f90 Added itpi_x operator needed by IBM --- src/constant_density/incomp_class.f90 | 28 +++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index cb34e25e3..ac8636924 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -75,6 +75,7 @@ module incomp_class ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity + real(WP), dimension(:,:,:,:), allocatable :: itpi_x,itpi_y,itpi_z !< Interpolation for Ui/Vi/Wi real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Interpolation for U real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Interpolation for V real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Interpolation for W @@ -249,6 +250,22 @@ subroutine init_metrics(this) integer :: i,j,k,st1,st2 real(WP), dimension(-1:0) :: itpx,itpy,itpz + + ! Allocate finite difference Ui/Vi/Wi interpolation coefficients + allocate(this%itpi_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%itpi_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%itpi_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + ! Create interpolation coefficients to cell face + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + this%itpi_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpi_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + this%itpi_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + ! Allocate finite difference viscosity interpolation coefficients allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) @@ -443,6 +460,17 @@ subroutine adjust_metrics(this) if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%umask(this%cfg%imino,:,:)=this%umask(this%cfg%imino+1,:,:) if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) + + ! Adjust Ui/Vi/Wi interpolation coefficients back to cell faces in the presence of walls (only walls!) + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (this%umask(i,j,k).eq.1) this%itpi_x(:,i,j,k)=0.0_WP + if (this%vmask(i,j,k).eq.1) this%itpi_y(:,i,j,k)=0.0_WP + if (this%wmask(i,j,k).eq.1) this%itpi_z(:,i,j,k)=0.0_WP + end do + end do + end do ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ From 0a0a86eea608dbe70551b0021cc9087fab071bfb Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 26 Jan 2023 12:04:22 -0500 Subject: [PATCH 081/152] fixing merge issues --- examples/channel/src/simulation.f90 | 2 +- examples/hit/input | 4 ++++ examples/hit/src/simulation.f90 | 18 +++++++++--------- 3 files changed, 14 insertions(+), 10 deletions(-) diff --git a/examples/channel/src/simulation.f90 b/examples/channel/src/simulation.f90 index e4366e893..ee593b26b 100644 --- a/examples/channel/src/simulation.f90 +++ b/examples/channel/src/simulation.f90 @@ -122,7 +122,7 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds - create_and_initialize_flow_solver: block] + create_and_initialize_flow_solver: block use hypre_str_class, only: pcg_pfmg,gmres_pfmg use mathtools, only: twoPi integer :: i,j,k diff --git a/examples/hit/input b/examples/hit/input index 6860a4dd7..686851ab0 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -20,6 +20,10 @@ Number of particles : 0 Max timestep size : 1e-3 Max cfl number : 0.9 +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + # Implicit velocity solver Implicit tolerance : 1e-6 Implicit iteration : 100 diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index b93e193a9..e85d2dfa5 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -3,7 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg use pfft3d_class, only: pfft3d - !use hypre_str_class, only: hypre_str + use hypre_str_class, only: hypre_str use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +15,8 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - type(pfft3d), public :: ps - !type(hypre_str), public :: ps + !type(pfft3d), public :: ps + type(hypre_str), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -72,7 +72,7 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block - !use hypre_str_class, only: pcg_pfmg + use hypre_str_class, only: pcg_pfmg ! Create flow solver fs=incomp(cfg=cfg,name='NS solver') ! Assign constant viscosity @@ -80,11 +80,11 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps=pfft3d(cfg, 'Pressure Solver', 7) - !ps%maxlevel=10 <- uncomment for other solvers - !call param_read('Pressure iteration',ps%maxit) - !call param_read('Pressure tolerance',ps%rcvg) + !ps=pfft3d(cfg=cfg,name='Pressure') + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver From 3060d19a7d914c0b03da1e171dfe30d2dd551f3f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 26 Jan 2023 13:05:51 -0500 Subject: [PATCH 082/152] Update Make.p3dfft Need to point to correct directories --- tools/GNUMake/packages/Make.p3dfft | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/GNUMake/packages/Make.p3dfft b/tools/GNUMake/packages/Make.p3dfft index a8f2f5352..014b2bcf5 100644 --- a/tools/GNUMake/packages/Make.p3dfft +++ b/tools/GNUMake/packages/Make.p3dfft @@ -3,8 +3,8 @@ ifdef P3DFFT_DIR ifndef FFTW_DIR $(error FFTW required for P3DFFT) endif - INCLUDE_LOCATIONS += $(P3DFFT_DIR) - LIBRARY_LOCATIONS += $(P3DFFT_DIR) + INCLUDE_LOCATIONS += $(P3DFFT_DIR)/include + LIBRARY_LOCATIONS += $(P3DFFT_DIR)/lib LIBRARIES += -lp3dfft.3 -lfftw3 -lfftw3f -lmpi_cxx -lstdc++ else $(error P3DFFT_DIR not defined, but it is currently required by NGA2) From 0dc01ce9ea54ee47d1689c22226233f58f177474 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 26 Jan 2023 14:07:58 -0500 Subject: [PATCH 083/152] Update Make.p3dfft Not needed --- tools/GNUMake/packages/Make.p3dfft | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/GNUMake/packages/Make.p3dfft b/tools/GNUMake/packages/Make.p3dfft index 014b2bcf5..6d79a86ba 100644 --- a/tools/GNUMake/packages/Make.p3dfft +++ b/tools/GNUMake/packages/Make.p3dfft @@ -5,7 +5,7 @@ ifdef P3DFFT_DIR endif INCLUDE_LOCATIONS += $(P3DFFT_DIR)/include LIBRARY_LOCATIONS += $(P3DFFT_DIR)/lib - LIBRARIES += -lp3dfft.3 -lfftw3 -lfftw3f -lmpi_cxx -lstdc++ + LIBRARIES += -lp3dfft.3 -lfftw3 -lfftw3f -lstdc++ else $(error P3DFFT_DIR not defined, but it is currently required by NGA2) endif From 475fade7223a38038fdf64479d5fd46269901b3e Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Fri, 27 Jan 2023 13:09:15 -0500 Subject: [PATCH 084/152] fixed off by one error --- src/solver/pfft3d_class.f90 | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index cd4c2cbc7..04bdd7267 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -16,7 +16,6 @@ module pfft3d_class !> pfft3d object definition type, extends(linsol) :: pfft3d - logical :: oddball integer :: trans_f, trans_b complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs real(C_DOUBLE), dimension(:,:,:), allocatable :: unstrided_rhs, unstrided_sol @@ -207,9 +206,6 @@ subroutine pfft3d_init(this) call p3dfft_plan_3Dtrans(this%trans_f, grid_real, grid_fourier, type_rcc) call p3dfft_plan_3Dtrans(this%trans_b, grid_fourier, grid_real, type_ccr) - ! tag process with zero wavenumber - this%oddball = all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1) - ! allocate fourier space arrays allocate(this%factored_operator(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) allocate(this%transformed_rhs(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) @@ -218,9 +214,9 @@ end subroutine pfft3d_init !> Setup solver - done everytime the operator changes subroutine pfft3d_setup(this) - use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM - use parallel, only: MPI_REAL_WP - use messager, only: die + use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM + use parallel, only: MPI_REAL_WP + use messager, only: die implicit none integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2, ierr class(pfft3d), intent(inout) :: this @@ -241,7 +237,6 @@ subroutine pfft3d_setup(this) ! check circulent operator if (this%cfg%amRoot) ref_stencil = this%opr(:,1,1,1) call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) - !TODO if (ierr .ne. 0) call die("[p circulent = .true. do k = this%cfg%kmin_, this%cfg%kmax_ do j = this%cfg%jmin_, this%cfg%jmax_ @@ -257,9 +252,9 @@ subroutine pfft3d_setup(this) ! build opr_col(:,:,:) = 0.0_C_DOUBLE do n = 1, this%nst - i = modulo(this%stc(n,1) - this%cfg%imin, this%cfg%nx) + this%cfg%imin - j = modulo(this%stc(n,2) - this%cfg%jmin, this%cfg%ny) + this%cfg%jmin - k = modulo(this%stc(n,3) - this%cfg%kmin, this%cfg%nz) + this%cfg%kmin + i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin + j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin + k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin if ( & this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & @@ -271,7 +266,11 @@ subroutine pfft3d_setup(this) call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) ! make zero wavenumber not zero - if (this%oddball) this%factored_operator(1,1,1) = 1.0_C_DOUBLE + ! setting this to one has the nice side effect of returning a solution with + ! the same integral + if (all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1)) then + this%factored_operator(1,1,1) = 1.0_C_DOUBLE + end if ! make sure other wavenumbers not close to zero i = count(abs(this%factored_operator) .lt. 1000 * epsilon(1.0_C_DOUBLE)) @@ -314,9 +313,6 @@ subroutine pfft3d_solve(this) ! divide this%transformed_rhs = this%transformed_rhs * this%factored_operator - ! fix zero wavenumber - if (this%oddball) this%transformed_rhs(1,1,1) = (0.0_WP, 0.0_WP) - ! do backward transform call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) @@ -327,8 +323,8 @@ subroutine pfft3d_solve(this) call this%cfg%sync(this%sol) ! If verbose run, log and or print info - if (verbose.gt.0) call this%log - if (verbose.gt.1) call this%print_short + if (verbose .gt. 0) call this%log + if (verbose .gt. 1) call this%print_short end subroutine pfft3d_solve From 5781f18da8e6d62cd86fb3976d8efac800ac7c38 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Fri, 27 Jan 2023 13:09:51 -0500 Subject: [PATCH 085/152] added Poisson equation with point sources test case for p3dfft solver --- examples/poissontest/GNUmakefile | 53 ++++++++ examples/poissontest/README | 1 + examples/poissontest/input | 19 +++ examples/poissontest/src/Make.package | 2 + examples/poissontest/src/geometry.f90 | 72 +++++++++++ examples/poissontest/src/simulation.f90 | 158 ++++++++++++++++++++++++ 6 files changed, 305 insertions(+) create mode 100644 examples/poissontest/GNUmakefile create mode 100644 examples/poissontest/README create mode 100644 examples/poissontest/input create mode 100644 examples/poissontest/src/Make.package create mode 100644 examples/poissontest/src/geometry.f90 create mode 100644 examples/poissontest/src/simulation.f90 diff --git a/examples/poissontest/GNUmakefile b/examples/poissontest/GNUmakefile new file mode 100644 index 000000000..169b46eeb --- /dev/null +++ b/examples/poissontest/GNUmakefile @@ -0,0 +1,53 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +USE_P3DFFT = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +#HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 +P3DFFT_DIR = /opt/p3dfft-3/build + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core constant_density data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules + diff --git a/examples/poissontest/README b/examples/poissontest/README new file mode 100644 index 000000000..386d2c1f6 --- /dev/null +++ b/examples/poissontest/README @@ -0,0 +1 @@ +Simple FFT test case. diff --git a/examples/poissontest/input b/examples/poissontest/input new file mode 100644 index 000000000..34eb922ae --- /dev/null +++ b/examples/poissontest/input @@ -0,0 +1,19 @@ +# Parallelization +Partition : 1 4 1 + +# Mesh definition +Lx : 16.0 +nx : 16 +Ly : 16.0 +ny : 16 +Lz : 1.0 +nz : 1 + +# Point sources +Number of point sources : 3 +Point source x : 2.5 7.5 3.5 +Point source y : 13.5 11.5 1.5 +Point source z : 0.5 0.5 0.5 +Point source strengths : -1.0 2.0 -1.0 + + diff --git a/examples/poissontest/src/Make.package b/examples/poissontest/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/poissontest/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/poissontest/src/geometry.f90 b/examples/poissontest/src/geometry.f90 new file mode 100644 index 000000000..7676edd2f --- /dev/null +++ b/examples/poissontest/src/geometry.f90 @@ -0,0 +1,72 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + ! Read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + allocate(x(nx+1), y(ny+1), z(nz+1)) + ! Create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1, WP) / real(nx, WP) * Lx + end do + do i = 1, ny+1 + y(i) = real(i-1, WP) / real(ny, WP) * Ly + end do + do i = 1, nz+1 + z(i) = real(i-1, WP) / real(nz, WP) * Lz + end do + ! General serial grid object + grid = sgrid(coord=cartesian, no=1, x=x, y=y, z=z, xper=.true., & + yper=.true., zper=.true., name='Box') + end block create_grid + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition', partition, short='p') + + ! Create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF = 1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/poissontest/src/simulation.f90 b/examples/poissontest/src/simulation.f90 new file mode 100644 index 000000000..8d791a291 --- /dev/null +++ b/examples/poissontest/src/simulation.f90 @@ -0,0 +1,158 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use pfft3d_class, only: pfft3d + use ensight_class, only: ensight + implicit none + private + + type(pfft3d), public :: ps + + !> Ensight postprocessing + type(ensight) :: ens_out + + public :: simulation_init, simulation_run, simulation_final + + !> Problem constants + integer :: npts + real(WP), dimension(:,:), allocatable :: ptsrcs + +contains + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + ! Read params + read_input: block + use messager, only: die + integer :: n + + call param_read('Number of point sources', npts) + allocate(ptsrcs(npts,4)) + call param_read('Point source x', ptsrcs(:,1)) + call param_read('Point source y', ptsrcs(:,2)) + call param_read('Point source z', ptsrcs(:,3)) + call param_read('Point source strengths', ptsrcs(:,4)) + + do n = 1, npts + if (ptsrcs(n,1) .lt. 0.0_WP .or. ptsrcs(n,1) .gt. cfg%xL .or. & + ptsrcs(n,2) .lt. 0.0_WP .or. ptsrcs(n,2) .gt. cfg%yL .or. & + ptsrcs(n,3) .lt. 0.0_WP .or. ptsrcs(n,3) .gt. cfg%zL) then + call die("point not in domain") + end if + end do + + end block read_input + + ! Create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + integer :: i, j, k + + ! create solver + ps = pfft3d(cfg=cfg, nst=7, name='P3dfft Test') + call ps%init() + + ! set stencil + ps%stc(1,:) = (/ 0, 0, 0 /) + ps%stc(2,:) = (/ +1, 0, 0 /) + ps%stc(3,:) = (/ -1, 0, 0 /) + ps%stc(4,:) = (/ 0, +1, 0 /) + ps%stc(5,:) = (/ 0, -1, 0 /) + ps%stc(6,:) = (/ 0, 0, +1 /) + ps%stc(7,:) = (/ 0, 0, -1 /) + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + ps%opr(2,i,j,k) = cfg%dxmi(i)**2 + ps%opr(3,i,j,k) = cfg%dxmi(i)**2 + ps%opr(4,i,j,k) = cfg%dymi(j)**2 + ps%opr(5,i,j,k) = cfg%dymi(j)**2 + ps%opr(6,i,j,k) = cfg%dzmi(k)**2 + ps%opr(7,i,j,k) = cfg%dzmi(k)**2 + ps%opr(1,i,j,k) = - sum(ps%opr(2:7,i,j,k)) + end do + end do + end do + + ! setup + call ps%setup() + + end block create_and_initialize_flow_solver + + ! Add Ensight output + create_ensight: block + + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg, name='PoissionTest') + + ! Add variables to output + call ens_out%add_scalar('rhs',ps%rhs) + call ens_out%add_scalar('sol',ps%sol) + + end block create_ensight + + end subroutine simulation_init + + !> Solve problem + subroutine simulation_run + implicit none + + ! set up rhs + ! this sucks, but it doesn't matter + rhs_setup: block + integer :: n, i, j, k, ic, jc, kc + real(WP) :: d2, d2c + + ps%rhs(:,:,:) = 0.0_WP + + do n = 1, npts + d2c = huge(d2c) + do k = cfg%kmin, cfg%kmax + do j = cfg%jmin, cfg%jmax + do i = cfg%imin, cfg%imax + d2 = (cfg%xm(i) - ptsrcs(n,1))**2 + d2 = d2 + (cfg%ym(j) - ptsrcs(n,2))**2 + d2 = d2 + (cfg%zm(k) - ptsrcs(n,3))**2 + if (d2c .gt. d2) then + d2c = d2; ic = i; jc = j; kc = k; + end if + end do + end do + end do + if (cfg%imin_ .le. ic .and. ic .le. cfg%imax_ .and. & + cfg%jmin_ .le. jc .and. jc .le. cfg%jmax_ .and. & + cfg%kmin_ .le. kc .and. kc .le. cfg%kmax_) then + ps%rhs(ic,jc,kc) = ps%rhs(ic,jc,kc) + ptsrcs(n,4) + end if + end do + + end block rhs_setup + + ! Solve Poisson equation + call ps%solve() + + ! Output to ensight + call ens_out%write_data(0.0_WP) + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(ptsrcs) + + end subroutine simulation_final + +end module simulation + From 3afc9c941ecace11deb2f6e49c0f2750eac058c1 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 27 Jan 2023 18:48:44 -0500 Subject: [PATCH 086/152] Update to pipe cases Geometry now computes volume fraction field for IBM, useful for integration to take into account correct volume --- examples/ib_pipe/GNUmakefile | 2 +- examples/ib_pipe/src/geometry.f90 | 55 +++++++++++++++++++++++---- examples/ib_pipe/src/simulation.f90 | 53 ++++---------------------- examples/riser/src/geometry.f90 | 55 +++++++++++++++++++++++---- examples/riser/src/simulation.f90 | 59 ++++++----------------------- 5 files changed, 116 insertions(+), 108 deletions(-) diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 936d89562..355f0c0bf 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -23,7 +23,7 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ # NGA compilation definitions diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 27a956cad..30064fcee 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -7,8 +7,11 @@ module geometry !> Single config type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D - public :: geometry_init + public :: geometry_init, get_VF contains @@ -25,7 +28,7 @@ subroutine geometry_init create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,D,dx + real(WP) :: Lx,Ly,Lz,dx real(WP), dimension(:), allocatable :: x,y,z ! Read in grid definition @@ -81,11 +84,49 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=1.0_WP + integer :: i,j,k + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + cfg%VF(i,j,k)=get_VF(i,j,k,'SC') + end do + end do + end do end block create_walls - end subroutine geometry_init - - -end module geometry + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + + end module geometry diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 56c68aa1b..4c36ba091 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,7 +1,7 @@ !> Various definitions and tools for running an NGA2 simulation module simulation use precision, only: WP - use geometry, only: cfg + use geometry, only: cfg,D,get_VF use hypre_str_class, only: hypre_str use incomp_class, only: incomp use timetracker_class, only: timetracker @@ -29,8 +29,8 @@ module simulation !> Work arrays real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP), dimension(:,:,:), allocatable :: G,VF - real(WP) :: Ubulk,Umean,Dpipe + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: Ubulk,Umean contains @@ -84,7 +84,6 @@ subroutine simulation_init allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -95,7 +94,6 @@ subroutine simulation_init integer :: i,j,k real(WP) :: amp ! Initial fields - call param_read('Pipe diameter',Dpipe) call param_read('Bulk velocity',Ubulk); Umean=Ubulk call param_read('Fluctuation amp',amp,default=0.0_WP) fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP @@ -120,20 +118,18 @@ subroutine simulation_init end block initialize_velocity - ! Initialize IBM fields - initialize_ibm: block + ! Initialize levelset + initialize_G: block integer :: i,j,k do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) end do end do end do - call fs%cfg%sync(VF) call fs%cfg%sync(G) - end block initialize_ibm + end block initialize_G ! Add Ensight output create_ensight: block @@ -145,7 +141,7 @@ subroutine simulation_init ! Add variables to output call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',VF) + call ens_out%add_scalar('ibm_vf',fs%cfg%VF) call ens_out%add_scalar('pressure',fs%P) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) @@ -256,7 +252,6 @@ subroutine simulation_run do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') VFx =get_VF(i,j,k,'U') VFy =get_VF(i,j,k,'V') VFz =get_VF(i,j,k,'W') @@ -269,7 +264,6 @@ subroutine simulation_run call fs%cfg%sync(fs%U) call fs%cfg%sync(fs%V) call fs%cfg%sync(fs%W) - call fs%cfg%sync(VF) end block ibm_correction ! Apply other boundary conditions on the resulting fields @@ -315,37 +309,6 @@ subroutine simulation_run end subroutine simulation_run - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - case('V') - delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r - case('W') - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r - case default - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - !> Finalize the NGA2 simulation subroutine simulation_final implicit none diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 index 27a956cad..30064fcee 100644 --- a/examples/riser/src/geometry.f90 +++ b/examples/riser/src/geometry.f90 @@ -7,8 +7,11 @@ module geometry !> Single config type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D - public :: geometry_init + public :: geometry_init, get_VF contains @@ -25,7 +28,7 @@ subroutine geometry_init create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,D,dx + real(WP) :: Lx,Ly,Lz,dx real(WP), dimension(:), allocatable :: x,y,z ! Read in grid definition @@ -81,11 +84,49 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=1.0_WP + integer :: i,j,k + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + cfg%VF(i,j,k)=get_VF(i,j,k,'SC') + end do + end do + end do end block create_walls - end subroutine geometry_init - - -end module geometry + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + + end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 82dbb12f7..f1faeed4a 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -2,7 +2,7 @@ module simulation use string, only: str_medium use precision, only: WP - use geometry, only: cfg + use geometry, only: cfg,D,get_VF use lowmach_class, only: lowmach use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -41,8 +41,8 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp - real(WP), dimension(:,:,:), allocatable :: G,VF - real(WP) :: visc,rho,Dpipe,mfr,mfr_target,bforce + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,rho,mfr,mfr_target,bforce !> Wallclock time for monitoring type :: timer @@ -230,7 +230,6 @@ subroutine simulation_init allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -251,7 +250,6 @@ subroutine simulation_init ! Create solver lp=lpt(cfg=cfg,name='LPT') ! Get pipe diameter from input - call param_read('Pipe diameter',Dpipe) ! Get mean volume fraction from input call param_read('Particle volume fraction',VFavg) ! Get drag model from input @@ -337,7 +335,7 @@ subroutine simulation_init end do ! Check if particle is within the pipe r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) - if (r.le.0.5_WP*(Dpipe-lp%p(i)%d)) then + if (r.le.0.5_WP*(D-lp%p(i)%d)) then ! Activate the particle lp%p(i)%flag=0 ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) @@ -371,7 +369,7 @@ subroutine simulation_init end do ! Get mean diameter and volume fraction call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) - call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*Dpipe**2/4.0_WP*lp%cfg%xL) + call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*D**2/4.0_WP*lp%cfg%xL) if (lp%cfg%amRoot) then print*,"===== Particle Setup Description =====" print*,'Number of particles', lp%np @@ -434,20 +432,18 @@ subroutine simulation_init end block initialize_velocity - ! Initialize IBM fields - initialize_ibm: block + ! Initialize levelset + initialize_G: block integer :: i,j,k do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) end do end do end do - call fs%cfg%sync(VF) call fs%cfg%sync(G) - end block initialize_ibm + end block initialize_G ! Add Ensight output create_ensight: block @@ -460,7 +456,7 @@ subroutine simulation_init call ens_out%add_particle('particles',pmesh) call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',VF) + call ens_out%add_scalar('ibm_vf',fs%cfg%VF) call ens_out%add_scalar('pressure',fs%P) call ens_out%add_scalar('epsp',lp%VF) ! Output to ensight @@ -641,7 +637,6 @@ subroutine simulation_run do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') VFx =get_VF(i,j,k,'U') VFy =get_VF(i,j,k,'V') VFz =get_VF(i,j,k,'W') @@ -654,7 +649,6 @@ subroutine simulation_run call fs%cfg%sync(fs%U) call fs%cfg%sync(fs%V) call fs%cfg%sync(fs%W) - call fs%cfg%sync(VF) end block ibm_correction ! Apply other boundary conditions and update momentum @@ -758,37 +752,6 @@ subroutine simulation_run end subroutine simulation_run - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - case('V') - delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r - case('W') - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r - case default - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - !> Finalize the NGA2 simulation subroutine simulation_final implicit none @@ -799,7 +762,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,VF) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G) end subroutine simulation_final From ccae70d28e549db52b48929d8cb1fad2f4439bd3 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Fri, 27 Jan 2023 21:30:23 -0500 Subject: [PATCH 087/152] fixed scaling --- examples/poissontest/input | 2 +- src/solver/pfft3d_class.f90 | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/examples/poissontest/input b/examples/poissontest/input index 34eb922ae..bdfde8ea9 100644 --- a/examples/poissontest/input +++ b/examples/poissontest/input @@ -14,6 +14,6 @@ Number of point sources : 3 Point source x : 2.5 7.5 3.5 Point source y : 13.5 11.5 1.5 Point source z : 0.5 0.5 0.5 -Point source strengths : -1.0 2.0 -1.0 +Point source strengths : -2.0 4.0 -1.0 diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 04bdd7267..f50a24deb 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -316,6 +316,11 @@ subroutine pfft3d_solve(this) ! do backward transform call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) + ! rescale + ! p3dfft might have a sign error, check -1 + this%unstrided_sol = (-1.0_WP / (this%cfg%nx * this%cfg%ny * this%cfg%nz))& + * this%unstrided_sol + ! copy to strided output this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%unstrided_sol(:,:,:) From 766c357dc3d5bfdb1c5bbdf91896d17fbd4f1cac Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 28 Jan 2023 10:16:42 -0500 Subject: [PATCH 088/152] Update lpt_class.f90 Do not include particles w/ id=0 when computing VF --- src/particles/lpt_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 8a8b24021..3637eb09f 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -837,7 +837,7 @@ subroutine update_VF(this) ! Transfer particle volume do i=1,this%np_ ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle + if (this%p(i)%flag.eq.1 .or. this%p(i)%id.eq.0) cycle ! Transfer particle volume Vp=Pi/6.0_WP*this%p(i)%d**3 call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') From 3b1639bb2cdcd3176037ebfed639f3951e419532 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 30 Jan 2023 13:56:56 -0500 Subject: [PATCH 089/152] p3dfft merge Merge Jack's P3DFFT updates --- examples/hit/GNUmakefile | 10 +++++----- examples/hit/input | 2 +- examples/hit/src/simulation.f90 | 16 ++++++++-------- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index 2a349c0a1..f0430d60f 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -9,7 +9,7 @@ USE_P3DFFT = TRUE USE_HYPRE = TRUE USE_LAPACK = TRUE PROFILE = FALSE -DEBUG = TRUE +DEBUG = FALSE COMP = gnu EXEBASE = nga @@ -24,10 +24,10 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR = /opt/homebrew/Cellar/fftw/3.3.10_1 -P3DFFT_DIR = /opt/p3dfft-3/build +LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR=/Users/jcaps/Research/Codes/Builds/hypre +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 +P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/input b/examples/hit/input index 686851ab0..64e00db70 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 2 1 +Partition : 1 1 1 # Mesh definition Lx : 1 diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index e85d2dfa5..a2dd34f1d 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -3,7 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg use pfft3d_class, only: pfft3d - use hypre_str_class, only: hypre_str + !use hypre_str_class, only: hypre_str use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +15,8 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - !type(pfft3d), public :: ps - type(hypre_str), public :: ps + type(pfft3d), public :: ps + !type(hypre_str), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -80,11 +80,11 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=pfft3d(cfg=cfg,name='Pressure') - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) + ps=pfft3d(cfg=cfg,name='Pressure',nst=7) + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + !ps%maxlevel=10 + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver From e9773ceab54419168b20501ae9969fbc6514a922 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 31 Jan 2023 14:55:18 -0500 Subject: [PATCH 090/152] Update pfft3d_class.f90 Serial FFTW implemented and verified it works. --- src/solver/pfft3d_class.f90 | 139 ++++++++++++++++++++++++------------ 1 file changed, 95 insertions(+), 44 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index f50a24deb..83e84edd3 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -8,6 +8,7 @@ module pfft3d_class use config_class, only: config use linsol_class, only: linsol implicit none + include 'fftw3.f' private ! Expose type/constructor/methods @@ -16,9 +17,17 @@ module pfft3d_class !> pfft3d object definition type, extends(linsol) :: pfft3d - integer :: trans_f, trans_b - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs - real(C_DOUBLE), dimension(:,:,:), allocatable :: unstrided_rhs, unstrided_sol + !> Parallel FFT (p3dfft) variables + integer :: trans_f, trans_b + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs + + !> Serial FFT (fftw) variables + logical :: serial_fft + integer(KIND=8) :: fplan_serial,bplan_serial + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: inout_serial + + !> Work arrays + real(C_DOUBLE), dimension(:,:,:), allocatable :: unstrided_rhs, unstrided_sol contains @@ -53,6 +62,7 @@ subroutine pfft3d_log(this) end subroutine pfft3d_log + !> Print pfft3d info to the screen subroutine pfft3d_print(this) use, intrinsic :: iso_fortran_env, only: output_unit @@ -66,6 +76,7 @@ subroutine pfft3d_print(this) end subroutine pfft3d_print + !> Short print of pfft3d info to the screen subroutine pfft3d_print_short(this) use, intrinsic :: iso_fortran_env, only: output_unit @@ -77,6 +88,7 @@ subroutine pfft3d_print_short(this) end subroutine pfft3d_print_short + !> Constructor for an pfft3d object function pfft3d_from_args(cfg, name, nst) result(self) use messager, only: die @@ -114,9 +126,11 @@ function pfft3d_from_args(cfg, name, nst) result(self) ! Setup is not done self%setup_done = .false. + self%serial_fft = .false. end function pfft3d_from_args + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver !> Only the stencil needs to be defined at this point @@ -155,6 +169,17 @@ subroutine pfft3d_init(this) end block check_solver_is_useable + ! Check if FFT should be handled in serial + if (this%cfg%nproc.eq.1) then + this%serial_fft=.true. + allocate(this%inout_serial(this%cfg%nx,this%cfg%ny,this%cfg%nz)) + call dfftw_plan_dft_3d(this%fplan_serial,this%cfg%nx,this%cfg%ny,this%cfg%nz,& + this%inout_serial,this%inout_serial,FFTW_FORWARD,FFTW_MEASURE) + call dfftw_plan_dft_3d(this%bplan_serial,this%cfg%nx,this%cfg%ny,this%cfg%nz,& + this%inout_serial,this%inout_serial,FFTW_BACKWARD,FFTW_MEASURE) + return + end if + ! Set up work structures for P3DFFT call p3dfft_setup @@ -188,7 +213,7 @@ subroutine pfft3d_init(this) ! from your program default communicator. p3dfft_grid = p3dfft_init_proc_grid(pdims, MPI_COMM_WORLD) - ! Initialize initial grid, no conjugate symmetry (-1) + ! Initialize grid, no conjugate symmetry (-1) call p3dfft_init_data_grid(grid_real, ldims_real, glob_start_real, & gdims_real, -1, p3dfft_grid, dmap_real, mem_order_real) @@ -206,12 +231,13 @@ subroutine pfft3d_init(this) call p3dfft_plan_3Dtrans(this%trans_f, grid_real, grid_fourier, type_rcc) call p3dfft_plan_3Dtrans(this%trans_b, grid_fourier, grid_real, type_ccr) - ! allocate fourier space arrays + ! Allocate fourier space arrays allocate(this%factored_operator(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) allocate(this%transformed_rhs(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) end subroutine pfft3d_init + !> Setup solver - done everytime the operator changes subroutine pfft3d_setup(this) use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM @@ -223,15 +249,15 @@ subroutine pfft3d_setup(this) logical :: circulent real(WP), dimension(this%nst) :: ref_stencil real(C_DOUBLE), dimension(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_: & - this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col + this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col - ! compute stencil inverse + ! Compute stencil inverse stx1 = minval(this%stc(:,1)); stx2 = maxval(this%stc(:,1)); sty1 = minval(this%stc(:,2)); sty2 = maxval(this%stc(:,2)); stz1 = minval(this%stc(:,3)); stz2 = maxval(this%stc(:,3)); allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)) do n = 1, this%nst - this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3)) = n + this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3)) = n end do ! check circulent operator @@ -239,48 +265,55 @@ subroutine pfft3d_setup(this) call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) circulent = .true. do k = this%cfg%kmin_, this%cfg%kmax_ - do j = this%cfg%jmin_, this%cfg%jmax_ - do i = this%cfg%imin_, this%cfg%imax_ - if (any(this%opr(:,i,j,k) .ne. ref_stencil(:))) circulent = .false. - end do - end do + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + if (any(this%opr(:,i,j,k) .ne. ref_stencil(:))) circulent = .false. + end do + end do end do if (.not. circulent) then - call die("[pf3dft] stencil must be uniform in space") + call die("[pf3dft] stencil must be uniform in space") end if - ! build + ! Build the operator opr_col(:,:,:) = 0.0_C_DOUBLE do n = 1, this%nst - i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin - j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin - k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin - if ( & - this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & - this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & - this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & - ) opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) + i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin + j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin + k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin + if ( & + this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & + this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & + this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & + ) opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) end do - ! take transform of operator - call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) + ! Take transform of operator + if (this%serial_fft) then + this%factored_operator=opr_col + this%inout_serial=opr_col + call dfftw_execute_dft(this%fplan_serial,this%inout_serial,this%inout_serial) + this%factored_operator=this%inout_serial + else + call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) + end if - ! make zero wavenumber not zero - ! setting this to one has the nice side effect of returning a solution with + ! Make zero wavenumber not zero + ! Setting this to one has the nice side effect of returning a solution with ! the same integral if (all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1)) then - this%factored_operator(1,1,1) = 1.0_C_DOUBLE + this%factored_operator(1,1,1) = 1.0_C_DOUBLE end if - ! make sure other wavenumbers not close to zero + ! Make sure other wavenumbers are not close to zero i = count(abs(this%factored_operator) .lt. 1000 * epsilon(1.0_C_DOUBLE)) call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) if (j .gt. 0) call die("[pf3dft] elements of transformed operator near zero") - ! divide now instead of later + ! Divide now instead of later this%factored_operator = 1.0_C_DOUBLE / this%factored_operator - ! check for division issues + ! Check for division issues i = count(isnan(abs(this%factored_operator))) call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) if (j .gt. 0) call die("[pf3dft] elements of transformed operator are nan") @@ -290,6 +323,7 @@ subroutine pfft3d_setup(this) end subroutine pfft3d_setup + !> do the solve subroutine pfft3d_solve(this) use messager, only: die @@ -304,27 +338,37 @@ subroutine pfft3d_solve(this) jmn_ = this%cfg%jmin_; jmx_ = this%cfg%jmax_; kmn_ = this%cfg%kmin_; kmx_ = this%cfg%kmax_; - ! copy to unstrided array + ! Copy to unstrided array this%unstrided_rhs(:,:,:) = this%rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_) - ! do forward transform - call p3dfft_3Dtrans_double(this%trans_f, this%unstrided_rhs, this%transformed_rhs, 0) + ! Do forward transform + if (this%serial_fft) then + this%inout_serial=this%unstrided_rhs + call dfftw_execute_dft(this%fplan_serial,this%inout_serial,this%inout_serial) + this%transformed_rhs=this%inout_serial + else + call p3dfft_3Dtrans_double(this%trans_f, this%unstrided_rhs, this%transformed_rhs, 0) + end if - ! divide + ! Divide this%transformed_rhs = this%transformed_rhs * this%factored_operator - ! do backward transform - call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) - - ! rescale - ! p3dfft might have a sign error, check -1 - this%unstrided_sol = (-1.0_WP / (this%cfg%nx * this%cfg%ny * this%cfg%nz))& - * this%unstrided_sol + ! Do backward transform and rescale + if (this%serial_fft) then + this%inout_serial=this%transformed_rhs + call dfftw_execute_dft(this%bplan_serial,this%inout_serial,this%inout_serial) + !this%unstrided_sol=this%transformed_rhs + this%unstrided_sol=1/real(this%cfg%nx*this%cfg%ny*this%cfg%nz,WP)*this%inout_serial + else + call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) + this%unstrided_sol = (-1 / (this%cfg%nx * this%cfg%ny * this%cfg%nz))& + * this%unstrided_sol + end if - ! copy to strided output + ! Copy to strided output this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%unstrided_sol(:,:,:) - ! sync + ! Sync call this%cfg%sync(this%sol) ! If verbose run, log and or print info @@ -333,6 +377,7 @@ subroutine pfft3d_solve(this) end subroutine pfft3d_solve + subroutine pfft3d_destroy(this) implicit none class(pfft3d), intent(inout) :: this @@ -340,6 +385,12 @@ subroutine pfft3d_destroy(this) ! do nothing; included for consistency with other methods this%setup_done = .false. + if (this%serial_fft) then + call dfftw_destroy_plan(this%fplan_serial) + call dfftw_destroy_plan(this%bplan_serial) + end if + this%serial_fft=.false. + end subroutine pfft3d_destroy end module pfft3d_class From 73720a64513a346cdf545e106503b4cfcb17f1ed Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 31 Jan 2023 17:00:46 -0500 Subject: [PATCH 091/152] Update pfft3d_class.f90 3D FFT is now working in serial and in parallel (tested on the HIT case)! --- src/solver/pfft3d_class.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 83e84edd3..aec102859 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -290,7 +290,6 @@ subroutine pfft3d_setup(this) ! Take transform of operator if (this%serial_fft) then - this%factored_operator=opr_col this%inout_serial=opr_col call dfftw_execute_dft(this%fplan_serial,this%inout_serial,this%inout_serial) this%factored_operator=this%inout_serial @@ -352,19 +351,18 @@ subroutine pfft3d_solve(this) ! Divide this%transformed_rhs = this%transformed_rhs * this%factored_operator - ! Do backward transform and rescale if (this%serial_fft) then this%inout_serial=this%transformed_rhs call dfftw_execute_dft(this%bplan_serial,this%inout_serial,this%inout_serial) - !this%unstrided_sol=this%transformed_rhs - this%unstrided_sol=1/real(this%cfg%nx*this%cfg%ny*this%cfg%nz,WP)*this%inout_serial + this%unstrided_sol=this%inout_serial else call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) - this%unstrided_sol = (-1 / (this%cfg%nx * this%cfg%ny * this%cfg%nz))& - * this%unstrided_sol end if + ! Rescale + this%unstrided_sol = this%unstrided_sol/real(this%cfg%nx * this%cfg%ny * this%cfg%nz,WP) + ! Copy to strided output this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%unstrided_sol(:,:,:) From 0750caf15d7703745a91940e256b96e4506288f3 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 1 Feb 2023 09:05:18 -0500 Subject: [PATCH 092/152] Fix conflicts with merge Synced with Olivier's develop branch --- src/constant_density/incomp_class.f90 | 13 +- src/variable_density/lowmach_class.f90 | 183 +------------------------ 2 files changed, 3 insertions(+), 193 deletions(-) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index e1b68db49..c09848812 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -259,7 +259,7 @@ subroutine init_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do @@ -460,17 +460,6 @@ subroutine adjust_metrics(this) if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%umask(this%cfg%imino,:,:)=this%umask(this%cfg%imino+1,:,:) if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) - - ! Adjust Ui/Vi/Wi interpolation coefficients back to cell faces in the presence of walls (only walls!) - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (this%umask(i,j,k).eq.1) this%itpi_x(:,i,j,k)=0.0_WP - if (this%vmask(i,j,k).eq.1) this%itpi_y(:,i,j,k)=0.0_WP - if (this%wmask(i,j,k).eq.1) this%itpi_z(:,i,j,k)=0.0_WP - end do - end do - end do ! I am assuming here that we do not really need to zero out wall cells ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 0bf43df38..35727f3b7 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -121,8 +121,6 @@ module lowmach_class procedure :: get_dmomdt !< Calculate dmom/dt procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient - procedure :: get_div_stress !< Calculate divergence of stress - procedure :: get_vorticity !< Calculate vorticity tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL @@ -291,7 +289,7 @@ subroutine init_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do @@ -1220,183 +1218,6 @@ subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) call this%cfg%sync(Pgrady) call this%cfg%sync(Pgradz) end subroutine get_pgrad - - - !> Calculate divergence of stress based on U/V/W/P (needed by LPT class) - subroutine get_div_stress(this,divx,divy,divz) - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divy !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: divz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ii,jj,kk - real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ - - ! Allocate flux arrays - allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Stress tensor in X - do kk=this%cfg%kmin_,this%cfg%kmax_+1 - do jj=this%cfg%jmin_,this%cfg%jmax_+1 - do ii=this%cfg%imin_,this%cfg%imax_+1 - ! Fluxes on x-face - i=ii-1; j=jj-1; k=kk-1 - FX(i,j,k)=+this%visc(i,j,k)*(sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) & - & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & - & -this%P(i,j,k) - ! Fluxes on y-face - i=ii; j=jj; k=kk - FY(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))+sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))) - ! Fluxes on z-face - i=ii; j=jj; k=kk - FZ(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))+sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))) - end do - end do - end do - ! Divergence of X stress - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - divx(i,j,k)=sum(this%divu_x(:,i,j,k)*FX(i-1:i,j,k))+& - & sum(this%divu_y(:,i,j,k)*FY(i,j:j+1,k))+& - & sum(this%divu_z(:,i,j,k)*FZ(i,j,k:k+1)) - end do - end do - end do - ! Sync it - call this%cfg%sync(divx) - - ! Stress tensor in Y - do kk=this%cfg%kmin_,this%cfg%kmax_+1 - do jj=this%cfg%jmin_,this%cfg%jmax_+1 - do ii=this%cfg%imin_,this%cfg%imax_+1 - ! Fluxes on x-face - i=ii; j=jj; k=kk - FX(i,j,k)=+sum(this%itp_xy(:,:,i,j,k)*this%visc(i-1:i,j-1:j,k))*(sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))+sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))) - ! Fluxes on y-face - i=ii-1; j=jj-1; k=kk-1 - FY(i,j,k)=+this%visc(i,j,k)*(sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) & - & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & - & -this%P(i,j,k) - ! Fluxes on z-face - i=ii; j=jj; k=kk - FZ(i,j,k)=+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))+sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))) - end do - end do - end do - ! Divergence of Y stress - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - divy(i,j,k)=sum(this%divv_x(:,i,j,k)*FX(i:i+1,j,k))+& - & sum(this%divv_y(:,i,j,k)*FY(i,j-1:j,k))+& - & sum(this%divv_z(:,i,j,k)*FZ(i,j,k:k+1)) - end do - end do - end do - ! Sync it - call this%cfg%sync(divy) - - ! Stress tensor in Z - do kk=this%cfg%kmin_,this%cfg%kmax_+1 - do jj=this%cfg%jmin_,this%cfg%jmax_+1 - do ii=this%cfg%imin_,this%cfg%imax_+1 - ! Fluxes on x-face - i=ii; j=jj; k=kk - FX(i,j,k)=+sum(this%itp_xz(:,:,i,j,k)*this%visc(i-1:i,j,k-1:k))*(sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))+sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))) - ! Fluxes on y-face - i=ii; j=jj; k=kk - FY(i,j,k)=-+sum(this%itp_yz(:,:,i,j,k)*this%visc(i,j-1:j,k-1:k))*(sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))+sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))) - ! Fluxes on z-face - i=ii-1; j=jj-1; k=kk-1 - FZ(i,j,k)=+this%visc(i,j,k)*(sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))+sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) & - & -2.0_WP/3.0_WP*(sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)))) & - & -this%P(i,j,k) - end do - end do - end do - ! Divergence in Z - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - divz(i,j,k)=sum(this%divw_x(:,i,j,k)*FX(i:i+1,j,k))+& - & sum(this%divw_y(:,i,j,k)*FY(i,j:j+1,k))+& - & sum(this%divw_z(:,i,j,k)*FZ(i,j,k-1:k)) - end do - end do - end do - ! Sync it - call this%cfg%sync(divz) - - ! Deallocate flux arrays - deallocate(FX,FY,FZ) - - end subroutine get_div_stress - - - !> Calculate vorticity vector - subroutine get_vorticity(this,vort) - use messager, only: die - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - - ! Check vort's first two dimensions - if (size(vort,dim=1).ne.3) call die('[lowmach get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - - ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) - dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) - dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) - dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) - dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) - dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) - end do - end do - end do - - ! Interpolate off-diagonal components of the velocity gradient to the cell center - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - vort(1,i,j,k)=0.25_WP*(sum(dwdy(i,j:j+1,k:k+1))-sum(dvdz(i,j:j+1,k:k+1))) - vort(2,i,j,k)=0.25_WP*(sum(dudz(i:i+1,j,k:k+1))-sum(dwdx(i:i+1,j,k:k+1))) - vort(3,i,j,k)=0.25_WP*(sum(dvdx(i:i+1,j:j+1,k))-sum(dudy(i:i+1,j:j+1,k))) - end do - end do - end do - - ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP - end do - end do - end do - - ! Sync it - call this%cfg%sync(vort) - - ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - - end subroutine get_vorticity !> Divide momentum by rho to form velocity @@ -1517,7 +1338,7 @@ subroutine get_strainrate(this,SR) end do ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) From 2d5aba0bac68e24a3dc5a2047124ffcd0b165725 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 1 Feb 2023 13:07:14 -0500 Subject: [PATCH 093/152] Update poissontest Add consistency with NGA solver --- examples/poissontest/src/simulation.f90 | 38 +++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/examples/poissontest/src/simulation.f90 b/examples/poissontest/src/simulation.f90 index 8d791a291..0827480e4 100644 --- a/examples/poissontest/src/simulation.f90 +++ b/examples/poissontest/src/simulation.f90 @@ -129,11 +129,49 @@ subroutine simulation_run end if end do + ! Consistent with NGA2 solver + ps%rhs=-ps%rhs + end block rhs_setup ! Solve Poisson equation + ps%sol=0.0_WP call ps%solve() + shift_p: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + integer :: i,j,k,ierr + real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot + ! Loop over domain and integrate volume and pressure + my_vol_tot=0.0_WP + my_pressure_tot=0.0_WP + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + my_vol_tot =my_vol_tot +cfg%vol(i,j,k)*cfg%VF(i,j,k) + my_pressure_tot=my_pressure_tot+cfg%vol(i,j,k)*cfg%VF(i,j,k)*ps%sol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,cfg%comm,ierr) + call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,cfg%comm,ierr) + pressure_tot=pressure_tot/vol_tot + + ! Shift the pressure + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + if (cfg%VF(i,j,k).gt.0.0_WP) ps%sol(i,j,k)=ps%sol(i,j,k)-pressure_tot + end do + end do + end do + call cfg%sync(ps%sol) + end block shift_p + + ! Consistent with NGA2 solver + ps%rhs=-ps%rhs + ! Output to ensight call ens_out%write_data(0.0_WP) From ec09e9fb811cd0442997c8a17fec65e651c8688b Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 1 Feb 2023 13:08:21 -0500 Subject: [PATCH 094/152] Update pfft3d_class.f90 3D FFT works in many cases, in parallel num procs must be evenly divisible into nx. Also seems to be a bug in the p3dfft library when nz=1 and npx=1. --- src/solver/pfft3d_class.f90 | 46 +++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index aec102859..1649f4914 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -140,8 +140,8 @@ subroutine pfft3d_init(this) implicit none include "mpif.h" class(pfft3d), intent(inout) :: this - integer :: type_ccr, type_rcc - integer(C_INT) :: p3dfft_grid, grid_real, grid_fourier + integer :: type_ccr, type_rcc, contig_dim, buf_int + integer(C_INT) :: p3dfft_grid, grid_real, grid_fourier, buf_cint integer, dimension(3) :: type_ids_f, type_ids_b, & glob_start_real, glob_start_fourier integer(C_INT), dimension(3) :: pdims, ldims_real, ldims_fourier, & @@ -156,17 +156,12 @@ subroutine pfft3d_init(this) ! Various checks to ensure we can use this solver check_solver_is_useable: block - integer :: ndcp, ndims ! Periodicity and uniformity of mesh if (.not.(this%cfg%xper.and.this%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') if (.not.(this%cfg%yper.and.this%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') if (.not.(this%cfg%zper.and.this%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') - ! Ensure that we have at least one non-decomposed direction - ndims = count(gdims_real .gt. 1); ndcp = count(pdims .gt. 1); - if (ndcp .ge. ndims) call die('[pdfft3 constructor] Need at least one NON-decomposed direction') - end block check_solver_is_useable ! Check if FFT should be handled in serial @@ -180,23 +175,36 @@ subroutine pfft3d_init(this) return end if + ! Various checks for parallel FFT + check_psolver_is_useable: block + + ! Check (restrictive) processor decomp + if (modulo(this%cfg%nx,this%cfg%npx).ne.0) call die('[pfft3d constructor] Need nx to evenly divide into npx') + if (modulo(this%cfg%ny,this%cfg%npy).ne.0) call die('[pfft3d constructor] Need ny to evenly divide into npy') + if (modulo(this%cfg%nz,this%cfg%npz).ne.0) call die('[pfft3d constructor] Need nz to evenly divide into npz') + + ! Ensure that we have at least one non-decomposed direction + contig_dim = findloc((/this%cfg%npx, this%cfg%npy, this%cfg%npz /), value=1, dim=1) + if (contig_dim.eq.0) call die('[pdfft3 constructor] Need at least one NON-decomposed direction') + + ! Possible bug in p3dfft library + if (this%cfg%nz.eq.1. .and. this%cfg%npx.gt.1) call die('[pfft3d constructor] 2D case requires npx=1') + + end block check_psolver_is_useable + ! Set up work structures for P3DFFT call p3dfft_setup ! Set up 2 transform types for 3D transforms - type_ids_f(:) = (/ P3DFFT_R2CFFT_D, P3DFFT_CFFT_FORWARD_D, P3DFFT_CFFT_FORWARD_D /) - type_ids_b(:) = (/ P3DFFT_C2RFFT_D, P3DFFT_CFFT_BACKWARD_D, P3DFFT_CFFT_BACKWARD_D /) - - ! Now initialize 3D transforms (forward and backward) with these types - call p3dfft_init_3Dtype(type_rcc, type_ids_f) - call p3dfft_init_3Dtype(type_ccr, type_ids_b) + type_ids_f(:) = P3DFFT_CFFT_FORWARD_D; type_ids_f(contig_dim) = P3DFFT_R2CFFT_D + type_ids_b(:) = P3DFFT_CFFT_BACKWARD_D; type_ids_b(contig_dim) = P3DFFT_C2RFFT_D ! Set up processor order and memory ordering, as well as the final global ! grid dimensions. These will be different from the original dimensions in ! one dimension due to conjugate symmetry, since we are doing ! real-to-complex transform. gdims_fourier(:) = gdims_real(:) - gdims_fourier(1) = gdims_fourier(1) / 2 + 1 + gdims_fourier(contig_dim) = gdims_fourier(contig_dim) / 2 + 1 mem_order_real(:) = (/ 0, 1, 2 /) ! Set up memory order for the final grid layout (for complex array in @@ -209,13 +217,17 @@ subroutine pfft3d_init(this) mem_order_fourier(:) = (/ 1, 2, 0 /) dmap_real(:) = (/ 0, 1, 2 /); dmap_fourier(:) = (/ 1, 2, 0 /); + ! Now initialize 3D transforms (forward and backward) with these types + call p3dfft_init_3Dtype(type_rcc, type_ids_f) + call p3dfft_init_3Dtype(type_ccr, type_ids_b) + ! Specify the default communicator for P3DFFT++. This can be different ! from your program default communicator. p3dfft_grid = p3dfft_init_proc_grid(pdims, MPI_COMM_WORLD) ! Initialize grid, no conjugate symmetry (-1) call p3dfft_init_data_grid(grid_real, ldims_real, glob_start_real, & - gdims_real, -1, p3dfft_grid, dmap_real, mem_order_real) + gdims_real, -1, p3dfft_grid, dmap_real, mem_order_real) ! Check ldims_real against pgrid if (.not. all((/ this%cfg%nx_, this%cfg%ny_, this%cfg%nz_ /) .eq. & @@ -225,7 +237,7 @@ subroutine pfft3d_init(this) ! Final grid has conjugate symmetry in X dimension (0) call p3dfft_init_data_grid(grid_fourier, ldims_fourier, glob_start_fourier,& - gdims_fourier, 0, p3dfft_grid, dmap_fourier, mem_order_fourier) + gdims_fourier, 0, p3dfft_grid, dmap_fourier, mem_order_fourier) ! Plan transforms call p3dfft_plan_3Dtrans(this%trans_f, grid_real, grid_fourier, type_rcc) @@ -351,6 +363,7 @@ subroutine pfft3d_solve(this) ! Divide this%transformed_rhs = this%transformed_rhs * this%factored_operator + ! Do backward transform and rescale if (this%serial_fft) then this%inout_serial=this%transformed_rhs @@ -380,7 +393,6 @@ subroutine pfft3d_destroy(this) implicit none class(pfft3d), intent(inout) :: this - ! do nothing; included for consistency with other methods this%setup_done = .false. if (this%serial_fft) then From 917ece432e3193761e79558203d96630fcb64f93 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 1 Feb 2023 14:18:07 -0500 Subject: [PATCH 095/152] Update pfft3d_class.f90 This version works in 2D + 3D, still issue with 2D when npx=1 --- src/solver/pfft3d_class.f90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 1649f4914..5300a91c6 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -196,15 +196,22 @@ subroutine pfft3d_init(this) call p3dfft_setup ! Set up 2 transform types for 3D transforms - type_ids_f(:) = P3DFFT_CFFT_FORWARD_D; type_ids_f(contig_dim) = P3DFFT_R2CFFT_D - type_ids_b(:) = P3DFFT_CFFT_BACKWARD_D; type_ids_b(contig_dim) = P3DFFT_C2RFFT_D + !type_ids_f(:) = P3DFFT_CFFT_FORWARD_D; type_ids_f(contig_dim) = P3DFFT_R2CFFT_D + !type_ids_b(:) = P3DFFT_CFFT_BACKWARD_D; type_ids_b(contig_dim) = P3DFFT_C2RFFT_D + type_ids_f(:) = (/ P3DFFT_R2CFFT_D, P3DFFT_CFFT_FORWARD_D, P3DFFT_CFFT_FORWARD_D /) + type_ids_b(:) = (/ P3DFFT_C2RFFT_D, P3DFFT_CFFT_BACKWARD_D, P3DFFT_CFFT_BACKWARD_D /) + + ! Now initialize 3D transforms (forward and backward) with these types + call p3dfft_init_3Dtype(type_rcc, type_ids_f) + call p3dfft_init_3Dtype(type_ccr, type_ids_b) ! Set up processor order and memory ordering, as well as the final global ! grid dimensions. These will be different from the original dimensions in ! one dimension due to conjugate symmetry, since we are doing ! real-to-complex transform. gdims_fourier(:) = gdims_real(:) - gdims_fourier(contig_dim) = gdims_fourier(contig_dim) / 2 + 1 + gdims_fourier(1) = gdims_fourier(1) / 2 + 1 + !gdims_fourier(contig_dim) = gdims_fourier(contig_dim) / 2 + 1 mem_order_real(:) = (/ 0, 1, 2 /) ! Set up memory order for the final grid layout (for complex array in @@ -217,10 +224,6 @@ subroutine pfft3d_init(this) mem_order_fourier(:) = (/ 1, 2, 0 /) dmap_real(:) = (/ 0, 1, 2 /); dmap_fourier(:) = (/ 1, 2, 0 /); - ! Now initialize 3D transforms (forward and backward) with these types - call p3dfft_init_3Dtype(type_rcc, type_ids_f) - call p3dfft_init_3Dtype(type_ccr, type_ids_b) - ! Specify the default communicator for P3DFFT++. This can be different ! from your program default communicator. p3dfft_grid = p3dfft_init_proc_grid(pdims, MPI_COMM_WORLD) From 2aa1478a71f15450223bf6a21490a6e316ad3055 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 2 Feb 2023 07:37:32 -0500 Subject: [PATCH 096/152] Particle-laden pipe flow is working We now have clustering! Added ability to detect collisions with cylinder walls. --- examples/riser/GNUmakefile | 24 +++++----- examples/riser/input | 18 ++++---- examples/riser/src/simulation.f90 | 44 +++++++++---------- src/particles/lpt_class.f90 | 73 ++++++++++++++++++++++++++++--- 4 files changed, 113 insertions(+), 46 deletions(-) diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile index 818048416..f9da1babb 100644 --- a/examples/riser/GNUmakefile +++ b/examples/riser/GNUmakefile @@ -2,15 +2,17 @@ NGA_HOME ?= ../.. # Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_HYPRE = TRUE -USE_LAPACK= TRUE -USE_IRL = FALSE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +USE_FFTW = FALSE +USE_P3DFFT = FALSE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga # Directories that contain user-defined code Udirs := src @@ -23,8 +25,10 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/riser/input b/examples/riser/input index 7320f4009..f0e31fe3d 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -1,12 +1,12 @@ # Parallelization -Partition : 4 1 1 +Partition : 1 4 1 # Mesh definition +Pipe length : 0.08 Pipe diameter : .01 -Pipe length : 0.05 -nx : 128 -ny : 32 -nz : 32 +nx : 570 +ny : 70 +nz : 1 # Time integration Max timestep size : 1e-5 @@ -20,7 +20,7 @@ Density : 1.2 Gravity : -9.81 0 0 # Particle properties -Particle volume fraction : 0.01 +Particle volume fraction : 0.012 Particle mean diameter : 58e-6 Particle standard deviation : 25-6 Particle min diameter : 21e-6 @@ -40,11 +40,11 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 40e-5 +Ensight output period : 100e-5 # Postprocessing output -Postproc output period : 100e-5 +Postproc output period : 200e-5 # Restart files -Restart output period : 20e-5 +Restart output period : 200e-5 !Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index f1faeed4a..221bb5454 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -573,7 +573,7 @@ subroutine simulation_run resU=resU+bforce ! Collide and advance particles - call lp%collide(dt=time%dtmid) + call lp%collide(dt=time%dtmid,pipe_D=D,pipe_pos=(/0.0_WP,0.0_WP/),pipe_dir='x') call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) @@ -617,6 +617,27 @@ subroutine simulation_run end do end block add_lpt_src + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) + RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) + RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + end do + end do + end do + end block ibm_correction + ! Add body forcing call bodyforce_mfr(resU) bforce=(mfr_target-mfr)/time%dtmid @@ -630,27 +651,6 @@ subroutine simulation_run fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx =get_VF(i,j,k,'U') - VFy =get_VF(i,j,k,'V') - VFz =get_VF(i,j,k,'W') - fs%U(i,j,k)=VFx*fs%U(i,j,k) - fs%V(i,j,k)=VFy*fs%V(i,j,k) - fs%W(i,j,k)=VFz*fs%W(i,j,k) - end do - end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibm_correction - ! Apply other boundary conditions and update momentum call fs%apply_bcond(time%tmid,time%dtmid) call fs%rho_multiply() diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 3637eb09f..ee0dc94e4 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -352,12 +352,21 @@ end function constructor !> Resolve collisional interaction between particles !> Requires tau_col, e_n, e_w and mu_f to be set beforehand - subroutine collide(this,dt) + subroutine collide(this,dt,pipe_D,pipe_pos,pipe_dir) implicit none class(lpt), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + real(WP), intent(in), optional :: pipe_D,pipe_pos(2) + character(len=*), intent(in), optional :: pipe_dir + + ! Check if all pipe properties are provided + check_pipe: block + use messager, only: die + if (present(pipe_D).and.(.not.present(pipe_pos).or..not.present(pipe_dir))) & + call die('[lpt collide] Missing pipe parameters') + end block check_pipe ! Start by zeroing out the collision force zero_force: block @@ -419,7 +428,7 @@ subroutine collide(this,dt) use mpi_f08 use mathtools, only: Pi,normalize,cross_product integer :: i1,i2,ii,jj,kk,nn,ierr - real(WP) :: d1,m1,d2,m2,d12,m12 + real(WP) :: d1,m1,d2,m2,d12,m12,buf real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv real(WP), parameter :: aclipnorm=1.0e-6_WP @@ -480,6 +489,57 @@ subroutine collide(this,dt) ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) end if + + ! Collide with pipe walls + if (present(pipe_D)) then + select case(trim(pipe_dir)) + case('x') + d12=0.5_WP*pipe_D-sqrt((r1(2)-pipe_pos(1))**2+(r1(3)-pipe_pos(2))**2) + n12(1) = 0.0_WP + n12(2) = pipe_pos(1) - r1(2) + n12(3) = pipe_pos(2) - r1(3) + case('y') + d12=0.5_WP*pipe_D-sqrt((r1(1)-pipe_pos(1))**2+(r1(3)-pipe_pos(2))**2) + n12(1) = pipe_pos(1) - r1(1) + n12(2) = 0.0_WP + n12(3) = pipe_pos(2) - r1(3) + case('z') + d12=0.5_WP*pipe_D-sqrt((r1(1)-pipe_pos(1))**2+(r1(2)-pipe_pos(2))**2) + n12(1) = pipe_pos(1) - r1(1) + n12(2) = pipe_pos(2) - r1(2) + n12(3) = 0.0_WP + end select + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + n12 = -n12/buf + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + end if ! Loop over nearest cells do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 @@ -1201,7 +1261,7 @@ subroutine get_max(this) use parallel, only: MPI_REAL_WP implicit none class(lpt), intent(inout) :: this - real(WP) :: buf,safe_np + real(WP) :: buf,safe_np,vol_total integer :: i,j,k,ierr ! Create safe np @@ -1248,19 +1308,22 @@ subroutine get_max(this) call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np ! Get mean, max, and min volume fraction + vol_total=0.0_WP this%VFmean=0.0_WP this%VFmax =-huge(1.0_WP) this%VFmin =+huge(1.0_WP) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ + vol_total=vol_total+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k) this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) this%VFmax =max(this%VFmax,this%VF(i,j,k)) this%VFmin =min(this%VFmin,this%VF(i,j,k)) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(vol_total,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); vol_total=buf + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/vol_total call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -1273,7 +1336,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/vol_total end subroutine get_max From 5842d2e76cab2053f8c1e170fe6ae44b03cf1985 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 2 Feb 2023 09:58:44 -0500 Subject: [PATCH 097/152] Update pfft3d_class.f90 Less restrictive check, the old check failed when domain length had decimal value --- src/solver/pfft3d_class.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 5300a91c6..45b5d80b2 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -275,21 +275,21 @@ subroutine pfft3d_setup(this) this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3)) = n end do - ! check circulent operator + ! Check circulent operator if (this%cfg%amRoot) ref_stencil = this%opr(:,1,1,1) call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) circulent = .true. do k = this%cfg%kmin_, this%cfg%kmax_ do j = this%cfg%jmin_, this%cfg%jmax_ do i = this%cfg%imin_, this%cfg%imax_ - if (any(this%opr(:,i,j,k) .ne. ref_stencil(:))) circulent = .false. + if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.10.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**2)) circulent = .false. end do end do end do if (.not. circulent) then call die("[pf3dft] stencil must be uniform in space") end if - + ! Build the operator opr_col(:,:,:) = 0.0_C_DOUBLE do n = 1, this%nst From ef24ad81c5997d286e962e4700f96bbf549a6c00 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 2 Feb 2023 10:04:56 -0500 Subject: [PATCH 098/152] Update pfft3d_class.f90 Because Jack insists --- src/solver/pfft3d_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 45b5d80b2..391ebb333 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -282,7 +282,7 @@ subroutine pfft3d_setup(this) do k = this%cfg%kmin_, this%cfg%kmax_ do j = this%cfg%jmin_, this%cfg%jmax_ do i = this%cfg%imin_, this%cfg%imax_ - if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.10.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**2)) circulent = .false. + if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulent = .false. end do end do end do From 7aefa45ab1819bc66db2a35cb6797e8bde487f53 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 2 Feb 2023 17:16:10 -0500 Subject: [PATCH 099/152] Update geometry.f90 How did my compiler miss this? --- examples/ib_pipe/src/geometry.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 30064fcee..40007dfab 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -85,13 +85,14 @@ subroutine geometry_init ! Create masks for this config create_walls: block integer :: i,j,k - do k=cfg%kmino_,cfg%kmaxo_ - do j=cfg%jmino_,cfg%jmaxo_ - do i=cfg%imino_,cfg%imaxo_ + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ cfg%VF(i,j,k)=get_VF(i,j,k,'SC') end do end do end do + call cfd%sync(cfg%VF) end block create_walls From 3278fd087ae6d31cd9d924184c78493524e81ffc Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 2 Feb 2023 20:36:28 -0500 Subject: [PATCH 100/152] Update geometry.f90 I should compile being pushing --- examples/ib_pipe/src/geometry.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 40007dfab..9a01d9bcc 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -92,7 +92,7 @@ subroutine geometry_init end do end do end do - call cfd%sync(cfg%VF) + call cfg%sync(cfg%VF) end block create_walls From 9e568018f4e5985fc46da3df229dda0227943ecf Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 3 Feb 2023 17:44:31 -0500 Subject: [PATCH 101/152] Merge branch 'develop' of https://github.com/desjardi/NGA2 into develop --- examples/falling_drop/input | 15 +- examples/falling_drop/src/geometry.f90 | 146 +- examples/falling_drop/src/simulation.f90 | 533 ++++--- examples/ib_drop/GNUmakefile | 48 + examples/ib_drop/README | 1 + examples/ib_drop/input | 41 + examples/ib_drop/src/Make.package | 2 + examples/ib_drop/src/geometry.f90 | 70 + examples/ib_drop/src/simulation.f90 | 486 +++++++ examples/ib_pipe/GNUmakefile | 2 +- examples/ib_pipe/input | 28 +- examples/ib_pipe/src/geometry.f90 | 53 +- examples/ib_pipe/src/simulation.f90 | 682 +++++---- examples/ib_tester/src/simulation.f90 | 12 +- src/immersed/df_class.f90 | 1664 +++++++++++----------- src/subgrid/sgsmodel_class.f90 | 57 +- 16 files changed, 2269 insertions(+), 1571 deletions(-) create mode 100644 examples/ib_drop/GNUmakefile create mode 100644 examples/ib_drop/README create mode 100644 examples/ib_drop/input create mode 100644 examples/ib_drop/src/Make.package create mode 100644 examples/ib_drop/src/geometry.f90 create mode 100644 examples/ib_drop/src/simulation.f90 diff --git a/examples/falling_drop/input b/examples/falling_drop/input index 10e5ce8f2..3b84920aa 100644 --- a/examples/falling_drop/input +++ b/examples/falling_drop/input @@ -1,25 +1,24 @@ # Parallelization -Partition : 1 1 4 +Partition : 1 1 8 # Mesh definition -Lx : 0.01 -Ly : 1 -Lz : 1 +Lx : 0.001 +Ly : 0.1 +Lz : 0.1 nx : 1 ny : 100 nz : 100 # Fluid properties -Gravity : 0 -1 0 +Gravity : 0 -9.81 0 Liquid dynamic viscosity : 1.137e-3 Gas dynamic viscosity : 1.780e-5 Liquid density : 1000 Gas density : 1.226 Surface tension coefficient : 0.0728 -Static contact angle : 70 # Time integration -Max timestep size : 1e-2 +Max timestep size : 1e-3 Max cfl number : 0.9 Max time : 5 @@ -32,4 +31,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 1e-1 \ No newline at end of file +Ensight output period : 1e-2 \ No newline at end of file diff --git a/examples/falling_drop/src/geometry.f90 b/examples/falling_drop/src/geometry.f90 index f24872289..e69f237a9 100644 --- a/examples/falling_drop/src/geometry.f90 +++ b/examples/falling_drop/src/geometry.f90 @@ -1,76 +1,74 @@ !> Various definitions and tools for initializing NGA2 config module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - - contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) - - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx - end do - do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly - end do - do k=1,nz+1 - z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='FallingDrop') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - ! Read in partition - call param_read('Partition',partition,short='p') - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - end block create_cfg - - - ! Create masks for this config - create_walls: block - ! Put walls all around - cfg%VF=0.0_WP - cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP - call cfg%sync(cfg%VF) - end block create_walls - - - end subroutine geometry_init - - - end module geometry \ No newline at end of file + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='FallingDrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry \ No newline at end of file diff --git a/examples/falling_drop/src/simulation.f90 b/examples/falling_drop/src/simulation.f90 index 0749084da..03731c4aa 100644 --- a/examples/falling_drop/src/simulation.f90 +++ b/examples/falling_drop/src/simulation.f90 @@ -33,16 +33,16 @@ module simulation real(WP), dimension(3) :: center real(WP) :: radius,depth - contains - - - !> Function that defines a level set function for a falling drop problem +contains + + + !> Function that defines a level set function for a falling drop problem function levelset_falling_drop(xyz,t) result(G) - implicit none - real(WP), dimension(3),intent(in) :: xyz - real(WP), intent(in) :: t - real(WP) :: G - ! Create the droplet + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet G=radius-sqrt(sum((xyz-center)**2)) ! Add the pool G=max(G,depth-xyz(2)) @@ -51,175 +51,173 @@ end function levelset_falling_drop !> Initialization of problem solver subroutine simulation_init - use param, only: param_read - implicit none - - - ! Allocate work arrays + use param, only: param_read + implicit none + + + ! Allocate work arrays allocate_work_arrays: block - allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize time tracker with 2 subiterations + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Initialize our VOF solver and field + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: lvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver - vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') - ! Initialize to a droplet and a pool - center=[0.0_WP,0.5_WP,0.0_WP] - radius=0.1_WP - depth =0.2_WP - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - ! Call adaptive refinement code to get volume and barycenters recursively - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) - vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) - if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then - vf%Lbary(:,i,j,k)=v_cent - vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) - else - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end if + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.05_WP,0.0_WP] + radius=0.01_WP + depth =0.02_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do end do - end do - end do - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a two-phase flow solver without bconds + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg,pcg_pfmg - use mathtools, only: Pi - ! Create flow solver - fs=tpns(cfg=cfg,name='Two-phase NS') - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l) - call param_read('Gas dynamic viscosity',fs%visc_g) - ! Assign constant density to each phase - call param_read('Liquid density',fs%rho_l) - call param_read('Gas density',fs%rho_g) - ! Read in surface tension coefficient - call param_read('Surface tension coefficient',fs%sigma) - call param_read('Static contact angle',fs%contact_angle) - fs%contact_angle=fs%contact_angle*Pi/180.0_WP - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=gmres_amg) - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Calculate cell-centered velocities and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() + use ils_class, only: gmres_amg,pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=gmres_amg) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() end block create_and_initialize_flow_solver ! Add Ensight output create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='FallingDrop') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VOF',vf%VF) - call ens_out%add_scalar('curvature',vf%curv) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight ! Create a monitor file create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call vf%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLst,'STension CFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() end block create_monitor @@ -228,114 +226,114 @@ end subroutine simulation_init !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase subroutine simulation_run - implicit none - - ! Perform time integration + implicit none + + ! Perform time integration do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old VOF - vf%VFold=vf%VF - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Apply time-varying Dirichlet conditions - ! This is where time-dpt Dirichlet would be enforced - - ! Prepare old staggered density (at n) - call fs%get_olddensity(vf=vf) - - ! VOF solver step - call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) - - ! Prepare new staggered viscosity (at n+1) - call fs%get_viscosity(vf=vf) - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Preliminary mass and momentum transport step at the interface - call fs%prepare_advection_upwind(dt=time%dt) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU - resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV - resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply other boundary conditions - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%update_laplacian() - call fs%correct_mfr() - call fs%get_div() - call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho_U - fs%V=fs%V-time%dt*resV/fs%rho_V - fs%W=fs%W-time%dt*resW/fs%rho_W - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call vf%get_max() - call mfile%write() - call cflfile%write() - - end do - + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + end subroutine simulation_run !> Finalize the NGA2 simulation subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors + implicit none + + ! Get rid of all objects - need destructors ! monitor ! ensight ! bcond @@ -347,7 +345,4 @@ subroutine simulation_final end subroutine simulation_final - - - - end module simulation \ No newline at end of file +end module simulation \ No newline at end of file diff --git a/examples/ib_drop/GNUmakefile b/examples/ib_drop/GNUmakefile new file mode 100644 index 000000000..1b5555613 --- /dev/null +++ b/examples/ib_drop/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre +IRL_DIR = /Users/desjardi/Repositories/Builds/irl + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := two_phase immersed core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/ib_drop/README b/examples/ib_drop/README new file mode 100644 index 000000000..40018fe6e --- /dev/null +++ b/examples/ib_drop/README @@ -0,0 +1 @@ +This is a direct forcing IBM case that tests the interaction between IB and the two-phase flow solvers. It simulates a drop impacting a bumpy cylinder. diff --git a/examples/ib_drop/input b/examples/ib_drop/input new file mode 100644 index 000000000..1710ec8eb --- /dev/null +++ b/examples/ib_drop/input @@ -0,0 +1,41 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Lx : 0.1 +Ly : 0.1 +Lz : 0.000390625 +nx : 256 +ny : 256 +nz : 1 + +# IBM properties +Number of markers : 200 +Cylinder diameter : 0.01 +Cylinder position : 0.03 +Perturbation amp : 0.0005 +Perturbation freq : 6 + +# Fluid properties +Gravity : 0 -9.81 0 +Liquid dynamic viscosity : 1.137e-3 +Gas dynamic viscosity : 1.780e-5 +Liquid density : 1000 +Gas density : 1.226 +Surface tension coefficient : 0.0728 + +# Time integration +Max timestep size : 5e-4 +Max cfl number : 0.9 +Max time : 5 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 5e-3 \ No newline at end of file diff --git a/examples/ib_drop/src/Make.package b/examples/ib_drop/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_drop/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_drop/src/geometry.f90 b/examples/ib_drop/src/geometry.f90 new file mode 100644 index 000000000..c4d9ee6bd --- /dev/null +++ b/examples/ib_drop/src/geometry.f90 @@ -0,0 +1,70 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='ib_drop') + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_drop/src/simulation.f90 b/examples/ib_drop/src/simulation.f90 new file mode 100644 index 000000000..f5c61ecf3 --- /dev/null +++ b/examples/ib_drop/src/simulation.f90 @@ -0,0 +1,486 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use df_class, only: dfibm + use vfs_class, only: vfs + use tpns_class, only: tpns + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, a vfs and tpns solver, and corresponding time tracker + type(vfs), public :: vf + type(tpns), public :: fs + type(dfibm), public :: df + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP), dimension(3) :: center + real(WP) :: radius + +contains + + + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=radius-sqrt(sum((xyz-center)**2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.06_WP,0.0_WP] + radius=0.01_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: gmres_amg,pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi,arctan + integer :: i,j,k,np + real(WP) :: Dcyl,Ycyl,amp,freq,theta,r + + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + + ! Read cylinder properties + call param_read('Number of markers',np) + call param_read('Cylinder diameter',Dcyl) + call param_read('Cylinder position',Ycyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =1 + df%p(i)%vel=0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm=df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(2)=df%p(i)%pos(2)+Ycyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)-Ycyl) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%G(i,j,k)=sqrt((df%cfg%xm(i))**2+(df%cfg%ym(j)-Ycyl)**2)-r + end do + end do + end do + call df%cfg%sync(df%G) + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%min_meshsize + end if + + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ib_drop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('markers',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('GIB',df%G) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + ! Get IB source terms + resU=vf%VF*fs%rho_l+(1.0_WP-vf%VF)*fs%rho_g + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) + ! Interpolate to the staggered cells and synchronize + resU=0.0_WP; resV=0.0_WP; resW=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=sum(fs%itpr_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + resV(i,j,k)=sum(fs%itpr_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + resW(i,j,k)=sum(fs%itpr_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + ! Increment velocity field + fs%U=fs%U+resU + fs%V=fs%V+resV + fs%W=fs%W+resW + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 355f0c0bf..5fb2b0a6a 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -30,7 +30,7 @@ HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := constant_density core data solver config grid libraries +Bdirs := subgrid constant_density core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 79891db38..3a98424db 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -4,30 +4,30 @@ Partition : 8 1 1 # Mesh definition Pipe diameter : 1 Pipe length : 4 -nx : 256 -ny : 96 -nz : 96 +nx : 256 +ny : 64 +nz : 64 # Pipe properties -Bulk velocity : 1 -Fluctuation amp : 0.2 +Bulk velocity : 1 +Fluctuation amp : 0.2 # Time integration -Max timestep size : 0.008 -Max cfl number : 0.9 -Max time : 1000 +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 # Fluid properties -Dynamic viscosity : 0.001 -Density : 1 +Dynamic viscosity : 2e-4 +Density : 1 # Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 +Pressure tolerance : 1e-4 +Pressure iteration : 100 # Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 +Implicit tolerance : 1e-4 +Implicit iteration : 100 # Ensight output Ensight output period : 1 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 9a01d9bcc..568a556c9 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -7,12 +7,13 @@ module geometry !> Single config type(config), public :: cfg - + !> Pipe diameter real(WP), public :: D - public :: geometry_init, get_VF + public :: geometry_init,get_VF + contains @@ -37,7 +38,7 @@ subroutine geometry_init call param_read('ny',ny); allocate(y(ny+1)) call param_read('nx',nx); allocate(x(nx+1)) call param_read('nz',nz); allocate(z(nz+1)) - + dx=Lx/real(nx,WP) no=6 if (ny.gt.1) then @@ -50,7 +51,7 @@ subroutine geometry_init else Lz=dx end if - + ! Create simple rectilinear grid do i=1,nx+1 x(i)=real(i-1,WP)/real(nx,WP)*Lx @@ -66,7 +67,7 @@ subroutine geometry_init grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') end block create_grid - + ! Create a config from that grid on our entire group create_cfg: block @@ -84,23 +85,23 @@ subroutine geometry_init ! Create masks for this config create_walls: block - integer :: i,j,k - do k=cfg%kmin_,cfg%kmax_ - do j=cfg%jmin_,cfg%jmax_ - do i=cfg%imin_,cfg%imax_ - cfg%VF(i,j,k)=get_VF(i,j,k,'SC') - end do - end do - end do - call cfg%sync(cfg%VF) + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=get_VF(i,j,k,'SC') + end do + end do + end do + call cfg%sync(cfg%VF) end block create_walls - end subroutine geometry_init - - - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) implicit none integer, intent(in) :: i,j,k character(len=*) :: dir @@ -108,15 +109,15 @@ function get_VF(i,j,k,dir) result(VF) real(WP) :: r,eta,lam,delta,VFx,VFy,VFz real(WP), dimension(3) :: norm select case(trim(dir)) - case('U') + case('U','u') delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r - case('V') + case('V','v') delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r - case('W') + case('W','w') delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r @@ -127,7 +128,7 @@ function get_VF(i,j,k,dir) result(VF) end select lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - - end module geometry + end function get_VF + + +end module geometry diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 4c36ba091..d9aa060a5 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,326 +1,380 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg,D,get_VF - use hypre_str_class, only: hypre_str - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(timetracker), public :: time - - !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP), dimension(:,:,:), allocatable :: G - real(WP) :: Ubulk,Umean - + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + contains - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create an incompressible flow solver without bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg - real(WP) :: visc - ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our velocity field - initialize_velocity: block - use mathtools, only: twoPi - use random, only: random_uniform - integer :: i,j,k - real(WP) :: amp - ! Initial fields - call param_read('Bulk velocity',Ubulk); Umean=Ubulk - call param_read('Fluctuation amp',amp,default=0.0_WP) - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! For faster transition - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=Ubulk*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) - fs%V(i,j,k)=Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) - fs%U(i,j,k)=fs%U(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) - fs%V(i,j,k)=fs%V(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do end do end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - ! Compute cell-centered velocity - call fs%interp_vel(Ui,Vi,Wi) - ! Compute divergence - call fs%get_div() - end block initialize_velocity - - - ! Initialize levelset - initialize_G: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do end do end do - end do - call fs%cfg%sync(G) - end block initialize_G - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='pipe') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',fs%cfg%VF) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(Umean,'Umean') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - - ! Add body forcing - forcing: block - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - integer :: i,j,k,ierr - real(WP) :: myU,myUvol,Uvol,VFx - myU=0.0_WP; myUvol=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) - myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx - end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=14 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) end do end do - call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myU ,Umean,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=Umean/Uvol - resU=resU+Ubulk-Umean - end block forcing - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx =get_VF(i,j,k,'U') - VFy =get_VF(i,j,k,'V') - VFz =get_VF(i,j,k,'W') - fs%U(i,j,k)=VFx*fs%U(i,j,k) - fs%V(i,j,k)=VFy*fs%V(i,j,k) - fs%W(i,j,k)=VFz*fs%W(i,j,k) - end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) end do end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibm_correction - - ! Apply other boundary conditions on the resulting fields - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho - - ! Increment sub-iteration counter - time%it=time%it+1 - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call mfile%write() - call cflfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + end module simulation diff --git a/examples/ib_tester/src/simulation.f90 b/examples/ib_tester/src/simulation.f90 index 8d25a4951..31d4aebd2 100644 --- a/examples/ib_tester/src/simulation.f90 +++ b/examples/ib_tester/src/simulation.f90 @@ -107,12 +107,12 @@ subroutine simulation_init ! Allocate work arrays allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 36d6b4ae1..8d8e492dc 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -1,849 +1,847 @@ !> Basic direct forcing IBM class: !> Provides support for Lagrangian marker particles module df_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION - implicit none - private - - - ! Expose type/constructor/methods - public :: dfibm - - - !> Memory adaptation parameter - real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor - real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor - - !> I/O chunk size to read at a time - integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - !> Basic marker particle definition - type :: part - !> MPI_DOUBLE_PRECISION data - real(WP) :: dA !< Element area - real(WP), dimension(3) :: norm !< Outward normal vector - real(WP), dimension(3) :: pos !< Particle center coordinates - real(WP), dimension(3) :: vel !< Velocity of particle - !> MPI_INTEGER data - integer :: id !< ID the object is associated with - integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) - end type part - !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=2 - integer , dimension(part_nblock) :: part_lblock=[10,5] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] - !> MPI_PART derived datatype and size - type(MPI_Datatype) :: MPI_PART - integer :: MPI_PART_SIZE - - !> Basic ibm object definition - type :: obj - !> MPI_DOUBLE_PRECISION data - real(WP) :: vol !< Object volume - real(WP), dimension(3) :: pos !< Center of mass - real(WP), dimension(3) :: vel !< Translational velocity of the object - real(WP), dimension(3) :: angVel !< Angular velocity of the object - real(WP), dimension(3) :: F !< Hydrodynamic force - end type obj - - !> Direct forcing IBM solver object definition - type :: dfibm - - ! This is our underlying config - class(config), pointer :: cfg !< This is the config the solver is build for - - ! This is the name of the solver - character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM - - ! Marker particle data - integer :: np !< Global number of particles - integer :: np_ !< Local number of particles - integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor - type(part), dimension(:), allocatable :: p !< Array of particles of type part - - ! Object data - integer :: nobj !< Global number of objects - type(obj), dimension(:), allocatable :: o !< Array of objects of type obj - - ! CFL numbers - real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers - - ! Solver parameters - real(WP) :: nstep=1 !< Number of substeps (default=1) - logical :: can_move !< Flag to allow moving IBM objects - - ! Monitoring info - real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info - real(WP) :: Umin,Umax,Umean !< U velocity info - real(WP) :: Vmin,Vmax,Vmean !< V velocity info - real(WP) :: Wmin,Wmax,Wmean !< W velocity info - real(WP) :: Fx,Fy,Fz !< Total force - - ! Volume fraction associated with IBM projection - real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered - - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - - ! Distance levelset for visualization and collision detection - real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered - + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: dfibm + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic marker particle definition + type :: part + !> MPI_DOUBLE_PRECISION data + real(WP) :: dA !< Element area + real(WP), dimension(3) :: norm !< Outward normal vector + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + !> MPI_INTEGER data + integer :: id !< ID the object is associated with + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=2 + integer , dimension(part_nblock) :: part_lblock=[10,5] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Basic ibm object definition + type :: obj + !> MPI_DOUBLE_PRECISION data + real(WP) :: vol !< Object volume + real(WP), dimension(3) :: pos !< Center of mass + real(WP), dimension(3) :: vel !< Translational velocity of the object + real(WP), dimension(3) :: angVel !< Angular velocity of the object + real(WP), dimension(3) :: F !< Hydrodynamic force + end type obj + + !> Direct forcing IBM solver object definition + type :: dfibm + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM + + ! Marker particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Object data + integer :: nobj !< Global number of objects + type(obj), dimension(:), allocatable :: o !< Array of objects of type obj + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + logical :: can_move !< Flag to allow moving IBM objects + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info + real(WP) :: Umin,Umax,Umean !< U velocity info + real(WP) :: Vmin,Vmax,Vmean !< V velocity info + real(WP) :: Wmin,Wmax,Wmean !< W velocity info + real(WP) :: Fx,Fy,Fz !< Total force + + ! Volume fraction associated with IBM projection + real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + + ! Distance levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered + contains - procedure :: update_partmesh !< Update a partmesh object using current particles - procedure :: setup_obj !< Setup IBM object - procedure :: get_source !< Compute direct forcing source - procedure :: resize !< Resize particle array to given size - procedure :: recycle !< Recycle particle array by removing flagged particles - procedure :: sync !< Synchronize particles across interprocessor boundaries - procedure :: read !< Parallel read particles from file - procedure :: write !< Parallel write particles to file - procedure :: get_max !< Extract various monitoring data - procedure :: get_cfl !< Calculate maximum CFL - procedure :: update_VF !< Compute volume fraction - procedure :: get_delta !< Compute regularized delta function - procedure :: interpolate !< Interpolation routine from mesh=>marker - procedure :: extrapolate !< Extrapolation routine from marker=>mesh - end type dfibm - - - !> Declare df solver constructor - interface dfibm - procedure constructor - end interface dfibm - + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: setup_obj !< Setup IBM object + procedure :: get_source !< Compute direct forcing source + procedure :: resize !< Resize particle array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute volume fraction + procedure :: get_delta !< Compute regularized delta function + procedure :: interpolate !< Interpolation routine from mesh=>marker + procedure :: extrapolate !< Extrapolation routine from marker=>mesh + end type dfibm + + + !> Declare df solver constructor + interface dfibm + procedure constructor + end interface dfibm + contains - !> Default constructor for direct forcing solver - function constructor(cfg,name) result(self) - implicit none - type(dfibm) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - integer :: i,j,k - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Allocate variables - allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 - self%np_=0; self%np=0 - call self%resize(0) - - ! Initialize MPI derived datatype for a particle - call prepare_mpi_part() - - ! Allocate levelset, VF and src arrays on cfg mesh - allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - - ! Initialize object - self%can_move=.false. - self%nobj=0 - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (self%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + !> Default constructor for direct forcing solver + function constructor(cfg,name) result(self) + implicit none + type(dfibm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate levelset, VF and src arrays on cfg mesh + allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + + ! Initialize object + self%can_move=.false. + self%nobj=0 + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Setup IBM objects, each processors own all objects + subroutine setup_obj(this) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i,j,n,ibuf,ierr + real(WP) :: myVol,dV,fac + real(WP), dimension(3) :: pos0,dist + ! Determine number of objects based on marker ID + n=1 + do i=1,this%np_ + n=max(n,this%p(i)%id) + end do + call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + ! Allocate and zero out the object array + allocate(this%o(1:this%nobj)) + if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then + fac=1.0_WP/3.0_WP + else + fac=1.0_WP/2.0_WP end if - end block logging - - end function constructor - - - !> Setup IBM objects, each processors own all objects - subroutine setup_obj(this) - use mpi_f08 - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i,j,n,ibuf,ierr - real(WP) :: myVol,dV,fac - real(WP), dimension(3) :: pos0,dist - ! Determine number of objects based on marker ID - n=1 - do i=1,this%np_ - n=max(n,this%p(i)%id) - end do - call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - ! Allocate and zero out the object array - allocate(this%o(1:this%nobj)) - if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then - fac=1.0_WP/3.0_WP - else - fac=1.0_WP/2.0_WP - end if - do i=1,this%nobj - ! Zero-out object properties - this%o(i)%pos=0.0_WP - this%o(i)%vel=0.0_WP - this%o(i)%angVel=0.0_WP - this%o(i)%F=0.0_WP - ! Compute center of mass - myVol=0.0_WP - do j=1,this%np_ - ! Determine particle associated with object - if (this%p(j)%id.eq.i) then - myVol=myVol+this%p(j)%dA - this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV - ! Determine object volume - myVol=0.0_WP - do j=1,this%np_ - if (this%p(j)%id.eq.i) then - dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) - if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) - if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) - if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) - myVol=myVol+fac*sum(dist)*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV - end do - end subroutine setup_obj - - - !> Compute direct forcing source by a specified time step dt - subroutine get_source(this,dt,U,V,W,rho) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: dti,rho_,dV - real(WP), dimension(3) :: vel,src - - ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - - ! Zero-out forces on objects - do i=1,this%nobj - this%o(i)%F=0.0_WP - end do - - ! Advance the equations - dti=1.0_WP/dt - do i=1,this%np_ - ! Interpolate the velocity to the particle location - vel=0.0_WP - if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') - if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') - if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') - rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') - ! Compute the source term - src=(this%p(i)%vel-vel) - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Send source term back to the mesh - if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') - if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') - if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') - ! Sum up force on object (Newton's 3rd law) - j=max(this%p(i)%id,1) - this%o(j)%F=this%o(j)%F-rho_*src*dV*dti - end do - - ! Sum at boundaries - call this%cfg%syncsum(this%srcU) - call this%cfg%syncsum(this%srcV) - call this%cfg%syncsum(this%srcW) - - ! Sum over each object - do j=1,this%nobj - call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src - end do - - ! Recompute volume fraction - call this%update_VF() - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + do i=1,this%nobj + ! Zero-out object properties + this%o(i)%pos=0.0_WP + this%o(i)%vel=0.0_WP + this%o(i)%angVel=0.0_WP + this%o(i)%F=0.0_WP + ! Compute center of mass + myVol=0.0_WP + do j=1,this%np_ + ! Determine particle associated with object + if (this%p(j)%id.eq.i) then + myVol=myVol+this%p(j)%dA + this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV + ! Determine object volume + myVol=0.0_WP + do j=1,this%np_ + if (this%p(j)%id.eq.i) then + dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) + if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) + if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) + if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) + myVol=myVol+fac*sum(dist)*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV + end do + end subroutine setup_obj + + + !> Compute direct forcing source by a specified time step dt + subroutine get_source(this,dt,U,V,W,rho) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: dti,rho_,dV + real(WP), dimension(3) :: vel,src + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + + ! Zero-out forces on objects + do i=1,this%nobj + this%o(i)%F=0.0_WP + end do + + ! Advance the equations + dti=1.0_WP/dt + do i=1,this%np_ + ! Interpolate the velocity to the particle location + vel=0.0_WP + if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') + if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') + if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') + rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') + ! Compute the source term + src=(this%p(i)%vel-vel) + ! Get element volume + dV=this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Send source term back to the mesh + if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') + ! Sum up force on object (Newton's 3rd law) + j=max(this%p(i)%id,1) + this%o(j)%F=this%o(j)%F-rho_*src*dV*dti + end do + + ! Sum at boundaries + call this%cfg%syncsum(this%srcU) + call this%cfg%syncsum(this%srcV) + call this%cfg%syncsum(this%srcW) + + ! Sum over each object + do j=1,this%nobj + call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src + end do + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end subroutine get_source + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i + real(WP) :: dV + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Get element volume + dV = this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Transfer volume to mesh + call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') + end do + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + end subroutine update_VF + + + !> Compute regularized delta function + subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(out) :: delta !< Return delta function + integer, intent(in) :: ic,jc,kc !< Cell index + real(WP), intent(in) :: xp,yp,zp !< Position of marker + character(len=*) :: dir + real(WP) :: deltax,deltay,deltaz,r + + ! Compute in X + if (trim(adjustl(dir)).eq.'U') then + r=(xp-this%cfg%x(ic))*this%cfg%dxmi(ic) + deltax=roma_kernel(r)*this%cfg%dxmi(ic) + else + r=(xp-this%cfg%xm(ic))*this%cfg%dxi(ic) + deltax=roma_kernel(r)*this%cfg%dxi(ic) end if - end block logging - - end subroutine get_source - - - !> Update particle volume fraction using our current particles - subroutine update_VF(this) - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i - real(WP) :: dV - ! Reset volume fraction - this%VF=0.0_WP - ! Transfer particle volume - do i=1,this%np_ - ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Transfer volume to mesh - call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') - end do - ! Sum at boundaries - call this%cfg%syncsum(this%VF) - end subroutine update_VF - - - !> Compute regularized delta function - subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(out) :: delta !< Return delta function - integer, intent(in) :: ic,jc,kc !< Cell index - real(WP), intent(in) :: xp,yp,zp !< Position of marker - character(len=*) :: dir - real(WP) :: deltax,deltay,deltaz,r - - ! Compute in X - if (trim(adjustl(dir)).eq.'U') then - r = (xp-this%cfg%x(ic))*this%cfg%dxmi(ic) - deltax = roma_kernel(r)*this%cfg%dxmi(ic) - else - r = (xp-this%cfg%xm(ic))*this%cfg%dxi(ic) - deltax = roma_kernel(r)*this%cfg%dxi(ic) - end if - - ! Compute in Y - if (trim(adjustl(dir)).eq.'V') then - r = (yp-this%cfg%y(jc))*this%cfg%dymi(jc) - deltay = roma_kernel(r)*this%cfg%dymi(jc) - else - r = (yp-this%cfg%ym(jc))*this%cfg%dyi(jc) - deltay = roma_kernel(r)*this%cfg%dyi(jc) - end if - - ! Compute in Z - if (trim(adjustl(dir)).eq.'W') then - r = (zp-this%cfg%z(kc))*this%cfg%dzmi(kc) - deltaz = roma_kernel(r)*this%cfg%dzmi(kc) - else - r = (zp-this%cfg%zm(kc))*this%cfg%dzi(kc) - deltaz = roma_kernel(r)*this%cfg%dzi(kc) - end if - - ! Put it all together - delta=deltax*deltay*deltaz - - contains - ! Mollification kernel - ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 - function roma_kernel(r) result(phi) + + ! Compute in Y + if (trim(adjustl(dir)).eq.'V') then + r=(yp-this%cfg%y(jc))*this%cfg%dymi(jc) + deltay=roma_kernel(r)*this%cfg%dymi(jc) + else + r=(yp-this%cfg%ym(jc))*this%cfg%dyi(jc) + deltay=roma_kernel(r)*this%cfg%dyi(jc) + end if + + ! Compute in Z + if (trim(adjustl(dir)).eq.'W') then + r=(zp-this%cfg%z(kc))*this%cfg%dzmi(kc) + deltaz=roma_kernel(r)*this%cfg%dzmi(kc) + else + r=(zp-this%cfg%zm(kc))*this%cfg%dzi(kc) + deltaz=roma_kernel(r)*this%cfg%dzi(kc) + end if + + ! Put it all together + delta=deltax*deltay*deltaz + + contains + ! Mollification kernel + ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 + function roma_kernel(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + if (abs(r).le.0.5_WP) then + phi=1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) + else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then + phi=1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + else + phi=0.0_WP + end if + end function roma_kernel + + end subroutine get_delta + + + !> Interpolation routine + function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) implicit none - real(WP), intent(in) :: r - real(WP) :: phi - if (abs(r).le.0.5_WP) then - phi = 1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) - else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then - phi = 1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + character(len=*) :: dir + real(WP) :: Ap + integer :: di,dj,dk + integer :: i1,i2,j1,j2,k1,k2 + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + ! Get the interpolation points + i1=ip-2; i2=ip+2 + j1=jp-2; j2=jp+2 + k1=kp-2; k2=kp+2 + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual interpolation on Ap + Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) + end function interpolate + + + !> Extrapolation routine + subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) + use messager, only: die + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(in) :: Ap + character(len=*) :: dir + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + integer :: di,dj,dk + ! If particle has left processor domain or reached last ghost cell, kill job + if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& + & jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& + & kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then + write(*,*) ip,jp,kp,xp,yp,zp + call die('[df extrapolate] Particle has left the domain') + end if + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual extrapolation on A + A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap + end subroutine extrapolate + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z + + ! Return if not used + if (.not.this%can_move) then + cfl=0.0_WP + return + end if + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Get mean, max, and min volume fraction and total force + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) + this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) + this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(dfibm), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(dfibm), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(dfibm), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 else - phi = 0.0_WP + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if end if - end function roma_kernel - - end subroutine get_delta - - - !> Interpolation routine - function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - character(len=*) :: dir - real(WP) :: Ap - integer :: di,dj,dk - integer :: i1,i2,j1,j2,k1,k2 - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - ! Get the interpolation points - i1=ip-2; i2=ip+2 - j1=jp-2; j2=jp+2 - k1=kp-2; k2=kp+2 - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual interpolation on Ap - Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) - end function interpolate - - - !> Extrapolation routine - subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) - use messager, only: die - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - real(WP), intent(in) :: Ap - character(len=*) :: dir - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - integer :: di,dj,dk - ! If particle has left processor domain or reached last ghost cell, kill job - if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& - jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& - kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then - write(*,*) ip,jp,kp,xp,yp,zp - call die('[df extrapolate] Particle has left the domain') - end if - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual extrapolation on A - A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap - end subroutine extrapolate - - - !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl - integer :: i,ierr - real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z - - ! Return if not used - if (.not.this%can_move) then - cfl=0.0_WP - return - end if - - ! Set the CFLs to zero - my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP - do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) - end do - my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt - - ! Get the parallel max - call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Return the maximum CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - - end subroutine get_cfl - - - !> Extract various monitoring data from particle field - subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP) :: buf,safe_np - integer :: i,j,k,ierr - - ! Create safe np - safe_np=real(max(this%np,1),WP) - - ! Diameter and velocity min/max/mean - this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP - this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP - this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP - do i=1,this%np_ - this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) - this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) - this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) - end do - call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf - call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf - call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np - call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf - call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf - call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np - call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf - call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf - call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - - ! Get mean, max, and min volume fraction and total force - this%VFmean=0.0_WP - this%VFmax =-huge(1.0_WP) - this%VFmin =+huge(1.0_WP) - this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) - this%VFmax =max(this%VFmax,this%VF(i,j,k)) - this%VFmin =min(this%VFmin,this%VF(i,j,k)) - this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) - this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) - this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf - call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf - call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total - - end subroutine get_max - - - !> Update particle mesh using our current particles - subroutine update_partmesh(this,pmesh) - use partmesh_class, only: partmesh - implicit none - class(dfibm), intent(inout) :: this - class(partmesh), intent(inout) :: pmesh - integer :: i - ! Reset particle mesh storage - call pmesh%reset() - ! Nothing else to do if no particle is present - if (this%np_.eq.0) return - ! Copy particle info - call pmesh%set_size(this%np_) - do i=1,this%np_ - pmesh%pos(:,i)=this%p(i)%pos - end do - end subroutine update_partmesh - - - !> Creation of the MPI datatype for particle - subroutine prepare_mpi_part() - use mpi_f08 - use messager, only: die - implicit none - integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp - integer(MPI_ADDRESS_KIND) :: lb,extent - type(MPI_Datatype) :: MPI_PART_TMP - integer :: i,mysize,ierr - ! Prepare the displacement array - disp(1)=0 - do i=2,part_nblock - call MPI_Type_size(part_tblock(i-1),mysize,ierr) - disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) - end do - ! Create and commit the new type - call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) - call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) - call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) - call MPI_Type_commit(MPI_PART,ierr) - ! If a problem was encountered, say it - if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') - ! Get the size of this type - call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) - end subroutine prepare_mpi_part - - - !> Synchronize particle arrays across processors - subroutine sync(this) - use mpi_f08 - implicit none - class(dfibm), intent(inout) :: this - integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc - integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp - integer :: n,prank,ierr - type(part), dimension(:), allocatable :: buf_send - ! Recycle first to minimize communication load - call this%recycle() - ! Prepare information about what to send - nsend_proc=0 - do n=1,this%np_ - prank=this%cfg%get_rank(this%p(n)%ind) - nsend_proc(prank)=nsend_proc(prank)+1 - end do - nsend_proc(this%cfg%rank)=0 - ! Inform processors of what they will receive - call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - ! Prepare displacements for all-to-all - nsend_disp(0)=0 - nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array - do n=1,this%cfg%nproc-1 - nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) - nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) - end do - ! Allocate buffer to send particles - allocate(buf_send(sum(nsend_proc))) - ! Pack the particles in the send buffer - nsend_proc=0 - do n=1,this%np_ - ! Get the rank - prank=this%cfg%get_rank(this%p(n)%ind) - ! Skip particles still inside - if (prank.eq.this%cfg%rank) cycle - ! Pack up for sending - nsend_proc(prank)=nsend_proc(prank)+1 - buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) - ! Flag particle for removal - this%p(n)%flag=1 - end do - ! Allocate buffer for receiving particles - call this%resize(this%np_+sum(nrecv_proc)) - ! Perform communication - call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) - ! Deallocate buffer - deallocate(buf_send) - ! Recycle to remove duplicate particles - call this%recycle() - end subroutine sync - - - !> Adaptation of particle array size - subroutine resize(this,n) - implicit none - class(dfibm), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize particle array to size n - if (.not.allocated(this%p)) then - ! Allocate directly to size n - allocate(this%p(n)) - this%p(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%p,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%p - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%p) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%p(1:n) - call move_alloc(tmp,this%p) - end if - end if - end subroutine resize - - - !> Clean-up of particle array by removing flag=1 particles - subroutine recycle(this) - implicit none - class(dfibm), intent(inout) :: this - integer :: new_size,i,ierr - ! Compact all active particles at the beginning of the array - new_size=0 - if (allocated(this%p)) then - do i=1,size(this%p,dim=1) - if (this%p(i)%flag.ne.1) then - new_size=new_size+1 - if (i.ne.new_size) then - this%p(new_size)=this%p(i) - this%p(i)%flag=1 - end if - end if - end do - end if - ! Resize to new size - call this%resize(new_size) - ! Update number of particles - this%np_=new_size - call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - this%np=sum(this%np_proc) - end subroutine recycle - - - !> Parallel write particles to file - subroutine write(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset - integer :: i,ierr,iunit - - ! Root serial-writes the file header - if (this%cfg%amRoot) then - ! Open the file - open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) - ! Number of particles and particle object size - write(iunit) this%np,MPI_PART_SIZE - ! Done with the header - close(iunit) - end if - - ! The rest is done in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) - - ! Get current position - call MPI_FILE_GET_POSITION(ifile,offset,ierr) - - ! Compute the offset and write - do i=1,this%cfg%rank - offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) - end do - if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + end subroutine resize + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(dfibm), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do end if - end block logging - - end subroutine write - - - !> Parallel read particles to file - subroutine read(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset,header_offset - integer :: i,j,ierr,npadd,psize,nchunk,cnt - integer, dimension(:,:), allocatable :: ppp - - ! First open the file in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) - - ! Read file header first - call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) - call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) - - ! Remember current position - call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) - - ! Check compatibility of particle type - if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') - - ! Naively share reading task among all processors - nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 - allocate(ppp(this%cfg%nproc,nchunk)) - ppp=int(npadd/(this%cfg%nproc*nchunk)) - cnt=0 - out:do j=1,nchunk - do i=1,this%cfg%nproc - cnt=cnt+1 - if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out - ppp(i,j)=ppp(i,j)+1 - end do - end do out - - ! Read by chunk - do j=1,nchunk - ! Find offset - offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) - ! Resize particle array - call this%resize(this%np_+ppp(this%cfg%rank+1,j)) - ! Read this file - call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) - ! Most general case: relocate every droplet - do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - ! Exchange all that - call this%sync() - end do - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header if (this%cfg%amRoot) then - write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) end if - end block logging - - end subroutine read - - + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + end module df_class diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index 86a74c310..e5aeb2264 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -26,7 +26,7 @@ module sgsmodel_class integer :: imax_in,jmax_in,kmax_in !< Safe max in each direction ! Some clipping parameters - real(WP) :: Cs_ref=0.1_WP + real(WP) :: Cs_ref=0.17_WP ! LM and MM tensor norms and eddy viscosity real(WP), dimension(:,:,:), allocatable :: LM,MM !< LM and MM tensor norms @@ -463,33 +463,41 @@ subroutine visc_vreman(this,rho,gradu) implicit none class(sgsmodel), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient - real(WP), dimension(:,:,:), allocatable :: alph2 !< velocity gradient tensor squared - real(WP) :: C,B,beta11,beta22,beta33,beta12,beta13,beta23 - integer :: i,j,k - - allocate(alph2(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - alph2 = gradu(1,1,:,:,:)**2 + gradu(1,2,:,:,:)**2 + gradu(1,3,:,:,:)**2 + & - & gradu(2,1,:,:,:)**2 + gradu(2,2,:,:,:)**2 + gradu(2,3,:,:,:)**2 + & - & gradu(3,1,:,:,:)**2 + gradu(3,2,:,:,:)**2 + gradu(3,3,:,:,:)**2 - - ! Model constant - FOR HIT c \approx 0.07 - ! For complex flows c = 2.5*Cs**2 - C = 2.5_WP*this%Cs_ref**2 + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient + real(WP) :: A,B,C + real(WP), dimension(1:3,1:3) :: beta + integer :: i,j,k,ii,jj + + ! Model constant is c=2.5*Cs_ref**2 + ! Vreman uses c=0.07 which corresponds to Cs_ref=0.17 + C=2.5_WP*this%Cs_ref**2 ! Compute the eddy viscosity do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - beta11 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)**2 + gradu(2,1,i,j,k)**2 + gradu(3,1,i,j,k)**2) - beta22 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)**2 + gradu(2,2,i,j,k)**2 + gradu(3,2,i,j,k)**2) - beta33 = this%delta(i,j,k)**2*(gradu(1,3,i,j,k)**2 + gradu(2,3,i,j,k)**2 + gradu(3,3,i,j,k)**2) - beta12 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,2,i,j,k) + gradu(2,1,i,j,k)*gradu(2,2,i,j,k) + gradu(3,1,i,j,k)*gradu(3,2,i,j,k)) - beta13 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,3,i,j,k) + gradu(2,1,i,j,k)*gradu(2,3,i,j,k) + gradu(3,1,i,j,k)*gradu(3,3,i,j,k)) - beta23 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)*gradu(1,3,i,j,k) + gradu(2,2,i,j,k)*gradu(2,3,i,j,k) + gradu(3,2,i,j,k)*gradu(3,3,i,j,k)) - - B = beta11*beta22 - beta12**2 + beta11*beta33 - beta13**2 + beta22*beta33 - beta23**2 - this%visc(i,j,k) = C*sqrt(B/alph2(i,j,k)) + ! Compute A=gradu_ij*gradu_ij invariant + A=gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2+& + & gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2+& + & gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2 + ! Compute beta_ij=dx_m*dx_m*gradu_mi*gradu_mj + do jj=1,3 + do ii=1,3 + beta(ii,jj)=this%cfg%dx(i)**2*gradu(1,ii,i,j,k)*gradu(1,jj,i,j,k)& + & +this%cfg%dy(j)**2*gradu(2,ii,i,j,k)*gradu(2,jj,i,j,k)& + & +this%cfg%dz(k)**2*gradu(3,ii,i,j,k)*gradu(3,jj,i,j,k) + end do + end do + ! Compute B invariant + B=beta(1,1)*beta(2,2)-beta(1,2)**2& + &+beta(1,1)*beta(3,3)-beta(1,3)**2& + &+beta(2,2)*beta(3,3)-beta(2,3)**2 + ! Assemble algebraic eddy viscosity model + if (B.lt.1.0e-8_WP) then + this%visc(i,j,k)=0.0_WP + else + this%visc(i,j,k)=rho(i,j,k)*C*sqrt(B/A) + end if end do end do end do @@ -497,9 +505,6 @@ subroutine visc_vreman(this,rho,gradu) ! Synchronize visc call this%cfg%sync(this%visc) - ! Deallocate work arrays - deallocate(alph2) - end subroutine visc_vreman From b7dbc2b76fbe10ace9c73eedb0aa2388fbbcf26d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 4 Feb 2023 11:05:08 -0500 Subject: [PATCH 102/152] P3DFFT allows for general decomposition Implemented P3DFFT compatible parallel decomposition, can now run FFT pressure solver w/ nprocs that don't evenly divide into the number of grid points! For IB Pipe need to add epsilon to cfg%VF, pressure solver doesn't like zero volumes --- examples/hit/src/geometry.f90 | 7 +- examples/ib_pipe/GNUmakefile | 4 + examples/ib_pipe/input | 4 - examples/ib_pipe/src/geometry.f90 | 7 +- examples/ib_pipe/src/simulation.f90 | 8 +- examples/poissontest/src/geometry.f90 | 3 +- examples/riser/GNUmakefile | 4 +- examples/riser/input | 4 - examples/riser/src/geometry.f90 | 258 +++++++++++++------------- examples/riser/src/simulation.f90 | 146 ++++++++++----- src/config/config_class.f90 | 9 +- src/grid/pgrid_class.f90 | 110 +++++++---- src/solver/pfft3d_class.f90 | 5 - 13 files changed, 325 insertions(+), 244 deletions(-) diff --git a/examples/hit/src/geometry.f90 b/examples/hit/src/geometry.f90 index ff2998165..90b88068a 100644 --- a/examples/hit/src/geometry.f90 +++ b/examples/hit/src/geometry.f90 @@ -22,7 +22,7 @@ subroutine geometry_init ! Create a grid from input params create_grid: block - use sgrid_class, only: cartesian + use sgrid_class, only: cartesian integer :: i,nx real(WP) :: Lx real(WP), dimension(:), allocatable :: x @@ -40,12 +40,13 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block - use parallel, only: group + use parallel, only: group + use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) end block create_cfg ! Create masks for this config diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 5fb2b0a6a..878fc6118 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -6,6 +6,8 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -25,6 +27,8 @@ VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 3a98424db..8a0bda7d7 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -21,10 +21,6 @@ Max time : 1000 Dynamic viscosity : 2e-4 Density : 1 -# Pressure solver -Pressure tolerance : 1e-4 -Pressure iteration : 100 - # Implicit velocity solver Implicit tolerance : 1e-4 Implicit iteration : 100 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 568a556c9..ff3356c6b 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -72,24 +72,25 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group + use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) end block create_cfg ! Create masks for this config create_walls: block - integer :: i,j,k + integer :: i,j,k do k=cfg%kmin_,cfg%kmax_ do j=cfg%jmin_,cfg%jmax_ do i=cfg%imin_,cfg%imax_ - cfg%VF(i,j,k)=get_VF(i,j,k,'SC') + cfg%VF(i,j,k)=get_VF(i,j,k,'SC')+epsilon(1.0_WP) end do end do end do diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index d9aa060a5..b8435a79a 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -3,6 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg,D,get_VF use hypre_str_class, only: hypre_str + use pfft3d_class, only: pfft3d use incomp_class, only: incomp use sgsmodel_class, only: sgsmodel use timetracker_class, only: timetracker @@ -14,7 +15,7 @@ module simulation !> Get an an incompressible solver, pressure solver, and corresponding time tracker type(incomp), public :: fs - type(hypre_str), public :: ps + type(pfft3d), public :: ps type(hypre_str), public :: vs type(sgsmodel), public :: sgs type(timetracker), public :: time @@ -101,10 +102,7 @@ subroutine simulation_init call param_read('Density',fs%rho) call param_read('Dynamic viscosity',visc); fs%visc=visc ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=14 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) + ps=pfft3d(cfg=cfg,name='Pressure',nst=7) ! Configure implicit velocity solver vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) call param_read('Implicit iteration',vs%maxit) diff --git a/examples/poissontest/src/geometry.f90 b/examples/poissontest/src/geometry.f90 index 7676edd2f..6a7794277 100644 --- a/examples/poissontest/src/geometry.f90 +++ b/examples/poissontest/src/geometry.f90 @@ -51,13 +51,14 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group + use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition', partition, short='p') ! Create partitioned grid - cfg = config(grp=group, decomp=partition, grid=grid) + cfg = config(grp=group, decomp=partition, grid=grid, strat=p3dfft_decomp) end block create_cfg diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile index f9da1babb..412f34732 100644 --- a/examples/riser/GNUmakefile +++ b/examples/riser/GNUmakefile @@ -6,8 +6,8 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK = TRUE -USE_FFTW = FALSE -USE_P3DFFT = FALSE +USE_FFTW = TRUE +USE_P3DFFT = TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE diff --git a/examples/riser/input b/examples/riser/input index f0e31fe3d..4ead9b117 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -31,10 +31,6 @@ Collision timescale : 15e-5 Coefficient of restitution : 0.8 Friction coefficient : 0.1 -# Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 - # Implicit velocity solver Implicit tolerance : 1e-6 Implicit iteration : 100 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 index 30064fcee..fa864efea 100644 --- a/examples/riser/src/geometry.f90 +++ b/examples/riser/src/geometry.f90 @@ -1,132 +1,134 @@ !> Various definitions and tools for initializing NGA2 config module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - !> Pipe diameter - real(WP), public :: D - - public :: geometry_init, get_VF - + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init, get_VF + contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,dx - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Pipe length',Lx) - call param_read('Pipe diameter',D) - call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nx',nx); allocate(x(nx+1)) - call param_read('nz',nz); allocate(z(nz+1)) - - dx=Lx/real(nx,WP) - no=6 - if (ny.gt.1) then - Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) - else - Ly=dx - end if - if (nz.gt.1) then - Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) - else - Lz=dx - end if - - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx - end do - do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly - end do - do k=1,nz+1 - z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + use pgrid_class, only: p3dfft_decomp + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=get_VF(i,j,k,'SC')+epsilon(1.0_WP) + end do end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition',partition,short='p') - - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - - end block create_cfg - - - ! Create masks for this config - create_walls: block - integer :: i,j,k - do k=cfg%kmino_,cfg%kmaxo_ - do j=cfg%jmino_,cfg%jmaxo_ - do i=cfg%imino_,cfg%imaxo_ - cfg%VF(i,j,k)=get_VF(i,j,k,'SC') - end do - end do - end do - end block create_walls - - - end subroutine geometry_init - - - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r - case('V') - delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r - case('W') - delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r - case default - delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - - end module geometry + end do + call cfg%sync(cfg%VF) + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 221bb5454..38ac84ab0 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -4,6 +4,8 @@ module simulation use precision, only: WP use geometry, only: cfg,D,get_VF use lowmach_class, only: lowmach + use pfft3d_class, only: pfft3d + use hypre_str_class, only: hypre_str use lpt_class, only: lpt use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -16,6 +18,8 @@ module simulation !> Get an LPT solver, a lowmach solver, and corresponding time tracker type(lowmach), public :: fs + type(pfft3d), public :: ps + type(hypre_str), public :: vs type(lpt), public :: lp type(timetracker), public :: time @@ -102,29 +106,40 @@ subroutine postproc() !!$ ! Deallocate work arrays !!$ deallocate(Uavg,Uavg_,vol,vol_) end subroutine postproc - + !> Compute massflow rate - subroutine bodyforce_mfr(srcU) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: vol,myRhoU,myUvol,Uvol - myRhoU=0.0_WP; myUvol=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') - myUvol=myUvol+vol - myRhoU=myRhoU+vol*(2.0_WP*fs%rhoU(i,j,k)-fs%rhoUold(i,j,k)) - if (present(srcU)) myRhoU=myRhoU+vol*srcU(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myRhoU,mfr,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol - end subroutine bodyforce_mfr + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*(fs%rhoU(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*fs%rhoU(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr !> Initialization of problem solver @@ -195,7 +210,7 @@ subroutine simulation_init ! Create a low Mach flow solver with bconds create_flow_solver: block - use ils_class, only: pcg_pfmg,pcg_amg + use hypre_str_class, only: pcg_pfmg ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') @@ -206,13 +221,13 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + ps=pfft3d(cfg=cfg,name='Pressure',nst=7) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_pfmg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_flow_solver @@ -425,7 +440,7 @@ subroutine simulation_init call df%pullval(name='mfr',val=mfr) call df%pullval(name='bforce',val=bforce) else - call bodyforce_mfr() + mfr=get_bodyforce_mfr() bforce=0.0_WP end if mfr_target=mfr @@ -615,33 +630,38 @@ subroutine simulation_run end do end do end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) end block add_lpt_src - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz - do k=fs%cfg%kmino_,fs%cfg%kmaxo_ - do j=fs%cfg%jmino_,fs%cfg%jmaxo_ - do i=fs%cfg%imino_,fs%cfg%imaxo_ - VFx=get_VF(i,j,k,'U') - VFy=get_VF(i,j,k,'V') - VFz=get_VF(i,j,k,'W') - RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) - RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) - RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) - resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) - resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) - resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) - end do - end do - end do - end block ibm_correction +!!$ ! Apply direct forcing to enforce BC at the pipe walls +!!$ ibm_correction: block +!!$ integer :: i,j,k +!!$ real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ VFx=get_VF(i,j,k,'U') +!!$ VFy=get_VF(i,j,k,'V') +!!$ VFz=get_VF(i,j,k,'W') +!!$ RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) +!!$ RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) +!!$ RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) +!!$ resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) +!!$ resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) +!!$ resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) +!!$ end do +!!$ end do +!!$ end do +!!$ end block ibm_correction ! Add body forcing - call bodyforce_mfr(resU) - bforce=(mfr_target-mfr)/time%dtmid - resU=resU+time%dtmid*bforce + bodyforcing: block + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dtmid*bforce + end block bodyforcing ! Form implicit residuals call fs%solve_implicit(time%dtmid,resU,resV,resW) @@ -651,6 +671,27 @@ subroutine simulation_run fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + fs%U(i,j,k)=fs%U(i,j,k)*VFx + fs%V(i,j,k)=fs%V(i,j,k)*VFy + fs%W(i,j,k)=fs%W(i,j,k)*VFz + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibm_correction + ! Apply other boundary conditions and update momentum call fs%apply_bcond(time%tmid,time%dtmid) call fs%rho_multiply() @@ -687,6 +728,9 @@ subroutine simulation_run call fs%get_div(drhodt=dRHOdt) wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + ! Recompute massflow rate + mfr=get_bodyforce_mfr() + ! Output to ensight if (ens_evt%occurs()) then update_pmesh: block diff --git a/src/config/config_class.f90 b/src/config/config_class.f90 index c78562450..cb0f9c1af 100644 --- a/src/config/config_class.f90 +++ b/src/config/config_class.f90 @@ -43,7 +43,7 @@ module config_class !> Single-grid config constructor from a serial grid - function construct_from_sgrid(grp,decomp,grid) result(self) + function construct_from_sgrid(grp,decomp,grid,strat) result(self) use sgrid_class, only: sgrid use string, only: str_medium use mpi_f08, only: MPI_Group @@ -52,8 +52,13 @@ function construct_from_sgrid(grp,decomp,grid) result(self) type(sgrid), intent(in) :: grid type(MPI_Group), intent(in) :: grp integer, dimension(3), intent(in) :: decomp + integer, intent(in), optional :: strat ! Create a partitioned grid with the provided group and decomposition - self%pgrid=pgrid(grid,grp,decomp) + if (present(strat)) then + self%pgrid=pgrid(grid,grp,decomp,strat) + else + self%pgrid=pgrid(grid,grp,decomp) + end if ! Finish preparing the config call self%prep end function construct_from_sgrid diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index f0ba13b90..59574be83 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -8,12 +8,12 @@ module pgrid_class implicit none private - !> Default parallelization strategy - character(len=str_medium), parameter :: defstrat='fewest_dir' - integer, parameter :: defmincell=4 - ! Expose type/constructor/methods public :: pgrid + + !> Parallelization strategy + integer, parameter, public :: default_decomp=1 + integer, parameter, public :: p3dfft_decomp=2 !> Partitioned grid type type, extends(sgrid) :: pgrid @@ -190,7 +190,7 @@ end function construct_pgrid_from_file !> Partitioned grid constructor from sgrid - function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) + function construct_pgrid_from_sgrid(grid,grp,decomp,strat) result(self) use string, only: lowercase use messager, only: die use param, only: verbose @@ -199,6 +199,7 @@ function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) type(sgrid), intent(in) :: grid !< Base grid type(MPI_Group), intent(in) :: grp !< MPI group integer, dimension(3), intent(in) :: decomp !< Requested domain decomposition + integer, intent(in), optional :: strat !< Optional decomposition strategy ! Initialize MPI environment self%group=grp; call self%init_mpi @@ -211,7 +212,11 @@ function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) self%npx=decomp(1); self%npy=decomp(2); self%npz=decomp(3) ! Perform actual domain decomposition of grid - call self%domain_decomp() + if (present(strat)) then + call self%domain_decomp(strat=strat) + else + call self%domain_decomp() + end if ! If verbose run, log and or print grid if (verbose.gt.0) call self%log @@ -243,12 +248,13 @@ end subroutine pgrid_init_mpi !> Prepares the domain decomposition of the pgrid - subroutine pgrid_domain_decomp(self) + subroutine pgrid_domain_decomp(self,strat) use messager, only: die use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none class(pgrid), intent(inout) :: self - integer :: ierr,q,r + integer, intent(in), optional :: strat + integer :: strat_,ierr,q,r type(MPI_Comm) :: tmp_comm integer, parameter :: ndims=3 logical, parameter :: reorder=.true. @@ -284,34 +290,66 @@ subroutine pgrid_domain_decomp(self) dir=[.true.,.false.,.true.] call MPI_CART_SUB(self%comm,dir,self%zxcomm,ierr) call MPI_COMM_RANK(self%zxcomm,self%zxrank,ierr) - - ! Perform decomposition in x - q=self%nx/self%npx; r=mod(self%nx,self%npx) - self%imin_ =self%imin+ coords(1) *q+min(coords(1) ,r) - self%imax_ =self%imin+(coords(1)+1)*q+min(coords(1)+1,r)-1 - self%nx_ =self%imax_-self%imin_+1 - self%nxo_ =self%nx_+2*self%no - self%imino_=self%imin_-self%no - self%imaxo_=self%imax_+self%no - - ! Perform decomposition in y - q=self%ny/self%npy; r=mod(self%ny,self%npy) - self%jmin_ =self%jmin+ coords(2) *q+min(coords(2) ,r) - self%jmax_ =self%jmin+(coords(2)+1)*q+min(coords(2)+1,r)-1 - self%ny_ =self%jmax_-self%jmin_+1 - self%nyo_ =self%ny_+2*self%no - self%jmino_=self%jmin_-self%no - self%jmaxo_=self%jmax_+self%no - - ! Perform decomposition in z - q=self%nz/self%npz; r=mod(self%nz,self%npz) - self%kmin_ =self%kmin+ coords(3) *q+min(coords(3) ,r) - self%kmax_ =self%kmin+(coords(3)+1)*q+min(coords(3)+1,r)-1 - self%nz_ =self%kmax_-self%kmin_+1 - self%nzo_ =self%nz_+2*self%no - self%kmino_=self%kmin_-self%no - self%kmaxo_=self%kmax_+self%no - + + ! Choose a decomposition strategy + strat_=default_decomp; if (present(strat)) strat_=strat + select case(strat_) + case(default_decomp) + ! Perform decomposition in x + q=self%nx/self%npx; r=mod(self%nx,self%npx) + self%imin_ =self%imin+ coords(1) *q+min(coords(1) ,r) + self%imax_ =self%imin+(coords(1)+1)*q+min(coords(1)+1,r)-1 + self%nx_ =self%imax_-self%imin_+1 + self%nxo_ =self%nx_+2*self%no + self%imino_=self%imin_-self%no + self%imaxo_=self%imax_+self%no + + ! Perform decomposition in y + q=self%ny/self%npy; r=mod(self%ny,self%npy) + self%jmin_ =self%jmin+ coords(2) *q+min(coords(2) ,r) + self%jmax_ =self%jmin+(coords(2)+1)*q+min(coords(2)+1,r)-1 + self%ny_ =self%jmax_-self%jmin_+1 + self%nyo_ =self%ny_+2*self%no + self%jmino_=self%jmin_-self%no + self%jmaxo_=self%jmax_+self%no + + ! Perform decomposition in z + q=self%nz/self%npz; r=mod(self%nz,self%npz) + self%kmin_ =self%kmin+ coords(3) *q+min(coords(3) ,r) + self%kmax_ =self%kmin+(coords(3)+1)*q+min(coords(3)+1,r)-1 + self%nz_ =self%kmax_-self%kmin_+1 + self%nzo_ =self%nz_+2*self%no + self%kmino_=self%kmin_-self%no + self%kmaxo_=self%kmax_+self%no + case(p3dfft_decomp) + ! Perform p3dfft compatible decomposition in x + q=self%nx/self%npx; r=mod(self%nx,self%npx) + self%imin_ =self%imax+1-q*(self%npx-coords(1) )-min(self%npx-coords(1),r) + self%imax_ =self%imax -q*(self%npx-coords(1)-1)-min(self%npx-coords(1)-1,r) + self%nx_ =self%imax_-self%imin_+1 + self%nxo_ =self%nx_+2*self%no + self%imino_=self%imin_-self%no + self%imaxo_=self%imax_+self%no + + ! Perform p3dfft compatible decomposition in y + q=self%ny/self%npy; r=mod(self%ny,self%npy) + self%jmin_ =self%jmax+1-q*(self%npy-coords(2) )-min(self%npy-coords(2),r) + self%jmax_ =self%jmax -q*(self%npy-coords(2)-1)-min(self%npy-coords(2)-1,r) + self%ny_ =self%jmax_-self%jmin_+1 + self%nyo_ =self%ny_+2*self%no + self%jmino_=self%jmin_-self%no + self%jmaxo_=self%jmax_+self%no + + ! Perform p3dfft compatible decomposition in z + q=self%nz/self%npz; r=mod(self%nz,self%npz) + self%kmin_ =self%kmax+1-q*(self%npz-coords(3) )-min(self%npz-coords(3),r) + self%kmax_ =self%kmax -q*(self%npz-coords(3)-1)-min(self%npz-coords(3)-1,r) + self%nz_ =self%kmax_-self%kmin_+1 + self%nzo_ =self%nz_+2*self%no + self%kmino_=self%kmin_-self%no + self%kmaxo_=self%kmax_+self%no + end select + ! We also need to prepare communication buffers allocate(self%syncbuf_x1(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) allocate(self%syncbuf_x2(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 391ebb333..353276f73 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -178,11 +178,6 @@ subroutine pfft3d_init(this) ! Various checks for parallel FFT check_psolver_is_useable: block - ! Check (restrictive) processor decomp - if (modulo(this%cfg%nx,this%cfg%npx).ne.0) call die('[pfft3d constructor] Need nx to evenly divide into npx') - if (modulo(this%cfg%ny,this%cfg%npy).ne.0) call die('[pfft3d constructor] Need ny to evenly divide into npy') - if (modulo(this%cfg%nz,this%cfg%npz).ne.0) call die('[pfft3d constructor] Need nz to evenly divide into npz') - ! Ensure that we have at least one non-decomposed direction contig_dim = findloc((/this%cfg%npx, this%cfg%npy, this%cfg%npz /), value=1, dim=1) if (contig_dim.eq.0) call die('[pdfft3 constructor] Need at least one NON-decomposed direction') From 5c4d2320485255e53dcbc84d00ed726ff791996c Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 4 Feb 2023 11:09:40 -0500 Subject: [PATCH 103/152] Update simulation.f90 monitor the correct mfr each time step --- examples/ib_pipe/src/simulation.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index b8435a79a..adc3a34a3 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -347,6 +347,9 @@ subroutine simulation_run ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() + + ! Recompute mass flowrate for monitor + mfr=get_bodyforce_mfr() ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) From be5f1f9a152d9b789bc297b8c64f3848ce3edfdf Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 7 Feb 2023 13:47:39 -0500 Subject: [PATCH 104/152] In-house P3DFFT NGA2 now runs without external dependency for parallel fft library. Slightly slower than using a library, but can likely be optimized --- examples/hit/GNUmakefile | 20 +- examples/ib_pipe/GNUmakefile | 2 - examples/ib_pipe/src/geometry.f90 | 2 +- src/solver/Make.package | 2 +- src/solver/pfft3d_class.f90 | 1625 +++++++++++++++++++++------- tools/GNUMake/Make.defs | 4 - tools/GNUMake/packages/Make.p3dfft | 12 - 7 files changed, 1238 insertions(+), 429 deletions(-) delete mode 100644 tools/GNUMake/packages/Make.p3dfft diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f0430d60f..e15a4a4c7 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -2,16 +2,15 @@ NGA_HOME ?= ../.. # Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_FFTW = TRUE -USE_P3DFFT = TRUE -USE_HYPRE = TRUE -USE_LAPACK = TRUE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga # Directories that contain user-defined code Udirs := src @@ -27,7 +26,6 @@ VPATH_LOCATIONS += $(Ulocs) LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR=/Users/jcaps/Research/Codes/Builds/hypre FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 -P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 878fc6118..99f991ace 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -7,7 +7,6 @@ USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE USE_FFTW = TRUE -USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -27,7 +26,6 @@ VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index ff3356c6b..845eaec8f 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -79,7 +79,7 @@ subroutine geometry_init call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + cfg=config(grp=group,decomp=partition,grid=grid) end block create_cfg diff --git a/src/solver/Make.package b/src/solver/Make.package index 55d909dc8..1a8b68d18 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -2,7 +2,7 @@ f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 ils_class.f90 ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 endif -ifeq ($(USE_P3DFFT),TRUE) +ifeq ($(USE_FFTW),TRUE) f90EXE_sources += pfft3d_class.f90 endif diff --git a/src/solver/pfft3d_class.f90 b/src/solver/pfft3d_class.f90 index 353276f73..6597bc519 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/pfft3d_class.f90 @@ -1,405 +1,1234 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -!> Makes use of the P3DFFT++ module pfft3d_class - use p3dfft_plus_plus - use precision, only: WP - use config_class, only: config - use linsol_class, only: linsol - implicit none - include 'fftw3.f' - private - - ! Expose type/constructor/methods - public :: pfft3d - - !> pfft3d object definition - type, extends(linsol) :: pfft3d - - !> Parallel FFT (p3dfft) variables - integer :: trans_f, trans_b - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs - - !> Serial FFT (fftw) variables - logical :: serial_fft - integer(KIND=8) :: fplan_serial,bplan_serial - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: inout_serial - - !> Work arrays - real(C_DOUBLE), dimension(:,:,:), allocatable :: unstrided_rhs, unstrided_sol - - contains - - procedure :: log => pfft3d_log !< Long-form logging of solver status - procedure :: print => pfft3d_print !< Long-form printing of solver status - procedure :: print_short => pfft3d_print_short !< One-line printing of solver status - procedure :: init => pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup => pfft3d_setup !< Solver setup (every time the operator changes) - procedure :: solve => pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy => pfft3d_destroy !< Solver destruction (every time the operator changes) - - end type pfft3d - - !> Declare pfft3d constructor - interface pfft3d; procedure pfft3d_from_args; end interface pfft3d; - + use precision, only: WP + use config_class, only: config + use string, only: str_short + use linsol_class, only: linsol + use, intrinsic :: iso_c_binding + implicit none + include 'fftw3.f' + private + + ! Expose type/constructor/methods + public :: pfft3d + + !> pfft3d object definition + type, extends(linsol) :: pfft3d + + ! FFT's oddball + logical :: oddball + + ! Data storage for FFTW plans + complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_x,out_x + complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_y,out_y + complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_z,out_z + + ! FFTW plans + integer(KIND=8) :: fplan_x,bplan_x + integer(KIND=8) :: fplan_y,bplan_y + integer(KIND=8) :: fplan_z,bplan_z + + !> Unstrided arrays + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs + + ! Storage for transposed data + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: xtrans + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: ytrans + complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: ztrans + + ! Transpose partition - X + integer, dimension(:), allocatable :: imin_x,imax_x + integer, dimension(:), allocatable :: jmin_x,jmax_x + integer, dimension(:), allocatable :: kmin_x,kmax_x + integer, dimension(:), allocatable :: nx_x,ny_x,nz_x + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + integer :: sendcount_x,recvcount_x + character(len=str_short) :: xdir + + ! Transpose partition - Y + integer, dimension(:), allocatable :: imin_y,imax_y + integer, dimension(:), allocatable :: jmin_y,jmax_y + integer, dimension(:), allocatable :: kmin_y,kmax_y + integer, dimension(:), allocatable :: nx_y,ny_y,nz_y + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + integer :: sendcount_y,recvcount_y + character(len=str_short) :: ydir + + ! Transpose partition - Z + integer, dimension(:), allocatable :: imin_z,imax_z + integer, dimension(:), allocatable :: jmin_z,jmax_z + integer, dimension(:), allocatable :: kmin_z,kmax_z + integer, dimension(:), allocatable :: nx_z,ny_z,nz_z + complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + integer :: sendcount_z,recvcount_z + character(len=str_short) :: zdir + + contains + + procedure :: log => pfft3d_log !< Long-form logging of solver status + procedure :: print => pfft3d_print !< Long-form printing of solver status + procedure :: print_short => pfft3d_print_short !< One-line printing of solver status + procedure :: init => pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup => pfft3d_setup !< Solver setup (every time the operator changes) + procedure :: solve => pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy => pfft3d_destroy !< Solver destruction (every time the operator changes) + + procedure, private :: pfft3d_fourier_transform + procedure, private :: pfft3d_inverse_transform + + procedure, private :: pfft3d_xtranspose_init + procedure, private :: pfft3d_ytranspose_init + procedure, private :: pfft3d_ztranspose_init + + procedure, private :: pfft3d_xtranspose_forward + procedure, private :: pfft3d_ytranspose_forward + procedure, private :: pfft3d_ztranspose_forward + + procedure, private :: pfft3d_xtranspose_backward + procedure, private :: pfft3d_ytranspose_backward + procedure, private :: pfft3d_ztranspose_backward + + end type pfft3d + + !> Declare pfft3d constructor + interface pfft3d + procedure pfft3d_from_args + end interface pfft3d + + contains - - !> Log pfft3d info - subroutine pfft3d_log(this) - use string, only: str_long - use messager, only: log - implicit none - class(pfft3d), intent(in) :: this - character(len=str_long) :: message - - if (this%cfg%amRoot) then - write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') & - trim(this%name), trim(this%cfg%name) - call log(message) - end if - - end subroutine pfft3d_log - - - !> Print pfft3d info to the screen - subroutine pfft3d_print(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) then - write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') & - trim(this%name), trim(this%cfg%name) - end if - - end subroutine pfft3d_print - - - !> Short print of pfft3d info to the screen - subroutine pfft3d_print_short(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(pfft3d), intent(in) :: this - - if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for & - config [",a16,"]")') trim(this%name), trim(this%cfg%name) - - end subroutine pfft3d_print_short - - - !> Constructor for an pfft3d object - function pfft3d_from_args(cfg, name, nst) result(self) - use messager, only: die - implicit none - type(pfft3d) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - integer, intent(in) :: nst - integer :: imn_, imx_, jmn_, jmx_, kmn_, kmx_, imno_, imxo_, jmno_, jmxo_,& - kmno_, kmxo_ - - ! Link the config and store the name - self%cfg => cfg - self%name = trim(adjustl(name)) - - imn_ = self%cfg%imin_; imx_ = self%cfg%imax_; - jmn_ = self%cfg%jmin_; jmx_ = self%cfg%jmax_; - kmn_ = self%cfg%kmin_; kmx_ = self%cfg%kmax_; - imno_ = self%cfg%imino_; imxo_ = self%cfg%imaxo_; - jmno_ = self%cfg%jmino_; jmxo_ = self%cfg%jmaxo_; - kmno_ = self%cfg%kmino_; kmxo_ = self%cfg%kmaxo_; - - ! Set up stencil size and map - self%nst = nst; allocate(self%stc(self%nst,3)); - - ! Allocate rhs, operator and solution - allocate(self%unstrided_rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) - allocate(self%unstrided_sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_)) - allocate(self%opr(self%nst,imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) - allocate(self%rhs(imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) - allocate(self%sol(imno_:imxo_,jmno_:jmxo_,kmno_:kmxo_)) - - ! Zero out some info - self%method = 0; self%it = 0; self%aerr = 0.0_WP; self%rerr = 0.0_WP; - - ! Setup is not done - self%setup_done = .false. - self%serial_fft = .false. - - end function pfft3d_from_args - - - !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change - !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver - !> Only the stencil needs to be defined at this point - subroutine pfft3d_init(this) - !use mpi_f08, only: MPI_COMM_WORLD - use messager, only: die - implicit none - include "mpif.h" - class(pfft3d), intent(inout) :: this - integer :: type_ccr, type_rcc, contig_dim, buf_int - integer(C_INT) :: p3dfft_grid, grid_real, grid_fourier, buf_cint - integer, dimension(3) :: type_ids_f, type_ids_b, & - glob_start_real, glob_start_fourier - integer(C_INT), dimension(3) :: pdims, ldims_real, ldims_fourier, & - mem_order_real, mem_order_fourier, dmap_real, dmap_fourier, gdims_real, & - gdims_fourier - - ! Set up global dimensions of the grid - gdims_real(:) = (/ this%cfg%nx, this%cfg%ny, this%cfg%nz /) - - ! Define the initial processor grid - pdims(:) = (/ this%cfg%npx, this%cfg%npy, this%cfg%npz /) - - ! Various checks to ensure we can use this solver - check_solver_is_useable: block - - ! Periodicity and uniformity of mesh - if (.not.(this%cfg%xper.and.this%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') - if (.not.(this%cfg%yper.and.this%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') - if (.not.(this%cfg%zper.and.this%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') - - end block check_solver_is_useable - - ! Check if FFT should be handled in serial - if (this%cfg%nproc.eq.1) then - this%serial_fft=.true. - allocate(this%inout_serial(this%cfg%nx,this%cfg%ny,this%cfg%nz)) - call dfftw_plan_dft_3d(this%fplan_serial,this%cfg%nx,this%cfg%ny,this%cfg%nz,& - this%inout_serial,this%inout_serial,FFTW_FORWARD,FFTW_MEASURE) - call dfftw_plan_dft_3d(this%bplan_serial,this%cfg%nx,this%cfg%ny,this%cfg%nz,& - this%inout_serial,this%inout_serial,FFTW_BACKWARD,FFTW_MEASURE) - return - end if - - ! Various checks for parallel FFT - check_psolver_is_useable: block - - ! Ensure that we have at least one non-decomposed direction - contig_dim = findloc((/this%cfg%npx, this%cfg%npy, this%cfg%npz /), value=1, dim=1) - if (contig_dim.eq.0) call die('[pdfft3 constructor] Need at least one NON-decomposed direction') - - ! Possible bug in p3dfft library - if (this%cfg%nz.eq.1. .and. this%cfg%npx.gt.1) call die('[pfft3d constructor] 2D case requires npx=1') - - end block check_psolver_is_useable - - ! Set up work structures for P3DFFT - call p3dfft_setup - - ! Set up 2 transform types for 3D transforms - !type_ids_f(:) = P3DFFT_CFFT_FORWARD_D; type_ids_f(contig_dim) = P3DFFT_R2CFFT_D - !type_ids_b(:) = P3DFFT_CFFT_BACKWARD_D; type_ids_b(contig_dim) = P3DFFT_C2RFFT_D - type_ids_f(:) = (/ P3DFFT_R2CFFT_D, P3DFFT_CFFT_FORWARD_D, P3DFFT_CFFT_FORWARD_D /) - type_ids_b(:) = (/ P3DFFT_C2RFFT_D, P3DFFT_CFFT_BACKWARD_D, P3DFFT_CFFT_BACKWARD_D /) - - ! Now initialize 3D transforms (forward and backward) with these types - call p3dfft_init_3Dtype(type_rcc, type_ids_f) - call p3dfft_init_3Dtype(type_ccr, type_ids_b) - - ! Set up processor order and memory ordering, as well as the final global - ! grid dimensions. These will be different from the original dimensions in - ! one dimension due to conjugate symmetry, since we are doing - ! real-to-complex transform. - gdims_fourier(:) = gdims_real(:) - gdims_fourier(1) = gdims_fourier(1) / 2 + 1 - !gdims_fourier(contig_dim) = gdims_fourier(contig_dim) / 2 + 1 - mem_order_real(:) = (/ 0, 1, 2 /) - - ! Set up memory order for the final grid layout (for complex array in - ! Fourier space). It is more convenient to have the storage order of - ! the array reversed, this helps save on memory access bandwidth, and - ! shouldn't affect the operations in the Fourier space very much, - ! requiring basically a change in the loop order. However it is possible - ! to define the memory ordering the same as default (0,1,2). Note that - ! the memory ordering is specified in C indices, i.e. starting from 0. - mem_order_fourier(:) = (/ 1, 2, 0 /) - dmap_real(:) = (/ 0, 1, 2 /); dmap_fourier(:) = (/ 1, 2, 0 /); - - ! Specify the default communicator for P3DFFT++. This can be different - ! from your program default communicator. - p3dfft_grid = p3dfft_init_proc_grid(pdims, MPI_COMM_WORLD) - - ! Initialize grid, no conjugate symmetry (-1) - call p3dfft_init_data_grid(grid_real, ldims_real, glob_start_real, & - gdims_real, -1, p3dfft_grid, dmap_real, mem_order_real) - - ! Check ldims_real against pgrid - if (.not. all((/ this%cfg%nx_, this%cfg%ny_, this%cfg%nz_ /) .eq. & - ldims_real)) then - call die("[pfftd3] parallel fft decomposition does not match cfg") - end if - - ! Final grid has conjugate symmetry in X dimension (0) - call p3dfft_init_data_grid(grid_fourier, ldims_fourier, glob_start_fourier,& - gdims_fourier, 0, p3dfft_grid, dmap_fourier, mem_order_fourier) - - ! Plan transforms - call p3dfft_plan_3Dtrans(this%trans_f, grid_real, grid_fourier, type_rcc) - call p3dfft_plan_3Dtrans(this%trans_b, grid_fourier, grid_real, type_ccr) - - ! Allocate fourier space arrays - allocate(this%factored_operator(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) - allocate(this%transformed_rhs(ldims_fourier(1), ldims_fourier(2), ldims_fourier(3))) - - end subroutine pfft3d_init - - - !> Setup solver - done everytime the operator changes - subroutine pfft3d_setup(this) - use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM - use parallel, only: MPI_REAL_WP - use messager, only: die - implicit none - integer :: i, j, k, n, stx1, stx2, sty1, sty2, stz1, stz2, ierr - class(pfft3d), intent(inout) :: this - logical :: circulent - real(WP), dimension(this%nst) :: ref_stencil - real(C_DOUBLE), dimension(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_: & - this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col - - ! Compute stencil inverse - stx1 = minval(this%stc(:,1)); stx2 = maxval(this%stc(:,1)); - sty1 = minval(this%stc(:,2)); sty2 = maxval(this%stc(:,2)); - stz1 = minval(this%stc(:,3)); stz2 = maxval(this%stc(:,3)); - allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)) - do n = 1, this%nst - this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3)) = n - end do - - ! Check circulent operator - if (this%cfg%amRoot) ref_stencil = this%opr(:,1,1,1) - call MPI_BCAST(ref_stencil, this%nst, MPI_REAL_WP, 0, this%cfg%comm, ierr) - circulent = .true. - do k = this%cfg%kmin_, this%cfg%kmax_ - do j = this%cfg%jmin_, this%cfg%jmax_ - do i = this%cfg%imin_, this%cfg%imax_ - if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulent = .false. - end do - end do - end do - if (.not. circulent) then - call die("[pf3dft] stencil must be uniform in space") - end if - - ! Build the operator - opr_col(:,:,:) = 0.0_C_DOUBLE - do n = 1, this%nst - i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin - j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin - k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin - if ( & - this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & - this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & - this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & - ) opr_col(i,j,k) = opr_col(i,j,k) + real(ref_stencil(n), C_DOUBLE) - end do - - ! Take transform of operator - if (this%serial_fft) then - this%inout_serial=opr_col - call dfftw_execute_dft(this%fplan_serial,this%inout_serial,this%inout_serial) - this%factored_operator=this%inout_serial - else - call p3dfft_3Dtrans_double(this%trans_f, opr_col, this%factored_operator, 0) - end if - - ! Make zero wavenumber not zero - ! Setting this to one has the nice side effect of returning a solution with - ! the same integral - if (all((/ this%cfg%iproc, this%cfg%jproc, this%cfg%kproc /) .eq. 1)) then - this%factored_operator(1,1,1) = 1.0_C_DOUBLE - end if - - ! Make sure other wavenumbers are not close to zero - i = count(abs(this%factored_operator) .lt. 1000 * epsilon(1.0_C_DOUBLE)) - call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) - if (j .gt. 0) call die("[pf3dft] elements of transformed operator near zero") - - ! Divide now instead of later - this%factored_operator = 1.0_C_DOUBLE / this%factored_operator - - ! Check for division issues - i = count(isnan(abs(this%factored_operator))) - call MPI_ALLREDUCE(i, j, 1, MPI_INTEGER, MPI_SUM, this%cfg%comm, ierr) - if (j .gt. 0) call die("[pf3dft] elements of transformed operator are nan") - - ! Set setup-flag to true - this%setup_done = .true. - - end subroutine pfft3d_setup - - - !> do the solve - subroutine pfft3d_solve(this) - use messager, only: die - use param, only: verbose - implicit none - class(pfft3d), intent(inout) :: this - integer :: imn_, imx_, jmn_, jmx_, kmn_, kmx_ - - if (.not. this%setup_done) call die("[pfftd3] solve called before setup") - - imn_ = this%cfg%imin_; imx_ = this%cfg%imax_; - jmn_ = this%cfg%jmin_; jmx_ = this%cfg%jmax_; - kmn_ = this%cfg%kmin_; kmx_ = this%cfg%kmax_; - - ! Copy to unstrided array - this%unstrided_rhs(:,:,:) = this%rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_) - - ! Do forward transform - if (this%serial_fft) then - this%inout_serial=this%unstrided_rhs - call dfftw_execute_dft(this%fplan_serial,this%inout_serial,this%inout_serial) - this%transformed_rhs=this%inout_serial - else - call p3dfft_3Dtrans_double(this%trans_f, this%unstrided_rhs, this%transformed_rhs, 0) - end if - - ! Divide - this%transformed_rhs = this%transformed_rhs * this%factored_operator - - ! Do backward transform and rescale - if (this%serial_fft) then - this%inout_serial=this%transformed_rhs - call dfftw_execute_dft(this%bplan_serial,this%inout_serial,this%inout_serial) - this%unstrided_sol=this%inout_serial - else - call p3dfft_3Dtrans_double(this%trans_b, this%transformed_rhs, this%unstrided_sol, 0) - end if - - ! Rescale - this%unstrided_sol = this%unstrided_sol/real(this%cfg%nx * this%cfg%ny * this%cfg%nz,WP) - - ! Copy to strided output - this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%unstrided_sol(:,:,:) - - ! Sync - call this%cfg%sync(this%sol) - - ! If verbose run, log and or print info - if (verbose .gt. 0) call this%log - if (verbose .gt. 1) call this%print_short - - end subroutine pfft3d_solve - - - subroutine pfft3d_destroy(this) - implicit none - class(pfft3d), intent(inout) :: this - - this%setup_done = .false. - - if (this%serial_fft) then - call dfftw_destroy_plan(this%fplan_serial) - call dfftw_destroy_plan(this%bplan_serial) - end if - this%serial_fft=.false. - - end subroutine pfft3d_destroy - + + + !> Log pfft3d info + subroutine pfft3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(pfft3d), intent(in) :: this + character(len=str_long) :: message + + if (this%cfg%amRoot) then + write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + call log(message) + end if + + end subroutine pfft3d_log + + + !> Print pfft3d info to the screen + subroutine pfft3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + + class(pfft3d), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + end if + + end subroutine pfft3d_print + + + !> Short print of pfft3d info to the screen + subroutine pfft3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(pfft3d), intent(in) :: this + + if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + + end subroutine pfft3d_print_short + + + !> Constructor for an pfft3d object + function pfft3d_from_args(cfg,name,nst) result(self) + use messager, only: die + implicit none + type(pfft3d) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set up stencil size and map + self%nst=nst; allocate(self%stc(self%nst,3)) + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Allocate unstrided arrays + allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%transformed_rhs(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + + ! Zero out some info + self%method=0; self%it=0; self%aerr=0.0_WP; self%rerr=0.0_WP + + ! Setup is not done + self%setup_done=.false. + + end function pfft3d_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine pfft3d_init(this) + use messager, only: die + implicit none + class(pfft3d), intent(inout) :: this + + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + ! Periodicity and uniformity of mesh + if (.not.(this%cfg%xper.and.this%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') + if (.not.(this%cfg%yper.and.this%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') + if (.not.(this%cfg%zper.and.this%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') + end block check_solver_is_useable + + ! Initialize transpose and FFTW plans in x + if (this%cfg%nx.gt.1) then + call this%pfft3d_xtranspose_init() + allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) + call dfftw_plan_dft_1d(this%fplan_x,this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) + call dfftw_plan_dft_1d(this%bplan_x,this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in y + if (this%cfg%ny.gt.1) then + call this%pfft3d_ytranspose_init() + allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) + call dfftw_plan_dft_1d(this%fplan_y,this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) + call dfftw_plan_dft_1d(this%bplan_y,this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in z + if (this%cfg%nz.gt.1) then + call this%pfft3d_ztranspose_init() + allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) + call dfftw_plan_dft_1d(this%fplan_z,this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) + call dfftw_plan_dft_1d(this%bplan_z,this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Find who owns the oddball + this%oddball=.false. + if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. + + end subroutine pfft3d_init + + + !> Initialize transpose tool in x + subroutine pfft3d_xtranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,ip,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%xdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%xdir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%xdir='z' + end if + + ! Allocate global partitions + allocate( this%nx_x(this%cfg%npx)) + allocate( this%ny_x(this%cfg%npx)) + allocate( this%nz_x(this%cfg%npx)) + allocate(this%imin_x(this%cfg%npx)) + allocate(this%imax_x(this%cfg%npx)) + allocate(this%jmin_x(this%cfg%npx)) + allocate(this%jmax_x(this%cfg%npx)) + allocate(this%kmin_x(this%cfg%npx)) + allocate(this%kmax_x(this%cfg%npx)) + + ! Partition + select case (trim(this%xdir)) + case ('x') + + ! No transpose required, use local partition + this%nx_x=this%cfg%nx_ + this%ny_x=this%cfg%ny_ + this%nz_x=this%cfg%nz_ + this%imin_x=this%cfg%imin_ + this%imax_x=this%cfg%imax_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%ny/this%cfg%npx + r=mod(this%cfg%ny,this%cfg%npx) + if (ip.le.r) then + this%ny_x(ip) =q+1 + this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) + else + this%ny_x(ip) =q + this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q + end if + this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 + end do + this%nz_x=this%cfg%nz_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%nz/this%cfg%npx + r=mod(this%cfg%nz,this%cfg%npx) + if (ip.le.r) then + this%nz_x(ip) =q+1 + this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) + else + this%nz_x(ip) =q + this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q + end if + this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 + end do + this%ny_x=this%cfg%ny_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + end select + + ! Allocate storage + allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) + + end subroutine pfft3d_xtranspose_init + + + !> Initialize transpose tool in y + subroutine pfft3d_ytranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,jp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%ydir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%ydir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%ydir='x' + end if + + ! Allocate global partitions + allocate( this%nx_y(this%cfg%npy)) + allocate( this%ny_y(this%cfg%npy)) + allocate( this%nz_y(this%cfg%npy)) + allocate(this%imin_y(this%cfg%npy)) + allocate(this%imax_y(this%cfg%npy)) + allocate(this%jmin_y(this%cfg%npy)) + allocate(this%jmax_y(this%cfg%npy)) + allocate(this%kmin_y(this%cfg%npy)) + allocate(this%kmax_y(this%cfg%npy)) + + ! Partition + select case (trim(this%ydir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nx/this%cfg%npy + r=mod(this%cfg%nx,this%cfg%npy) + if (jp.le.r) then + this%nx_y(jp) =q+1 + this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) + else + this%nx_y(jp) =q + this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q + end if + this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 + end do + this%nz_y=this%cfg%nz_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + case ('y') + + ! No transpose required, use local partition + this%nx_y=this%cfg%nx_ + this%ny_y=this%cfg%ny_ + this%nz_y=this%cfg%nz_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + this%jmin_y=this%cfg%jmin_ + this%jmax_y=this%cfg%jmax_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nz/this%cfg%npy + r=mod(this%cfg%nz,this%cfg%npy) + if (jp.le.r) then + this%nz_y(jp) =q+1 + this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) + else + this%nz_y(jp) =q + this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q + end if + this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 + end do + this%nx_y=this%cfg%nx_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + end select + + ! Allocate storage + allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) + + end subroutine pfft3d_ytranspose_init + + + !> Initialize transpose tool in z + subroutine pfft3d_ztranspose_init(this) + use mpi_f08 + implicit none + class(pfft3d), intent(inout) :: this + integer :: ierr,kp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%zdir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%zdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%zdir='y' + end if + + ! Allocate global partitions + allocate( this%nx_z(this%cfg%npz)) + allocate( this%ny_z(this%cfg%npz)) + allocate( this%nz_z(this%cfg%npz)) + allocate(this%imin_z(this%cfg%npz)) + allocate(this%imax_z(this%cfg%npz)) + allocate(this%jmin_z(this%cfg%npz)) + allocate(this%jmax_z(this%cfg%npz)) + allocate(this%kmin_z(this%cfg%npz)) + allocate(this%kmax_z(this%cfg%npz)) + + ! Partition + select case (trim(this%zdir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%nx/this%cfg%npz + r=mod(this%cfg%nx,this%cfg%npz) + if (kp.le.r) then + this%nx_z(kp) =q+1 + this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) + else + this%nx_z(kp) =q + this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q + end if + this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 + end do + this%ny_z=this%cfg%ny_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%ny/this%cfg%npz + r=mod(this%cfg%ny,this%cfg%npz) + if (kp.le.r) then + this%ny_z(kp) =q+1 + this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) + else + this%ny_z(kp) =q + this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q + end if + this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 + end do + this%nx_z=this%cfg%nx_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('z') + + ! No transpose required, use local partition + this%nx_z=this%cfg%nx_ + this%ny_z=this%cfg%ny_ + this%nz_z=this%cfg%nz_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + this%kmin_z=this%cfg%kmin_ + this%kmax_z=this%cfg%kmax_ + + end select + + ! Allocate storage + allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) + + end subroutine pfft3d_ztranspose_init + + + !> Perform forward transpose in x + subroutine pfft3d_xtranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + At=A + case ('y') + ! Transpose x=>y + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose x=>z + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine pfft3d_xtranspose_forward + + + !> Perform forward transpose in y + subroutine pfft3d_ytranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(C_DOUBLE_COMPLEX), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose y=>x + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + At=A + case ('z') + ! Transpose y=>z + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine pfft3d_ytranspose_forward + + + !> Perform forward transpose in z + subroutine pfft3d_ztranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(C_DOUBLE_COMPLEX), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose z=>x + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose z=>y + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + At=A + end select + + end subroutine pfft3d_ztranspose_forward + + + !> Perform backward transpose in x + subroutine pfft3d_xtranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + A=At + case ('y') + ! Transpose y=>x + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + jj=j-this%jmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose z=>x + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + kk=k-this%kmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine pfft3d_xtranspose_backward + + + !> Perform backward transpose in y + subroutine pfft3d_ytranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose x=>y + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + A=At + case ('z') + ! Transpose z=>y + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine pfft3d_ytranspose_backward + + + !> Perform backward transpose in z + subroutine pfft3d_ztranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose x=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose y=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + A=At + end select + + end subroutine pfft3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine pfft3d_fourier_transform(this,A) + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%pfft3d_xtranspose_forward(A,this%xtrans) + ! Forward transform - X + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x =this%xtrans(:,j,k) + call dfftw_execute(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k) = this%out_x + end do + end do + ! Transpose back + call this%pfft3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%pfft3d_ytranspose_forward(A,this%ytrans) + ! Forward transform - Y + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y = this%ytrans(i,:,k) + call dfftw_execute(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k) = this%out_y + end do + end do + ! Transpose back + call this%pfft3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%pfft3d_ztranspose_forward(A,this%ztrans) + ! Forward transform - Z + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z = this%ztrans(i,j,:) + call dfftw_execute(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:) = this%out_z + end do + end do + ! Transpose back + call this%pfft3d_ztranspose_backward(this%ztrans,A) + end if + + ! Oddball + if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_) = 0.0_WP + + end subroutine pfft3d_fourier_transform + + + !> FFT -> real and transpose back + subroutine pfft3d_inverse_transform(this,A) + implicit none + class(pfft3d), intent(inout) :: this + complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%pfft3d_xtranspose_forward(A,this%xtrans) + ! Inverse transform + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x = this%xtrans(:,j,k) + call dfftw_execute(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k) = this%out_x/this%cfg%nx + end do + end do + ! Transpose back + call this%pfft3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%pfft3d_ytranspose_forward(A,this%ytrans) + ! Inverse transform + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y = this%ytrans(i,:,k) + call dfftw_execute(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k) = this%out_y/this%cfg%ny + end do + end do + ! Transpose back + call this%pfft3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%pfft3d_ztranspose_forward(A,this%ztrans) + ! Inverse transform + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z = this%ztrans(i,j,:) + call dfftw_execute(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:) = this%out_z/this%cfg%nz + end do + end do + ! Transpose back + call this%pfft3d_ztranspose_backward(this%ztrans,A) + end if + + end subroutine pfft3d_inverse_transform + + + !> Setup solver - done everytime the operator changes + subroutine pfft3d_setup(this) + use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM + use parallel, only: MPI_REAL_WP + use messager, only: die + implicit none + integer :: i,j,k,n,stx1,stx2,sty1,sty2,stz1,stz2,ierr + class(pfft3d), intent(inout) :: this + logical :: circulent + real(WP), dimension(this%nst) :: ref_stencil + real(WP), dimension(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col + + ! Compute stencil inverse + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)); + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)); + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)); + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)) + do n=1,this%nst + this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3))=n + end do + + ! Check circulent operator + if (this%cfg%amRoot) ref_stencil=this%opr(:,1,1,1) + call MPI_BCAST(ref_stencil,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) + circulent=.true. + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulent=.false. + end do + end do + end do + if (.not.circulent) then + call die('[pfft3d] stencil must be uniform in space') + end if + + ! Build the operator + this%factored_operator(:,:,:) = 0.0_C_DOUBLE + do n = 1, this%nst + i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin + j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin + k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin + if ( & + this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & + this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & + this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & + ) this%factored_operator(i,j,k) =this%factored_operator(i,j,k) + & + real(ref_stencil(n), C_DOUBLE) + end do + + ! Take transform of operator + call this%pfft3d_fourier_transform(this%factored_operator) + + ! Make zero wavenumber not zero + ! Setting this to one has the nice side effect of returning a solution with the same integral + if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=1.0_C_DOUBLE + + ! Make sure other wavenumbers are not close to zero + i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_C_DOUBLE)) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) call die('[pfft3d] elements of transformed operator near zero') + + ! Divide now instead of later + this%factored_operator = 1.0_C_DOUBLE / this%factored_operator + + ! Check for division issues + i=count(isnan(abs(this%factored_operator))) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) call die('[pfft3d] elements of transformed operator are nan') + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine pfft3d_setup + + + !> Do the solve + subroutine pfft3d_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(pfft3d), intent(inout) :: this + integer :: imn_,imx_,jmn_,jmx_,kmn_,kmx_ + + if (.not.this%setup_done) call die('[pfftd3] solve called before setup') + + imn_=this%cfg%imin_; imx_=this%cfg%imax_; + jmn_=this%cfg%jmin_; jmx_=this%cfg%jmax_; + kmn_=this%cfg%kmin_; kmx_=this%cfg%kmax_; + + ! Copy to unstrided array + this%transformed_rhs=this%rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_) + + ! Forward transform + call this%pfft3d_fourier_transform(this%transformed_rhs) + + ! Divide + this%transformed_rhs=this%transformed_rhs*this%factored_operator + + ! Backward transform + call this%pfft3d_inverse_transform(this%transformed_rhs) + + ! Copy to strided output + this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%transformed_rhs(:,:,:) + + ! Sync + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine pfft3d_solve + + + subroutine pfft3d_destroy(this) + implicit none + class(pfft3d), intent(inout) :: this + + this%setup_done=.false. + + call dfftw_destroy_plan(this%fplan_x); call dfftw_destroy_plan(this%bplan_x) + call dfftw_destroy_plan(this%fplan_y); call dfftw_destroy_plan(this%bplan_y) + call dfftw_destroy_plan(this%fplan_z); call dfftw_destroy_plan(this%bplan_z) + + end subroutine pfft3d_destroy + end module pfft3d_class diff --git a/tools/GNUMake/Make.defs b/tools/GNUMake/Make.defs index 3c76ff074..2ff6b8a48 100644 --- a/tools/GNUMake/Make.defs +++ b/tools/GNUMake/Make.defs @@ -270,10 +270,6 @@ ifeq ($(USE_FFTW),TRUE) $(info Loading $(NGA_HOME)/tools/GNUMake/packages/Make.fftw...) include $(NGA_HOME)/tools/GNUMake/packages/Make.fftw endif -ifeq ($(USE_P3DFFT),TRUE) - $(info Loading $(NGA_HOME)/tools/GNUMake/packages/Make.p3dfft...) - include $(NGA_HOME)/tools/GNUMake/packages/Make.p3dfft -endif ############################################################### diff --git a/tools/GNUMake/packages/Make.p3dfft b/tools/GNUMake/packages/Make.p3dfft deleted file mode 100644 index 6d79a86ba..000000000 --- a/tools/GNUMake/packages/Make.p3dfft +++ /dev/null @@ -1,12 +0,0 @@ -# Add appropriate P3DFFT includes and libraries -ifdef P3DFFT_DIR - ifndef FFTW_DIR - $(error FFTW required for P3DFFT) - endif - INCLUDE_LOCATIONS += $(P3DFFT_DIR)/include - LIBRARY_LOCATIONS += $(P3DFFT_DIR)/lib - LIBRARIES += -lp3dfft.3 -lfftw3 -lfftw3f -lstdc++ -else - $(error P3DFFT_DIR not defined, but it is currently required by NGA2) -endif - From cac0ade27004857b838ebe98f9f6408d1ab048c4 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 7 Feb 2023 14:01:04 -0500 Subject: [PATCH 105/152] nothing important Back to Olivier's version --- examples/ib_pipe/src/geometry.f90 | 2 +- examples/riser/src/geometry.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 845eaec8f..a64d5cf1b 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -90,7 +90,7 @@ subroutine geometry_init do k=cfg%kmin_,cfg%kmax_ do j=cfg%jmin_,cfg%jmax_ do i=cfg%imin_,cfg%imax_ - cfg%VF(i,j,k)=get_VF(i,j,k,'SC')+epsilon(1.0_WP) + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) end do end do end do diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 index fa864efea..fd02739a8 100644 --- a/examples/riser/src/geometry.f90 +++ b/examples/riser/src/geometry.f90 @@ -89,7 +89,7 @@ subroutine geometry_init do k=cfg%kmin_,cfg%kmax_ do j=cfg%jmin_,cfg%jmax_ do i=cfg%imin_,cfg%imax_ - cfg%VF(i,j,k)=get_VF(i,j,k,'SC')+epsilon(1.0_WP) + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) end do end do end do From ee68f906d34c637a4d58e28da6db516624f519bc Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 7 Feb 2023 14:09:04 -0500 Subject: [PATCH 106/152] IB collision + linsol integration Replace pipe collision detection with more general (but expensive) IB detection. Also brought linsol into the variable density solvers. --- examples/riser/src/simulation.f90 | 96 ++++++++++++++----------- src/particles/lpt_class.f90 | 45 +++++------- src/variable_density/lowmach_class.f90 | 61 ++++++++-------- src/variable_density/vdscalar_class.f90 | 67 +++++++++-------- 4 files changed, 139 insertions(+), 130 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 38ac84ab0..803065133 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -46,6 +46,7 @@ module simulation real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp real(WP), dimension(:,:,:), allocatable :: G + real(WP), dimension(:,:,:,:), allocatable :: Gnorm real(WP) :: visc,rho,mfr,mfr_target,bforce !> Wallclock time for monitoring @@ -245,6 +246,7 @@ subroutine simulation_init allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -447,17 +449,25 @@ subroutine simulation_init end block initialize_velocity - ! Initialize levelset + ! Initialize levelset and its normal initialize_G: block integer :: i,j,k + real(WP) :: buf + real(WP), dimension(3) :: n12 do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + n12(1)=0.0_WP + n12(2)=-fs%cfg%ym(j) + n12(3)=-fs%cfg%zm(k) + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + Gnorm(:,i,j,k)=n12/buf end do end do end do call fs%cfg%sync(G) + call fs%cfg%sync(Gnorm) end block initialize_G ! Add Ensight output @@ -588,7 +598,7 @@ subroutine simulation_run resU=resU+bforce ! Collide and advance particles - call lp%collide(dt=time%dtmid,pipe_D=D,pipe_pos=(/0.0_WP,0.0_WP/),pipe_dir='x') + call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) @@ -635,26 +645,26 @@ subroutine simulation_run call fs%cfg%sync(resW) end block add_lpt_src -!!$ ! Apply direct forcing to enforce BC at the pipe walls -!!$ ibm_correction: block -!!$ integer :: i,j,k -!!$ real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz -!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ -!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ -!!$ do i=fs%cfg%imin_,fs%cfg%imax_ -!!$ VFx=get_VF(i,j,k,'U') -!!$ VFy=get_VF(i,j,k,'V') -!!$ VFz=get_VF(i,j,k,'W') -!!$ RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) -!!$ RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) -!!$ RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) -!!$ resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) -!!$ resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) -!!$ resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) -!!$ end do -!!$ end do -!!$ end do -!!$ end block ibm_correction + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) + RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) + RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + end do + end do + end do + end block ibm_correction ! Add body forcing bodyforcing: block @@ -671,26 +681,26 @@ subroutine simulation_run fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - VFy=get_VF(i,j,k,'V') - VFz=get_VF(i,j,k,'W') - fs%U(i,j,k)=fs%U(i,j,k)*VFx - fs%V(i,j,k)=fs%V(i,j,k)*VFy - fs%W(i,j,k)=fs%W(i,j,k)*VFz - end do - end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibm_correction +!!$ ! Apply direct forcing to enforce BC at the pipe walls +!!$ ibm_correction: block +!!$ integer :: i,j,k +!!$ real(WP) :: VFx,VFy,VFz +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ VFx=get_VF(i,j,k,'U') +!!$ VFy=get_VF(i,j,k,'V') +!!$ VFz=get_VF(i,j,k,'W') +!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx +!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy +!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz +!!$ end do +!!$ end do +!!$ end do +!!$ call fs%cfg%sync(fs%U) +!!$ call fs%cfg%sync(fs%V) +!!$ call fs%cfg%sync(fs%W) +!!$ end block ibm_correction ! Apply other boundary conditions and update momentum call fs%apply_bcond(time%tmid,time%dtmid) @@ -806,7 +816,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) end subroutine simulation_final diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index ee0dc94e4..46481366f 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -352,21 +352,23 @@ end function constructor !> Resolve collisional interaction between particles !> Requires tau_col, e_n, e_w and mu_f to be set beforehand - subroutine collide(this,dt,pipe_D,pipe_pos,pipe_dir) + subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) implicit none class(lpt), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Gib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nxib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nyib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nzib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - real(WP), intent(in), optional :: pipe_D,pipe_pos(2) - character(len=*), intent(in), optional :: pipe_dir - ! Check if all pipe properties are provided - check_pipe: block + ! Check if all IB parameters are present + check_G: block use messager, only: die - if (present(pipe_D).and.(.not.present(pipe_pos).or..not.present(pipe_dir))) & - call die('[lpt collide] Missing pipe parameters') - end block check_pipe + if (present(Gib).and.(.not.present(Nxib).or..not.present(Nyib).or..not.present(Nzib))) & + call die('[lpt collide] IB collisions need Gib, Nxib, Nyib, AND Nzib') + end block check_G ! Start by zeroing out the collision force zero_force: block @@ -489,26 +491,13 @@ subroutine collide(this,dt,pipe_D,pipe_pos,pipe_dir) ! Calculate collision torque this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) end if - - ! Collide with pipe walls - if (present(pipe_D)) then - select case(trim(pipe_dir)) - case('x') - d12=0.5_WP*pipe_D-sqrt((r1(2)-pipe_pos(1))**2+(r1(3)-pipe_pos(2))**2) - n12(1) = 0.0_WP - n12(2) = pipe_pos(1) - r1(2) - n12(3) = pipe_pos(2) - r1(3) - case('y') - d12=0.5_WP*pipe_D-sqrt((r1(1)-pipe_pos(1))**2+(r1(3)-pipe_pos(2))**2) - n12(1) = pipe_pos(1) - r1(1) - n12(2) = 0.0_WP - n12(3) = pipe_pos(2) - r1(3) - case('z') - d12=0.5_WP*pipe_D-sqrt((r1(1)-pipe_pos(1))**2+(r1(2)-pipe_pos(2))**2) - n12(1) = pipe_pos(1) - r1(1) - n12(2) = pipe_pos(2) - r1(2) - n12(3) = 0.0_WP - end select + + ! Collide with IB + if (present(Gib)) then + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Gib,bc='n') + n12(1)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nxib,bc='n') + n12(2)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nyib,bc='n') + n12(3)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nzib,bc='n') buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) n12 = -n12/buf rnv=dot_product(v1,n12) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 35727f3b7..eb0c3094e 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -6,7 +6,7 @@ module lowmach_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -78,10 +78,10 @@ module lowmach_class real(WP), dimension(:,:,:), allocatable :: div !< Divergence array ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity @@ -191,12 +191,6 @@ function constructor(cfg,name) result(self) ! Allocate fluid viscosity allocate(self%visc(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -760,15 +754,18 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(lowmach), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided integer :: i,j,k ! Adjust metrics based on bcflag array call this%adjust_metrics() + + ! Point to pressure solver linsol object + this%psolv=>pressure_solver ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] @@ -803,23 +800,31 @@ subroutine setup(this,pressure_ils,implicit_ils) end do ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) + call this%psolv%init() call this%psolv%setup() - - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 105e30b51..106cb3690 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -5,7 +5,7 @@ module vdscalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -60,7 +60,7 @@ module vdscalar_class real(WP), dimension(:,:,:), allocatable :: rhoSCold !< rhoSCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -151,9 +151,6 @@ function constructor(cfg,scheme,name) result(self) call die('[scalar constructor] Unknown vdscalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -368,32 +365,40 @@ end subroutine adjust_metrics !> Finish setting up the variable density scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) - implicit none - class(vdscalar), intent(inout) :: this - integer, intent(in) :: implicit_ils - integer :: count,st - - ! Adjust metrics based on mask array - call this%adjust_metrics() - - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) - + subroutine setup(this,implicit_solver) + implicit none + class(vdscalar), intent(inout) :: this + class(linsol), target, intent(in), optional :: implicit_solver + integer :: count,st + + ! Adjust metrics based on mask array + call this%adjust_metrics() + + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if + end subroutine setup From 5b56d8f6fc8d4ceda19c55f66b2c98f3f8c2c958 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 08:52:48 -0500 Subject: [PATCH 107/152] LPT updates Remove solver specific flags. Added optional argument to avoid overlap when injection routine is called. Also fixed a bug with LPT cfl, before the LPT cfl was overwriting flow solver CFL. Now we have option to use collisional CFL and then check max. --- examples/fluidized_bed/src/simulation.f90 | 12 ++-- examples/part_inject/src/simulation.f90 | 8 ++- examples/riser/src/simulation.f90 | 12 ++-- src/particles/lpt_class.f90 | 73 +++++++++++------------ 4 files changed, 55 insertions(+), 50 deletions(-) diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 6d882be9c..e6749edd1 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -285,9 +285,11 @@ subroutine simulation_init ! Create monitor filea create_monitor: block + real(WP) :: buf ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call fs%get_cfl(time%dt,buf) + time%cfl=max(time%cfl,buf) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -356,6 +358,7 @@ subroutine simulation_run use mathtools, only: twoPi use parallel, only: parallel_time implicit none + real(WP) :: buf ! Perform time integration do while (.not.time%done()) @@ -364,8 +367,9 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call fs%get_cfl(time%dt,buf) + time%cfl=max(time%cfl,buf) call time%adjust_dt() call time%increment() diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index 09d75af36..b947c1722 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -144,8 +144,9 @@ subroutine simulation_init ! Create a monitor file create_monitor: block + real(WP) :: buf ! Prepare some info about fields - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) call lp%get_max() ! Create simulation monitor mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') @@ -183,17 +184,18 @@ end subroutine simulation_init !> Perform an NGA2 simulation subroutine simulation_run implicit none + real(WP) :: buf ! Perform time integration do while (.not.time%done()) ! Increment time - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) call time%adjust_dt() call time%increment() ! Inject particles - call lp%inject(dt=time%dt) + call lp%inject(dt=time%dt,avoid_overlap=.true.) ! Collide particles call lp%collide(dt=time%dt) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 803065133..b55e94e28 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -490,9 +490,11 @@ subroutine simulation_init ! Create monitor filea create_monitor: block + real(WP) :: buf ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call fs%get_cfl(time%dt,buf) + time%cfl=max(time%cfl,buf) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -573,6 +575,7 @@ end subroutine simulation_init subroutine simulation_run use parallel, only: parallel_time implicit none + real(WP) :: buf ! Perform time integration do while (.not.time%done()) @@ -581,8 +584,9 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call fs%get_cfl(time%dt,buf) + time%cfl=max(time%cfl,buf) call time%adjust_dt() call time%increment() diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 46481366f..be74f5991 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -79,10 +79,8 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) character(len=str_medium), public :: drag_model !< Drag model - logical :: use_lift=.false. !< Compute lift force on particles ! Collisional parameters - logical :: use_col=.true. !< Flag for collisions real(WP) :: tau_col !< Characteristic collision time scale real(WP) :: e_n !< Normal restitution coefficient real(WP) :: e_w !< Wall restitution coefficient @@ -379,9 +377,6 @@ subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) end do end block zero_force - ! Return if not used - if (.not.this%use_col) return - ! Then share particles across overlap call this%share() @@ -701,7 +696,6 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) - !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) myp%pos=pold%pos+0.5_WP*mydt*myp%vel myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip @@ -814,7 +808,6 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') ! Interpolate the fluid vorticity to the particle location if needed - !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) end block interpolate ! Compute acceleration due to drag @@ -847,19 +840,17 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque opt_dt=tau/real(this%nstep,WP) end block compute_drag - ! Compute acceleration due to Saffman lift - compute_lift: block - use mathtools, only: Pi,cross_product - real(WP) :: omegag,Cl,Reg - if (this%use_lift) then - omegag=sqrt(sum(fvort**2)) - if (omegag.gt.0.0_WP) then - Reg = p%d**2*omegag*frho/fvisc - Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) - acc=acc+Cl*cross_product(fvel-p%vel,fvort) - end if - end if - end block compute_lift +!!$ ! Compute acceleration due to Saffman lift +!!$ compute_lift: block +!!$ use mathtools, only: Pi,cross_product +!!$ real(WP) :: omegag,Cl,Reg +!!$ omegag=sqrt(sum(fvort**2)) +!!$ if (omegag.gt.0.0_WP) then +!!$ Reg = p%d**2*omegag*frho/fvisc +!!$ Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) +!!$ acc=acc+Cl*cross_product(fvel-p%vel,fvort) +!!$ end if +!!$ end block compute_lift ! Compute fluid torque (assumed Stokes drag) compute_torque: block @@ -1001,22 +992,23 @@ end subroutine filter !> Inject particles from a prescribed location with given mass flowrate !> Requires injection parameters to be set beforehand - subroutine inject(this,dt) + subroutine inject(this,dt,avoid_overlap) use mpi_f08 use parallel, only: MPI_REAL_WP use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection - real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters - real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep - integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id + real(WP), intent(inout) :: dt !< Timestep size over which to advance + logical, intent(in), optional :: avoid_overlap !< Option to avoid overlap durig injection + real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection + real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters + real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep + integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id integer :: i,j,np0_,np2,np_tmp,count,ierr integer, dimension(:), allocatable :: nrecv type(part), dimension(:), allocatable :: p2 type(MPI_Status) :: status - logical :: overlap + logical :: avoid_overlap_,overlap ! Initial number of particles np0_=this%np_ @@ -1034,7 +1026,9 @@ subroutine inject(this,dt) call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) ! Communicate nearby particles to check for overlap - if (this%use_col) then + avoid_overlap_=.false. + if (present(avoid_overlap)) avoid_overlap_=avoid_overlap + if (avoid_overlap_) then allocate(nrecv(this%cfg%nproc)) count=0 inj_min(1)=this%cfg%x(this%cfg%imino) @@ -1103,7 +1097,7 @@ subroutine inject(this,dt) this%p(count)%pos=get_position() overlap=.false. ! Check overlap with particles recently injected - if (this%use_col) then + if (avoid_overlap_) then do j=1,np_tmp-1 if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. end do @@ -1206,13 +1200,14 @@ end subroutine inject !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) + subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX use parallel, only: MPI_REAL_WP implicit none class(lpt), intent(inout) :: this real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl + real(WP), intent(out) :: cflc + real(WP), optional :: cfl integer :: i,ierr real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col @@ -1232,14 +1227,14 @@ subroutine get_cfl(this,dt,cfl) call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) ! Return the maximum convective CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - if (this%use_col) then - my_CFL_col=10.0_WP*my_CFL_col*dt - call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - cfl = max(cfl,this%CFL_col) - else - this%CFL_col=0.0_WP - end if + cflc=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + ! Compute collision CFL + my_CFL_col=10.0_WP*my_CFL_col*dt + call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! If asked for, also return the maximum overall CFL + if (present(CFL)) cfl=max(cflc,this%CFL_col) end subroutine get_cfl From 3be151fbb55a48aae73310fd6fa9ccfcd997a59b Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 11:29:26 -0500 Subject: [PATCH 108/152] Update GNUmakefile Remove p3dfft --- examples/riser/GNUmakefile | 2 -- 1 file changed, 2 deletions(-) diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile index 412f34732..44ad3a454 100644 --- a/examples/riser/GNUmakefile +++ b/examples/riser/GNUmakefile @@ -7,7 +7,6 @@ USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK = TRUE USE_FFTW = TRUE -USE_P3DFFT = TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -27,7 +26,6 @@ VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -P3DFFT_DIR=/Users/jcaps/Research/Codes/Builds/p3dfft FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions From 8461ee6cbca3d2075cb920236020f6265cc5469d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 15:03:37 -0500 Subject: [PATCH 109/152] remove p3dfft decomp Thought I removed this --- examples/hit/src/geometry.f90 | 3 +-- examples/riser/src/geometry.f90 | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/examples/hit/src/geometry.f90 b/examples/hit/src/geometry.f90 index 90b88068a..fcd8bef7c 100644 --- a/examples/hit/src/geometry.f90 +++ b/examples/hit/src/geometry.f90 @@ -41,12 +41,11 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group - use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + cfg=config(grp=group,decomp=partition,grid=grid) end block create_cfg ! Create masks for this config diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 index fd02739a8..2bbf23f40 100644 --- a/examples/riser/src/geometry.f90 +++ b/examples/riser/src/geometry.f90 @@ -71,14 +71,13 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group - use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + cfg=config(grp=group,decomp=partition,grid=grid) end block create_cfg From 9d83c8e353dd101d04d88509c5ec6b5ef6ea5764 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 17:36:10 -0500 Subject: [PATCH 110/152] Squashed commit of the following: commit 0bca3e86d38e65d82bcf05e26ad2d4884d15fbac Author: Olivier Desjardins Date: Tue Feb 7 23:19:41 2023 -0500 Added IB-particle collision from Jesse. Switched all solvers (except MAST!) to new linsol class. ALMOST ALL EXAMPLES WILL NEED TO BE UPDATED! commit 26b4fe29243963770710ed5b59b9b912dbec536b Author: Olivier Desjardins Date: Tue Feb 7 22:29:02 2023 -0500 Switched fourier3d to c2c... commit 19ae45186b1966242d8e3675f8f66be17bd5ea05 Author: Olivier Desjardins Date: Tue Feb 7 22:09:34 2023 -0500 Commit what I think is the cleanest implementation of r2r fftw solver - but that requires another strategy for building the operator commit a9becb0343bc7f3b07d3c8b230c9882426b5b3bb Author: Olivier Desjardins Date: Tue Feb 7 16:22:59 2023 -0500 p3dfft is also removed as decomposition strategy commit 31219cef08bbbbf0c0a4cac2985d47ac89f32938 Author: Olivier Desjardins Date: Tue Feb 7 16:16:07 2023 -0500 May not be working yet - this commit removes p3dfft altogether, replaces it with our in-house fourier solver. commit ff795e1aa35e23c9fcabe11d79fae700d605ed57 Author: Olivier Desjardins Date: Tue Feb 7 09:49:15 2023 -0500 Started adding a multiphase_pipe case. Started adding back in-house fourier solver. Fixed bug with hit. commit ec57c3a84e25f3af98e0a7ea79615efe3841aa2d Author: Olivier Desjardins Date: Mon Feb 6 13:41:15 2023 -0500 Proper non-dimensionalization of the swirl injection case commit 49d5325fd38e0624ff6a5d66c0e75ebbf4c02960 Author: Olivier Desjardins Date: Mon Feb 6 13:17:20 2023 -0500 Moved library directory specification to my .zshrc to remove all reference to 'desjardi'... commit 7937d14022734d4ccf24315e24f2fade3a7914a6 Author: Olivier Desjardins Date: Mon Feb 6 10:59:56 2023 -0500 Adding a swirl atomizer test case. commit c70dd8ba887f39b40510b75409d30dd525e58390 Author: Olivier Desjardins Date: Sun Feb 5 21:51:08 2023 -0500 Particles with id=0 do not modify the flow and are not advanced. They're just kinda... there. commit 305694cffbe3ff5ccc5f544adef497eebcd0f40d Author: Olivier Desjardins Date: Sun Feb 5 21:35:21 2023 -0500 Removed shock-particle case, it's not ready. commit 4bf8f61d4996c35aff2581a5e8f2987d0e05e9a8 Author: Olivier Desjardins Date: Sun Feb 5 21:34:04 2023 -0500 Updated shit_p routines to make use of newly defined integration tools and fluid_vol variable. commit af17f44d5ce8eb088e9433e3e0b1188d6b0e5066 Author: Olivier Desjardins Date: Sun Feb 5 20:01:42 2023 -0500 Absorded range of modifications from Jesse's repository. Most important is the use of p3dfft for fourier-based linear solvers. commit f962bc2b278e419c8d8d09e5e45d5ea677bf9d6e Author: Olivier Desjardins Date: Fri Feb 3 17:17:33 2023 -0500 Clean-up ib_pipe to make it a proper pipe flow LES. Cleaned up Vreman's sgs model. commit 6c4766c03f875933dc4435d09b36cc43908e77b5 Author: Olivier Desjardins Date: Fri Feb 3 14:19:32 2023 -0500 Slight clean-up of the turbulent ib_pipe case. commit bf6f53909e43e24aed0f4cfb802118bb447f61fd Author: Olivier Desjardins Date: Thu Feb 2 22:57:49 2023 -0500 ib_pipe modified to absorb Jesse's changes, and pushed to turbulent conditions. commit d7892206a0a67fc87a3357270811944df00e26bc Author: Olivier Desjardins Date: Thu Feb 2 14:56:07 2023 -0500 Small changes to falling_drop, added new ib_drop case. commit 1ceb7d2b0dced02f0bbb0782a4c386ab350bce29 Author: Olivier Desjardins Date: Wed Feb 1 10:41:13 2023 -0500 Reindent df_class. Need to think about role of rho here for two-phase flows. --- examples/MAST_drop/GNUmakefile | 5 +- examples/bctester/GNUmakefile | 4 +- examples/boat/GNUmakefile | 5 +- examples/boat/src/lpt_class.f90 | 4 +- examples/bus/GNUmakefile | 5 +- examples/channel/GNUmakefile | 3 +- examples/collision/GNUmakefile | 5 +- examples/compil_test/GNUmakefile | 4 +- examples/coupler_tester/GNUmakefile | 6 +- examples/drop_breakup/GNUmakefile | 5 +- examples/drop_breakup/src/simulation.f90 | 3 +- examples/falling_drop/GNUmakefile | 4 +- examples/falling_drop/src/simulation.f90 | 25 +- examples/film/GNUmakefile | 5 +- examples/filmKH/GNUmakefile | 4 +- examples/filmRT/GNUmakefile | 6 +- examples/fluidized_bed/GNUmakefile | 3 +- examples/hit/GNUmakefile | 7 +- examples/hit/input | 15 +- examples/hit/src/simulation.f90 | 18 +- examples/ib_drop/GNUmakefile | 4 +- examples/ib_pipe/GNUmakefile | 6 +- examples/ib_pipe/input | 4 + examples/ib_pipe/src/geometry.f90 | 6 +- examples/ib_pipe/src/simulation.f90 | 16 +- examples/ib_tester/GNUmakefile | 3 +- examples/imbibition/GNUmakefile | 5 +- examples/internal_bc/GNUmakefile | 4 +- examples/levitating_drop/GNUmakefile | 5 +- examples/ljsc/GNUmakefile | 5 +- examples/multiphaseKH/GNUmakefile | 6 +- examples/multiphaseRT/GNUmakefile | 6 +- examples/multiphase_pipe/GNUmakefile | 47 + examples/multiphase_pipe/README | 2 + examples/multiphase_pipe/input | 33 + examples/multiphase_pipe/src/Make.package | 2 + examples/multiphase_pipe/src/geometry.f90 | 136 + examples/multiphase_pipe/src/simulation.f90 | 380 +++ examples/nozzle_2grids/GNUmakefile | 5 +- examples/nozzle_2phase/GNUmakefile | 5 +- examples/nozzle_2phase/src/simulation.f90 | 3 +- examples/nozzle_3grids/GNUmakefile | 5 +- examples/nozzle_3grids/src/simulation.f90 | 3 +- examples/nozzle_internal/GNUmakefile | 4 +- examples/part_bed/GNUmakefile | 6 +- examples/part_bed/src/simulation.f90 | 1 + examples/part_inject/GNUmakefile | 4 +- examples/part_tester/GNUmakefile | 6 +- examples/part_tester/src/simulation.f90 | 1 + examples/pvessel/GNUmakefile | 5 +- examples/rayleigh-taylor/GNUmakefile | 4 +- examples/shock_water_cylinder/GNUmakefile | 5 +- examples/spreading/GNUmakefile | 6 +- examples/swirl_atomizer/GNUmakefile | 47 + examples/swirl_atomizer/README | 1 + examples/swirl_atomizer/input | 39 + examples/swirl_atomizer/src/Make.package | 2 + examples/swirl_atomizer/src/geometry.f90 | 73 + examples/swirl_atomizer/src/simulation.f90 | 515 ++++ examples/vdjet/GNUmakefile | 4 +- examples/vortexTG/GNUmakefile | 5 +- examples/water_air_rarefaction/GNUmakefile | 5 +- examples/zalesak/GNUmakefile | 4 +- src/config/config_class.f90 | 25 + src/constant_density/incomp_class.f90 | 22 +- src/constant_density/scalar_class.f90 | 181 +- src/grid/pgrid_class.f90 | 1 - src/libraries/precision.mod | Bin 0 -> 364 bytes src/particles/lpt_class.f90 | 563 ++-- src/solver/Make.package | 2 +- src/solver/diag_class.f90 | 2381 ++++++++--------- .../{pfft3d_class.f90 => fourier3d_class.f90} | 603 +++-- src/two_phase/mast_class.f90 | 181 +- src/two_phase/tpns_class.f90 | 81 +- src/variable_density/lowmach_class.f90 | 35 +- src/variable_density/vdscalar_class.f90 | 68 +- 76 files changed, 3445 insertions(+), 2262 deletions(-) create mode 100644 examples/multiphase_pipe/GNUmakefile create mode 100644 examples/multiphase_pipe/README create mode 100644 examples/multiphase_pipe/input create mode 100644 examples/multiphase_pipe/src/Make.package create mode 100644 examples/multiphase_pipe/src/geometry.f90 create mode 100644 examples/multiphase_pipe/src/simulation.f90 create mode 100644 examples/swirl_atomizer/GNUmakefile create mode 100644 examples/swirl_atomizer/README create mode 100644 examples/swirl_atomizer/input create mode 100644 examples/swirl_atomizer/src/Make.package create mode 100644 examples/swirl_atomizer/src/geometry.f90 create mode 100644 examples/swirl_atomizer/src/simulation.f90 create mode 100644 src/libraries/precision.mod rename src/solver/{pfft3d_class.f90 => fourier3d_class.f90} (71%) diff --git a/examples/MAST_drop/GNUmakefile b/examples/MAST_drop/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/MAST_drop/GNUmakefile +++ b/examples/MAST_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/bctester/GNUmakefile b/examples/bctester/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/bctester/GNUmakefile +++ b/examples/bctester/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/GNUmakefile b/examples/boat/GNUmakefile index b4a53ee9b..b83ed2464 100644 --- a/examples/boat/GNUmakefile +++ b/examples/boat/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/src/lpt_class.f90 b/examples/boat/src/lpt_class.f90 index 7654753f6..3982109a9 100644 --- a/examples/boat/src/lpt_class.f90 +++ b/examples/boat/src/lpt_class.f90 @@ -752,7 +752,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -765,7 +765,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/examples/bus/GNUmakefile b/examples/bus/GNUmakefile index 5c202ce34..9bec65f40 100644 --- a/examples/bus/GNUmakefile +++ b/examples/bus/GNUmakefile @@ -21,10 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre - +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile index 4cdeaeb5f..fc48c5afb 100644 --- a/examples/channel/GNUmakefile +++ b/examples/channel/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/collision/GNUmakefile b/examples/collision/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/collision/GNUmakefile +++ b/examples/collision/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/compil_test/GNUmakefile b/examples/compil_test/GNUmakefile index 9ad19ecfc..8e0aca067 100644 --- a/examples/compil_test/GNUmakefile +++ b/examples/compil_test/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/coupler_tester/GNUmakefile b/examples/coupler_tester/GNUmakefile index 2ad327124..e83454a63 100644 --- a/examples/coupler_tester/GNUmakefile +++ b/examples/coupler_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/drop_breakup/GNUmakefile b/examples/drop_breakup/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/drop_breakup/GNUmakefile +++ b/examples/drop_breakup/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/drop_breakup/src/simulation.f90 b/examples/drop_breakup/src/simulation.f90 index d7a3c612d..9d8162c79 100644 --- a/examples/drop_breakup/src/simulation.f90 +++ b/examples/drop_breakup/src/simulation.f90 @@ -814,7 +814,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%Acol=0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =diam !< Assign diameter to account for full volume lp%p(np)%pos =[cc%meta_structures_list(m)%x,cc%meta_structures_list(m)%y,cc%meta_structures_list(m)%z] !< Place the drop at the liquid barycenter lp%p(np)%vel =[cc%meta_structures_list(m)%u,cc%meta_structures_list(m)%v,cc%meta_structures_list(m)%w] !< Assign mean structure velocity as drop velocity diff --git a/examples/falling_drop/GNUmakefile b/examples/falling_drop/GNUmakefile index 3fb87f2d8..466227c85 100644 --- a/examples/falling_drop/GNUmakefile +++ b/examples/falling_drop/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/falling_drop/src/simulation.f90 b/examples/falling_drop/src/simulation.f90 index 03731c4aa..6e21f7e5c 100644 --- a/examples/falling_drop/src/simulation.f90 +++ b/examples/falling_drop/src/simulation.f90 @@ -2,6 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg + use hypre_str_class, only: hypre_str use tpns_class, only: tpns use vfs_class, only: vfs use timetracker_class, only: timetracker @@ -11,7 +12,9 @@ module simulation implicit none private - !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker + type(hypre_str), public :: ps + type(hypre_str), public :: vs type(tpns), public :: fs type(vfs), public :: vf type(timetracker), public :: time @@ -137,7 +140,7 @@ subroutine simulation_init ! Create a two-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg,pcg_pfmg + use hypre_str_class, only: pcg_pfmg ! Create flow solver fs=tpns(cfg=cfg,name='Two-phase NS') ! Assign constant viscosity to each phase @@ -150,14 +153,16 @@ subroutine simulation_init call param_read('Surface tension coefficient',fs%sigma) ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=gmres_amg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) ! Zero initial field fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP ! Calculate cell-centered velocities and divergence @@ -345,4 +350,4 @@ subroutine simulation_final end subroutine simulation_final -end module simulation \ No newline at end of file +end module simulation diff --git a/examples/film/GNUmakefile b/examples/film/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/film/GNUmakefile +++ b/examples/film/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/filmKH/GNUmakefile b/examples/filmKH/GNUmakefile index 0a43fee0f..c4825c881 100644 --- a/examples/filmKH/GNUmakefile +++ b/examples/filmKH/GNUmakefile @@ -23,9 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/filmRT/GNUmakefile b/examples/filmRT/GNUmakefile index 0fa3aaa03..258639eff 100644 --- a/examples/filmRT/GNUmakefile +++ b/examples/filmRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/GNUmakefile b/examples/fluidized_bed/GNUmakefile index 669bb01a2..663465958 100644 --- a/examples/fluidized_bed/GNUmakefile +++ b/examples/fluidized_bed/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index e15a4a4c7..52dbd4c18 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -5,6 +5,7 @@ NGA_HOME ?= ../.. PRECISION = DOUBLE USE_MPI = TRUE USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE PROFILE = FALSE @@ -22,10 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 -HYPRE_DIR=/Users/jcaps/Research/Codes/Builds/hypre -FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs @@ -47,4 +45,3 @@ all: $(executable) # NGA compilation rules include $(NGA_HOME)/tools/GNUMake/Make.rules - diff --git a/examples/hit/input b/examples/hit/input index 64e00db70..563066350 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,9 +1,9 @@ # Parallelization -Partition : 1 1 1 +Partition : 1 1 4 # Mesh definition Lx : 1 -nx : 4 +nx : 64 # Fluid properties Dynamic viscosity : 0.01 @@ -14,20 +14,11 @@ Eddy turnover time : 0.1 # Particle properties Particle density : 0.018 Particle diameter : 1 -Number of particles : 0 +Number of particles : 0!100000 # Time integration Max timestep size : 1e-3 Max cfl number : 0.9 -# Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - # Ensight output Ensight output period : 0.01 - diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index a2dd34f1d..be6cbba4e 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,8 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg - use pfft3d_class, only: pfft3d - !use hypre_str_class, only: hypre_str + use fourier3d_class, only: fourier3d use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +14,7 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - type(pfft3d), public :: ps - !type(hypre_str), public :: ps + type(fourier3d), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -80,11 +78,7 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - ps=pfft3d(cfg=cfg,name='Pressure',nst=7) - !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - !ps%maxlevel=10 - !call param_read('Pressure iteration',ps%maxit) - !call param_read('Pressure tolerance',ps%rcvg) + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -316,9 +310,9 @@ subroutine simulation_run end do call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) ! Calculate mean velocity - call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%fluid_vol ! Add forcing term resU=resU+time%dt*KE0/KE*(fs%U-meanU)/(2.0_WP*tau_eddy) resV=resV+time%dt*KE0/KE*(fs%V-meanV)/(2.0_WP*tau_eddy) diff --git a/examples/ib_drop/GNUmakefile b/examples/ib_drop/GNUmakefile index 1b5555613..14a82a163 100644 --- a/examples/ib_drop/GNUmakefile +++ b/examples/ib_drop/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/irl +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 99f991ace..bdb62cb2b 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -7,6 +7,7 @@ USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -23,10 +24,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR=/opt/homebrew/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 8a0bda7d7..3a98424db 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -21,6 +21,10 @@ Max time : 1000 Dynamic viscosity : 2e-4 Density : 1 +# Pressure solver +Pressure tolerance : 1e-4 +Pressure iteration : 100 + # Implicit velocity solver Implicit tolerance : 1e-4 Implicit iteration : 100 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index a64d5cf1b..e9cd3b5cc 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -72,7 +72,6 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group - use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition @@ -86,7 +85,7 @@ subroutine geometry_init ! Create masks for this config create_walls: block - integer :: i,j,k + integer :: i,j,k do k=cfg%kmin_,cfg%kmax_ do j=cfg%jmin_,cfg%jmax_ do i=cfg%imin_,cfg%imax_ @@ -95,6 +94,7 @@ subroutine geometry_init end do end do call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() end block create_walls @@ -132,4 +132,4 @@ function get_VF(i,j,k,dir) result(VF) end function get_VF -end module geometry +end module geometry \ No newline at end of file diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index adc3a34a3..c767cf64b 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -3,7 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg,D,get_VF use hypre_str_class, only: hypre_str - use pfft3d_class, only: pfft3d + use fourier3d_class, only: fourier3d use incomp_class, only: incomp use sgsmodel_class, only: sgsmodel use timetracker_class, only: timetracker @@ -15,7 +15,8 @@ module simulation !> Get an an incompressible solver, pressure solver, and corresponding time tracker type(incomp), public :: fs - type(pfft3d), public :: ps + !type(hypre_str), public :: ps + type(fourier3d), public :: ps type(hypre_str), public :: vs type(sgsmodel), public :: sgs type(timetracker), public :: time @@ -91,7 +92,7 @@ subroutine simulation_init time%dt=time%dtmax time%itmax=2 end block initialize_timetracker - + ! Create an incompressible flow solver without bconds create_flow_solver: block @@ -102,7 +103,11 @@ subroutine simulation_init call param_read('Density',fs%rho) call param_read('Dynamic viscosity',visc); fs%visc=visc ! Configure pressure solver - ps=pfft3d(cfg=cfg,name='Pressure',nst=7) + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + !ps%maxlevel=14 + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) call param_read('Implicit iteration',vs%maxit) @@ -347,9 +352,6 @@ subroutine simulation_run ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() - - ! Recompute mass flowrate for monitor - mfr=get_bodyforce_mfr() ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/examples/ib_tester/GNUmakefile b/examples/ib_tester/GNUmakefile index ca4484e85..5b291856a 100644 --- a/examples/ib_tester/GNUmakefile +++ b/examples/ib_tester/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/imbibition/GNUmakefile b/examples/imbibition/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/imbibition/GNUmakefile +++ b/examples/imbibition/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/internal_bc/GNUmakefile b/examples/internal_bc/GNUmakefile index 6f90a907b..68f202cd3 100644 --- a/examples/internal_bc/GNUmakefile +++ b/examples/internal_bc/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/levitating_drop/GNUmakefile b/examples/levitating_drop/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/levitating_drop/GNUmakefile +++ b/examples/levitating_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ljsc/GNUmakefile b/examples/ljsc/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/ljsc/GNUmakefile +++ b/examples/ljsc/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphaseKH/GNUmakefile b/examples/multiphaseKH/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseKH/GNUmakefile +++ b/examples/multiphaseKH/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphaseRT/GNUmakefile b/examples/multiphaseRT/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseRT/GNUmakefile +++ b/examples/multiphaseRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphase_pipe/GNUmakefile b/examples/multiphase_pipe/GNUmakefile new file mode 100644 index 000000000..b92867b7c --- /dev/null +++ b/examples/multiphase_pipe/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := subgrid constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/multiphase_pipe/README b/examples/multiphase_pipe/README new file mode 100644 index 000000000..ba28b9a69 --- /dev/null +++ b/examples/multiphase_pipe/README @@ -0,0 +1,2 @@ +Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: +Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. diff --git a/examples/multiphase_pipe/input b/examples/multiphase_pipe/input new file mode 100644 index 000000000..3a98424db --- /dev/null +++ b/examples/multiphase_pipe/input @@ -0,0 +1,33 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Pipe diameter : 1 +Pipe length : 4 +nx : 256 +ny : 64 +nz : 64 + +# Pipe properties +Bulk velocity : 1 +Fluctuation amp : 0.2 + +# Time integration +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : 2e-4 +Density : 1 + +# Pressure solver +Pressure tolerance : 1e-4 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-4 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 diff --git a/examples/multiphase_pipe/src/Make.package b/examples/multiphase_pipe/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/multiphase_pipe/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/multiphase_pipe/src/geometry.f90 b/examples/multiphase_pipe/src/geometry.f90 new file mode 100644 index 000000000..9f2df8dae --- /dev/null +++ b/examples/multiphase_pipe/src/geometry.f90 @@ -0,0 +1,136 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init,get_VF + + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + use pgrid_class, only: p3dfft_decomp + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U','u') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V','v') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W','w') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry \ No newline at end of file diff --git a/examples/multiphase_pipe/src/simulation.f90 b/examples/multiphase_pipe/src/simulation.f90 new file mode 100644 index 000000000..052f8051d --- /dev/null +++ b/examples/multiphase_pipe/src/simulation.f90 @@ -0,0 +1,380 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + +contains + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=14 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + +end module simulation diff --git a/examples/nozzle_2grids/GNUmakefile b/examples/nozzle_2grids/GNUmakefile index 86fde1a2e..f77956a50 100644 --- a/examples/nozzle_2grids/GNUmakefile +++ b/examples/nozzle_2grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/GNUmakefile b/examples/nozzle_2phase/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/nozzle_2phase/GNUmakefile +++ b/examples/nozzle_2phase/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/src/simulation.f90 b/examples/nozzle_2phase/src/simulation.f90 index 3ddea7849..1333c4b95 100644 --- a/examples/nozzle_2phase/src/simulation.f90 +++ b/examples/nozzle_2phase/src/simulation.f90 @@ -852,7 +852,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%Acol=0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =(6.0_WP*Vd/pi)**(1.0_WP/3.0_WP) !< Assign diameter from model above lp%p(np)%pos =vf%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp%p(np)%vel =fs%cfg%get_velocity(pos=lp%p(np)%pos,i0=i,j0=j,k0=k,U=fs%U,V=fs%V,W=fs%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_3grids/GNUmakefile b/examples/nozzle_3grids/GNUmakefile index 7eb9f094c..ce3cd7055 100644 --- a/examples/nozzle_3grids/GNUmakefile +++ b/examples/nozzle_3grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_3grids/src/simulation.f90 b/examples/nozzle_3grids/src/simulation.f90 index 80fa99650..c3c3027fa 100644 --- a/examples/nozzle_3grids/src/simulation.f90 +++ b/examples/nozzle_3grids/src/simulation.f90 @@ -1627,7 +1627,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp3%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp3%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp3%p(np)%col =0.0_WP !< Give zero collision force + lp3%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp3%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp3%p(np)%d =(6.0_WP*Vl/pi)**(1.0_WP/3.0_WP) !< Assign diameter based on remaining liquid volume lp3%p(np)%pos =vf2%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp3%p(np)%vel =fs2%cfg%get_velocity(pos=lp3%p(np)%pos,i0=i,j0=j,k0=k,U=fs2%U,V=fs2%V,W=fs2%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_internal/GNUmakefile b/examples/nozzle_internal/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/nozzle_internal/GNUmakefile +++ b/examples/nozzle_internal/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/GNUmakefile b/examples/part_bed/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_bed/GNUmakefile +++ b/examples/part_bed/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index 43f5cfdb5..60d4343ed 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -84,6 +84,7 @@ subroutine simulation_init lp%p(i)%vel=0.0_WP ! Give zero collision force lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile index c66736380..08f94d1c9 100644 --- a/examples/part_inject/GNUmakefile +++ b/examples/part_inject/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_tester/GNUmakefile b/examples/part_tester/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_tester/GNUmakefile +++ b/examples/part_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index 988bbb6aa..269a24285 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -77,6 +77,7 @@ subroutine simulation_init lp%p(i)%vel=0.0_WP ! Give zero collision force lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/pvessel/GNUmakefile b/examples/pvessel/GNUmakefile index 53ecb4714..7d199c73f 100644 --- a/examples/pvessel/GNUmakefile +++ b/examples/pvessel/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -COOLPROP_DIR= /Users/desjardi/Builds/coolprop +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/rayleigh-taylor/GNUmakefile b/examples/rayleigh-taylor/GNUmakefile index bd18602c5..f928f86a6 100644 --- a/examples/rayleigh-taylor/GNUmakefile +++ b/examples/rayleigh-taylor/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/shock_water_cylinder/GNUmakefile b/examples/shock_water_cylinder/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/shock_water_cylinder/GNUmakefile +++ b/examples/shock_water_cylinder/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/spreading/GNUmakefile b/examples/spreading/GNUmakefile index d2be840a9..01b390664 100644 --- a/examples/spreading/GNUmakefile +++ b/examples/spreading/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/swirl_atomizer/GNUmakefile b/examples/swirl_atomizer/GNUmakefile new file mode 100644 index 000000000..d3c3c1851 --- /dev/null +++ b/examples/swirl_atomizer/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +USE_ODRPACK=FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/swirl_atomizer/README b/examples/swirl_atomizer/README new file mode 100644 index 000000000..e13540dfa --- /dev/null +++ b/examples/swirl_atomizer/README @@ -0,0 +1 @@ +This is an implementation of a two-phase pressure swirl atomizer. diff --git a/examples/swirl_atomizer/input b/examples/swirl_atomizer/input new file mode 100644 index 000000000..3d2151b27 --- /dev/null +++ b/examples/swirl_atomizer/input @@ -0,0 +1,39 @@ +# Parallelization +Partition : 8 1 1 + +# Domain definition +Lx : 5 +Ly : 5 +Lz : 5 +nx : 100 +ny : 100 +nz : 100 + +# Problem definition +Inner radius : 0.4 +Outer radius : 0.6 +Liquid velocity : 1 +Swirl ratio : 1 + +# Fluid properties - Dimensional case +Liquid dynamic viscosity : 1e-3 +Gas dynamic viscosity : 1e-5 +Liquid density : 1 +Gas density : 1e-3 +Surface tension coefficient : 1e-3 + +# Time integration +Max timestep size : 4e-3 +Max cfl number : 0.9 +Max time : 100 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-5 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 diff --git a/examples/swirl_atomizer/src/Make.package b/examples/swirl_atomizer/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/swirl_atomizer/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/swirl_atomizer/src/geometry.f90 b/examples/swirl_atomizer/src/geometry.f90 new file mode 100644 index 000000000..b247f2af5 --- /dev/null +++ b/examples/swirl_atomizer/src/geometry.f90 @@ -0,0 +1,73 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid and geometry definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='swirl_atomizer') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/swirl_atomizer/src/simulation.f90 b/examples/swirl_atomizer/src/simulation.f90 new file mode 100644 index 000000000..73e0ea519 --- /dev/null +++ b/examples/swirl_atomizer/src/simulation.f90 @@ -0,0 +1,515 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use surfmesh_class, only: surfmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + type(surfmesh), public :: smesh + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: SRmag + real(WP), dimension(:,:,:,:), allocatable :: SR + + !> Problem definition + real(WP) :: R1,R2 !< Inner and outer radii of annulus + real(WP) :: Ul,SW !< Liquid axial velocity and swirl ratio + +contains + + + !> Function that defines a level set function for an annular liquid region + function levelset_annulus(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G,r + r=sqrt(xyz(2)**2+xyz(3)**2) + G=min(r-R1,R2-r) + end function levelset_annulus + + + !> Function that localizes the top (x+) of the domain + function xp_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function xp_locator + + + !> Function that localizes the bottom (x-) of the domain boundary + function xm_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.le.pg%imin) isIn=.true. + end function xm_locator + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SRmag(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR (6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot,name='pressure_swirl') + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,r2p,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Set full domain to gas + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + vf%VF(i,j,k)=0.0_WP + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end do + end do + end do + ! Initialize an annular interface at the inlet only + call param_read('Inner radius',R1) + call param_read('Outer radius',R2) + if (vf%cfg%iproc.eq.1) then + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino,vf%cfg%imin-1 + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_annulus,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + end if + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use tpns_class, only: dirichlet,clipped_neumann + use ils_class, only: pcg_pfmg + integer :: i,j,k + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity' ,fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density' ,fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Inflow on the left of domain + call fs%add_bcond(name='inflow',type=dirichlet, face='x',dir=-1,canCorrect=.false.,locator=xm_locator) + ! Clipped Neumann outflow on the right of domain + call fs%add_bcond(name='bc_xp' ,type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=xp_locator) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + end block create_and_initialize_flow_solver + + + ! Initialize our velocity field + initialize_velocity: block + use tpns_class, only: bcond + type(bcond), pointer :: mybc + real(WP) :: r,theta + integer :: n,i,j,k + ! Zero initial field in the domain + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Read in inflow parameters + call param_read('Liquid velocity',Ul) + call param_read('Swirl ratio',SW) + ! Apply axial and swirl component Dirichlet at inlet + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + ! Set U velocity + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%U(i,j,k)=Ul + ! Set V velocity + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%y(j),cfg%zm(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%V(i,j,k)=+4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*cos(theta) + ! Set W velocity + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%ym(j),cfg%z(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%W(i,j,k)=-4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*sin(theta) + end do + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + + ! Create surfmesh object for interface polygon output + create_smesh: block + use irl_fortran_interface + integer :: i,j,k,nplane,np + ! Include an extra variable for number of planes + smesh=surfmesh(nvar=1,name='plic') + smesh%varname(1)='nplane' + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block create_smesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='swirl_atomizer') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('Pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_surface('vofplic',smesh) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(vf%SDint,'SD integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Calculate SR + ! call fs%get_strainrate(Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) + + ! ! Model shear thinning fluid + ! nonewt: block + ! integer :: i,j,k + ! real(WP), parameter :: C=1.137e-3_WP + ! real(WP), parameter :: n=0.3_WP + ! ! Update viscosity + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! ! Power law model + ! SRmag(i,j,k)=sqrt(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! SRmag(i,j,k)=max(SRmag(i,j,k),1000.0_WP**(1.0_WP/(n-1.0_WP))) + ! fs%visc_l(i,j,k)=C*SRmag(i,j,k)**(n-1.0_WP) + ! ! Carreau Model + ! ! SRmag(i,j,k)=sqrt(2.00_WP*SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! ! fs%visc_l(i,j,k)=visc_inf+(visc_0-visc_inf)*(1.00_WP+(lambda*SRmag(i,j,k))**2.00_WP)**((n-1.00_WP)/2.00_WP) + ! end do + ! end do + ! end do + ! ! call fs%cfg%sync(fs%visc_l) + ! end block nonewt + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + ! Update surfmesh object + update_smesh: block + use irl_fortran_interface + integer :: nplane,np,i,j,k + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block update_smesh + ! Perform ensight output + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + ! After we're done clip all VOF at the exit area and along the sides - hopefully nothing's left + clip_vof: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (i.ge.vf%cfg%imax-5) vf%VF(i,j,k)=0.0_WP + if (j.ge.vf%cfg%jmax-5) vf%VF(i,j,k)=0.0_WP + if (j.le.vf%cfg%jmin+5) vf%VF(i,j,k)=0.0_WP + if (k.ge.vf%cfg%kmax-5) vf%VF(i,j,k)=0.0_WP + if (k.le.vf%cfg%kmin+5) vf%VF(i,j,k)=0.0_WP + end do + end do + end do + end block clip_vof + + end do + + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,SR,SRmag) + + end subroutine simulation_final + + +end module simulation diff --git a/examples/vdjet/GNUmakefile b/examples/vdjet/GNUmakefile index f467f9676..7f4563ac0 100644 --- a/examples/vdjet/GNUmakefile +++ b/examples/vdjet/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Repositories/Builds/hypre -IRL_DIR = /Users/desjardi/Repositories/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/vortexTG/GNUmakefile b/examples/vortexTG/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/vortexTG/GNUmakefile +++ b/examples/vortexTG/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/water_air_rarefaction/GNUmakefile b/examples/water_air_rarefaction/GNUmakefile index bef49b8f7..466227c85 100644 --- a/examples/water_air_rarefaction/GNUmakefile +++ b/examples/water_air_rarefaction/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/zalesak/GNUmakefile b/examples/zalesak/GNUmakefile index 13301e748..26c33af3b 100644 --- a/examples/zalesak/GNUmakefile +++ b/examples/zalesak/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /opt/homebrew -IRL_DIR = /Users/desjardi/Repositories/Builds/irl +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/src/config/config_class.f90 b/src/config/config_class.f90 index cb0f9c1af..bdac6b0bf 100644 --- a/src/config/config_class.f90 +++ b/src/config/config_class.f90 @@ -19,11 +19,13 @@ module config_class ! Geometry real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction info (VF=1 is fluid, VF=0 is wall) + real(WP) :: fluid_vol !< Total fluid volume in the config contains procedure :: print=>config_print !< Output configuration information to the screen procedure :: write=>config_write !< Write out config files: grid and geometry procedure, private :: prep=>config_prep !< Finish preparing config after the partitioned grid is loaded + procedure :: calc_fluid_vol !< Compute fluid_vol after VF has been set procedure :: VF_extend !< Extend VF array into the non-periodic domain overlaps procedure :: integrate !< Integrate a variable on config while accounting for VF procedure :: set_scalar !< Subroutine that extrapolates a provided scalar value at a point to a pgrid field @@ -88,6 +90,8 @@ function construct_from_file(grp,decomp,no,fgrid,fgeom) result(self) call geomfile%pullvar('VF',self%VF) ! Perform an extension in the overlap call self%VF_extend() + ! Update fluid_vol + call self%calc_fluid_vol() end block read_VF end function construct_from_file @@ -127,6 +131,7 @@ subroutine config_prep(this) ! Allocate wall geometry - assume all fluid until told otherwise allocate(this%VF(this%imino_:this%imaxo_,this%jmino_:this%jmaxo_,this%kmino_:this%kmaxo_)); this%VF=1.0_WP + this%fluid_vol=this%vol_total end subroutine config_prep @@ -171,6 +176,26 @@ subroutine VF_extend(this) end if end subroutine VF_extend + + !> Calculate the total fluid volume by integrating VF + subroutine calc_fluid_vol(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(config), intent(inout) :: this + integer :: i,j,k,ierr + real(WP) :: buf + buf=0.0_WP + do k=this%kmin_,this%kmax_ + do j=this%jmin_,this%jmax_ + do i=this%imin_,this%imax_ + buf=buf+this%vol(i,j,k)*this%VF(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(buf,this%fluid_vol,1,MPI_REAL_WP,MPI_SUM,this%comm,ierr) + end subroutine calc_fluid_vol + !> Calculate the integral of a field on the config while accounting for VF subroutine integrate(this,A,integral) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index c09848812..f835f2de1 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -1724,28 +1724,14 @@ end subroutine correct_mfr !> Shift pressure to ensure zero average subroutine shift_p(this,pressure) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP implicit none class(incomp), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index 484f033e7..a7a877d17 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -5,7 +5,7 @@ module scalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -59,7 +59,7 @@ module scalar_class real(WP), dimension(:,:,:), allocatable :: SCold !< SCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -74,7 +74,7 @@ module scalar_class real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity ! Bquick requires additional storage - real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup + real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup real(WP), dimension(:,:,:,:), allocatable :: bitp_xm,bitp_ym,bitp_zm !< Minus interpolation for SC - backup ! Masking info for metric modification @@ -91,8 +91,8 @@ module scalar_class procedure :: apply_bcond !< Apply all boundary conditions procedure :: init_metrics !< Initialize metrics procedure :: adjust_metrics !< Adjust metrics - procedure :: metric_reset !< Reset adaptive metrics like bquick - procedure :: metric_adjust !< Adjust adaptive metrics like bquick + procedure :: metric_reset !< Reset adaptive metrics like bquick + procedure :: metric_adjust !< Adjust adaptive metrics like bquick procedure :: get_drhoSCdt !< Calculate drhoSC/dt procedure :: get_max !< Calculate maximum field values procedure :: get_int !< Calculate integral field values @@ -136,13 +136,13 @@ function constructor(cfg,scheme,name) result(self) ! Prepare advection scheme self%scheme=scheme select case (self%scheme) - case (upwind) - ! Check current overlap - if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=1 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (upwind) + ! Check current overlap + if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=1 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (quick) ! Check current overlap if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') @@ -150,20 +150,17 @@ function constructor(cfg,scheme,name) result(self) self%nst=3 self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 - case (bquick) - ! Check current overlap - if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=3 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (bquick) + ! Check current overlap + if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=3 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case default call die('[scalar constructor] Unknown scalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -224,10 +221,10 @@ subroutine init_metrics(this) allocate(this%itp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered ! Create scalar interpolation coefficients to cell faces select case (this%scheme) - case (upwind) - this%itp_xp=1.0_WP; this%itp_xm=1.0_WP - this%itp_yp=1.0_WP; this%itp_ym=1.0_WP - this%itp_zp=1.0_WP; this%itp_zm=1.0_WP + case (upwind) + this%itp_xp=1.0_WP; this%itp_xm=1.0_WP + this%itp_yp=1.0_WP; this%itp_ym=1.0_WP + this%itp_zp=1.0_WP; this%itp_zm=1.0_WP case (quick,bquick) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -382,42 +379,50 @@ end subroutine adjust_metrics !> Finish setting up the scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) + subroutine setup(this,implicit_solver) implicit none class(scalar), intent(inout) :: this - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st ! Adjust metrics based on mask array call this%adjust_metrics() ! Bquick needs to remember the quick coefficients - select case (this%scheme) + select case (this%scheme) case (bquick) - allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp - allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm - allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp - allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym - allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp - allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm + allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp + allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm + allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp + allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym + allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp + allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm end select - - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -705,53 +710,53 @@ subroutine metric_reset(this) this%itp_zm=this%bitp_zm end select end subroutine metric_reset - - + + !> Adjust adaptive metrics like bquick subroutine metric_adjust(this,SC,SCmin,SCmax) - implicit none - class(scalar), intent(inout) :: this + implicit none + class(scalar), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SC !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), optional :: SCmin - real(WP), optional :: SCmax - integer :: i,j,k - select case (this%scheme) - case (bquick) - if (present(SCmin)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).lt.SCmin) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + real(WP), optional :: SCmin + real(WP), optional :: SCmax + integer :: i,j,k + select case (this%scheme) + case (bquick) + if (present(SCmin)) then + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).lt.SCmin) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if + end if + end do + end do + end do + end if if (present(SCmax)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).gt.SCmax) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if - end select + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).gt.SCmax) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if + end do + end do + end do + end if + end select end subroutine metric_adjust - + !> Print out info for scalar solver subroutine scalar_print(this) diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 59574be83..148978cc5 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -253,7 +253,6 @@ subroutine pgrid_domain_decomp(self,strat) use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none class(pgrid), intent(inout) :: self - integer, intent(in), optional :: strat integer :: strat_,ierr,q,r type(MPI_Comm) :: tmp_comm integer, parameter :: ndims=3 diff --git a/src/libraries/precision.mod b/src/libraries/precision.mod new file mode 100644 index 0000000000000000000000000000000000000000..575582711d32a4fc04a849d2e7c82e516daa9199 GIT binary patch literal 364 zcmV-y0h9h8iwFP!000006V;VjZ-PJ&fZz95%-g_&W`X5;D>2lN>SB<#kH*N-ka!jC z@$K1BakwJ0h%@ml3*OBVFLI3j>nI@7x6UY z=~0~|@!+74XgnE3gDCAygNG0((B{9@mZ5aPs!#Gh=rW*MuWSY}pQeFytdXD1(ZgEO z^mb<}Qk__U1?vh1Q(`cQ;dKQ=oedjsHGiKK>%Djq{;urYtGAq|Pgqm5$Aluagfz K?-op62LJ$(^sEU0 literal 0 HcmV?d00001 diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index be74f5991..de482fec8 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -348,279 +348,279 @@ function constructor(cfg,name) result(self) end function constructor - !> Resolve collisional interaction between particles + !> Resolve collisional interaction between particles, walls, and an optional IB level set !> Requires tau_col, e_n, e_w and mu_f to be set beforehand subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Gib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nxib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nyib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nzib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - - ! Check if all IB parameters are present - check_G: block - use messager, only: die - if (present(Gib).and.(.not.present(Nxib).or..not.present(Nyib).or..not.present(Nzib))) & - call die('[lpt collide] IB collisions need Gib, Nxib, Nyib, AND Nzib') - end block check_G - - ! Start by zeroing out the collision force - zero_force: block - integer :: i - do i=1,this%np_ - this%p(i)%Acol=0.0_WP - this%p(i)%Tcol=0.0_WP - end do - end block zero_force - - ! Then share particles across overlap - call this%share() - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - - ! Finally, calculate collision force - collision_force: block - use mpi_f08 - use mathtools, only: Pi,normalize,cross_product - integer :: i1,i2,ii,jj,kk,nn,ierr - real(WP) :: d1,m1,d2,m2,d12,m12,buf - real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t - real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv - real(WP), parameter :: aclipnorm=1.0e-6_WP - real(WP), parameter :: acliptan=1.0e-9_WP - real(WP), parameter :: rcliptan=0.05_WP - - ! Reset collision counter - this%ncol=0 - - ! Precompute coefficients for k and eta - k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 - eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col - k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 - eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col - - ! Loop over all local particles - collision: do i1=1,this%np_ - - ! Cycle if id<=0 - if (this%p(i1)%id.le.0) cycle collision - - ! Store particle data - r1=this%p(i1)%pos - v1=this%p(i1)%vel - w1=this%p(i1)%angVel - d1=this%p(i1)%d - m1=this%rho*Pi/6.0_WP*d1**3 - - ! First collide with walls - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') - n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) - n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1*k_coeff_w - eta_n=m1*eta_coeff_w - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt/d1.gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - end if - - ! Collide with IB - if (present(Gib)) then - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Gib,bc='n') - n12(1)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nxib,bc='n') - n12(2)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nyib,bc='n') - n12(3)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nzib,bc='n') - buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) - n12 = -n12/buf - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1*k_coeff_w - eta_n=m1*eta_coeff_w - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt/d1.gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - end if - end if - - ! Loop over nearest cells - do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 - do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 - do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - v2=this%p(i2)%vel - w2=this%p(i2)%angVel - d2=this%p(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - v2=this%g(i2)%vel - w2=this%g(i2)%angVel - d2=this%g(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - end if - - ! Compute relative information - d12=norm2(r1-r2) - if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision - n12=(r2-r1)/d12 - v12=v1-v2 - rnv=dot_product(v12,n12) - r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) - delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - m12=m1*m2/(m1+m2) - k_n=m12*k_coeff - eta_n=m12*eta_coeff - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - ! Add up the collisions - this%ncol=this%ncol+1 - end if - - end do - - end do - end do - end do - - ! Deal with dimensionality - if (this%cfg%nx.eq.1) then - this%p(i1)%Acol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%ny.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Acol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%nz.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Acol(3)=0.0_WP - end if - - end do collision - - ! Determine total number of collisions - call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 - - end block collision_force - - end subroutine collide - + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Gib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nxib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nyib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nzib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + + ! Check if all IB parameters are present + check_G: block + use messager, only: die + if (present(Gib).and.(.not.present(Nxib).or..not.present(Nyib).or..not.present(Nzib))) & + call die('[lpt collide] IB collisions need Gib, Nxib, Nyib, AND Nzib') + end block check_G + + ! Start by zeroing out the collision force + zero_force: block + integer :: i + do i=1,this%np_ + this%p(i)%Acol=0.0_WP + this%p(i)%Tcol=0.0_WP + end do + end block zero_force + + ! Then share particles across overlap + call this%share() + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i + end do + + end block pic_prep + + ! Finally, calculate collision force + collision_force: block + use mpi_f08 + use mathtools, only: Pi,normalize,cross_product + integer :: i1,i2,ii,jj,kk,nn,ierr + real(WP) :: d1,m1,d2,m2,d12,m12,buf + real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t + real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv + real(WP), parameter :: aclipnorm=1.0e-6_WP + real(WP), parameter :: acliptan=1.0e-9_WP + real(WP), parameter :: rcliptan=0.05_WP + + ! Reset collision counter + this%ncol=0 + + ! Precompute coefficients for k and eta + k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 + eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col + k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 + eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col + + ! Loop over all local particles + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision + + ! Store particle data + r1=this%p(i1)%pos + v1=this%p(i1)%vel + w1=this%p(i1)%angVel + d1=this%p(i1)%d + m1=this%rho*Pi/6.0_WP*d1**3 + + ! First collide with walls + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') + n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) + n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + + ! Collide with IB + if (present(Gib)) then + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Gib,bc='n') + n12(1)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nxib,bc='n') + n12(2)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nyib,bc='n') + n12(3)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nzib,bc='n') + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + n12 = -n12/buf + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + end if + + ! Loop over nearest cells + do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 + do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 + do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + v2=this%p(i2)%vel + w2=this%p(i2)%angVel + d2=this%p(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + v2=this%g(i2)%vel + w2=this%g(i2)%angVel + d2=this%g(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + end if + + ! Compute relative information + d12=norm2(r1-r2) + if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision + n12=(r2-r1)/d12 + v12=v1-v2 + rnv=dot_product(v12,n12) + r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) + delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + m12=m1*m2/(m1+m2) + k_n=m12*k_coeff + eta_n=m12*eta_coeff + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + ! Add up the collisions + this%ncol=this%ncol+1 + end if + + end do + + end do + end do + end do + + ! Deal with dimensionality + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if + + end do collision + + ! Determine total number of collisions + call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 + + end block collision_force + + end subroutine collide + !> Advance the particle equations by a specified time step dt !> p%id=0 => no coll, no solve @@ -650,7 +650,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo) :: sx,sy,sz + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz type(part) :: myp,pold ! Zero out source term arrays @@ -661,19 +661,19 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Get fluid stress if (present(stress_x)) then - sx=stress_x + sx=stress_x else - sx=0.0_WP + sx=0.0_WP end if if (present(stress_y)) then - sy=stress_y + sy=stress_y else - sy=0.0_WP + sy=0.0_WP end if if (present(stress_z)) then - sz=stress_z + sz=stress_z else - sz=0.0_WP + sz=0.0_WP end if ! Zero out number of particles removed @@ -877,7 +877,7 @@ subroutine update_VF(this) ! Transfer particle volume do i=1,this%np_ ! Skip inactive particle - if (this%p(i)%flag.eq.1 .or. this%p(i)%id.eq.0) cycle + if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle ! Transfer particle volume Vp=Pi/6.0_WP*this%p(i)%d**3 call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') @@ -1306,8 +1306,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(vol_total,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); vol_total=buf - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -1320,7 +1319,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/src/solver/Make.package b/src/solver/Make.package index 1a8b68d18..0df50134e 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -3,7 +3,7 @@ ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 endif ifeq ($(USE_FFTW),TRUE) - f90EXE_sources += pfft3d_class.f90 + f90EXE_sources += fourier3d_class.f90 endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index f8b7b9975..7f3a8b58d 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -1,1201 +1,1190 @@ !> Direct diagonal solvers defined here module diag_class - use precision, only: WP - use config_class, only: config - use string, only: str_medium - implicit none - private - - ! Expose type/constructor/methods - public :: diag - - !> diag object definition - type :: diag - ! Diagonalr solver works for a config - type(config), pointer :: cfg !< Config for the diag solver - character(len=str_medium) :: name !< Name of solver - integer :: ndiags !< Number of diagonals - real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays - real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays - real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays - + use precision, only: WP + use config_class, only: config + use string, only: str_medium + implicit none + private + + ! Expose type/constructor/methods + public :: diag + + !> diag object definition + type :: diag + ! Diagonal solver works for a config + type(config), pointer :: cfg !< Config for the diag solver + character(len=str_medium) :: name !< Name of solver + integer :: ndiags !< Number of diagonals + real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays + real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays + real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays contains - procedure :: linsol_x !< Linear solver in x - procedure :: linsol_y !< Linear solver in y - procedure :: linsol_z !< Linear solver in z - procedure :: tridiagonal - procedure :: pentadiagonal - procedure :: polydiagonal - final :: destructor !< Destructor for diag - end type diag - - !> Declare diag constructor - interface diag - procedure diag_from_args - end interface diag - + procedure :: linsol_x !< Linear solver in x + procedure :: linsol_y !< Linear solver in y + procedure :: linsol_z !< Linear solver in z + procedure :: tridiagonal + procedure :: pentadiagonal + procedure :: polydiagonal + final :: destructor !< Destructor for diag + end type diag + + !> Declare diag constructor + interface diag + procedure diag_from_args + end interface diag + contains - - !> Destructor for diag object - subroutine destructor(this) - implicit none - type(diag) :: this - if (allocated(this%Ax)) deallocate(this%Ax) - if (allocated(this%Ay)) deallocate(this%Ay) - if (allocated(this%Az)) deallocate(this%Az) - if (allocated(this%Rx)) deallocate(this%Rx) - if (allocated(this%Ry)) deallocate(this%Ry) - if (allocated(this%Rz)) deallocate(this%Rz) - if (allocated(this%stackmem)) deallocate(this%stackmem) - end subroutine destructor - - - !> Constructor for a diag object - function diag_from_args(cfg,name,n) result(self) - use messager, only: die - implicit none - type(diag) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - integer, intent(in) :: n - integer :: nst - - ! Link the config and store the name - self%cfg=>cfg - self%name=trim(adjustl(name)) - - ! Number of diagonals and stencil size - self%ndiags=n - nst=(n-1)/2 - - ! Allocate arrays - allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) - allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) - allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) - allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) - allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) - allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) - - end function diag_from_args - - - ! Real solver in x - subroutine linsol_x(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,& - -(this%ndiags-1)/2),this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) - end select - - return - end subroutine linsol_x - - - ! Real solver in y - subroutine linsol_y(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,& - -(this%ndiags-1)/2),this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) - end select - - return - end subroutine linsol_y - - - ! Real solver in z - subroutine linsol_z(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,& - -(this%ndiags-1)/2),this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) - end select - - return - end subroutine linsol_z - - - subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER - real(WP), dimension(lot,n) :: B ! DIAGONAL - real(WP), dimension(lot,n) :: C ! UPPER - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot) :: r1 - real(WP), dimension(lot) :: r2 - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:), allocatable :: sendbuf - real(WP), dimension(:,:,:), allocatable :: recvbuf1 - real(WP), dimension(:,:), allocatable :: recvbuf2 - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 - ! Stuff - integer :: i,igroup - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call tridiagonal_serial(A,B,C,R,n,lot) - else - call tridiagonal_periodic_serial(A,B,C,R,n,lot) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot*12*proc)) - allocate(recvbuf1(nlot,6,2*proc)) - allocate(recvbuf2(nlot,2*proc)) - - ! Initialize boundary values - s1(:,1) = a(:,1) - s2(:,n) = c(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(i) - do i=2,n - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - s1(:,i) = -s1(:,i-1)*const(:) - end do - - ! Backward elimination - ! Lower boundary in s2(i) - do i=n-1,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) - s2(:,i) = -s2(:,i+1)*const(:) - end do - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced pentadiagonal system - ! Use of pentadiagonal system is more robust than the - ! reordered (removes zeros) tridiagonal system - - ! Send rows of pentadiagonal system - ! (0, s1, b, 0, s2; r) - ! (s1, 0, b, s2, 0; r) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = ngroup(igroup) - - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) - - ! Clear unused values - nk = ngroup(nrank+1) - recvbuf1(nk+1:nlot, :, :) = 0.0_WP - recvbuf1(nk+1:nlot, 3, :) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - ! Store in buf to avoid creating a temporary array (there must be a better way to do this) - allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) - buf1=recvbuf1(:,1,2:2*proc-1) - buf2=recvbuf1(:,2,2:2*proc-1) - buf3=recvbuf1(:,3,2:2*proc-1) - buf4=recvbuf1(:,4,2:2*proc-1) - buf5=recvbuf1(:,5,2:2*proc-1) - buf6=recvbuf1(:,6,2:2*proc-1) - call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) - recvbuf1(:,1,2:2*proc-1)=buf1 - recvbuf1(:,2,2:2*proc-1)=buf2 - recvbuf1(:,3,2:2*proc-1)=buf3 - recvbuf1(:,4,2:2*proc-1)=buf4 - recvbuf1(:,5,2:2*proc-1)=buf5 - recvbuf1(:,6,2:2*proc-1)=buf6 - deallocate(buf1,buf2,buf3,buf4,buf5,buf6) - else - allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) - buf1=recvbuf1(:,1,:) - buf2=recvbuf1(:,2,:) - buf3=recvbuf1(:,3,:) - buf4=recvbuf1(:,4,:) - buf5=recvbuf1(:,5,:) - buf6=recvbuf1(:,6,:) - call pentadiagonal_periodic_serial(buf1,buf2,buf3,buf4,buf5,buf6,& - 2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) - recvbuf1(:,1,:)=buf1 - recvbuf1(:,2,:)=buf2 - recvbuf1(:,3,:)=buf3 - recvbuf1(:,4,:)=buf4 - recvbuf1(:,5,:)=buf5 - recvbuf1(:,6,:)=buf6 - deallocate(buf1,buf2,buf3,buf4,buf5,buf6) - end if - - ! Move solution to first slot - do i=1,2*proc - recvbuf2(:,i) = recvbuf1(:,6,i) - end do - - ! Permute the order - do i=1,proc-1 - const(1:nlot) = recvbuf2(:,2*i) - recvbuf2(:,2*i) = recvbuf2(:,2*i+1) - recvbuf2(:,2*i+1) = const(1:nlot) - end do - - ! If periodic, don't forget the end points - if (nper) then - const(1:nlot) = recvbuf2(:,1) - recvbuf2(:,1) = recvbuf2(:,2*proc) - recvbuf2(:,2*proc) = const(1:nlot) - end if - - ! Scatter back the solution - call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - do i=1,n - r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) - end do - - deallocate(sendbuf) - deallocate(recvbuf2) - deallocate(recvbuf1) - deallocate(ngroup) - - return - end subroutine tridiagonal - - - !> TriDiagonal Solver - Serial Case - Periodic - subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - r = r/(a + b + c) - return - else if (n .eq. 2) then - ! Solve 2x2 system - c(:,1) = c(:,1) + a(:,1) - a(:,2) = a(:,2) + c(:,2) - const(:) = a(:,2)/b(:,1) - b(:,2) = b(:,2) - c(:,1)*const(:) - r(:,2) = r(:,2) - r(:,1)*const(:) - r(:,2) = r(:,2)/b(:,2) - r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) - return - end if - - ! Forward elimination - do i=2,n-2 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - ! Boundary is stored in a(i) - a(:,i) = -a(:,i-1)*const(:) - end do - i=n-1 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = c(:,i) - a(:,i-1)*const(:) - i=n - const(:) = a(:,i)/b(:,i-1) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = b(:,i) - a(:,i-1)*const(:) - - ! Backward elimination - do i=n-2,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - a(:,i) = a(:,i) - a(:,i+1)*const(:) - end do - - ! Eliminate oddball - const(:) = c(:,n)/b(:,1) - r(:,n) = r(:,n) - r(:,1)*const(:) - a(:,n) = a(:,n) - a(:,1)*const(:) - - ! Backward substitution - r(:,n) = r(:,n)/a(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) - end do - - return - end subroutine tridiagonal_periodic_serial - - - !> TriDiagonal Solver - Serial Case - Not Periodic - subroutine tridiagonal_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - ! Forward elimination - do i=2,n - const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - end do - - ! Back-substitution - r(:,n) = r(:,n)/b(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine tridiagonal_serial - - subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot,2) :: r1 - real(WP), dimension(lot,2) :: r2 - real(WP), dimension(lot,n,2) :: s1 - real(WP), dimension(lot,n,2) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:,:), allocatable :: sendbuf - real(WP), dimension(:,:), allocatable :: recvbuf - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:,:), allocatable :: AA - real(WP), dimension(:,:), allocatable :: swap - - ! Stuff - integer :: i,igroup,j,k,m - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call pentadiagonal_serial(A,B,C,D,E,R,n,lot) - else - call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot,24*proc)) - allocate(recvbuf(nlot,24*proc)) - - if (n > 1) then ! do normal stuff - - ! Initialize boundary values - s1(:,1,1) = a(:,1) - s1(:,1,2) = b(:,1) - s1(:,2,1) = 0.0_WP - s1(:,2,2) = a(:,2) - s2(:,n-1,1) = e(:,n-1) - s2(:,n-1,2) = 0.0_WP - s2(:,n,1) = d(:,n) - s2(:,n,2) = e(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(:,i,1:2) - do i=1,n-2 - ! Eliminate a(i+2) - const(:) = a(:,i+2)/c(:,i) - b(:,i+2) = b(:,i+2) - d(:,i)*const(:) - c(:,i+2) = c(:,i+2) - e(:,i)*const(:) - r(:,i+2) = r(:,i+2) - r(:,i)*const(:) - s1(:,i+2,1) = -s1(:,i,1)*const(:) - s1(:,i+2,2) = -s1(:,i,2)*const(:) - - ! Eliminate b(i+1) - const(:) = b(:,i+1)/c(:,i) - c(:,i+1) = c(:,i+1) - d(:,i)*const(:) - d(:,i+1) = d(:,i+1) - e(:,i)*const(:) - r(:,i+1) = r(:,i+1) - r(:,i)*const(:) - s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) - s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) - end do - ! Eliminate b(n) - const(:) = b(:,n)/c(:,n-1) - c(:,n) = c(:,n) - d(:,n-1)*const(:) - r(:,n) = r(:,n) - r(:,n-1)*const(:) - s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) - s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) - s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) - - ! Backward elimination - ! Lower boundary in s2(:,i,1:2) - do i=n,3,-1 - ! Eliminate e(i-2) - const(:) = e(:,i-2)/c(:,i) - r(:,i-2) = r(:,i-2) - r(:,i)*const(:) - s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) - s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) - s2(:,i-2,1) = -s2(:,i,1)*const(:) - s2(:,i-2,2) = -s2(:,i,2)*const(:) - - ! Eliminate d(i-1) - const(:) = d(:,i-1)/c(:,i) - r(:,i-1) = r(:,i-1) - r(:,i)*const(:) - s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) - s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) - s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) - s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) - end do - ! Eliminate d(1) - const(:) = d(:,1)/c(:,2) - r(:,1) = r(:,1) - r(:,2)*const(:) - s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) - s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) - s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) - s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) - - end if ! n > 1 - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced 11-diagonal system - ! Use of 11-diagonal system is more robust than the - ! reordered (removes zeros) 7-diagonal system - - ! Send rows of 11-diagonal system - ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) - ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) - ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) - ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) - ! For efficiency, only send non-zero elements - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - if (n > 1) then ! do normal stuff - - do i=1,2 - sendbuf(1:nk, L+0) = c(k1:k2, i) - sendbuf(1:nk, L+1) = r(k1:k2, i) - sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) - sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - sendbuf(1:nk, L+0) = s1(k1:k2, i,j) - sendbuf(1:nk, L+1) = s2(k1:k2, i,j) - sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) - sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) - L = L + 4 - end do - end do - - else ! n == 1 special case - - sendbuf(1:nk, L+0) = c(k1:k2, 1) - sendbuf(1:nk, L+1) = r(k1:k2, 1) - sendbuf(1:nk, L+2) = 1.0_WP - sendbuf(1:nk, L+3) = 0.0_WP - sendbuf(1:nk, L+4) = 1.0_WP - sendbuf(1:nk, L+5) = 0.0_WP - sendbuf(1:nk, L+6) = c(k1:k2, 1) - sendbuf(1:nk, L+7) = r(k1:k2, 1) - sendbuf(1:nk, L+8) = a(k1:k2, 1) - sendbuf(1:nk, L+9) = d(k1:k2, 1) - sendbuf(1:nk, L+10) = 0.0_WP - sendbuf(1:nk, L+11) = 0.0_WP - sendbuf(1:nk, L+12) = b(k1:k2, 1) - sendbuf(1:nk, L+13) = e(k1:k2, 1) - sendbuf(1:nk, L+14) = -1.0_WP - sendbuf(1:nk, L+15) = 0.0_WP - sendbuf(1:nk, L+16) = 0.0_WP - sendbuf(1:nk, L+17) = -1.0_WP - sendbuf(1:nk, L+18) = a(k1:k2, 1) - sendbuf(1:nk, L+19) = d(k1:k2, 1) - sendbuf(1:nk, L+20) = 0.0_WP - sendbuf(1:nk, L+21) = 0.0_WP - sendbuf(1:nk, L+22) = b(k1:k2, 1) - sendbuf(1:nk, L+23) = e(k1:k2, 1) - L = L + 24 - - end if - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) - - ! Build reduced matrix - allocate(AA(nlot, 4*proc, -5:5 + 1)) - AA = 0.0_WP - L = 1 - do k=1,proc - m = 4*(k-1) - - do i=1,2 - AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) - AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) - AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) - AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) - AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) - AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) - AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) - L = L + 4 - end do - end do - - end do - - ! Clear unused values - nk = ngroup(nrank+1) - AA(nk+1:nlot, :, :) = 0.0_WP - AA(nk+1:nlot, :, 0) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) - else - if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' - call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) - end if - - ! Move solution to beginning of recvbuf - recvbuf(:, 1:4*proc) = AA(:, :, 6) - deallocate(AA) - - ! Permute the order - allocate (swap(nlot,2)) - do i=1,proc-1 - swap(:,:) = recvbuf(:, 4*i-1:4*i) - recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) - recvbuf(:, 4*i+1:4*i+2) = swap(:,:) - end do - ! If periodic, don't forget the end points - if (nper) then - swap(:,:) = recvbuf(:, 4*proc-1:4*proc) - recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) - recvbuf(:, 1:2) = swap(:,:) - end if - deallocate (swap) - - ! Scatter back the solution - deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) - call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) - r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) - L = L + 4 - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - if (n > 1) then ! do normal stuff - - do j=1,2 - do i=1,n - r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) - end do - end do - r = r / c - - else ! n == 1 special case - - r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & - -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) - - end if - - deallocate(sendbuf) - deallocate(recvbuf) - deallocate(ngroup) - - return - end subroutine pentadiagonal - - - ! ================================================= ! - ! PentaDiagonal Solver - Serial Case - Not periodic ! - ! ================================================= ! - subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,1) = R(:,1)/C(:,1) - return - else if (n .eq. 2) then - ! Solve 2x2 system - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - end if - - ! Forward elimination - do i=1,n-2 - ! Eliminate A(2,i+1) - const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - - ! Eliminate A(1,i+2) - const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - end do - ! Eliminate A(2,n) - const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) - C(:,n) = C(:,n) - D(:,n-1)*const(:) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - - ! Back-substitution - R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) - R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine pentadiagonal_serial - - - - ! ============================================= ! - ! PentaDiagonal Solver - Serial Case - Periodic ! - ! ============================================= ! - subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) - return - else if (n .eq. 2) then - ! Solve 2x2 system - C(:,:) = C(:,:) + A(:,:) + E(:,:) - D(:,1) = D(:,1) + B(:,1) - B(:,2) = B(:,2) + D(:,2) - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - else if (n .eq. 3) then - B(:,:) = B(:,:) + E(:,:) - D(:,:) = D(:,:) + A(:,:) - call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) - return - else if (n .eq. 4) then - A(:,:) = A(:,:) + E(:,:) - E(:,:) = 0.0_WP - end if - - ! Initialize boundary data - s1 = 0.0_WP - s1(:,1) = A(:,1) - s1(:,n-3) = s1(:,n-3) + E(:,n-3) - s1(:,n-2) = D(:,n-2) - s1(:,n-1) = C(:,n-1) - s1(:,n) = B(:,n) - s2 = 0.0_WP - s2(:,1) = B(:,1) - s2(:,2) = A(:,2) - s2(:,n-2) = s2(:,n-2) + E(:,n-2) - s2(:,n-1) = D(:,n-1) - s2(:,n) = C(:,n) - - ! Forward elimination - do i=1,n-2 - ! Eliminate b(i+1) - const(:) = B(:,i+1)/C(:,i) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) - s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) - - ! Eliminate a(i+2) - const(:) = A(:,i+2)/C(:,i) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) - s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) - end do - - ! Backward elimination - do i=n-2,3,-1 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate e(i-2) - const(:) = E(:,i-2)/C(:,i) - R(:,i-2) = R(:,i-2) - R(:,i)*const(:) - s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) - s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) - end do - i=2 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate oddball region - const(:) = E(:,n-1)/C(:,1) - R(:,n-1) = R(:,n-1) - R(:,1)*const(:) - s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) - s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) - - const(:) = D(:,n)/C(:,1) - R(:,n) = R(:,n) - R(:,1)*const(:) - s1(:,n) = s1(:,n) - s1(:,1)*const(:) - s2(:,n) = s2(:,n) - s2(:,1)*const(:) - - const(:) = E(:,n)/C(:,2) - R(:,n) = R(:,n) - R(:,2)*const(:) - s1(:,n) = s1(:,n) - s1(:,2)*const(:) - s2(:,n) = s2(:,n) - s2(:,2)*const(:) - - ! Eliminate corner region - const(:) = s1(:,n)/s1(:,n-1) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) - - R(:,n) = R(:,n)/s2(:,n) - R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) - end do - - return - end subroutine pentadiagonal_periodic_serial - - - subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) - implicit none - class(diag), intent(inout) :: this - character(len=*), intent(in) :: dir - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - integer :: proc - logical :: nper - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc.eq.1) then - if (.not.nper) then - call polydiagonal_serial(nd,A,R,n,lot) - else - call polydiagonal_periodic_serial(nd,A,R,n,lot,b) - end if - return - else - stop 'polydiagonal: Implemented only in serial.' - end if - - return - end subroutine polydiagonal - - - subroutine polydiagonal_serial(nd,A,R,n,lot) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k - - ! Forward elimination - do i=1,n-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,n-i) - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,min(nd,n-i) - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Back-substitution - do i=n,1,-1 - do j=1,min(nd,n-i) - R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_serial - - - subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k,i0 - - if (n.eq.1) then - const(:) = 0.0_WP - do j=-nd,nd - const(:) = const(:) + A(:,j,1) - end do - R(:,1) = R(:,1) / const(:) - return - end if - - ! Setup bridge array - do j=1,nd - do i=1,n - b(:,i,j) = 0.0_WP - end do - end do - do i=1,nd - do j=i,nd - b(:,i,j) = A(:,i,-nd+j-i) - b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) - end do - end do - do i=n-nd+1,n - do j=1,nd - b(:,i,j) = A(:,i,-nd+j-(i-n)) - end do - end do - - ! Forward elimination - do i=1,n-nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,nd - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,nd - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Backward elimination - do i=n-nd,1,-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,i-1) - const(:) = A(:,i-j,j)*pivot(:) - do k=1,nd - b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) - end do - R(:,i-j) = R(:,i-j) - R(:,i)*const(:) - end do - end do - - ! Eliminate oddball region - do i=1,nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=i,nd - const(:) = A(:,n-j+i,j)*pivot(:) - do k=1,nd - b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) - end do - R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) - end do - end do - - ! Elimination for corner matrix - i0 = n-nd - do i=1,nd-1 - pivot(:) = 1.0_WP/b(:,i+i0,i) - do j=i+1,nd - const(:) = b(:,j+i0,i)*pivot(:) - do k=i+1,nd - b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) - end do - R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) - end do - end do - - ! Back-substitution for corner matrix - i0 = n-nd - do i=nd,1,-1 - do j=i+1,nd - R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) - end do - R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) - end do - - ! Back-substitution for bridge - do i=n-nd,1,-1 - do j=1,nd - R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_periodic_serial - - + + !> Destructor for diag object + subroutine destructor(this) + implicit none + type(diag) :: this + if (allocated(this%Ax)) deallocate(this%Ax) + if (allocated(this%Ay)) deallocate(this%Ay) + if (allocated(this%Az)) deallocate(this%Az) + if (allocated(this%Rx)) deallocate(this%Rx) + if (allocated(this%Ry)) deallocate(this%Ry) + if (allocated(this%Rz)) deallocate(this%Rz) + if (allocated(this%stackmem)) deallocate(this%stackmem) + end subroutine destructor + + + !> Constructor for a diag object + function diag_from_args(cfg,name,n) result(self) + use messager, only: die + implicit none + type(diag) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: n + integer :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Number of diagonals and stencil size + self%ndiags=n + nst=(n-1)/2 + + ! Allocate arrays + allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) + allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) + allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) + allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) + allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) + allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) + + end function diag_from_args + + + ! Real solver in x + subroutine linsol_x(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-(this%ndiags-1)/2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) + end select + + end subroutine linsol_x + + + ! Real solver in y + subroutine linsol_y(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-(this%ndiags-1)/2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) + end select + + end subroutine linsol_y + + + ! Real solver in z + subroutine linsol_z(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-(this%ndiags-1)/2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) + end select + + end subroutine linsol_z + + + subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER + real(WP), dimension(lot,n) :: B ! DIAGONAL + real(WP), dimension(lot,n) :: C ! UPPER + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot) :: r1 + real(WP), dimension(lot) :: r2 + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:), allocatable :: sendbuf + real(WP), dimension(:,:,:), allocatable :: recvbuf1 + real(WP), dimension(:,:), allocatable :: recvbuf2 + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 + ! Stuff + integer :: i,igroup + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call tridiagonal_serial(A,B,C,R,n,lot) + else + call tridiagonal_periodic_serial(A,B,C,R,n,lot) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot*12*proc)) + allocate(recvbuf1(nlot,6,2*proc)) + allocate(recvbuf2(nlot,2*proc)) + + ! Initialize boundary values + s1(:,1) = a(:,1) + s2(:,n) = c(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(i) + do i=2,n + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + s1(:,i) = -s1(:,i-1)*const(:) + end do + + ! Backward elimination + ! Lower boundary in s2(i) + do i=n-1,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) + s2(:,i) = -s2(:,i+1)*const(:) + end do + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced pentadiagonal system + ! Use of pentadiagonal system is more robust than the + ! reordered (removes zeros) tridiagonal system + + ! Send rows of pentadiagonal system + ! (0, s1, b, 0, s2; r) + ! (s1, 0, b, s2, 0; r) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = ngroup(igroup) + + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) + + ! Clear unused values + nk = ngroup(nrank+1) + recvbuf1(nk+1:nlot, :, :) = 0.0_WP + recvbuf1(nk+1:nlot, 3, :) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + ! Store in buf to avoid creating a temporary array (there must be a better way to do this) + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,2:2*proc-1) + buf2=recvbuf1(:,2,2:2*proc-1) + buf3=recvbuf1(:,3,2:2*proc-1) + buf4=recvbuf1(:,4,2:2*proc-1) + buf5=recvbuf1(:,5,2:2*proc-1) + buf6=recvbuf1(:,6,2:2*proc-1) + call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) + recvbuf1(:,1,2:2*proc-1)=buf1 + recvbuf1(:,2,2:2*proc-1)=buf2 + recvbuf1(:,3,2:2*proc-1)=buf3 + recvbuf1(:,4,2:2*proc-1)=buf4 + recvbuf1(:,5,2:2*proc-1)=buf5 + recvbuf1(:,6,2:2*proc-1)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + else + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,:) + buf2=recvbuf1(:,2,:) + buf3=recvbuf1(:,3,:) + buf4=recvbuf1(:,4,:) + buf5=recvbuf1(:,5,:) + buf6=recvbuf1(:,6,:) + call pentadiagonal_periodic_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) + recvbuf1(:,1,:)=buf1 + recvbuf1(:,2,:)=buf2 + recvbuf1(:,3,:)=buf3 + recvbuf1(:,4,:)=buf4 + recvbuf1(:,5,:)=buf5 + recvbuf1(:,6,:)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + end if + + ! Move solution to first slot + do i=1,2*proc + recvbuf2(:,i) = recvbuf1(:,6,i) + end do + + ! Permute the order + do i=1,proc-1 + const(1:nlot) = recvbuf2(:,2*i) + recvbuf2(:,2*i) = recvbuf2(:,2*i+1) + recvbuf2(:,2*i+1) = const(1:nlot) + end do + + ! If periodic, don't forget the end points + if (nper) then + const(1:nlot) = recvbuf2(:,1) + recvbuf2(:,1) = recvbuf2(:,2*proc) + recvbuf2(:,2*proc) = const(1:nlot) + end if + + ! Scatter back the solution + call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + do i=1,n + r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) + end do + + deallocate(sendbuf) + deallocate(recvbuf2) + deallocate(recvbuf1) + deallocate(ngroup) + + end subroutine tridiagonal + + + !> TriDiagonal Solver - Serial Case - Periodic + subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + r = r/(a + b + c) + return + else if (n .eq. 2) then + ! Solve 2x2 system + c(:,1) = c(:,1) + a(:,1) + a(:,2) = a(:,2) + c(:,2) + const(:) = a(:,2)/b(:,1) + b(:,2) = b(:,2) - c(:,1)*const(:) + r(:,2) = r(:,2) - r(:,1)*const(:) + r(:,2) = r(:,2)/b(:,2) + r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) + return + end if + + ! Forward elimination + do i=2,n-2 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + ! Boundary is stored in a(i) + a(:,i) = -a(:,i-1)*const(:) + end do + i=n-1 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = c(:,i) - a(:,i-1)*const(:) + i=n + const(:) = a(:,i)/b(:,i-1) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = b(:,i) - a(:,i-1)*const(:) + + ! Backward elimination + do i=n-2,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + a(:,i) = a(:,i) - a(:,i+1)*const(:) + end do + + ! Eliminate oddball + const(:) = c(:,n)/b(:,1) + r(:,n) = r(:,n) - r(:,1)*const(:) + a(:,n) = a(:,n) - a(:,1)*const(:) + + ! Backward substitution + r(:,n) = r(:,n)/a(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) + end do + + end subroutine tridiagonal_periodic_serial + + + !> TriDiagonal Solver - Serial Case - Not Periodic + subroutine tridiagonal_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + ! Forward elimination + do i=2,n + const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + end do + + ! Back-substitution + r(:,n) = r(:,n)/b(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) + end do + + end subroutine tridiagonal_serial + + + subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot,2) :: r1 + real(WP), dimension(lot,2) :: r2 + real(WP), dimension(lot,n,2) :: s1 + real(WP), dimension(lot,n,2) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:,:), allocatable :: sendbuf + real(WP), dimension(:,:), allocatable :: recvbuf + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:,:), allocatable :: AA + real(WP), dimension(:,:), allocatable :: swap + + ! Stuff + integer :: i,igroup,j,k,m + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call pentadiagonal_serial(A,B,C,D,E,R,n,lot) + else + call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot,24*proc)) + allocate(recvbuf(nlot,24*proc)) + + if (n > 1) then ! do normal stuff + + ! Initialize boundary values + s1(:,1,1) = a(:,1) + s1(:,1,2) = b(:,1) + s1(:,2,1) = 0.0_WP + s1(:,2,2) = a(:,2) + s2(:,n-1,1) = e(:,n-1) + s2(:,n-1,2) = 0.0_WP + s2(:,n,1) = d(:,n) + s2(:,n,2) = e(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(:,i,1:2) + do i=1,n-2 + ! Eliminate a(i+2) + const(:) = a(:,i+2)/c(:,i) + b(:,i+2) = b(:,i+2) - d(:,i)*const(:) + c(:,i+2) = c(:,i+2) - e(:,i)*const(:) + r(:,i+2) = r(:,i+2) - r(:,i)*const(:) + s1(:,i+2,1) = -s1(:,i,1)*const(:) + s1(:,i+2,2) = -s1(:,i,2)*const(:) + + ! Eliminate b(i+1) + const(:) = b(:,i+1)/c(:,i) + c(:,i+1) = c(:,i+1) - d(:,i)*const(:) + d(:,i+1) = d(:,i+1) - e(:,i)*const(:) + r(:,i+1) = r(:,i+1) - r(:,i)*const(:) + s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) + s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) + end do + ! Eliminate b(n) + const(:) = b(:,n)/c(:,n-1) + c(:,n) = c(:,n) - d(:,n-1)*const(:) + r(:,n) = r(:,n) - r(:,n-1)*const(:) + s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) + s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) + s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) + + ! Backward elimination + ! Lower boundary in s2(:,i,1:2) + do i=n,3,-1 + ! Eliminate e(i-2) + const(:) = e(:,i-2)/c(:,i) + r(:,i-2) = r(:,i-2) - r(:,i)*const(:) + s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) + s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) + s2(:,i-2,1) = -s2(:,i,1)*const(:) + s2(:,i-2,2) = -s2(:,i,2)*const(:) + + ! Eliminate d(i-1) + const(:) = d(:,i-1)/c(:,i) + r(:,i-1) = r(:,i-1) - r(:,i)*const(:) + s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) + s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) + s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) + s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) + end do + ! Eliminate d(1) + const(:) = d(:,1)/c(:,2) + r(:,1) = r(:,1) - r(:,2)*const(:) + s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) + s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) + s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) + s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) + + end if ! n > 1 + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced 11-diagonal system + ! Use of 11-diagonal system is more robust than the + ! reordered (removes zeros) 7-diagonal system + + ! Send rows of 11-diagonal system + ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) + ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) + ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) + ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) + ! For efficiency, only send non-zero elements + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + if (n > 1) then ! do normal stuff + + do i=1,2 + sendbuf(1:nk, L+0) = c(k1:k2, i) + sendbuf(1:nk, L+1) = r(k1:k2, i) + sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) + sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + sendbuf(1:nk, L+0) = s1(k1:k2, i,j) + sendbuf(1:nk, L+1) = s2(k1:k2, i,j) + sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) + sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) + L = L + 4 + end do + end do + + else ! n == 1 special case + + sendbuf(1:nk, L+0) = c(k1:k2, 1) + sendbuf(1:nk, L+1) = r(k1:k2, 1) + sendbuf(1:nk, L+2) = 1.0_WP + sendbuf(1:nk, L+3) = 0.0_WP + sendbuf(1:nk, L+4) = 1.0_WP + sendbuf(1:nk, L+5) = 0.0_WP + sendbuf(1:nk, L+6) = c(k1:k2, 1) + sendbuf(1:nk, L+7) = r(k1:k2, 1) + sendbuf(1:nk, L+8) = a(k1:k2, 1) + sendbuf(1:nk, L+9) = d(k1:k2, 1) + sendbuf(1:nk, L+10) = 0.0_WP + sendbuf(1:nk, L+11) = 0.0_WP + sendbuf(1:nk, L+12) = b(k1:k2, 1) + sendbuf(1:nk, L+13) = e(k1:k2, 1) + sendbuf(1:nk, L+14) = -1.0_WP + sendbuf(1:nk, L+15) = 0.0_WP + sendbuf(1:nk, L+16) = 0.0_WP + sendbuf(1:nk, L+17) = -1.0_WP + sendbuf(1:nk, L+18) = a(k1:k2, 1) + sendbuf(1:nk, L+19) = d(k1:k2, 1) + sendbuf(1:nk, L+20) = 0.0_WP + sendbuf(1:nk, L+21) = 0.0_WP + sendbuf(1:nk, L+22) = b(k1:k2, 1) + sendbuf(1:nk, L+23) = e(k1:k2, 1) + L = L + 24 + + end if + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) + + ! Build reduced matrix + allocate(AA(nlot, 4*proc, -5:5 + 1)) + AA = 0.0_WP + L = 1 + do k=1,proc + m = 4*(k-1) + + do i=1,2 + AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) + AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) + AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) + AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) + AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) + AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) + AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) + L = L + 4 + end do + end do + + end do + + ! Clear unused values + nk = ngroup(nrank+1) + AA(nk+1:nlot, :, :) = 0.0_WP + AA(nk+1:nlot, :, 0) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) + else + if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' + call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) + end if + + ! Move solution to beginning of recvbuf + recvbuf(:, 1:4*proc) = AA(:, :, 6) + deallocate(AA) + + ! Permute the order + allocate (swap(nlot,2)) + do i=1,proc-1 + swap(:,:) = recvbuf(:, 4*i-1:4*i) + recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) + recvbuf(:, 4*i+1:4*i+2) = swap(:,:) + end do + ! If periodic, don't forget the end points + if (nper) then + swap(:,:) = recvbuf(:, 4*proc-1:4*proc) + recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) + recvbuf(:, 1:2) = swap(:,:) + end if + deallocate (swap) + + ! Scatter back the solution + deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) + call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) + r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) + L = L + 4 + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + if (n > 1) then ! do normal stuff + + do j=1,2 + do i=1,n + r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) + end do + end do + r = r / c + + else ! n == 1 special case + + r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & + & -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) + + end if + + deallocate(sendbuf) + deallocate(recvbuf) + deallocate(ngroup) + + end subroutine pentadiagonal + + + ! ================================================= ! + ! PentaDiagonal Solver - Serial Case - Not periodic ! + ! ================================================= ! + subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,1) = R(:,1)/C(:,1) + return + else if (n .eq. 2) then + ! Solve 2x2 system + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + end if + + ! Forward elimination + do i=1,n-2 + ! Eliminate A(2,i+1) + const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + + ! Eliminate A(1,i+2) + const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + end do + ! Eliminate A(2,n) + const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) + C(:,n) = C(:,n) - D(:,n-1)*const(:) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + + ! Back-substitution + R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) + R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) + end do + + end subroutine pentadiagonal_serial + + + ! ============================================= ! + ! PentaDiagonal Solver - Serial Case - Periodic ! + ! ============================================= ! + subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) + return + else if (n .eq. 2) then + ! Solve 2x2 system + C(:,:) = C(:,:) + A(:,:) + E(:,:) + D(:,1) = D(:,1) + B(:,1) + B(:,2) = B(:,2) + D(:,2) + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + else if (n .eq. 3) then + B(:,:) = B(:,:) + E(:,:) + D(:,:) = D(:,:) + A(:,:) + call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) + return + else if (n .eq. 4) then + A(:,:) = A(:,:) + E(:,:) + E(:,:) = 0.0_WP + end if + + ! Initialize boundary data + s1 = 0.0_WP + s1(:,1) = A(:,1) + s1(:,n-3) = s1(:,n-3) + E(:,n-3) + s1(:,n-2) = D(:,n-2) + s1(:,n-1) = C(:,n-1) + s1(:,n) = B(:,n) + s2 = 0.0_WP + s2(:,1) = B(:,1) + s2(:,2) = A(:,2) + s2(:,n-2) = s2(:,n-2) + E(:,n-2) + s2(:,n-1) = D(:,n-1) + s2(:,n) = C(:,n) + + ! Forward elimination + do i=1,n-2 + ! Eliminate b(i+1) + const(:) = B(:,i+1)/C(:,i) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) + s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) + + ! Eliminate a(i+2) + const(:) = A(:,i+2)/C(:,i) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) + s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) + end do + + ! Backward elimination + do i=n-2,3,-1 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate e(i-2) + const(:) = E(:,i-2)/C(:,i) + R(:,i-2) = R(:,i-2) - R(:,i)*const(:) + s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) + s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) + end do + i=2 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate oddball region + const(:) = E(:,n-1)/C(:,1) + R(:,n-1) = R(:,n-1) - R(:,1)*const(:) + s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) + s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) + + const(:) = D(:,n)/C(:,1) + R(:,n) = R(:,n) - R(:,1)*const(:) + s1(:,n) = s1(:,n) - s1(:,1)*const(:) + s2(:,n) = s2(:,n) - s2(:,1)*const(:) + + const(:) = E(:,n)/C(:,2) + R(:,n) = R(:,n) - R(:,2)*const(:) + s1(:,n) = s1(:,n) - s1(:,2)*const(:) + s2(:,n) = s2(:,n) - s2(:,2)*const(:) + + ! Eliminate corner region + const(:) = s1(:,n)/s1(:,n-1) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) + + R(:,n) = R(:,n)/s2(:,n) + R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) + end do + + end subroutine pentadiagonal_periodic_serial + + + subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) + implicit none + class(diag), intent(inout) :: this + character(len=*), intent(in) :: dir + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + integer :: proc + logical :: nper + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc.eq.1) then + if (.not.nper) then + call polydiagonal_serial(nd,A,R,n,lot) + else + call polydiagonal_periodic_serial(nd,A,R,n,lot,b) + end if + return + else + stop 'polydiagonal: Implemented only in serial.' + end if + + end subroutine polydiagonal + + + subroutine polydiagonal_serial(nd,A,R,n,lot) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k + + ! Forward elimination + do i=1,n-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,n-i) + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,min(nd,n-i) + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Back-substitution + do i=n,1,-1 + do j=1,min(nd,n-i) + R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_serial + + + subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k,i0 + + if (n.eq.1) then + const(:) = 0.0_WP + do j=-nd,nd + const(:) = const(:) + A(:,j,1) + end do + R(:,1) = R(:,1) / const(:) + return + end if + + ! Setup bridge array + do j=1,nd + do i=1,n + b(:,i,j) = 0.0_WP + end do + end do + do i=1,nd + do j=i,nd + b(:,i,j) = A(:,i,-nd+j-i) + b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) + end do + end do + do i=n-nd+1,n + do j=1,nd + b(:,i,j) = A(:,i,-nd+j-(i-n)) + end do + end do + + ! Forward elimination + do i=1,n-nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,nd + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,nd + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Backward elimination + do i=n-nd,1,-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,i-1) + const(:) = A(:,i-j,j)*pivot(:) + do k=1,nd + b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) + end do + R(:,i-j) = R(:,i-j) - R(:,i)*const(:) + end do + end do + + ! Eliminate oddball region + do i=1,nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=i,nd + const(:) = A(:,n-j+i,j)*pivot(:) + do k=1,nd + b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) + end do + R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) + end do + end do + + ! Elimination for corner matrix + i0 = n-nd + do i=1,nd-1 + pivot(:) = 1.0_WP/b(:,i+i0,i) + do j=i+1,nd + const(:) = b(:,j+i0,i)*pivot(:) + do k=i+1,nd + b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) + end do + R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) + end do + end do + + ! Back-substitution for corner matrix + i0 = n-nd + do i=nd,1,-1 + do j=i+1,nd + R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) + end do + R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) + end do + + ! Back-substitution for bridge + do i=n-nd,1,-1 + do j=1,nd + R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_periodic_serial + + end module diag_class diff --git a/src/solver/pfft3d_class.f90 b/src/solver/fourier3d_class.f90 similarity index 71% rename from src/solver/pfft3d_class.f90 rename to src/solver/fourier3d_class.f90 index 6597bc519..b8bc1d930 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/fourier3d_class.f90 @@ -1,151 +1,115 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -module pfft3d_class +!> Makes use of FFTW and in-house parallel transpose operations +module fourier3d_class use precision, only: WP use config_class, only: config use string, only: str_short use linsol_class, only: linsol use, intrinsic :: iso_c_binding implicit none - include 'fftw3.f' private + ! Expose type/constructor/methods - public :: pfft3d + public :: fourier3d - !> pfft3d object definition - type, extends(linsol) :: pfft3d - + + !> fourier3d object definition + type, extends(linsol) :: fourier3d + ! FFT's oddball logical :: oddball ! Data storage for FFTW plans - complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_x,out_x - complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_y,out_y - complex(C_DOUBLE_COMPLEX), dimension(:), allocatable :: in_z,out_z + complex(WP), dimension(:), allocatable :: in_x,out_x + complex(WP), dimension(:), allocatable :: in_y,out_y + complex(WP), dimension(:), allocatable :: in_z,out_z ! FFTW plans - integer(KIND=8) :: fplan_x,bplan_x - integer(KIND=8) :: fplan_y,bplan_y - integer(KIND=8) :: fplan_z,bplan_z - + type(C_PTR) :: fplan_x,bplan_x + type(C_PTR) :: fplan_y,bplan_y + type(C_PTR) :: fplan_z,bplan_z + !> Unstrided arrays - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: factored_operator, transformed_rhs + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs ! Storage for transposed data - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: xtrans - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: ytrans - complex(C_DOUBLE_COMPLEX), dimension(:,:,:), allocatable :: ztrans + complex(WP), dimension(:,:,:), allocatable :: xtrans + complex(WP), dimension(:,:,:), allocatable :: ytrans + complex(WP), dimension(:,:,:), allocatable :: ztrans ! Transpose partition - X integer, dimension(:), allocatable :: imin_x,imax_x integer, dimension(:), allocatable :: jmin_x,jmax_x integer, dimension(:), allocatable :: kmin_x,kmax_x integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x integer :: sendcount_x,recvcount_x character(len=str_short) :: xdir - + ! Transpose partition - Y integer, dimension(:), allocatable :: imin_y,imax_y integer, dimension(:), allocatable :: jmin_y,jmax_y integer, dimension(:), allocatable :: kmin_y,kmax_y integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y integer :: sendcount_y,recvcount_y character(len=str_short) :: ydir - + ! Transpose partition - Z integer, dimension(:), allocatable :: imin_z,imax_z integer, dimension(:), allocatable :: jmin_z,jmax_z integer, dimension(:), allocatable :: kmin_z,kmax_z integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z integer :: sendcount_z,recvcount_z character(len=str_short) :: zdir contains - procedure :: log => pfft3d_log !< Long-form logging of solver status - procedure :: print => pfft3d_print !< Long-form printing of solver status - procedure :: print_short => pfft3d_print_short !< One-line printing of solver status - procedure :: init => pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup => pfft3d_setup !< Solver setup (every time the operator changes) - procedure :: solve => pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy => pfft3d_destroy !< Solver destruction (every time the operator changes) - - procedure, private :: pfft3d_fourier_transform - procedure, private :: pfft3d_inverse_transform + procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status + procedure :: print=>fourier3d_print !< Long-form printing of solver status + procedure :: log=>fourier3d_log !< Long-form logging of solver status + procedure :: init=>fourier3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>fourier3d_setup !< Solver setup (every time the operator changes) + procedure :: solve=>fourier3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>fourier3d_destroy !< Solver destruction (every time the operator changes) + + procedure, private :: fourier3d_fourier_transform + procedure, private :: fourier3d_inverse_transform - procedure, private :: pfft3d_xtranspose_init - procedure, private :: pfft3d_ytranspose_init - procedure, private :: pfft3d_ztranspose_init + procedure, private :: fourier3d_xtranspose_init + procedure, private :: fourier3d_ytranspose_init + procedure, private :: fourier3d_ztranspose_init - procedure, private :: pfft3d_xtranspose_forward - procedure, private :: pfft3d_ytranspose_forward - procedure, private :: pfft3d_ztranspose_forward + procedure, private :: fourier3d_xtranspose_forward + procedure, private :: fourier3d_ytranspose_forward + procedure, private :: fourier3d_ztranspose_forward - procedure, private :: pfft3d_xtranspose_backward - procedure, private :: pfft3d_ytranspose_backward - procedure, private :: pfft3d_ztranspose_backward + procedure, private :: fourier3d_xtranspose_backward + procedure, private :: fourier3d_ytranspose_backward + procedure, private :: fourier3d_ztranspose_backward - end type pfft3d + end type fourier3d - !> Declare pfft3d constructor - interface pfft3d - procedure pfft3d_from_args - end interface pfft3d - -contains + !> Declare fourier3d constructor + interface fourier3d + procedure fourier3d_from_args + end interface fourier3d - !> Log pfft3d info - subroutine pfft3d_log(this) - use string, only: str_long - use messager, only: log - implicit none - class(pfft3d), intent(in) :: this - character(len=str_long) :: message - - if (this%cfg%amRoot) then - write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) - call log(message) - end if - - end subroutine pfft3d_log - - - !> Print pfft3d info to the screen - subroutine pfft3d_print(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) then - write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) - end if - - end subroutine pfft3d_print - - - !> Short print of pfft3d info to the screen - subroutine pfft3d_print_short(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(pfft3d), intent(in) :: this - - if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - - end subroutine pfft3d_print_short +contains - !> Constructor for an pfft3d object - function pfft3d_from_args(cfg,name,nst) result(self) + !> Constructor for a fourier3d object + function fourier3d_from_args(cfg,name,nst) result(self) use messager, only: die implicit none - type(pfft3d) :: self + type(fourier3d) :: self class(config), target, intent(in) :: cfg character(len=*), intent(in) :: name integer, intent(in) :: nst @@ -154,79 +118,109 @@ function pfft3d_from_args(cfg,name,nst) result(self) self%cfg=>cfg self%name=trim(adjustl(name)) + ! Set solution method - not used + self%method=0 + ! Set up stencil size and map - self%nst=nst; allocate(self%stc(self%nst,3)) - + self%nst=nst + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + ! Allocate operator, rhs, and sol arrays allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP - - ! Allocate unstrided arrays - allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - allocate(self%transformed_rhs(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) ! Zero out some info - self%method=0; self%it=0; self%aerr=0.0_WP; self%rerr=0.0_WP + self%it=1 + self%aerr=0.0_WP + self%rerr=0.0_WP + + ! Allocate unstrided arrays + allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%transformed_rhs (self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) ! Setup is not done self%setup_done=.false. - end function pfft3d_from_args + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + integer :: ndim,ndcp + ! Periodicity and uniformity of mesh + if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[fourier3d constructor] Need x-direction needs to be periodic and uniform') + if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[fourier3d constructor] Need y-direction needs to be periodic and uniform') + if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[fourier3d constructor] Need z-direction needs to be periodic and uniform') + ! Ensure that we have at least one non-decomposed direction + ndim=0 + if (self%cfg%nx.gt.1) ndim=ndim+1 + if (self%cfg%ny.gt.1) ndim=ndim+1 + if (self%cfg%nz.gt.1) ndim=ndim+1 + ndcp=0 + if (self%cfg%npx.gt.1) ndcp=ndcp+1 + if (self%cfg%npy.gt.1) ndcp=ndcp+1 + if (self%cfg%npz.gt.1) ndcp=ndcp+1 + if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one NON-decomposed direction') + end block check_solver_is_useable + + end function fourier3d_from_args !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver !> Only the stencil needs to be defined at this point - subroutine pfft3d_init(this) + subroutine fourier3d_init(this) use messager, only: die implicit none - class(pfft3d), intent(inout) :: this - - ! Various checks to ensure we can use this solver - check_solver_is_useable: block - ! Periodicity and uniformity of mesh - if (.not.(this%cfg%xper.and.this%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') - if (.not.(this%cfg%yper.and.this%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') - if (.not.(this%cfg%zper.and.this%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') - end block check_solver_is_useable - + class(fourier3d), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + integer, dimension(3) :: periodicity,offset + include 'fftw3.f03' + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + ! Initialize transpose and FFTW plans in x if (this%cfg%nx.gt.1) then - call this%pfft3d_xtranspose_init() + call this%fourier3d_xtranspose_init() allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) - call dfftw_plan_dft_1d(this%fplan_x,this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) - call dfftw_plan_dft_1d(this%bplan_x,this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) + this%fplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) end if - + ! Initialize transpose and FFTW plans in y if (this%cfg%ny.gt.1) then - call this%pfft3d_ytranspose_init() + call this%fourier3d_ytranspose_init() allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) - call dfftw_plan_dft_1d(this%fplan_y,this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) - call dfftw_plan_dft_1d(this%bplan_y,this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) + this%fplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) end if - + ! Initialize transpose and FFTW plans in z if (this%cfg%nz.gt.1) then - call this%pfft3d_ztranspose_init() + call this%fourier3d_ztranspose_init() allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) - call dfftw_plan_dft_1d(this%fplan_z,this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) - call dfftw_plan_dft_1d(this%bplan_z,this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) + this%fplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) end if ! Find who owns the oddball this%oddball=.false. if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. - end subroutine pfft3d_init - - - !> Initialize transpose tool in x - subroutine pfft3d_xtranspose_init(this) + end subroutine fourier3d_init + + + !> Initialize transpose tool in x + subroutine fourier3d_xtranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,ip,q,r ! Determine non-decomposed direction to use for transpose @@ -337,14 +331,14 @@ subroutine pfft3d_xtranspose_init(this) ! Allocate storage allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - end subroutine pfft3d_xtranspose_init + end subroutine fourier3d_xtranspose_init !> Initialize transpose tool in y - subroutine pfft3d_ytranspose_init(this) + subroutine fourier3d_ytranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,jp,q,r ! Determine non-decomposed direction to use for transpose @@ -455,14 +449,14 @@ subroutine pfft3d_ytranspose_init(this) ! Allocate storage allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - end subroutine pfft3d_ytranspose_init + end subroutine fourier3d_ytranspose_init !> Initialize transpose tool in z - subroutine pfft3d_ztranspose_init(this) + subroutine fourier3d_ztranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,kp,q,r ! Determine non-decomposed direction to use for transpose @@ -573,17 +567,17 @@ subroutine pfft3d_ztranspose_init(this) ! Allocate storage allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - end subroutine pfft3d_ztranspose_init + end subroutine fourier3d_ztranspose_init !> Perform forward transpose in x - subroutine pfft3d_xtranspose_forward(this,A,At) + subroutine fourier3d_xtranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -642,17 +636,17 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end select - end subroutine pfft3d_xtranspose_forward + end subroutine fourier3d_xtranspose_forward !> Perform forward transpose in y - subroutine pfft3d_ytranspose_forward(this,A,At) + subroutine fourier3d_ytranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(C_DOUBLE_COMPLEX), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -711,17 +705,17 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end select - end subroutine pfft3d_ytranspose_forward + end subroutine fourier3d_ytranspose_forward !> Perform forward transpose in z - subroutine pfft3d_ztranspose_forward(this,A,At) + subroutine fourier3d_ztranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(C_DOUBLE_COMPLEX), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -780,17 +774,17 @@ subroutine pfft3d_ztranspose_forward(this,A,At) At=A end select - end subroutine pfft3d_ztranspose_forward + end subroutine fourier3d_ztranspose_forward !> Perform backward transpose in x - subroutine pfft3d_xtranspose_backward(this,At,A) + subroutine fourier3d_xtranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -849,17 +843,17 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end select - end subroutine pfft3d_xtranspose_backward - + end subroutine fourier3d_xtranspose_backward + !> Perform backward transpose in y - subroutine pfft3d_ytranspose_backward(this,At,A) + subroutine fourier3d_ytranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -918,17 +912,17 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end select - end subroutine pfft3d_ytranspose_backward + end subroutine fourier3d_ytranspose_backward !> Perform backward transpose in z - subroutine pfft3d_ztranspose_backward(this,At,A) + subroutine fourier3d_ztranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -987,248 +981,277 @@ subroutine pfft3d_ztranspose_backward(this,At,A) A=At end select - end subroutine pfft3d_ztranspose_backward - - - !> Transpose A and perform Fourier transform - subroutine pfft3d_fourier_transform(this,A) + end subroutine fourier3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine fourier3d_fourier_transform(this,A) implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) integer :: i,j,k - + include 'fftw3.f03' + if (this%cfg%nx.gt.1) then ! Transpose in X - call this%pfft3d_xtranspose_forward(A,this%xtrans) + call this%fourier3d_xtranspose_forward(A,this%xtrans) ! Forward transform - X do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x =this%xtrans(:,j,k) - call dfftw_execute(this%fplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k) = this%out_x + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x end do end do ! Transpose back - call this%pfft3d_xtranspose_backward(this%xtrans,A) + call this%fourier3d_xtranspose_backward(this%xtrans,A) end if - + if (this%cfg%ny.gt.1) then ! Transpose in Y - call this%pfft3d_ytranspose_forward(A,this%ytrans) + call this%fourier3d_ytranspose_forward(A,this%ytrans) ! Forward transform - Y do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y = this%ytrans(i,:,k) - call dfftw_execute(this%fplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k) = this%out_y + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y end do end do ! Transpose back - call this%pfft3d_ytranspose_backward(this%ytrans,A) + call this%fourier3d_ytranspose_backward(this%ytrans,A) end if - + if (this%cfg%nz.gt.1) then ! Transpose in Z - call this%pfft3d_ztranspose_forward(A,this%ztrans) + call this%fourier3d_ztranspose_forward(A,this%ztrans) ! Forward transform - Z do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z = this%ztrans(i,j,:) - call dfftw_execute(this%fplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:) = this%out_z + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z end do end do ! Transpose back - call this%pfft3d_ztranspose_backward(this%ztrans,A) + call this%fourier3d_ztranspose_backward(this%ztrans,A) end if - + ! Oddball - if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_) = 0.0_WP - - end subroutine pfft3d_fourier_transform - - - !> FFT -> real and transpose back - subroutine pfft3d_inverse_transform(this,A) + if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP + + end subroutine fourier3d_fourier_transform + + + !> FFT -> real and transpose back + subroutine fourier3d_inverse_transform(this,A) implicit none - class(pfft3d), intent(inout) :: this - complex(C_DOUBLE_COMPLEX), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) integer :: i,j,k - + include 'fftw3.f03' + if (this%cfg%nx.gt.1) then ! Transpose in X - call this%pfft3d_xtranspose_forward(A,this%xtrans) + call this%fourier3d_xtranspose_forward(A,this%xtrans) ! Inverse transform do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x = this%xtrans(:,j,k) - call dfftw_execute(this%bplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k) = this%out_x/this%cfg%nx + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x/this%cfg%nx end do end do ! Transpose back - call this%pfft3d_xtranspose_backward(this%xtrans,A) + call this%fourier3d_xtranspose_backward(this%xtrans,A) end if - + if (this%cfg%ny.gt.1) then ! Transpose in Y - call this%pfft3d_ytranspose_forward(A,this%ytrans) + call this%fourier3d_ytranspose_forward(A,this%ytrans) ! Inverse transform do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y = this%ytrans(i,:,k) - call dfftw_execute(this%bplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k) = this%out_y/this%cfg%ny + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y/this%cfg%ny end do end do ! Transpose back - call this%pfft3d_ytranspose_backward(this%ytrans,A) + call this%fourier3d_ytranspose_backward(this%ytrans,A) end if - + if (this%cfg%nz.gt.1) then ! Transpose in Z - call this%pfft3d_ztranspose_forward(A,this%ztrans) + call this%fourier3d_ztranspose_forward(A,this%ztrans) ! Inverse transform do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z = this%ztrans(i,j,:) - call dfftw_execute(this%bplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:) = this%out_z/this%cfg%nz + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z/this%cfg%nz end do end do ! Transpose back - call this%pfft3d_ztranspose_backward(this%ztrans,A) + call this%fourier3d_ztranspose_backward(this%ztrans,A) end if - end subroutine pfft3d_inverse_transform - - - !> Setup solver - done everytime the operator changes - subroutine pfft3d_setup(this) - use mpi_f08, only: MPI_BCAST, MPI_COMM_WORLD, MPI_ALLREDUCE, MPI_INTEGER, MPI_SUM - use parallel, only: MPI_REAL_WP +end subroutine fourier3d_inverse_transform + + +!> Setup solver - done everytime the operator changes + subroutine fourier3d_setup(this) use messager, only: die + use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM + use parallel, only: MPI_REAL_WP implicit none - integer :: i,j,k,n,stx1,stx2,sty1,sty2,stz1,stz2,ierr - class(pfft3d), intent(inout) :: this - logical :: circulent - real(WP), dimension(this%nst) :: ref_stencil - real(WP), dimension(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) :: opr_col - - ! Compute stencil inverse - stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)); - sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)); - stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)); - allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)) - do n=1,this%nst - this%stmap(this%stc(n,1),this%stc(n,2),this%stc(n,3))=n - end do + class(fourier3d), intent(inout) :: this + real(WP), dimension(1:this%nst) :: ref_opr + logical :: circulant + integer :: i,j,k,n,ierr + + ! If the solver has already been setup, destroy it first + if (this%setup_done) call this%destroy() ! Check circulent operator - if (this%cfg%amRoot) ref_stencil=this%opr(:,1,1,1) - call MPI_BCAST(ref_stencil,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) - circulent=.true. + if (this%cfg%amRoot) ref_opr=this%opr(:,this%cfg%imin,this%cfg%jmin,this%cfg%kmin) + call MPI_BCAST(ref_opr,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) + circulant=.true. do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - if (any(abs(this%opr(:,i,j,k)-ref_stencil(:)).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulent=.false. + if (any(abs(this%opr(:,i,j,k)-ref_opr).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulant=.false. end do end do end do - if (.not.circulent) then - call die('[pfft3d] stencil must be uniform in space') - end if - + if (.not.circulant) call die('[fourier3d setup] operator must be uniform in space') + ! Build the operator - this%factored_operator(:,:,:) = 0.0_C_DOUBLE - do n = 1, this%nst - i = modulo(this%stc(n,1) - this%cfg%imin + 1, this%cfg%nx) + this%cfg%imin - j = modulo(this%stc(n,2) - this%cfg%jmin + 1, this%cfg%ny) + this%cfg%jmin - k = modulo(this%stc(n,3) - this%cfg%kmin + 1, this%cfg%nz) + this%cfg%kmin - if ( & - this%cfg%imin_ .le. i .and. i .le. this%cfg%imax_ .and. & - this%cfg%jmin_ .le. j .and. j .le. this%cfg%jmax_ .and. & - this%cfg%kmin_ .le. k .and. k .le. this%cfg%kmax_ & - ) this%factored_operator(i,j,k) =this%factored_operator(i,j,k) + & - real(ref_stencil(n), C_DOUBLE) + this%factored_operator=0.0_WP + do n=1,this%nst + i=modulo(this%stc(n,1)-this%cfg%imin+1,this%cfg%nx)+this%cfg%imin + j=modulo(this%stc(n,2)-this%cfg%jmin+1,this%cfg%ny)+this%cfg%jmin + k=modulo(this%stc(n,3)-this%cfg%kmin+1,this%cfg%nz)+this%cfg%kmin + if (this%cfg%imin_.le.i.and.i.le.this%cfg%imax_.and.& + & this%cfg%jmin_.le.j.and.j.le.this%cfg%jmax_.and.& + & this%cfg%kmin_.le.k.and.k.le.this%cfg%kmax_) this%factored_operator(i,j,k)=this%factored_operator(i,j,k)+real(ref_opr(n),WP) end do - + ! Take transform of operator - call this%pfft3d_fourier_transform(this%factored_operator) + call this%fourier3d_fourier_transform(this%factored_operator) ! Make zero wavenumber not zero ! Setting this to one has the nice side effect of returning a solution with the same integral if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=1.0_C_DOUBLE ! Make sure other wavenumbers are not close to zero - i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_C_DOUBLE)) + i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_WP)) call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) - if (j.gt.0) call die('[pfft3d] elements of transformed operator near zero') + if (j.gt.0) then + print*,j + call die('[fourier3d setup] elements of transformed operator near zero') + end if ! Divide now instead of later - this%factored_operator = 1.0_C_DOUBLE / this%factored_operator + this%factored_operator=1.0_WP/this%factored_operator ! Check for division issues i=count(isnan(abs(this%factored_operator))) call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) - if (j.gt.0) call die('[pfft3d] elements of transformed operator are nan') + if (j.gt.0) call die('[fourier3d setup] elements of transformed operator are NaN') ! Set setup-flag to true this%setup_done=.true. - end subroutine pfft3d_setup + end subroutine fourier3d_setup - !> Do the solve - subroutine pfft3d_solve(this) + !> Solve the linear system iteratively + subroutine fourier3d_solve(this) use messager, only: die use param, only: verbose implicit none - class(pfft3d), intent(inout) :: this - integer :: imn_,imx_,jmn_,jmx_,kmn_,kmx_ - - if (.not.this%setup_done) call die('[pfftd3] solve called before setup') + class(fourier3d), intent(inout) :: this + integer :: i,j,k,ierr - imn_=this%cfg%imin_; imx_=this%cfg%imax_; - jmn_=this%cfg%jmin_; jmx_=this%cfg%jmax_; - kmn_=this%cfg%kmin_; kmx_=this%cfg%kmax_; + ! Check that setup was done + if (.not.this%setup_done) call die('[fourier3d solve] Solver has not been setup.') ! Copy to unstrided array - this%transformed_rhs=this%rhs(imn_:imx_,jmn_:jmx_,kmn_:kmx_) - + this%transformed_rhs=this%rhs(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) + ! Forward transform - call this%pfft3d_fourier_transform(this%transformed_rhs) - + call this%fourier3d_fourier_transform(this%transformed_rhs) + ! Divide this%transformed_rhs=this%transformed_rhs*this%factored_operator - + ! Backward transform - call this%pfft3d_inverse_transform(this%transformed_rhs) - + call this%fourier3d_inverse_transform(this%transformed_rhs) + ! Copy to strided output - this%sol(imn_:imx_,jmn_:jmx_,kmn_:kmx_) = this%transformed_rhs(:,:,:) + this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs - ! Sync + ! Sync the solution vector call this%cfg%sync(this%sol) ! If verbose run, log and or print info if (verbose.gt.0) call this%log if (verbose.gt.1) call this%print_short - end subroutine pfft3d_solve + end subroutine fourier3d_solve - subroutine pfft3d_destroy(this) + !> Destroy solver - done everytime the operator changes + subroutine fourier3d_destroy(this) + use messager, only: die implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this + integer :: ierr + include 'fftw3.f03' - this%setup_done=.false. + ! Destroy our plans + call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x) + call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y) + call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z) - call dfftw_destroy_plan(this%fplan_x); call dfftw_destroy_plan(this%bplan_x) - call dfftw_destroy_plan(this%fplan_y); call dfftw_destroy_plan(this%bplan_y) - call dfftw_destroy_plan(this%fplan_z); call dfftw_destroy_plan(this%bplan_z) + ! Set setup-flag to false + this%setup_done=.false. - end subroutine pfft3d_destroy + end subroutine fourier3d_destroy -end module pfft3d_class - + + !> Log fourier3d info + subroutine fourier3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(fourier3d), intent(in) :: this + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + end if + end subroutine fourier3d_log + + + !> Print fourier3d info to the screen + subroutine fourier3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fourier3d), intent(in) :: this + if (this%cfg%amRoot) then + write(output_unit,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + end if + end subroutine fourier3d_print + + + !> Short print of fourier3d info to the screen + subroutine fourier3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fourier3d), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("fourier3d solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + end subroutine fourier3d_print_short + + +end module fourier3d_class diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 3dcba0845..041dd74f0 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -2527,99 +2527,100 @@ end subroutine calculate_ustar end subroutine advection_step subroutine diffusion_src_explicit_step(this,dt,vf,matmod,sgs_visc,srcU,srcV,srcW,srcE) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - use vfs_class, only: vfs - use matm_class, only: matm - implicit none - class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver - class(vfs), intent(inout) :: vf !< The volume fraction solver - class(matm), intent(inout) :: matmod !< The material models for this solver - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT - real(WP), intent(in) :: dt !< Timestep size over which to advance - real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep - real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces - integer :: i,j,k,n,nCFL,ierr - real(WP) :: buf,myCFL,mydt,spec_heat - - ! Set up intermediate divergence - div =>this%tmp1 - ! Set up temporary face velocity - Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 - Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 - ! Set up face viscosities - visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 - - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Viscosity and thermal conductivity updated using new temperature and VOF - call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - - ! Estimate CFL from explicit diffusive and source terms - buf=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - ! Viscous CFL - buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) - spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & - +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) - buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) - ! Gravity CFL (check this) - buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & - dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & - dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) - end do - end do - end do - call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Calculate sub-step for viscous solver - nCFL=ceiling(myCFL) - mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon - - ! Sub-step for stability - do n=1,nCFL - ! Perform viscous step - call diffusion_src_explicit_substep() - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Calculate viscosity - if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - end do - - ! Nullify... - - contains - - subroutine diffusion_src_explicit_substep() + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + use vfs_class, only: vfs + use matm_class, only: matm implicit none + class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver + class(vfs), intent(inout) :: vf !< The volume fraction solver + class(matm), intent(inout) :: matmod !< The material models for this solver + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep + real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces + integer :: i,j,k,n,nCFL,ierr + real(WP) :: buf,myCFL,mydt,spec_heat - real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX - real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy - real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz - real(WP) :: dMUdx,dMUdy,dMUdz - real(WP) :: div2U,div2V,div2W - real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz - integer :: i,j,k,n + ! Set up intermediate divergence + div =>this%tmp1 + ! Set up temporary face velocity + Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 + Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 + ! Set up face viscosities + visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 - ! Viscous routine operates on face velocities, need to be updated each time - ! Update traditional face velocity (just interpolated) - call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) - ! Apply boundary condtions - bc_scope = 'velocity' - call this%apply_bcond(dt,bc_scope) - ! Calculate other interpolated face velocities (ignore masks) - call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) - call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) - ! BCs not needed, masks are already addressed, nothing used from within boundary + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Viscosity and thermal conductivity updated using new temperature and VOF + call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + + ! Estimate CFL from explicit diffusive and source terms + buf=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Viscous CFL + buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) + spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & + & +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) + buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) + ! Gravity CFL (check this) + buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & + & dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & + & dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) + end do + end do + end do + call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Calculate sub-step for viscous solver + nCFL=ceiling(myCFL) + mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon + + ! Sub-step for stability + do n=1,nCFL + ! Perform viscous step + call diffusion_src_explicit_substep() + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Calculate viscosity + if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + end do + + ! Nullify... + + contains + + subroutine diffusion_src_explicit_substep() + implicit none + + real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX + real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy + real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz + real(WP) :: dMUdx,dMUdy,dMUdz + real(WP) :: div2U,div2V,div2W + real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + + integer :: i,j,k,n + + ! Viscous routine operates on face velocities, need to be updated each time + ! Update traditional face velocity (just interpolated) + call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) + ! Apply boundary condtions + bc_scope = 'velocity' + call this%apply_bcond(dt,bc_scope) + ! Calculate other interpolated face velocities (ignore masks) + call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) + call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) + ! BCs not needed, masks are already addressed, nothing used from within boundary ! Compute divergence and SGS isotropic tensor in each cell do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 6dc3b63ba..913f77a30 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -7,7 +7,7 @@ module tpns_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -107,10 +107,10 @@ module tpns_class real(WP), dimension(:,:,:), allocatable :: FWX,FWY,FWZ !< W-momentum fluxes ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP) :: RHOeps !< Parameter for when to switch between centered and modified interpolation scheme @@ -245,12 +245,6 @@ function constructor(cfg,name) result(self) allocate(self%FWY(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWY=0.0_WP allocate(self%FWZ(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWZ=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -354,7 +348,7 @@ subroutine init_metrics(this) do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ do i=this%cfg%imino_+1,this%cfg%imaxo_ - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] end do end do end do @@ -839,14 +833,17 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(tpns), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided ! Adjust metrics based on bcflag array call this%adjust_metrics() + + ! Point to pressure solver linsol object + this%psolv=>pressure_solver ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] @@ -861,22 +858,30 @@ subroutine setup(this,pressure_ils,implicit_ils) this%psolv%opr(1,:,:,:)=this%cfg%VF ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) - - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP + call this%psolv%init() - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -2275,23 +2280,11 @@ subroutine shift_p(this,pressure) implicit none class(tpns), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index eb0c3094e..69887e31f 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -767,6 +767,9 @@ subroutine setup(this,pressure_solver,implicit_solver) ! Point to pressure solver linsol object this%psolv=>pressure_solver + ! Point to pressure solver linsol object + this%psolv=>pressure_solver + ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] this%psolv%stc(2,:)=[+1, 0, 0] @@ -802,13 +805,13 @@ subroutine setup(this,pressure_solver,implicit_solver) ! Initialize the pressure Poisson solver call this%psolv%init() call this%psolv%setup() - + ! Prepare implicit solver if it had been provided if (present(implicit_solver)) then - + ! Point to implicit solver linsol object this%implicit=>implicit_solver - + ! Set 7-pt stencil map for the velocity solver this%implicit%stc(1,:)=[ 0, 0, 0] this%implicit%stc(2,:)=[+1, 0, 0] @@ -817,13 +820,13 @@ subroutine setup(this,pressure_solver,implicit_solver) this%implicit%stc(5,:)=[ 0,-1, 0] this%implicit%stc(6,:)=[ 0, 0,+1] this%implicit%stc(7,:)=[ 0, 0,-1] - + ! Set the diagonal to 1 to make sure all cells participate in solver this%implicit%opr(1,:,:,:)=1.0_WP - + ! Initialize the implicit velocity solver call this%implicit%init() - + end if end subroutine setup @@ -1922,23 +1925,11 @@ subroutine shift_p(this,pressure) implicit none class(lowmach), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 106cb3690..89747e49b 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -60,7 +60,7 @@ module vdscalar_class real(WP), dimension(:,:,:), allocatable :: rhoSCold !< rhoSCold array ! Implicit scalar solver - class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -366,39 +366,39 @@ end subroutine adjust_metrics !> Finish setting up the variable density scalar solver now that bconds have been defined subroutine setup(this,implicit_solver) - implicit none - class(vdscalar), intent(inout) :: this - class(linsol), target, intent(in), optional :: implicit_solver - integer :: count,st - - ! Adjust metrics based on mask array - call this%adjust_metrics() - - ! Prepare implicit solver if it had been provided - if (present(implicit_solver)) then - - ! Point to implicit solver linsol object - this%implicit=>implicit_solver - - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit velocity solver - call this%implicit%init() - - end if - + implicit none + class(vdscalar), intent(inout) :: this + class(linsol), target, intent(in), optional :: implicit_solver + integer :: count,st + + ! Adjust metrics based on mask array + call this%adjust_metrics() + + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if + end subroutine setup From 9217d197df5c3921d256ebac52d98cb72d830621 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 17:37:46 -0500 Subject: [PATCH 111/152] Sync w/ Olivier Sync with Olivier's develop branch --- examples/falling_drop/src/simulation.f90 | 2 +- examples/fluidized_bed/input | 2 +- examples/fluidized_bed/src/simulation.f90 | 38 +- examples/hit/src/geometry.f90 | 4 +- examples/part_inject/input | 2 +- examples/part_inject/src/simulation.f90 | 6 +- examples/poissontest/GNUmakefile | 53 -- examples/poissontest/README | 1 - examples/poissontest/input | 19 - examples/poissontest/src/Make.package | 2 - examples/poissontest/src/geometry.f90 | 73 -- examples/poissontest/src/simulation.f90 | 196 ----- examples/riser/GNUmakefile | 50 -- examples/riser/README | 1 - examples/riser/input | 46 -- examples/riser/src/Make.package | 2 - examples/riser/src/geometry.f90 | 133 ---- examples/riser/src/simulation.f90 | 827 ---------------------- src/config/config_class.f90 | 9 +- src/constant_density/incomp_class.f90 | 2 +- src/grid/pgrid_class.f90 | 103 +-- src/particles/lpt_class.f90 | 37 +- src/solver/Make.package | 4 +- src/two_phase/mast_class.f90 | 2 +- src/two_phase/tpns_class.f90 | 2 +- src/variable_density/lowmach_class.f90 | 5 +- tools/GNUMake/Make.local | 10 +- tools/GNUMake/comps/gnu.mak | 5 +- 28 files changed, 92 insertions(+), 1544 deletions(-) delete mode 100644 examples/poissontest/GNUmakefile delete mode 100644 examples/poissontest/README delete mode 100644 examples/poissontest/input delete mode 100644 examples/poissontest/src/Make.package delete mode 100644 examples/poissontest/src/geometry.f90 delete mode 100644 examples/poissontest/src/simulation.f90 delete mode 100644 examples/riser/GNUmakefile delete mode 100644 examples/riser/README delete mode 100644 examples/riser/input delete mode 100644 examples/riser/src/Make.package delete mode 100644 examples/riser/src/geometry.f90 delete mode 100644 examples/riser/src/simulation.f90 diff --git a/examples/falling_drop/src/simulation.f90 b/examples/falling_drop/src/simulation.f90 index 6e21f7e5c..ba8ca3c82 100644 --- a/examples/falling_drop/src/simulation.f90 +++ b/examples/falling_drop/src/simulation.f90 @@ -350,4 +350,4 @@ subroutine simulation_final end subroutine simulation_final -end module simulation +end module simulation \ No newline at end of file diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 424988008..f506dfbd8 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 2 1 1 +Partition : 8 1 1 # Mesh definition Lx : .0256 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index e6749edd1..c0491e429 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -3,6 +3,8 @@ module simulation use precision, only: WP use geometry, only: cfg use lpt_class, only: lpt + use hypre_uns_class, only: hypre_uns + use hypre_str_class, only: hypre_str use lowmach_class, only: lowmach use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -12,7 +14,9 @@ module simulation implicit none private - !> Get an LPT solver, a lowmach solver, and corresponding time tracker + !> Get an LPT solver, a lowmach solver, and corresponding time tracker, plus a couple of linear solvers + type(hypre_uns), public :: ps + type(hypre_str), public :: vs type(lowmach), public :: fs type(lpt), public :: lp type(timetracker), public :: time @@ -96,14 +100,14 @@ subroutine simulation_init ! Create a low Mach flow solver with bconds create_flow_solver: block - use ils_class, only: pcg_pfmg,gmres_amg - use lowmach_class, only: dirichlet,clipped_neumann + use hypre_uns_class, only: gmres_amg + use hypre_str_class, only: pcg_pfmg + use lowmach_class, only: dirichlet,clipped_neumann ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) - ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity @@ -111,13 +115,15 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + ps=hypre_uns(cfg=cfg,name='Pressure',method=gmres_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=gmres_amg,implicit_ils=pcg_pfmg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_flow_solver @@ -285,11 +291,10 @@ subroutine simulation_init ! Create monitor filea create_monitor: block - real(WP) :: buf ! Prepare some info about fields - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) - call fs%get_cfl(time%dt,buf) - time%cfl=max(time%cfl,buf) + real(WP) :: cfl + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -358,7 +363,7 @@ subroutine simulation_run use mathtools, only: twoPi use parallel, only: parallel_time implicit none - real(WP) :: buf + real(WP) :: cfl ! Perform time integration do while (.not.time%done()) @@ -367,9 +372,8 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) - call fs%get_cfl(time%dt,buf) - time%cfl=max(time%cfl,buf) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() diff --git a/examples/hit/src/geometry.f90 b/examples/hit/src/geometry.f90 index fcd8bef7c..ff2998165 100644 --- a/examples/hit/src/geometry.f90 +++ b/examples/hit/src/geometry.f90 @@ -22,7 +22,7 @@ subroutine geometry_init ! Create a grid from input params create_grid: block - use sgrid_class, only: cartesian + use sgrid_class, only: cartesian integer :: i,nx real(WP) :: Lx real(WP), dimension(:), allocatable :: x @@ -40,7 +40,7 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block - use parallel, only: group + use parallel, only: group integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') diff --git a/examples/part_inject/input b/examples/part_inject/input index ce0325099..529ea015f 100644 --- a/examples/part_inject/input +++ b/examples/part_inject/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 2 2 +Partition : 2 2 2 # Mesh definition Lx : 0.007 diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index b947c1722..be9287951 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -144,9 +144,8 @@ subroutine simulation_init ! Create a monitor file create_monitor: block - real(WP) :: buf ! Prepare some info about fields - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call lp%get_max() ! Create simulation monitor mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') @@ -184,13 +183,12 @@ end subroutine simulation_init !> Perform an NGA2 simulation subroutine simulation_run implicit none - real(WP) :: buf ! Perform time integration do while (.not.time%done()) ! Increment time - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call time%adjust_dt() call time%increment() diff --git a/examples/poissontest/GNUmakefile b/examples/poissontest/GNUmakefile deleted file mode 100644 index 169b46eeb..000000000 --- a/examples/poissontest/GNUmakefile +++ /dev/null @@ -1,53 +0,0 @@ -# NGA location if not yet defined -NGA_HOME ?= ../.. - -# Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_FFTW = TRUE -USE_HYPRE = TRUE -USE_LAPACK = TRUE -USE_P3DFFT = TRUE -PROFILE = FALSE -DEBUG = TRUE -COMP = gnu -EXEBASE = nga - -# Directories that contain user-defined code -Udirs := src - -# Include user-defined sources -Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) -Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) -include $(Upack) -INCLUDE_LOCATIONS += $(Ulocs) -VPATH_LOCATIONS += $(Ulocs) - -# Define external libraries - this can also be in .profile -#HDF5_DIR = /opt/hdf5 -HYPRE_DIR = /opt/hypre -LAPACK_DIR = /opt/lapack-3.10.1 -FFTW_DIR = /opt/fftw-3.3.10 -P3DFFT_DIR = /opt/p3dfft-3/build - -# NGA compilation definitions -include $(NGA_HOME)/tools/GNUMake/Make.defs - -# Include NGA base code -Bdirs := particles core constant_density data solver config grid libraries -Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) -include $(Bpack) - -# Inform user of Make.packages used -ifdef Ulocs - $(info Taking user code from: $(Ulocs)) -endif -$(info Taking base code from: $(Bdirs)) - -# Target definition -all: $(executable) - @echo COMPILATION SUCCESSFUL - -# NGA compilation rules -include $(NGA_HOME)/tools/GNUMake/Make.rules - diff --git a/examples/poissontest/README b/examples/poissontest/README deleted file mode 100644 index 386d2c1f6..000000000 --- a/examples/poissontest/README +++ /dev/null @@ -1 +0,0 @@ -Simple FFT test case. diff --git a/examples/poissontest/input b/examples/poissontest/input deleted file mode 100644 index bdfde8ea9..000000000 --- a/examples/poissontest/input +++ /dev/null @@ -1,19 +0,0 @@ -# Parallelization -Partition : 1 4 1 - -# Mesh definition -Lx : 16.0 -nx : 16 -Ly : 16.0 -ny : 16 -Lz : 1.0 -nz : 1 - -# Point sources -Number of point sources : 3 -Point source x : 2.5 7.5 3.5 -Point source y : 13.5 11.5 1.5 -Point source z : 0.5 0.5 0.5 -Point source strengths : -2.0 4.0 -1.0 - - diff --git a/examples/poissontest/src/Make.package b/examples/poissontest/src/Make.package deleted file mode 100644 index a7a927853..000000000 --- a/examples/poissontest/src/Make.package +++ /dev/null @@ -1,2 +0,0 @@ -# List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/poissontest/src/geometry.f90 b/examples/poissontest/src/geometry.f90 deleted file mode 100644 index 6a7794277..000000000 --- a/examples/poissontest/src/geometry.f90 +++ /dev/null @@ -1,73 +0,0 @@ -!> Various definitions and tools for initializing NGA2 config -module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - public :: geometry_init - -contains - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i, nx, ny, nz - real(WP) :: Lx, Ly, Lz - real(WP), dimension(:), allocatable :: x, y, z - ! Read in grid definition - call param_read('Lx', Lx) - call param_read('nx', nx) - call param_read('Ly', Ly) - call param_read('ny', ny) - call param_read('Lz', Lz) - call param_read('nz', nz) - allocate(x(nx+1), y(ny+1), z(nz+1)) - ! Create simple rectilinear grid - do i = 1, nx+1 - x(i) = real(i-1, WP) / real(nx, WP) * Lx - end do - do i = 1, ny+1 - y(i) = real(i-1, WP) / real(ny, WP) * Ly - end do - do i = 1, nz+1 - z(i) = real(i-1, WP) / real(nz, WP) * Lz - end do - ! General serial grid object - grid = sgrid(coord=cartesian, no=1, x=x, y=y, z=z, xper=.true., & - yper=.true., zper=.true., name='Box') - end block create_grid - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - use pgrid_class, only: p3dfft_decomp - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition', partition, short='p') - - ! Create partitioned grid - cfg = config(grp=group, decomp=partition, grid=grid, strat=p3dfft_decomp) - - end block create_cfg - - ! Create masks for this config - create_walls: block - cfg%VF = 1.0_WP - end block create_walls - - end subroutine geometry_init - -end module geometry - diff --git a/examples/poissontest/src/simulation.f90 b/examples/poissontest/src/simulation.f90 deleted file mode 100644 index 0827480e4..000000000 --- a/examples/poissontest/src/simulation.f90 +++ /dev/null @@ -1,196 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use pfft3d_class, only: pfft3d - use ensight_class, only: ensight - implicit none - private - - type(pfft3d), public :: ps - - !> Ensight postprocessing - type(ensight) :: ens_out - - public :: simulation_init, simulation_run, simulation_final - - !> Problem constants - integer :: npts - real(WP), dimension(:,:), allocatable :: ptsrcs - -contains - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - ! Read params - read_input: block - use messager, only: die - integer :: n - - call param_read('Number of point sources', npts) - allocate(ptsrcs(npts,4)) - call param_read('Point source x', ptsrcs(:,1)) - call param_read('Point source y', ptsrcs(:,2)) - call param_read('Point source z', ptsrcs(:,3)) - call param_read('Point source strengths', ptsrcs(:,4)) - - do n = 1, npts - if (ptsrcs(n,1) .lt. 0.0_WP .or. ptsrcs(n,1) .gt. cfg%xL .or. & - ptsrcs(n,2) .lt. 0.0_WP .or. ptsrcs(n,2) .gt. cfg%yL .or. & - ptsrcs(n,3) .lt. 0.0_WP .or. ptsrcs(n,3) .gt. cfg%zL) then - call die("point not in domain") - end if - end do - - end block read_input - - ! Create a single-phase flow solver without bconds - create_and_initialize_flow_solver: block - integer :: i, j, k - - ! create solver - ps = pfft3d(cfg=cfg, nst=7, name='P3dfft Test') - call ps%init() - - ! set stencil - ps%stc(1,:) = (/ 0, 0, 0 /) - ps%stc(2,:) = (/ +1, 0, 0 /) - ps%stc(3,:) = (/ -1, 0, 0 /) - ps%stc(4,:) = (/ 0, +1, 0 /) - ps%stc(5,:) = (/ 0, -1, 0 /) - ps%stc(6,:) = (/ 0, 0, +1 /) - ps%stc(7,:) = (/ 0, 0, -1 /) - do k = cfg%kmin_, cfg%kmax_ - do j = cfg%jmin_, cfg%jmax_ - do i = cfg%imin_, cfg%imax_ - ps%opr(2,i,j,k) = cfg%dxmi(i)**2 - ps%opr(3,i,j,k) = cfg%dxmi(i)**2 - ps%opr(4,i,j,k) = cfg%dymi(j)**2 - ps%opr(5,i,j,k) = cfg%dymi(j)**2 - ps%opr(6,i,j,k) = cfg%dzmi(k)**2 - ps%opr(7,i,j,k) = cfg%dzmi(k)**2 - ps%opr(1,i,j,k) = - sum(ps%opr(2:7,i,j,k)) - end do - end do - end do - - ! setup - call ps%setup() - - end block create_and_initialize_flow_solver - - ! Add Ensight output - create_ensight: block - - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg, name='PoissionTest') - - ! Add variables to output - call ens_out%add_scalar('rhs',ps%rhs) - call ens_out%add_scalar('sol',ps%sol) - - end block create_ensight - - end subroutine simulation_init - - !> Solve problem - subroutine simulation_run - implicit none - - ! set up rhs - ! this sucks, but it doesn't matter - rhs_setup: block - integer :: n, i, j, k, ic, jc, kc - real(WP) :: d2, d2c - - ps%rhs(:,:,:) = 0.0_WP - - do n = 1, npts - d2c = huge(d2c) - do k = cfg%kmin, cfg%kmax - do j = cfg%jmin, cfg%jmax - do i = cfg%imin, cfg%imax - d2 = (cfg%xm(i) - ptsrcs(n,1))**2 - d2 = d2 + (cfg%ym(j) - ptsrcs(n,2))**2 - d2 = d2 + (cfg%zm(k) - ptsrcs(n,3))**2 - if (d2c .gt. d2) then - d2c = d2; ic = i; jc = j; kc = k; - end if - end do - end do - end do - if (cfg%imin_ .le. ic .and. ic .le. cfg%imax_ .and. & - cfg%jmin_ .le. jc .and. jc .le. cfg%jmax_ .and. & - cfg%kmin_ .le. kc .and. kc .le. cfg%kmax_) then - ps%rhs(ic,jc,kc) = ps%rhs(ic,jc,kc) + ptsrcs(n,4) - end if - end do - - ! Consistent with NGA2 solver - ps%rhs=-ps%rhs - - end block rhs_setup - - ! Solve Poisson equation - ps%sol=0.0_WP - call ps%solve() - - shift_p: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - integer :: i,j,k,ierr - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=cfg%kmin_,cfg%kmax_ - do j=cfg%jmin_,cfg%jmax_ - do i=cfg%imin_,cfg%imax_ - my_vol_tot =my_vol_tot +cfg%vol(i,j,k)*cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+cfg%vol(i,j,k)*cfg%VF(i,j,k)*ps%sol(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot - - ! Shift the pressure - do k=cfg%kmin_,cfg%kmax_ - do j=cfg%jmin_,cfg%jmax_ - do i=cfg%imin_,cfg%imax_ - if (cfg%VF(i,j,k).gt.0.0_WP) ps%sol(i,j,k)=ps%sol(i,j,k)-pressure_tot - end do - end do - end do - call cfg%sync(ps%sol) - end block shift_p - - ! Consistent with NGA2 solver - ps%rhs=-ps%rhs - - ! Output to ensight - call ens_out%write_data(0.0_WP) - - end subroutine simulation_run - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(ptsrcs) - - end subroutine simulation_final - -end module simulation - diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile deleted file mode 100644 index 44ad3a454..000000000 --- a/examples/riser/GNUmakefile +++ /dev/null @@ -1,50 +0,0 @@ -# NGA location if not yet defined -NGA_HOME ?= ../.. - -# Compilation parameters -PRECISION = DOUBLE -USE_MPI = TRUE -USE_HYPRE = TRUE -USE_LAPACK = TRUE -USE_FFTW = TRUE -USE_IRL = FALSE -PROFILE = FALSE -DEBUG = FALSE -COMP = gnu -EXEBASE = nga - -# Directories that contain user-defined code -Udirs := src - -# Include user-defined sources -Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) -Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) -include $(Upack) -INCLUDE_LOCATIONS += $(Ulocs) -VPATH_LOCATIONS += $(Ulocs) - -# Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 - -# NGA compilation definitions -include $(NGA_HOME)/tools/GNUMake/Make.defs - -# Include NGA base code -Bdirs := variable_density particles core data solver config grid libraries -Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) -include $(Bpack) - -# Inform user of Make.packages used -ifdef Ulocs - $(info Taking user code from: $(Ulocs)) -endif -$(info Taking base code from: $(Bdirs)) - -# Target definition -all: $(executable) - @echo COMPILATION SUCCESSFUL - -# NGA compilation rules -include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/riser/README b/examples/riser/README deleted file mode 100644 index 772f09724..000000000 --- a/examples/riser/README +++ /dev/null @@ -1 +0,0 @@ -Periodic pipe with particles. diff --git a/examples/riser/input b/examples/riser/input deleted file mode 100644 index 4ead9b117..000000000 --- a/examples/riser/input +++ /dev/null @@ -1,46 +0,0 @@ -# Parallelization -Partition : 1 4 1 - -# Mesh definition -Pipe length : 0.08 -Pipe diameter : .01 -nx : 570 -ny : 70 -nz : 1 - -# Time integration -Max timestep size : 1e-5 -Max cfl number : 1 -Max time : 10 - -# Fluid properties -Bulk velocity : 0.2 -Dynamic viscosity : 1.8e-5 -Density : 1.2 -Gravity : -9.81 0 0 - -# Particle properties -Particle volume fraction : 0.012 -Particle mean diameter : 58e-6 -Particle standard deviation : 25-6 -Particle min diameter : 21e-6 -Particle max diameter : 140e-6 -Particle diameter shift : 8e-6 -Particle density : 2250 -Collision timescale : 15e-5 -Coefficient of restitution : 0.8 -Friction coefficient : 0.1 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 100e-5 - -# Postprocessing output -Postproc output period : 200e-5 - -# Restart files -Restart output period : 200e-5 -!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/Make.package b/examples/riser/src/Make.package deleted file mode 100644 index a7a927853..000000000 --- a/examples/riser/src/Make.package +++ /dev/null @@ -1,2 +0,0 @@ -# List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 deleted file mode 100644 index 2bbf23f40..000000000 --- a/examples/riser/src/geometry.f90 +++ /dev/null @@ -1,133 +0,0 @@ -!> Various definitions and tools for initializing NGA2 config -module geometry - use config_class, only: config - use precision, only: WP - implicit none - private - - !> Single config - type(config), public :: cfg - - !> Pipe diameter - real(WP), public :: D - - public :: geometry_init, get_VF - -contains - - - !> Initialization of problem geometry - subroutine geometry_init - use sgrid_class, only: sgrid - use param, only: param_read - implicit none - type(sgrid) :: grid - - - ! Create a grid from input params - create_grid: block - use sgrid_class, only: cartesian - integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,dx - real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition - call param_read('Pipe length',Lx) - call param_read('Pipe diameter',D) - call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nx',nx); allocate(x(nx+1)) - call param_read('nz',nz); allocate(z(nz+1)) - - dx=Lx/real(nx,WP) - no=6 - if (ny.gt.1) then - Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) - else - Ly=dx - end if - if (nz.gt.1) then - Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) - else - Lz=dx - end if - - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx - end do - do j=1,ny+1 - y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly - end do - do k=1,nz+1 - z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz - end do - - ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block - use parallel, only: group - integer, dimension(3) :: partition - - ! Read in partition - call param_read('Partition',partition,short='p') - - ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid) - - end block create_cfg - - - ! Create masks for this config - create_walls: block - integer :: i,j,k - do k=cfg%kmin_,cfg%kmax_ - do j=cfg%jmin_,cfg%jmax_ - do i=cfg%imin_,cfg%imax_ - cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) - end do - end do - end do - call cfg%sync(cfg%VF) - end block create_walls - - - end subroutine geometry_init - - - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r - case('V') - delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r - case('W') - delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r - case default - delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - -end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 deleted file mode 100644 index b55e94e28..000000000 --- a/examples/riser/src/simulation.f90 +++ /dev/null @@ -1,827 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use string, only: str_medium - use precision, only: WP - use geometry, only: cfg,D,get_VF - use lowmach_class, only: lowmach - use pfft3d_class, only: pfft3d - use hypre_str_class, only: hypre_str - use lpt_class, only: lpt - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use datafile_class, only: datafile - use monitor_class, only: monitor - implicit none - private - - !> Get an LPT solver, a lowmach solver, and corresponding time tracker - type(lowmach), public :: fs - type(pfft3d), public :: ps - type(hypre_str), public :: vs - type(lpt), public :: lp - type(timetracker), public :: time - - !> Provide a datafile and an event tracker for saving restarts - type(event) :: save_evt - type(datafile) :: df - logical :: restarted - - !> Ensight postprocessing - type(ensight) :: ens_out - type(partmesh) :: pmesh - type(event) :: ens_evt - - !> Event for post-processing - type(event) :: ppevt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,lptfile,tfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt - real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp - real(WP), dimension(:,:,:), allocatable :: G - real(WP), dimension(:,:,:,:), allocatable :: Gnorm - real(WP) :: visc,rho,mfr,mfr_target,bforce - - !> Wallclock time for monitoring - type :: timer - real(WP) :: time_in - real(WP) :: time - real(WP) :: percent - end type timer - type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest - -contains - - - !> Specialized subroutine that outputs mean statistics - subroutine postproc() - use string, only: str_medium - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - integer :: iunit,ierr,i,j,k - real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ - character(len=str_medium) :: filename,timestamp -!!$ ! Allocate radial line storage -!!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP -!!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP -!!$ allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP -!!$ allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP -!!$ ! Integrate all data over x and z -!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ -!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ -!!$ do i=fs%cfg%imin_,fs%cfg%imax_ -!!$ vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) -!!$ Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) -!!$ end do -!!$ end do -!!$ end do -!!$ ! All-reduce the data -!!$ call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) -!!$ call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) -!!$ do j=fs%cfg%jmin,fs%cfg%jmax -!!$ if (vol(j).gt.0.0_WP) then -!!$ Uavg(j)=Uavg(j)/vol(j) -!!$ else -!!$ Uavg(j)=0.0_WP -!!$ end if -!!$ end do -!!$ ! If root, print it out -!!$ if (fs%cfg%amRoot) then -!!$ filename='Uavg_' -!!$ write(timestamp,'(es12.5)') time%t -!!$ open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) -!!$ write(iunit,'(a12,3x,a12)') 'Height','Uavg' -!!$ do j=fs%cfg%jmin,fs%cfg%jmax -!!$ write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) -!!$ end do -!!$ close(iunit) -!!$ end if -!!$ ! Deallocate work arrays -!!$ deallocate(Uavg,Uavg_,vol,vol_) - end subroutine postproc - - - !> Compute massflow rate - function get_bodyforce_mfr(srcU) result(mfr) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: vol,myRhoU,myUvol,Uvol,mfr - myRhoU=0.0_WP; myUvol=0.0_WP - if (present(srcU)) then - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') - myUvol=myUvol+vol - myRhoU=myRhoU+vol*(fs%rhoU(i,j,k)+srcU(i,j,k)) - end do - end do - end do - else - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') - myUvol=myUvol+vol - myRhoU=myRhoU+vol*fs%rhoU(i,j,k) - end do - end do - end do - end if - call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol - end function get_bodyforce_mfr - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Handle restart/saves here - restart_and_save: block - character(len=str_medium) :: timestamp - ! Create event for saving restart files - save_evt=event(time,'Restart output') - call param_read('Restart output period',save_evt%tper) - ! Check if we are restarting - call param_read(tag='Restart from',val=timestamp,short='r',default='') - restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. - if (restarted) then - ! If we are, read the name of the directory - call param_read('Restart from',timestamp,'r') - ! Read the datafile - df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) - else - ! If we are not restarting, we will still need a datafile for saving restart files - df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) - df%valname(1)='t' - df%valname(2)='dt' - df%valname(3)='mfr' - df%valname(4)='bforce' - df%varname(1)='U' - df%varname(2)='V' - df%varname(3)='W' - df%varname(4)='P' - end if - end block restart_and_save - - - ! Revisit timetracker to adjust time and time step values if this is a restart - update_timetracker: block - if (restarted) then - call df%pullval(name='t' ,val=time%t ) - call df%pullval(name='dt',val=time%dt) - time%told=time%t-time%dt - end if - end block update_timetracker - - - ! Initialize wallclock timers - initialize_timers: block - wt_total%time=0.0_WP; wt_total%percent=0.0_WP - wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP - wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP - wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP - wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP - end block initialize_timers - - - ! Create a low Mach flow solver with bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg - ! Create flow solver - fs=lowmach(cfg=cfg,name='Variable density low Mach NS') - - ! Assign constant density - call param_read('Density',rho); fs%rho=rho - ! Assign constant viscosity - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - ps=pfft3d(cfg=cfg,name='Pressure',nst=7) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT solver - initialize_lpt: block - use random, only: random_lognormal,random_uniform - use mathtools, only: Pi,twoPi - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER - use parallel, only: MPI_REAL_WP - real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf - real(WP) :: dmean,dsd,dmin,dmax,dshift - real(WP), dimension(:), allocatable :: dp - integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - character(len=str_medium) :: timestamp - logical :: overlap - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get pipe diameter from input - ! Get mean volume fraction from input - call param_read('Particle volume fraction',VFavg) - ! Get drag model from input - call param_read('Drag model',lp%drag_model,default='Tenneti') - ! Get particle density from input - call param_read('Particle density',lp%rho) - ! Get particle diameter from input - call param_read('Particle mean diameter',dmean) - call param_read('Particle standard deviation',dsd,default=0.0_WP) - call param_read('Particle min diameter',dmin,default=tiny(1.0_WP)) - call param_read('Particle max diameter',dmax,default=huge(1.0_WP)) - call param_read('Particle diameter shift',dshift,default=0.0_WP) - if (dsd.le.epsilon(1.0_WP)) then - dmin=dmean - dmax=dmean - end if - ! Get particle temperature from input - call param_read('Particle temperature',Tp,default=298.15_WP) - ! Set collision timescale - call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) - ! Set coefficient of restitution - call param_read('Coefficient of restitution',lp%e_n) - call param_read('Wall restitution',lp%e_w,default=lp%e_n) - call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) - ! Set gravity - call param_read('Gravity',lp%gravity) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Initialize particles - if (restarted) then - call param_read('Restart from',timestamp,'r') - ! Read the part file - call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) - else - ! Get volume of domain belonging to this proc - Vol_=0.0_WP - do k=lp%cfg%kmin_,lp%cfg%kmax_ - do j=lp%cfg%jmin_,lp%cfg%jmax_ - do i=lp%cfg%imin_,fs%cfg%imax_ - Vol_=Vol_+lp%cfg%dx(i)*lp%cfg%dy(j)*lp%cfg%dz(k) - end do - end do - end do - ! Get particle diameters - np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) - allocate(dp(np)) - sumVolp=0.0_WP; np=0 - do while(sumVolp.lt.VFavg*Vol_) - np=np+1 - dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift - do while (dp(np).gt.dmax+epsilon(1.0_WP).or.dp(np).lt.dmin-epsilon(1.0_WP)) - dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift - end do - sumVolp=sumVolp+Pi/6.0_WP*dp(np)**3 - end do - call lp%resize(np) - ! Allocate particle in cell arrays - allocate(npic( lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); npic=0 - allocate(ipic(1:40,lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); ipic=0 - ! Distribute particles - sumVolp=0.0_WP; meand=0.0_WP - do i=1,np - ! Set the diameter - lp%p(i)%d=dp(i) - ! Give position (avoid overlap) - overlap=.true. - do while (overlap) - lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin_),lp%cfg%x(lp%cfg%imax_+1)-dmax),& - & random_uniform(lp%cfg%y(lp%cfg%jmin_),lp%cfg%y(lp%cfg%jmax_+1)-dmax),& - & random_uniform(lp%cfg%z(lp%cfg%kmin_),lp%cfg%z(lp%cfg%kmax_+1)-dmax)] - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - overlap=.false. - do kk=lp%p(i)%ind(3)-1,lp%p(i)%ind(3)+1 - do jj=lp%p(i)%ind(2)-1,lp%p(i)%ind(2)+1 - do ii=lp%p(i)%ind(1)-1,lp%p(i)%ind(1)+1 - do nn=1,npic(ii,jj,kk) - j=ipic(nn,ii,jj,kk) - if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) overlap=.true. - end do - end do - end do - end do - end do - ! Check if particle is within the pipe - r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) - if (r.le.0.5_WP*(D-lp%p(i)%d)) then - ! Activate the particle - lp%p(i)%flag=0 - ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - ! Set the temperature - lp%p(i)%T=Tp - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero collision force - lp%p(i)%Acol=0.0_WP - lp%p(i)%Tcol=0.0_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Sum up volume - sumVolp=sumVolp+Pi/6.0_WP*lp%p(i)%d**3 - meand=meand+lp%p(i)%d - else - lp%p(i)%flag=1 - end if - end do - deallocate(dp,npic,ipic) - call lp%sync() - ! Set ID - offset=0 - do i=1,lp%cfg%rank - offset=offset+lp%np_proc(i) - end do - do i=1,lp%np_ - lp%p(i)%id=int(i+offset,8) - end do - ! Get mean diameter and volume fraction - call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) - call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*D**2/4.0_WP*lp%cfg%xL) - if (lp%cfg%amRoot) then - print*,"===== Particle Setup Description =====" - print*,'Number of particles', lp%np - print*,'Mean diameter', meand - print*,'Mean volume fraction',VFavg - end if - end if - ! Get initial particle volume fraction - call lp%update_VF() - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='lpt') - pmesh%varname(1)='diameter' - pmesh%vecname(1)='velocity' - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d - pmesh%vec(:,1,i)=lp%p(i)%vel - end do - end block create_pmesh - - - ! Initialize our velocity field - initialize_velocity: block - real(WP) :: Ubulk - if (restarted) then - call df%pullvar(name='U',var=fs%U) - call df%pullvar(name='V',var=fs%V) - call df%pullvar(name='W',var=fs%W) - call df%pullvar(name='P',var=fs%P) - else - ! Initial velocity - call param_read('Bulk velocity',Ubulk) - fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - end if - ! Set density from particle volume fraction and store initial density - fs%rho=rho*(1.0_WP-lp%VF) - rho0=rho - ! Form momentum - call fs%rho_multiply - fs%rhoUold=fs%rhoU - ! Apply all other boundary conditions - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div(drhodt=dRHOdt) - ! Compute MFR through all boundary conditions - call fs%get_mfr() - ! Set initial MFR and body force - if (restarted) then - call df%pullval(name='mfr',val=mfr) - call df%pullval(name='bforce',val=bforce) - else - mfr=get_bodyforce_mfr() - bforce=0.0_WP - end if - mfr_target=mfr - end block initialize_velocity - - - ! Initialize levelset and its normal - initialize_G: block - integer :: i,j,k - real(WP) :: buf - real(WP), dimension(3) :: n12 - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) - n12(1)=0.0_WP - n12(2)=-fs%cfg%ym(j) - n12(3)=-fs%cfg%zm(k) - buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) - Gnorm(:,i,j,k)=n12/buf - end do - end do - end do - call fs%cfg%sync(G) - call fs%cfg%sync(Gnorm) - end block initialize_G - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='riser') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_particle('particles',pmesh) - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',fs%cfg%VF) - call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create monitor filea - create_monitor: block - real(WP) :: buf - ! Prepare some info about fields - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) - call fs%get_cfl(time%dt,buf) - time%cfl=max(time%cfl,buf) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(mfr,'MFR') - call mfile%add_column(bforce,'Body force') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%add_column(lp%CFL_col,'Collision CFL') - call cflfile%write() - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%VFmean,'VFp mean') - call lptfile%add_column(lp%VFmax,'VFp max') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%ncol,'Collision number') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - ! Create timing monitor - tfile=monitor(amroot=fs%cfg%amRoot,name='timing') - call tfile%add_column(time%n,'Timestep number') - call tfile%add_column(time%t,'Time') - call tfile%add_column(wt_total%time,'Total [s]') - call tfile%add_column(wt_vel%time,'Velocity [s]') - call tfile%add_column(wt_vel%percent,'Velocity [%]') - call tfile%add_column(wt_pres%time,'Pressure [s]') - call tfile%add_column(wt_pres%percent,'Pressure [%]') - call tfile%add_column(wt_lpt%time,'LPT [s]') - call tfile%add_column(wt_lpt%percent,'LPT [%]') - call tfile%add_column(wt_rest%time,'Rest [s]') - call tfile%add_column(wt_rest%percent,'Rest [%]') - call tfile%write() - end block create_monitor - - - ! Create a specialized post-processing file - create_postproc: block - ! Create event for data postprocessing - ppevt=event(time=time,name='Postproc output') - call param_read('Postproc output period',ppevt%tper) - ! Perform the output - if (ppevt%occurs()) call postproc() - end block create_postproc - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - use parallel, only: parallel_time - implicit none - real(WP) :: buf - - ! Perform time integration - do while (.not.time%done()) - - ! Initial wallclock time - wt_total%time_in=parallel_time() - - ! Increment time - call lp%get_cfl(time%dt,cflc=buf,cfl=time%cfl) - call fs%get_cfl(time%dt,buf) - time%cfl=max(time%cfl,buf) - call time%adjust_dt() - call time%increment() - - ! Remember old density, velocity, and momentum - fs%rhoold=fs%rho - fs%Uold=fs%U; fs%rhoUold=fs%rhoU - fs%Vold=fs%V; fs%rhoVold=fs%rhoV - fs%Wold=fs%W; fs%rhoWold=fs%rhoW - - ! Get fluid stress (include mean body force from mfr forcing) - wt_lpt%time_in=parallel_time() - call fs%get_div_stress(resU,resV,resW) - resU=resU+bforce - - ! Collide and advance particles - call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& - srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) - - ! Update density based on particle volume fraction - fs%rho=rho*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - wt_vel%time_in=parallel_time() - - ! Build mid-time velocity and momentum - fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) - fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) - fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) - resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) - resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) - - ! Add momentum source term from lpt - add_lpt_src: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) - resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) - resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) - end do - end do - end do - call fs%cfg%sync(resU) - call fs%cfg%sync(resV) - call fs%cfg%sync(resW) - end block add_lpt_src - - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - VFy=get_VF(i,j,k,'V') - VFz=get_VF(i,j,k,'W') - RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) - RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) - RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) - resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) - resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) - resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) - end do - end do - end do - end block ibm_correction - - ! Add body forcing - bodyforcing: block - mfr=get_bodyforce_mfr(resU) - bforce=(mfr_target-mfr)/time%dtmid - resU=resU+time%dtmid*bforce - end block bodyforcing - - ! Form implicit residuals - call fs%solve_implicit(time%dtmid,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - -!!$ ! Apply direct forcing to enforce BC at the pipe walls -!!$ ibm_correction: block -!!$ integer :: i,j,k -!!$ real(WP) :: VFx,VFy,VFz -!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ -!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ -!!$ do i=fs%cfg%imin_,fs%cfg%imax_ -!!$ VFx=get_VF(i,j,k,'U') -!!$ VFy=get_VF(i,j,k,'V') -!!$ VFz=get_VF(i,j,k,'W') -!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx -!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy -!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz -!!$ end do -!!$ end do -!!$ end do -!!$ call fs%cfg%sync(fs%U) -!!$ call fs%cfg%sync(fs%V) -!!$ call fs%cfg%sync(fs%W) -!!$ end block ibm_correction - - ! Apply other boundary conditions and update momentum - call fs%apply_bcond(time%tmid,time%dtmid) - call fs%rho_multiply() - call fs%apply_bcond(time%tmid,time%dtmid) - - wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in - - ! Solve Poisson equation - wt_pres%time_in=parallel_time() - call fs%correct_mfr(drhodt=dRHOdt) - call fs%get_div(drhodt=dRHOdt) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct momentum and rebuild velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%rhoU=fs%rhoU-time%dtmid*resU - fs%rhoV=fs%rhoV-time%dtmid*resV - fs%rhoW=fs%rhoW-time%dtmid*resW - call fs%rho_divide - wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - wt_vel%time_in=parallel_time() - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div(drhodt=dRHOdt) - wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in - - ! Recompute massflow rate - mfr=get_bodyforce_mfr() - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=lp%p(i)%d - pmesh%vec(:,1,i)=lp%p(i)%vel - end do - end block update_pmesh - call ens_out%write_data(time%t) - end if - - ! Specialized post-processing - if (ppevt%occurs()) call postproc() - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - ! Monitor timing - wt_total%time=parallel_time()-wt_total%time_in - wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP - wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP - wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP - wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time - wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP - call tfile%write() - wt_total%time=0.0_WP; wt_total%percent=0.0_WP - wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP - wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP - wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP - wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP - - ! Finally, see if it's time to save restart files - if (save_evt%occurs()) then - save_restart: block - character(len=str_medium) :: timestamp - ! Prefix for files - write(timestamp,'(es12.5)') time%t - ! Prepare a new directory - if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') - ! Populate df and write it - call df%pushval(name='t' ,val=time%t ) - call df%pushval(name='dt',val=time%dt ) - call df%pushval(name='mfr',val=mfr_target) - call df%pushval(name='bforce',val=bforce ) - call df%pushvar(name='U' ,var=fs%U ) - call df%pushvar(name='V' ,var=fs%V ) - call df%pushvar(name='W' ,var=fs%W ) - call df%pushvar(name='P' ,var=fs%P ) - call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) - ! Write particle file - call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) - end block save_restart - end if - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) - - end subroutine simulation_final - -end module simulation diff --git a/src/config/config_class.f90 b/src/config/config_class.f90 index bdac6b0bf..91917045b 100644 --- a/src/config/config_class.f90 +++ b/src/config/config_class.f90 @@ -45,7 +45,7 @@ module config_class !> Single-grid config constructor from a serial grid - function construct_from_sgrid(grp,decomp,grid,strat) result(self) + function construct_from_sgrid(grp,decomp,grid) result(self) use sgrid_class, only: sgrid use string, only: str_medium use mpi_f08, only: MPI_Group @@ -54,13 +54,8 @@ function construct_from_sgrid(grp,decomp,grid,strat) result(self) type(sgrid), intent(in) :: grid type(MPI_Group), intent(in) :: grp integer, dimension(3), intent(in) :: decomp - integer, intent(in), optional :: strat ! Create a partitioned grid with the provided group and decomposition - if (present(strat)) then - self%pgrid=pgrid(grid,grp,decomp,strat) - else - self%pgrid=pgrid(grid,grp,decomp) - end if + self%pgrid=pgrid(grid,grp,decomp) ! Finish preparing the config call self%prep end function construct_from_sgrid diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index f835f2de1..8831ca27a 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -1541,7 +1541,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 148978cc5..936b38002 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -10,10 +10,6 @@ module pgrid_class ! Expose type/constructor/methods public :: pgrid - - !> Parallelization strategy - integer, parameter, public :: default_decomp=1 - integer, parameter, public :: p3dfft_decomp=2 !> Partitioned grid type type, extends(sgrid) :: pgrid @@ -190,7 +186,7 @@ end function construct_pgrid_from_file !> Partitioned grid constructor from sgrid - function construct_pgrid_from_sgrid(grid,grp,decomp,strat) result(self) + function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) use string, only: lowercase use messager, only: die use param, only: verbose @@ -199,7 +195,6 @@ function construct_pgrid_from_sgrid(grid,grp,decomp,strat) result(self) type(sgrid), intent(in) :: grid !< Base grid type(MPI_Group), intent(in) :: grp !< MPI group integer, dimension(3), intent(in) :: decomp !< Requested domain decomposition - integer, intent(in), optional :: strat !< Optional decomposition strategy ! Initialize MPI environment self%group=grp; call self%init_mpi @@ -212,11 +207,7 @@ function construct_pgrid_from_sgrid(grid,grp,decomp,strat) result(self) self%npx=decomp(1); self%npy=decomp(2); self%npz=decomp(3) ! Perform actual domain decomposition of grid - if (present(strat)) then - call self%domain_decomp(strat=strat) - else - call self%domain_decomp() - end if + call self%domain_decomp() ! If verbose run, log and or print grid if (verbose.gt.0) call self%log @@ -248,7 +239,7 @@ end subroutine pgrid_init_mpi !> Prepares the domain decomposition of the pgrid - subroutine pgrid_domain_decomp(self,strat) + subroutine pgrid_domain_decomp(self) use messager, only: die use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none @@ -289,66 +280,34 @@ subroutine pgrid_domain_decomp(self,strat) dir=[.true.,.false.,.true.] call MPI_CART_SUB(self%comm,dir,self%zxcomm,ierr) call MPI_COMM_RANK(self%zxcomm,self%zxrank,ierr) - - ! Choose a decomposition strategy - strat_=default_decomp; if (present(strat)) strat_=strat - select case(strat_) - case(default_decomp) - ! Perform decomposition in x - q=self%nx/self%npx; r=mod(self%nx,self%npx) - self%imin_ =self%imin+ coords(1) *q+min(coords(1) ,r) - self%imax_ =self%imin+(coords(1)+1)*q+min(coords(1)+1,r)-1 - self%nx_ =self%imax_-self%imin_+1 - self%nxo_ =self%nx_+2*self%no - self%imino_=self%imin_-self%no - self%imaxo_=self%imax_+self%no - - ! Perform decomposition in y - q=self%ny/self%npy; r=mod(self%ny,self%npy) - self%jmin_ =self%jmin+ coords(2) *q+min(coords(2) ,r) - self%jmax_ =self%jmin+(coords(2)+1)*q+min(coords(2)+1,r)-1 - self%ny_ =self%jmax_-self%jmin_+1 - self%nyo_ =self%ny_+2*self%no - self%jmino_=self%jmin_-self%no - self%jmaxo_=self%jmax_+self%no - - ! Perform decomposition in z - q=self%nz/self%npz; r=mod(self%nz,self%npz) - self%kmin_ =self%kmin+ coords(3) *q+min(coords(3) ,r) - self%kmax_ =self%kmin+(coords(3)+1)*q+min(coords(3)+1,r)-1 - self%nz_ =self%kmax_-self%kmin_+1 - self%nzo_ =self%nz_+2*self%no - self%kmino_=self%kmin_-self%no - self%kmaxo_=self%kmax_+self%no - case(p3dfft_decomp) - ! Perform p3dfft compatible decomposition in x - q=self%nx/self%npx; r=mod(self%nx,self%npx) - self%imin_ =self%imax+1-q*(self%npx-coords(1) )-min(self%npx-coords(1),r) - self%imax_ =self%imax -q*(self%npx-coords(1)-1)-min(self%npx-coords(1)-1,r) - self%nx_ =self%imax_-self%imin_+1 - self%nxo_ =self%nx_+2*self%no - self%imino_=self%imin_-self%no - self%imaxo_=self%imax_+self%no - - ! Perform p3dfft compatible decomposition in y - q=self%ny/self%npy; r=mod(self%ny,self%npy) - self%jmin_ =self%jmax+1-q*(self%npy-coords(2) )-min(self%npy-coords(2),r) - self%jmax_ =self%jmax -q*(self%npy-coords(2)-1)-min(self%npy-coords(2)-1,r) - self%ny_ =self%jmax_-self%jmin_+1 - self%nyo_ =self%ny_+2*self%no - self%jmino_=self%jmin_-self%no - self%jmaxo_=self%jmax_+self%no - - ! Perform p3dfft compatible decomposition in z - q=self%nz/self%npz; r=mod(self%nz,self%npz) - self%kmin_ =self%kmax+1-q*(self%npz-coords(3) )-min(self%npz-coords(3),r) - self%kmax_ =self%kmax -q*(self%npz-coords(3)-1)-min(self%npz-coords(3)-1,r) - self%nz_ =self%kmax_-self%kmin_+1 - self%nzo_ =self%nz_+2*self%no - self%kmino_=self%kmin_-self%no - self%kmaxo_=self%kmax_+self%no - end select - + + ! Perform decomposition in x + q=self%nx/self%npx; r=mod(self%nx,self%npx) + self%imin_ =self%imin+ coords(1) *q+min(coords(1) ,r) + self%imax_ =self%imin+(coords(1)+1)*q+min(coords(1)+1,r)-1 + self%nx_ =self%imax_-self%imin_+1 + self%nxo_ =self%nx_+2*self%no + self%imino_=self%imin_-self%no + self%imaxo_=self%imax_+self%no + + ! Perform decomposition in y + q=self%ny/self%npy; r=mod(self%ny,self%npy) + self%jmin_ =self%jmin+ coords(2) *q+min(coords(2) ,r) + self%jmax_ =self%jmin+(coords(2)+1)*q+min(coords(2)+1,r)-1 + self%ny_ =self%jmax_-self%jmin_+1 + self%nyo_ =self%ny_+2*self%no + self%jmino_=self%jmin_-self%no + self%jmaxo_=self%jmax_+self%no + + ! Perform decomposition in z + q=self%nz/self%npz; r=mod(self%nz,self%npz) + self%kmin_ =self%kmin+ coords(3) *q+min(coords(3) ,r) + self%kmax_ =self%kmin+(coords(3)+1)*q+min(coords(3)+1,r)-1 + self%nz_ =self%kmax_-self%kmin_+1 + self%nzo_ =self%nz_+2*self%no + self%kmino_=self%kmin_-self%no + self%kmaxo_=self%kmax_+self%no + ! We also need to prepare communication buffers allocate(self%syncbuf_x1(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) allocate(self%syncbuf_x2(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index de482fec8..e7782d88b 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -79,7 +79,7 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) character(len=str_medium), public :: drag_model !< Drag model - + ! Collisional parameters real(WP) :: tau_col !< Characteristic collision time scale real(WP) :: e_n !< Normal restitution coefficient @@ -376,7 +376,7 @@ subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) this%p(i)%Tcol=0.0_WP end do end block zero_force - + ! Then share particles across overlap call this%share() @@ -807,7 +807,6 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque fVF=1.0_WP-pVF ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Interpolate the fluid vorticity to the particle location if needed end block interpolate ! Compute acceleration due to drag @@ -840,17 +839,19 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque opt_dt=tau/real(this%nstep,WP) end block compute_drag -!!$ ! Compute acceleration due to Saffman lift -!!$ compute_lift: block -!!$ use mathtools, only: Pi,cross_product -!!$ real(WP) :: omegag,Cl,Reg -!!$ omegag=sqrt(sum(fvort**2)) -!!$ if (omegag.gt.0.0_WP) then -!!$ Reg = p%d**2*omegag*frho/fvisc -!!$ Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) -!!$ acc=acc+Cl*cross_product(fvel-p%vel,fvort) -!!$ end if -!!$ end block compute_lift + ! Compute acceleration due to Saffman lift + !compute_lift: block + ! use mathtools, only: Pi,cross_product + ! real(WP) :: omegag,Cl,Reg + ! if (this%use_lift) then + ! omegag=sqrt(sum(fvort**2)) + ! if (omegag.gt.0.0_WP) then + ! Reg = p%d**2*omegag*frho/fvisc + ! Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) + ! acc=acc+Cl*cross_product(fvel-p%vel,fvort) + ! end if + ! end if + !end block compute_lift ! Compute fluid torque (assumed Stokes drag) compute_torque: block @@ -999,7 +1000,7 @@ subroutine inject(this,dt,avoid_overlap) implicit none class(lpt), intent(inout) :: this real(WP), intent(inout) :: dt !< Timestep size over which to advance - logical, intent(in), optional :: avoid_overlap !< Option to avoid overlap durig injection + logical, intent(in), optional :: avoid_overlap !< Option to avoid overlap during injection real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep @@ -1235,7 +1236,7 @@ subroutine get_cfl(this,dt,cflc,cfl) ! If asked for, also return the maximum overall CFL if (present(CFL)) cfl=max(cflc,this%CFL_col) - + end subroutine get_cfl @@ -1245,7 +1246,7 @@ subroutine get_max(this) use parallel, only: MPI_REAL_WP implicit none class(lpt), intent(inout) :: this - real(WP) :: buf,safe_np,vol_total + real(WP) :: buf,safe_np integer :: i,j,k,ierr ! Create safe np @@ -1292,14 +1293,12 @@ subroutine get_max(this) call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np ! Get mean, max, and min volume fraction - vol_total=0.0_WP this%VFmean=0.0_WP this%VFmax =-huge(1.0_WP) this%VFmin =+huge(1.0_WP) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - vol_total=vol_total+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k) this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) this%VFmax =max(this%VFmax,this%VF(i,j,k)) this%VFmin =min(this%VFmin,this%VF(i,j,k)) diff --git a/src/solver/Make.package b/src/solver/Make.package index 0df50134e..0e5511f99 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -1,6 +1,6 @@ -f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 ils_class.f90 +f90EXE_sources += linsol_class.f90 bbmg_class.f90 diag_class.f90 ifeq ($(USE_HYPRE),TRUE) - f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 + f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif ifeq ($(USE_FFTW),TRUE) f90EXE_sources += fourier3d_class.f90 diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 041dd74f0..4d106e6f7 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -115,7 +115,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture - + ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 913f77a30..9eaf88f1a 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -2092,7 +2092,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLst) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) end subroutine get_cfl diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 69887e31f..d194ff686 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -763,9 +763,6 @@ subroutine setup(this,pressure_solver,implicit_solver) ! Adjust metrics based on bcflag array call this%adjust_metrics() - - ! Point to pressure solver linsol object - this%psolv=>pressure_solver ! Point to pressure solver linsol object this%psolv=>pressure_solver @@ -1735,7 +1732,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl diff --git a/tools/GNUMake/Make.local b/tools/GNUMake/Make.local index 83604cb94..e0b436202 100644 --- a/tools/GNUMake/Make.local +++ b/tools/GNUMake/Make.local @@ -30,18 +30,18 @@ VERBOSE=TRUE # But I want the opposite. That is ccache is used by default unless # USE_CCACHE is FALSE. But if I am using UPC++, I would like to turn # ccache off. -ifeq ($(USE_CCACHE),TRUE) - CCACHE = ccache +ifeq ($(USE_CCACHE),FALSE) + CCACHE = else ifeq ($(USE_UPCXX),TRUE) CCACHE = else - CCACHE = + CCACHE = ccache endif # When I run on my local desktop, I like to add this gfortran flag. -FFLAGS += -fcheck=array-temps -fallow-argument-mismatch -F90FLAGS += -fcheck=array-temps -fallow-argument-mismatch +FFLAGS += -fcheck=array-temps +F90FLAGS += -fcheck=array-temps # Instead of linking to static gfortran library, I like to use shared libraries. diff --git a/tools/GNUMake/comps/gnu.mak b/tools/GNUMake/comps/gnu.mak index 844aec3f0..fa254a9e3 100644 --- a/tools/GNUMake/comps/gnu.mak +++ b/tools/GNUMake/comps/gnu.mak @@ -40,9 +40,8 @@ ifeq ($(DEBUG),TRUE) CXXFLAGS += -Og -fno-inline -ggdb -Wshadow -Wall -Wno-sign-compare -ftrapv -Wno-unused-but-set-variable CFLAGS += -Og -fno-inline -ggdb -Wshadow -Wall -Wno-sign-compare -ftrapv - # TODO I don't like removing -pedantic from these, but it's needed to get p3dfft to compile - FFLAGS += -Og -ggdb -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv - F90FLAGS += -Og -ggdb -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv + FFLAGS += -Og -ggdb -pedantic -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv + F90FLAGS += -Og -ggdb -pedantic -fcheck=all -fbacktrace -Wall -Wuninitialized -Wunused -ffpe-trap=invalid,zero -finit-real=snan -finit-integer=2147483647 -ftrapv ifneq ($(gcc_major_version),$(filter $(gcc_major_version),4 5)) CXXFLAGS += -Wnull-dereference From 9a4ccf41c426f83bc5525083a1a9c8da27e038c0 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 17:48:24 -0500 Subject: [PATCH 112/152] Riser case Added the riser case --- examples/riser/GNUmakefile | 50 ++ examples/riser/README | 1 + examples/riser/input | 46 ++ examples/riser/src/Make.package | 2 + examples/riser/src/geometry.f90 | 133 +++++ examples/riser/src/simulation.f90 | 825 ++++++++++++++++++++++++++++++ 6 files changed, 1057 insertions(+) create mode 100644 examples/riser/GNUmakefile create mode 100644 examples/riser/README create mode 100644 examples/riser/input create mode 100644 examples/riser/src/Make.package create mode 100644 examples/riser/src/geometry.f90 create mode 100644 examples/riser/src/simulation.f90 diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile new file mode 100644 index 000000000..44ad3a454 --- /dev/null +++ b/examples/riser/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := variable_density particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/riser/README b/examples/riser/README new file mode 100644 index 000000000..772f09724 --- /dev/null +++ b/examples/riser/README @@ -0,0 +1 @@ +Periodic pipe with particles. diff --git a/examples/riser/input b/examples/riser/input new file mode 100644 index 000000000..4ead9b117 --- /dev/null +++ b/examples/riser/input @@ -0,0 +1,46 @@ +# Parallelization +Partition : 1 4 1 + +# Mesh definition +Pipe length : 0.08 +Pipe diameter : .01 +nx : 570 +ny : 70 +nz : 1 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 +Max time : 10 + +# Fluid properties +Bulk velocity : 0.2 +Dynamic viscosity : 1.8e-5 +Density : 1.2 +Gravity : -9.81 0 0 + +# Particle properties +Particle volume fraction : 0.012 +Particle mean diameter : 58e-6 +Particle standard deviation : 25-6 +Particle min diameter : 21e-6 +Particle max diameter : 140e-6 +Particle diameter shift : 8e-6 +Particle density : 2250 +Collision timescale : 15e-5 +Coefficient of restitution : 0.8 +Friction coefficient : 0.1 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 100e-5 + +# Postprocessing output +Postproc output period : 200e-5 + +# Restart files +Restart output period : 200e-5 +!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/Make.package b/examples/riser/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/riser/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 new file mode 100644 index 000000000..2bbf23f40 --- /dev/null +++ b/examples/riser/src/geometry.f90 @@ -0,0 +1,133 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init, get_VF + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 new file mode 100644 index 000000000..eff547c6e --- /dev/null +++ b/examples/riser/src/simulation.f90 @@ -0,0 +1,825 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg,D,get_VF + use lowmach_class, only: lowmach + use fourier3d_class, only: fourier3d + use hypre_str_class, only: hypre_str + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker + type(lowmach), public :: fs + type(fourier3d), public :: ps + type(hypre_str), public :: vs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Provide a datafile and an event tracker for saving restarts + type(event) :: save_evt + type(datafile) :: df + logical :: restarted + + !> Ensight postprocessing + type(ensight) :: ens_out + type(partmesh) :: pmesh + type(event) :: ens_evt + + !> Event for post-processing + type(event) :: ppevt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,lptfile,tfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: G + real(WP), dimension(:,:,:,:), allocatable :: Gnorm + real(WP) :: visc,rho,mfr,mfr_target,bforce + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + +contains + + + !> Specialized subroutine that outputs mean statistics + subroutine postproc() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp +!!$ ! Allocate radial line storage +!!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP +!!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP +!!$ allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP +!!$ allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP +!!$ ! Integrate all data over x and z +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) +!!$ Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) +!!$ end do +!!$ end do +!!$ end do +!!$ ! All-reduce the data +!!$ call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ if (vol(j).gt.0.0_WP) then +!!$ Uavg(j)=Uavg(j)/vol(j) +!!$ else +!!$ Uavg(j)=0.0_WP +!!$ end if +!!$ end do +!!$ ! If root, print it out +!!$ if (fs%cfg%amRoot) then +!!$ filename='Uavg_' +!!$ write(timestamp,'(es12.5)') time%t +!!$ open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) +!!$ write(iunit,'(a12,3x,a12)') 'Height','Uavg' +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) +!!$ end do +!!$ close(iunit) +!!$ end if +!!$ ! Deallocate work arrays +!!$ deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*(fs%rhoU(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*fs%rhoU(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Handle restart/saves here + restart_and_save: block + character(len=str_medium) :: timestamp + ! Create event for saving restart files + save_evt=event(time,'Restart output') + call param_read('Restart output period',save_evt%tper) + ! Check if we are restarting + call param_read(tag='Restart from',val=timestamp,short='r',default='') + restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. + if (restarted) then + ! If we are, read the name of the directory + call param_read('Restart from',timestamp,'r') + ! Read the datafile + df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) + else + ! If we are not restarting, we will still need a datafile for saving restart files + df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) + df%valname(1)='t' + df%valname(2)='dt' + df%valname(3)='mfr' + df%valname(4)='bforce' + df%varname(1)='U' + df%varname(2)='V' + df%varname(3)='W' + df%varname(4)='P' + end if + end block restart_and_save + + + ! Revisit timetracker to adjust time and time step values if this is a restart + update_timetracker: block + if (restarted) then + call df%pullval(name='t' ,val=time%t ) + call df%pullval(name='dt',val=time%dt) + time%told=time%t-time%dt + end if + end block update_timetracker + + + ! Initialize wallclock timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_lognormal,random_uniform + use mathtools, only: Pi,twoPi + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER + use parallel, only: MPI_REAL_WP + real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf + real(WP) :: dmean,dsd,dmin,dmax,dshift + real(WP), dimension(:), allocatable :: dp + integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + character(len=str_medium) :: timestamp + logical :: overlap + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get pipe diameter from input + ! Get mean volume fraction from input + call param_read('Particle volume fraction',VFavg) + ! Get drag model from input + call param_read('Drag model',lp%drag_model,default='Tenneti') + ! Get particle density from input + call param_read('Particle density',lp%rho) + ! Get particle diameter from input + call param_read('Particle mean diameter',dmean) + call param_read('Particle standard deviation',dsd,default=0.0_WP) + call param_read('Particle min diameter',dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',dshift,default=0.0_WP) + if (dsd.le.epsilon(1.0_WP)) then + dmin=dmean + dmax=dmean + end if + ! Get particle temperature from input + call param_read('Particle temperature',Tp,default=298.15_WP) + ! Set collision timescale + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Initialize particles + if (restarted) then + call param_read('Restart from',timestamp,'r') + ! Read the part file + call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) + else + ! Get volume of domain belonging to this proc + Vol_=0.0_WP + do k=lp%cfg%kmin_,lp%cfg%kmax_ + do j=lp%cfg%jmin_,lp%cfg%jmax_ + do i=lp%cfg%imin_,fs%cfg%imax_ + Vol_=Vol_+lp%cfg%dx(i)*lp%cfg%dy(j)*lp%cfg%dz(k) + end do + end do + end do + ! Get particle diameters + np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) + allocate(dp(np)) + sumVolp=0.0_WP; np=0 + do while(sumVolp.lt.VFavg*Vol_) + np=np+1 + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + do while (dp(np).gt.dmax+epsilon(1.0_WP).or.dp(np).lt.dmin-epsilon(1.0_WP)) + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + end do + sumVolp=sumVolp+Pi/6.0_WP*dp(np)**3 + end do + call lp%resize(np) + ! Allocate particle in cell arrays + allocate(npic( lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); npic=0 + allocate(ipic(1:40,lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); ipic=0 + ! Distribute particles + sumVolp=0.0_WP; meand=0.0_WP + do i=1,np + ! Set the diameter + lp%p(i)%d=dp(i) + ! Give position (avoid overlap) + overlap=.true. + do while (overlap) + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin_),lp%cfg%x(lp%cfg%imax_+1)-dmax),& + & random_uniform(lp%cfg%y(lp%cfg%jmin_),lp%cfg%y(lp%cfg%jmax_+1)-dmax),& + & random_uniform(lp%cfg%z(lp%cfg%kmin_),lp%cfg%z(lp%cfg%kmax_+1)-dmax)] + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + overlap=.false. + do kk=lp%p(i)%ind(3)-1,lp%p(i)%ind(3)+1 + do jj=lp%p(i)%ind(2)-1,lp%p(i)%ind(2)+1 + do ii=lp%p(i)%ind(1)-1,lp%p(i)%ind(1)+1 + do nn=1,npic(ii,jj,kk) + j=ipic(nn,ii,jj,kk) + if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) overlap=.true. + end do + end do + end do + end do + end do + ! Check if particle is within the pipe + r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) + if (r.le.0.5_WP*(D-lp%p(i)%d)) then + ! Activate the particle + lp%p(i)%flag=0 + ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + ! Set the temperature + lp%p(i)%T=Tp + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Sum up volume + sumVolp=sumVolp+Pi/6.0_WP*lp%p(i)%d**3 + meand=meand+lp%p(i)%d + else + lp%p(i)%flag=1 + end if + end do + deallocate(dp,npic,ipic) + call lp%sync() + ! Set ID + offset=0 + do i=1,lp%cfg%rank + offset=offset+lp%np_proc(i) + end do + do i=1,lp%np_ + lp%p(i)%id=int(i+offset,8) + end do + ! Get mean diameter and volume fraction + call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) + call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*D**2/4.0_WP*lp%cfg%xL) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', lp%np + print*,'Mean diameter', meand + print*,'Mean volume fraction',VFavg + end if + end if + ! Get initial particle volume fraction + call lp%update_VF() + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + real(WP) :: Ubulk + if (restarted) then + call df%pullvar(name='U',var=fs%U) + call df%pullvar(name='V',var=fs%V) + call df%pullvar(name='W',var=fs%W) + call df%pullvar(name='P',var=fs%P) + else + ! Initial velocity + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + end if + ! Set density from particle volume fraction and store initial density + fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho + ! Form momentum + call fs%rho_multiply + fs%rhoUold=fs%rhoU + ! Apply all other boundary conditions + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Set initial MFR and body force + if (restarted) then + call df%pullval(name='mfr',val=mfr) + call df%pullval(name='bforce',val=bforce) + else + mfr=get_bodyforce_mfr() + bforce=0.0_WP + end if + mfr_target=mfr + end block initialize_velocity + + + ! Initialize levelset and its normal + initialize_G: block + integer :: i,j,k + real(WP) :: buf + real(WP), dimension(3) :: n12 + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + n12(1)=0.0_WP + n12(2)=-fs%cfg%ym(j) + n12(3)=-fs%cfg%zm(k) + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + Gnorm(:,i,j,k)=n12/buf + end do + end do + end do + call fs%cfg%sync(G) + call fs%cfg%sync(Gnorm) + end block initialize_G + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='riser') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',fs%cfg%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create monitor filea + create_monitor: block + real(WP) :: cfl + ! Prepare some info about fields + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%ncol,'Collision number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc() + end block create_postproc + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use parallel, only: parallel_time + implicit none + real(WP) :: cfl + + ! Perform time integration + do while (.not.time%done()) + + ! Initial wallclock time + wt_total%time_in=parallel_time() + + ! Increment time + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Get fluid stress (include mean body force from mfr forcing) + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + resU=resU+bforce + + ! Collide and advance particles + call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + end block add_lpt_src + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) + RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) + RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + end do + end do + end do + end block ibm_correction + + ! Add body forcing + bodyforcing: block + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dtmid*bforce + end block bodyforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + +!!$ ! Apply direct forcing to enforce BC at the pipe walls +!!$ ibm_correction: block +!!$ integer :: i,j,k +!!$ real(WP) :: VFx,VFy,VFz +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ VFx=get_VF(i,j,k,'U') +!!$ VFy=get_VF(i,j,k,'V') +!!$ VFz=get_VF(i,j,k,'W') +!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx +!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy +!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz +!!$ end do +!!$ end do +!!$ end do +!!$ call fs%cfg%sync(fs%U) +!!$ call fs%cfg%sync(fs%V) +!!$ call fs%cfg%sync(fs%W) +!!$ end block ibm_correction + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Solve Poisson equation + wt_pres%time_in=parallel_time() + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Recompute massflow rate + mfr=get_bodyforce_mfr() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Specialized post-processing + if (ppevt%occurs()) call postproc() + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + ! Finally, see if it's time to save restart files + if (save_evt%occurs()) then + save_restart: block + character(len=str_medium) :: timestamp + ! Prefix for files + write(timestamp,'(es12.5)') time%t + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Populate df and write it + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt ) + call df%pushval(name='mfr',val=mfr_target) + call df%pushval(name='bforce',val=bforce ) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) + call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) + ! Write particle file + call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) + end block save_restart + end if + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) + + end subroutine simulation_final + +end module simulation From 2b6e5f7c649fd46f28a33553a6dd30961465a888 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 8 Feb 2023 21:31:47 -0500 Subject: [PATCH 113/152] Riser update Calculate fluid volume fraction using IB VF --- examples/riser/input | 4 ++-- examples/riser/src/geometry.f90 | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/examples/riser/input b/examples/riser/input index 4ead9b117..1f1fe64e4 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -14,7 +14,7 @@ Max cfl number : 1 Max time : 10 # Fluid properties -Bulk velocity : 0.2 +Bulk velocity : 0.272 Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 @@ -36,7 +36,7 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 100e-5 +Ensight output period : 200e-5 # Postprocessing output Postproc output period : 200e-5 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 index 2bbf23f40..57e685a7d 100644 --- a/examples/riser/src/geometry.f90 +++ b/examples/riser/src/geometry.f90 @@ -93,6 +93,7 @@ subroutine geometry_init end do end do call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() end block create_walls From 34608c81676ba1e1f7998f9a53656ea7df590a6e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 11:25:08 -0500 Subject: [PATCH 114/152] Squashed commit of the following: commit 2b6e5f7c649fd46f28a33553a6dd30961465a888 Author: jessecaps Date: Wed Feb 8 21:31:47 2023 -0500 Riser update Calculate fluid volume fraction using IB VF commit 9a4ccf41c426f83bc5525083a1a9c8da27e038c0 Author: jessecaps Date: Wed Feb 8 17:48:24 2023 -0500 Riser case Added the riser case commit 9217d197df5c3921d256ebac52d98cb72d830621 Author: jessecaps Date: Wed Feb 8 17:37:46 2023 -0500 Sync w/ Olivier Sync with Olivier's develop branch commit 9d83c8e353dd101d04d88509c5ec6b5ef6ea5764 Author: jessecaps Date: Wed Feb 8 17:36:10 2023 -0500 Squashed commit of the following: commit 0bca3e86d38e65d82bcf05e26ad2d4884d15fbac Author: Olivier Desjardins Date: Tue Feb 7 23:19:41 2023 -0500 Added IB-particle collision from Jesse. Switched all solvers (except MAST!) to new linsol class. ALMOST ALL EXAMPLES WILL NEED TO BE UPDATED! commit 26b4fe29243963770710ed5b59b9b912dbec536b Author: Olivier Desjardins Date: Tue Feb 7 22:29:02 2023 -0500 Switched fourier3d to c2c... commit 19ae45186b1966242d8e3675f8f66be17bd5ea05 Author: Olivier Desjardins Date: Tue Feb 7 22:09:34 2023 -0500 Commit what I think is the cleanest implementation of r2r fftw solver - but that requires another strategy for building the operator commit a9becb0343bc7f3b07d3c8b230c9882426b5b3bb Author: Olivier Desjardins Date: Tue Feb 7 16:22:59 2023 -0500 p3dfft is also removed as decomposition strategy commit 31219cef08bbbbf0c0a4cac2985d47ac89f32938 Author: Olivier Desjardins Date: Tue Feb 7 16:16:07 2023 -0500 May not be working yet - this commit removes p3dfft altogether, replaces it with our in-house fourier solver. commit ff795e1aa35e23c9fcabe11d79fae700d605ed57 Author: Olivier Desjardins Date: Tue Feb 7 09:49:15 2023 -0500 Started adding a multiphase_pipe case. Started adding back in-house fourier solver. Fixed bug with hit. commit ec57c3a84e25f3af98e0a7ea79615efe3841aa2d Author: Olivier Desjardins Date: Mon Feb 6 13:41:15 2023 -0500 Proper non-dimensionalization of the swirl injection case commit 49d5325fd38e0624ff6a5d66c0e75ebbf4c02960 Author: Olivier Desjardins Date: Mon Feb 6 13:17:20 2023 -0500 Moved library directory specification to my .zshrc to remove all reference to 'desjardi'... commit 7937d14022734d4ccf24315e24f2fade3a7914a6 Author: Olivier Desjardins Date: Mon Feb 6 10:59:56 2023 -0500 Adding a swirl atomizer test case. commit c70dd8ba887f39b40510b75409d30dd525e58390 Author: Olivier Desjardins Date: Sun Feb 5 21:51:08 2023 -0500 Particles with id=0 do not modify the flow and are not advanced. They're just kinda... there. commit 305694cffbe3ff5ccc5f544adef497eebcd0f40d Author: Olivier Desjardins Date: Sun Feb 5 21:35:21 2023 -0500 Removed shock-particle case, it's not ready. commit 4bf8f61d4996c35aff2581a5e8f2987d0e05e9a8 Author: Olivier Desjardins Date: Sun Feb 5 21:34:04 2023 -0500 Updated shit_p routines to make use of newly defined integration tools and fluid_vol variable. commit af17f44d5ce8eb088e9433e3e0b1188d6b0e5066 Author: Olivier Desjardins Date: Sun Feb 5 20:01:42 2023 -0500 Absorded range of modifications from Jesse's repository. Most important is the use of p3dfft for fourier-based linear solvers. commit f962bc2b278e419c8d8d09e5e45d5ea677bf9d6e Author: Olivier Desjardins Date: Fri Feb 3 17:17:33 2023 -0500 Clean-up ib_pipe to make it a proper pipe flow LES. Cleaned up Vreman's sgs model. commit 6c4766c03f875933dc4435d09b36cc43908e77b5 Author: Olivier Desjardins Date: Fri Feb 3 14:19:32 2023 -0500 Slight clean-up of the turbulent ib_pipe case. commit bf6f53909e43e24aed0f4cfb802118bb447f61fd Author: Olivier Desjardins Date: Thu Feb 2 22:57:49 2023 -0500 ib_pipe modified to absorb Jesse's changes, and pushed to turbulent conditions. commit d7892206a0a67fc87a3357270811944df00e26bc Author: Olivier Desjardins Date: Thu Feb 2 14:56:07 2023 -0500 Small changes to falling_drop, added new ib_drop case. commit 1ceb7d2b0dced02f0bbb0782a4c386ab350bce29 Author: Olivier Desjardins Date: Wed Feb 1 10:41:13 2023 -0500 Reindent df_class. Need to think about role of rho here for two-phase flows. commit 8461ee6cbca3d2075cb920236020f6265cc5469d Author: jessecaps Date: Wed Feb 8 15:03:37 2023 -0500 remove p3dfft decomp Thought I removed this commit 3be151fbb55a48aae73310fd6fa9ccfcd997a59b Author: jessecaps Date: Wed Feb 8 11:29:26 2023 -0500 Update GNUmakefile Remove p3dfft commit 5b56d8f6fc8d4ceda19c55f66b2c98f3f8c2c958 Author: jessecaps Date: Wed Feb 8 08:52:48 2023 -0500 LPT updates Remove solver specific flags. Added optional argument to avoid overlap when injection routine is called. Also fixed a bug with LPT cfl, before the LPT cfl was overwriting flow solver CFL. Now we have option to use collisional CFL and then check max. commit ee68f906d34c637a4d58e28da6db516624f519bc Author: jessecaps Date: Tue Feb 7 14:09:04 2023 -0500 IB collision + linsol integration Replace pipe collision detection with more general (but expensive) IB detection. Also brought linsol into the variable density solvers. commit cac0ade27004857b838ebe98f9f6408d1ab048c4 Author: jessecaps Date: Tue Feb 7 14:01:04 2023 -0500 nothing important Back to Olivier's version commit be5f1f9a152d9b789bc297b8c64f3848ce3edfdf Author: jessecaps Date: Tue Feb 7 13:47:39 2023 -0500 In-house P3DFFT NGA2 now runs without external dependency for parallel fft library. Slightly slower than using a library, but can likely be optimized commit 5c4d2320485255e53dcbc84d00ed726ff791996c Author: jessecaps Date: Sat Feb 4 11:09:40 2023 -0500 Update simulation.f90 monitor the correct mfr each time step commit b7dbc2b76fbe10ace9c73eedb0aa2388fbbcf26d Author: jessecaps Date: Sat Feb 4 11:05:08 2023 -0500 P3DFFT allows for general decomposition Implemented P3DFFT compatible parallel decomposition, can now run FFT pressure solver w/ nprocs that don't evenly divide into the number of grid points! For IB Pipe need to add epsilon to cfg%VF, pressure solver doesn't like zero volumes commit 9e568018f4e5985fc46da3df229dda0227943ecf Author: jessecaps Date: Fri Feb 3 17:44:31 2023 -0500 Merge branch 'develop' of https://github.com/desjardi/NGA2 into develop commit 3278fd087ae6d31cd9d924184c78493524e81ffc Author: jessecaps Date: Thu Feb 2 20:36:28 2023 -0500 Update geometry.f90 I should compile being pushing commit 7aefa45ab1819bc66db2a35cb6797e8bde487f53 Author: jessecaps Date: Thu Feb 2 17:16:10 2023 -0500 Update geometry.f90 How did my compiler miss this? commit ef24ad81c5997d286e962e4700f96bbf549a6c00 Author: jessecaps Date: Thu Feb 2 10:04:56 2023 -0500 Update pfft3d_class.f90 Because Jack insists commit 5842d2e76cab2053f8c1e170fe6ae44b03cf1985 Author: jessecaps Date: Thu Feb 2 09:58:44 2023 -0500 Update pfft3d_class.f90 Less restrictive check, the old check failed when domain length had decimal value commit 2aa1478a71f15450223bf6a21490a6e316ad3055 Author: jessecaps Date: Thu Feb 2 07:37:32 2023 -0500 Particle-laden pipe flow is working We now have clustering! Added ability to detect collisions with cylinder walls. commit 917ece432e3193761e79558203d96630fcb64f93 Author: jessecaps Date: Wed Feb 1 14:18:07 2023 -0500 Update pfft3d_class.f90 This version works in 2D + 3D, still issue with 2D when npx=1 commit ec09e9fb811cd0442997c8a17fec65e651c8688b Author: jessecaps Date: Wed Feb 1 13:08:21 2023 -0500 Update pfft3d_class.f90 3D FFT works in many cases, in parallel num procs must be evenly divisible into nx. Also seems to be a bug in the p3dfft library when nz=1 and npx=1. commit 2d5aba0bac68e24a3dc5a2047124ffcd0b165725 Author: jessecaps Date: Wed Feb 1 13:07:14 2023 -0500 Update poissontest Add consistency with NGA solver commit 0750caf15d7703745a91940e256b96e4506288f3 Author: jessecaps Date: Wed Feb 1 09:05:18 2023 -0500 Fix conflicts with merge Synced with Olivier's develop branch commit 1247ef2f6a6ffbbf22ade0ef2b4683f054073929 Merge: 73720a6 e21b0b1 Author: jessecaps Date: Wed Feb 1 08:57:43 2023 -0500 Merge branch 'develop' of https://github.com/desjardi/NGA2 into develop commit 73720a64513a346cdf545e106503b4cfcb17f1ed Author: jessecaps Date: Tue Jan 31 17:00:46 2023 -0500 Update pfft3d_class.f90 3D FFT is now working in serial and in parallel (tested on the HIT case)! commit e21b0b1ed32fbdec5a094acc0e223a5a63e8f471 Author: Olivier Desjardins Date: Tue Jan 31 16:17:16 2023 -0500 Replaced itpi by itpr in ib_tester. commit 48beaf0686cc85ae31f2345eb506602c9ded46f8 Author: Olivier Desjardins Date: Tue Jan 31 16:14:27 2023 -0500 Cleaned up gradU, strainrate, vorticity to make all solvers more similar. Also removed itpi from incomp and replaced by itpr. commit e9773ceab54419168b20501ae9969fbc6514a922 Author: jessecaps Date: Tue Jan 31 14:55:18 2023 -0500 Update pfft3d_class.f90 Serial FFTW implemented and verified it works. commit 3b1639bb2cdcd3176037ebfed639f3951e419532 Author: jessecaps Date: Mon Jan 30 13:56:56 2023 -0500 p3dfft merge Merge Jack's P3DFFT updates commit a8f65c1f39729a3ab2d110aea75da9045771c7ed Merge: 766c357 ccae70d Author: jessecaps Date: Mon Jan 30 13:56:32 2023 -0500 Merge branch 'p3dfft' into develop commit 766c357dc3d5bfdb1c5bbdf91896d17fbd4f1cac Author: jessecaps Date: Sat Jan 28 10:16:42 2023 -0500 Update lpt_class.f90 Do not include particles w/ id=0 when computing VF commit ccae70d28e549db52b48929d8cb1fad2f4439bd3 Author: John Wakefield Date: Fri Jan 27 21:30:23 2023 -0500 fixed scaling commit 3afc9c941ecace11deb2f6e49c0f2750eac058c1 Author: jessecaps Date: Fri Jan 27 18:48:44 2023 -0500 Update to pipe cases Geometry now computes volume fraction field for IBM, useful for integration to take into account correct volume commit 5781f18da8e6d62cd86fb3976d8efac800ac7c38 Author: John Wakefield Date: Fri Jan 27 13:09:51 2023 -0500 added Poisson equation with point sources test case for p3dfft solver commit 475fade7223a38038fdf64479d5fd46269901b3e Author: John Wakefield Date: Fri Jan 27 13:09:15 2023 -0500 fixed off by one error commit 2fa5f3a272c805491d6b1938f377b6ab0d06053a Author: Olivier Desjardins Date: Fri Jan 27 12:13:08 2023 -0500 Removed extra line from mast commit eebe39d3e788579c84ff6fe47674cae4848504aa Author: Olivier Desjardins Date: Thu Jan 26 17:29:07 2023 -0500 Removed redundant subroutine in low Mach solver due to incorrect conflict resolution. commit 0dc01ce9ea54ee47d1689c22226233f58f177474 Author: jessecaps Date: Thu Jan 26 14:07:58 2023 -0500 Update Make.p3dfft Not needed commit 3060d19a7d914c0b03da1e171dfe30d2dd551f3f Author: jessecaps Date: Thu Jan 26 13:05:51 2023 -0500 Update Make.p3dfft Need to point to correct directories commit 0a0a86eea608dbe70551b0021cc9087fab071bfb Author: jessecaps Date: Thu Jan 26 12:04:22 2023 -0500 fixing merge issues commit 82f803fa0faf4416c25e28f65f4b86e64be5726c Author: jessecaps Date: Wed Jan 25 22:26:45 2023 -0500 Update incomp_class.f90 Added itpi_x operator needed by IBM commit 90ca7e4003ce44670f36539f040f611fc70fe0ca Author: jessecaps Date: Wed Jan 25 21:43:07 2023 -0500 Remove old example case commit 30016bae2aa3fc0e513d0cc98f5661a9af256ff8 Merge: f805f3d 53a06cf Author: jessecaps Date: Wed Jan 25 21:36:34 2023 -0500 Merge branch 'p3dfft' into develop commit f805f3d6e002b9ac1a6a2a071c20b3f9f9426de1 Author: jessecaps Date: Wed Jan 25 18:16:31 2023 -0500 Resolve issues from previous merge Resolve issues from previous merge commit dd5fb99b91c540a9190d8b24b44590d0934591a5 Author: jessecaps Date: Wed Jan 25 18:07:45 2023 -0500 Update lowmach_class.f90 cosmetic commit 092cee56e9701ffdb22b24f5dbfd22696f800ed8 Merge: 8a3d5a9 397c154 Author: jessecaps Date: Wed Jan 25 18:07:13 2023 -0500 Merge branch 'develop' of https://github.com/desjardi/NGA2 into develop commit 8a3d5a9b4676bce1dc36ae214c2ca9bb2c1e2a81 Author: jessecaps Date: Wed Jan 25 17:56:14 2023 -0500 New riser case New riser case that solves particles in a periodic pipe. Uses a simple IBM for pipe and body forcing. Includes restart capabilities and wallclock timing. TODO: LPT collisions with pipe walls commit 53a06cfeb169b66d6745bedf63f97444de835d3b Author: John Wakefield Date: Wed Jan 25 16:33:23 2023 -0500 fixed processor-local indices in fourier space commit 397c154177f08e9a9d1b53e317990fd9015410c4 Author: Olivier Desjardins Date: Wed Jan 25 16:32:08 2023 -0500 Squashed commit of the following: commit 49fc8e8e32095cd8edb264afcf76a13ecc0ace04 Author: jessecaps Date: Mon Jan 9 15:46:23 2023 -0500 Update simulation.f90 Avoid division by 0 commit 0e80a30f2ed25a8c39631c8e2fc7c001634239fd Author: jessecaps Date: Sun Jan 8 11:56:35 2023 -0500 Part inject Particle injection example commit 8e5df3b717550cb4b8de88019868f8ae154f7922 Author: jessecaps Date: Sun Jan 8 11:53:24 2023 -0500 Update sgsmodel_class.f90 Separate out different SGS models. Currently includes constant coeff Smagornisky, Vreman, and dynamic smag. Dynamic smag still has a bug. commit 4d62407694b314bf2690fd0dbe83385a44c6b3c3 Author: jessecaps Date: Sun Jan 8 11:51:15 2023 -0500 Direct forcing solver added Direct forcing IBM solver with example. Still needs updates to allow for moving IBs but that is not difficult. commit ec6fad52022afd1741741b691a0dfdaf29c4eb0e Author: jessecaps Date: Sun Jan 8 11:45:05 2023 -0500 Channel case added Olivier's channel case (without non-Newtonian visc part) commit b533e73cbb1bb13dbb8a4ea62e1aa306a009b5cf Author: jessecaps Date: Sun Jan 8 11:43:23 2023 -0500 Simple IB pipe case Simple IB pipe case. Does not rely on an IBM solver. commit 42c6afb040430c92a31b2da4696b0676310732ff Author: jessecaps Date: Sun Jan 8 11:39:51 2023 -0500 Port new LPT routines to Master Fluidized bed example contains up-to-date changes to LPT. Implicit filtering works, particles feel fluid stress, LPT CFL bug fix, low Mach class has useful routines commit 19cc1c1e6aaae07e180e537af44e69e252aaa8db Author: jessecaps Date: Sun Jan 8 11:27:29 2023 -0500 Delete matm_class.f90 commit 4849175979ba7bb5d05ce170b297c04ee958ebba Author: jessecaps Date: Sun Dec 18 13:00:37 2022 -0500 LPT updates More progress porting old LPT stuff into lpt_class. Particles now have angular velocity and tangential collisions. By default friction coeff is set to 0, if it is given a value larger than 0 then torque due to collisions is accounted for. Also started making progress to account for lift and fluid torque due to drag. This requires interpolating fluid vorticity. commit 248792c1c9417badb44b2100fb621f6f46cd5ebc Author: jessecaps Date: Sat Dec 17 10:44:56 2022 -0500 new LPT CFL Added CFLs to LPT, if collisions are used this prevents particles to move more than 1/10 their diameter, otherwise they cannot move more than dx commit bb645e19e617efe8a8d254118a85f88a770c8e44 Author: jessecaps Date: Sat Dec 17 00:58:08 2022 -0500 Update lpt_class.f90 I think there was a bug in how Olivier implemented the spring stiffness. Updated version is consistent with old NGA and (I think) is the correct version commit 6260927f031ab503130f262851ed54c5f20d2c2d Author: jessecaps Date: Sat Dec 17 00:25:51 2022 -0500 Update simulation.f90 Particles leave the domain if they are too soft. Lowering Tcol helps commit dc0922e7cd0dfbcff0a09822067dceb45f4ace5d Author: jessecaps Date: Sat Dec 17 00:17:30 2022 -0500 LPT updates Keep track of number of particles added and removed each timestep commit 677da16cc25c9781311da7c409f31fce2a61136c Author: jessecaps Date: Fri Dec 16 23:01:25 2022 -0500 New LPT capabilities Added injection routine. This allows for particles to be injected randomly within a circular region. Special care is taken to avoid overlap if collisions are used. Also added separate coeff of restitution for walls. The example case injects particles with diameters sampled from a random lognormal distribution. commit b0a321eee41603046760c123ae22a98d922bf208 Author: jessecaps Date: Sat Dec 10 12:34:36 2022 -0500 diag solver updates The diagonal solver compiles and computes things but it is not working yet. haven't yet switched to the abstract linear solver commit 8f9a8cfc4693adb15bdd397d3a72fbc8fc73a131 Author: jessecaps Date: Fri Dec 9 11:27:45 2022 -0500 New diagonal solver class Added a diagonal solver class, taken from old NGA. Haven't yet tested. Will test on implicit filter in lpt class commit ab391b272e69928c1a1eed4724171cbfc1aadd8c Author: jessecaps Date: Wed Dec 7 15:31:42 2022 -0500 Output part vector to EnSight Added vectors to particle mesh following Max's suggestions commit c2aebbf0c8ae99e4d99b608f917c7359a38e358f Author: jessecaps Date: Wed Dec 7 08:50:43 2022 -0500 Updates to fluidized bed Still working on it commit 55eeef5e292c93c3536099a13e3a74eb99ee9043 Author: jessecaps Date: Wed Dec 7 08:49:45 2022 -0500 Update .gitignore We should ignore makefiles. Doesn't seem to be working though.... commit be802f8580d5529b3f5e0de6d09fbf74559d2f98 Author: jessecaps Date: Wed Dec 7 08:44:19 2022 -0500 fbed input Updates to fluidized bed input commit 73053379114f3b585d15451457919d5ec6292c92 Author: jessecaps Date: Wed Dec 7 08:42:42 2022 -0500 Update lpt_class.f90 Working on fluidized bed example. Started adding ability to do implicit filtering of projected terms. Still need to interpolate fluid stress to particle location. Case does not run using 3 or 4 procs in x, but runs with 1, 3, and 5... commit a3119877dddb9b31136c93e833f56669e882bd4d Author: jessecaps Date: Mon Dec 5 14:45:42 2022 -0500 Delete .#lpt_class.f90 remove garbage file commit a769c4e481863c1090f31660731513d763e2b8ed Merge: b674f28 2126f7a Author: jessecaps <80769669+jessecaps@users.noreply.github.com> Date: Mon Dec 5 20:31:32 2022 +0100 Merge pull request #1 from rgrawe/develop Develop commit 2126f7a5b13c19f63394872b1a268b80756e66d9 Merge: c6d27d3 b674f28 Author: rgrawe Date: Mon Dec 5 12:13:06 2022 -0500 Merge branch 'jcaps' of https://github.com/jessecaps/NGA2 into jcaps commit c6d27d3fc66407dd97224cb6515723269af22732 Author: rgrawe Date: Mon Dec 5 12:02:17 2022 -0500 Fluidized Bed Initialization With Grid Problems Attempting to initialize fluidized bed but there's something wrong with the grid. commit b674f2819e7baf9c6f7559cc37a4b8eae299f4f4 Author: jessecaps Date: Wed Nov 30 15:06:21 2022 -0500 Update simulation.f90 Need to specify drag model in HIT LPT initialization commit d9b56f6bf1dfef1678b3f255ba04561a146ec5ba Author: jessecaps Date: Wed Nov 30 14:17:23 2022 -0500 Update lpt_class.f90 Drag correction was being canceled out commit c7e81784abdeb5aeceb2f38da0a5b5a39f15c347 Author: jessecaps Date: Tue Nov 29 14:00:10 2022 -0500 Update lpt_class.f90 Added option to interpolate temperature to particle. Also made drag model public. commit 09a1e4fb0e69e3bdcb364766841e0679dfb8667d Author: jessecaps Date: Thu Nov 17 22:21:55 2022 -0600 Added HIT from new_linsol branch commit adaf88fef66fc9a2d96c6d703d1698c8d01be264 Author: jessecaps Date: Mon Nov 7 15:59:50 2022 +0100 Update to MAST Separate where/when viz arrays are computed in MAST commit d72f61de4b6389b890faae6b67d2c4230f2a9958 Author: jessecaps Date: Mon Nov 7 15:59:07 2022 +0100 Fixed Tenneti correlation Terms in Tenneti should all be multiplied by extra fVF commit c334b71795c1fff39d91d5837b65efa9c86da0ab Author: jessecaps Date: Mon Nov 7 15:17:44 2022 +0100 Particle mod Starting to create ability to choose different drag models commit 714298cfb383ed6b0dc2797de4fe7e462b30bc6a Author: jessecaps Date: Mon Nov 7 15:17:08 2022 +0100 Update to MAST Compute various terms that are useful for visualization commit 23fd21b42e46b071f0f8abc677d41d8bffb26d86 Author: jessecaps Date: Mon Nov 7 14:10:18 2022 +0100 Example MAST cases from Olivier's develop branch Example MAST cases from Olivier's develop branch commit ecbfe6209c7a4273277ec713508a1378c6afc423 Author: Jesse Capecelatro <> Date: Mon Nov 7 13:14:47 2022 +0100 Some updates to Makefiles commit 6aed7dbaa1a38179363504d59fbffe40803794de Author: Jesse Capecelatro <> Date: Mon Nov 7 12:59:20 2022 +0100 Shock-particle example case commit f808d59eae2123cdc69d400a4f8de2eacb1cd722 Author: Jesse Capecelatro <> Date: Mon Nov 7 12:59:02 2022 +0100 Olivier's changes from develop. Also updated LPT class to include energy source, temperature, etc. Still need to add heat transfer between phases. MAST now gets source from particles. Need to check energy equation. commit b0d6e7bc5e8b174113e6cf3db1ac975f5ee6927f Author: John Wakefield Date: Wed Jan 25 14:30:58 2023 -0500 fixed ref_stencil for non-root processes commit 30c26b79bceb41dc0d7fdac101389bd4c68263a3 Author: John Wakefield Date: Wed Jan 25 12:07:52 2023 -0500 current (not working) p3dfft class; same error as library example when run with valgrind commit dda84798d7074a0fb5b159373560458d6a5c8a8c Author: Fabien Evrard Date: Wed Jan 25 11:21:51 2023 -0500 Patch that fixes compilation using GNU compilers commit c8761dbd7fadb1997d922de21faca3639248a599 Author: jessecaps Date: Tue Jan 24 14:18:38 2023 -0500 Update lpt_class.f90 Make stress and src terms in LPT optional commit 350d467603d1076044e48107188103dd85df2c7e Author: Olivier Desjardins Date: Mon Jan 23 10:16:23 2023 -0500 Reset falling_drop case to original commit 20e71367abc04451a6f80f76370d6542776dbb4b Author: Olivier Desjardins Date: Mon Jan 23 10:08:15 2023 -0500 Renamed some dev files commit 642c411bc00a0e95838cdebbabe6e7a0ae4e216c Merge: de6f407 8ec29c4 Author: Olivier Desjardins Date: Tue Jan 17 15:08:59 2023 -0500 Merge pull request #27 from mbkuhn/levitating_drop commit 8ec29c4a4e14317ee6788f607f59afb3e25af8f2 Author: Michael Kuhn Date: Mon Jan 16 21:32:04 2023 -0700 working w/ stretched mesh, added print statements commit 514de663b623434006a5e1762da3e5b69c005ec4 Author: Michael Kuhn Date: Mon Jan 16 21:17:38 2023 -0700 working version with uniform mesh commit a6a05afcdca704891c1388c8e808eae94ce2f154 Author: Michael Kuhn Date: Mon Jan 16 12:22:57 2023 -0700 compiling with forcing commit 4a5c64d22fcc43aee0c514b67589bdc8145fc86a Author: Michael Kuhn Date: Mon Jan 16 11:37:47 2023 -0700 compiling version - without forcing commit 2224e252d5a95fed5ec50a95fae3e23c684330a2 Author: jessecaps Date: Sat Jan 14 14:09:52 2023 -0500 Remove case More work needs to be done before we can simulate shock-particle interactions in NGA2 commit 8420943006b7b58e9ec1bb8e947796ef476d4c8e Author: jessecaps Date: Fri Jan 13 12:57:56 2023 -0500 Update diag_class.f90 Added buffers to avoid warning messages printed to the screen commit aad15ec6f5dbe8891589d23a2452ea0684e38b7c Merge: 0616fb5 49fc8e8 Author: jessecaps Date: Tue Jan 10 10:20:07 2023 -0500 Merge branch 'master' into develop commit 0616fb549b7f2f204c5fe412e6a28e197a88c0c4 Author: jessecaps Date: Sat Jan 7 19:08:56 2023 -0500 Create GNUmakefile Makefile for ib_pipe commit 9ec1db7cefaf26289f568acb06f855c321bd93fa Author: jessecaps Date: Sat Jan 7 18:43:41 2023 -0500 Channel update Channel compiles using new lin_sol stuff. commit 4a524360118acf88c5382b006c476bc3b8ee07b6 Author: jessecaps Date: Sat Jan 7 18:30:31 2023 -0500 channel case Added Olivier's channel case (without non-Newtonian visc). Modified forcing in IB_pipe to be consistent. commit ced0d796b4d6075cc0af339c823a20b7403d30c8 Author: jessecaps Date: Fri Jan 6 16:40:49 2023 -0500 Update lowmach_class.f90 Added routine to calculate fluid vorticity. This will be needed when using lift in LPT commit 644f8b81f3d29ee57bc5d335d8aa3b380d81e9ec Author: jessecaps Date: Thu Jan 5 11:24:40 2023 -0500 Updates to SGS Max's changes separating out different SGS models and including Vreman model. commit 7a2b63e1cde9ddd137d42c56b4defe4c78869b7f Author: jessecaps Date: Wed Jan 4 20:56:25 2023 -0500 Delete matm_class.f90 commit 5780cd58c802f3773288de66a11f2f184336eb08 Author: jessecaps Date: Wed Jan 4 16:49:53 2023 -0500 LPT updates I prefer to have src terms as optional arguments in lpt_advance, this avoids us having to compute these terms if one-way coupled, and also allows us to eventually include sources for energy. Also reduced the inlet velocity in the fluidized bed test case to get proper bubbling. commit cd0cbd4d7e69b4e678f04ddc7989d29ef5a61930 Author: jessecaps Date: Wed Jan 4 11:00:11 2023 -0500 Update lpt_class.f90 Nothing important. commit 2f95259059a3ba9b43ab4e5a7cb1c713270a253c Author: jessecaps Date: Tue Jan 3 22:30:45 2023 -0500 LPT implicit filter now works and doesn't print warnings Store recbuf in buf to avoid annoying warnings. Also by default the implicit filter should be true, it is cheaper. commit 319148b31c0c18efdde8e702c7fd8312654e6f59 Author: jessecaps Date: Tue Jan 3 21:17:12 2023 -0500 Update lpt_class.f90 Fixed a bug with the implicit filter. It is now working! commit 65dd294773ffbc8e1825eefdb9993abb8f0f3b24 Author: jessecaps Date: Tue Jan 3 18:34:23 2023 -0500 Update simulation.f90 Time velocity and pressure separately. This can probably be written cleaner commit 4b3f51c594618714a4c7e8029aee1ba15a31be00 Author: jessecaps Date: Tue Jan 3 18:05:24 2023 -0500 Update simulation.f90 Slightly cleaner way to handle timing commit 042b2501c495f81c1d58a36943666812ac0981df Author: jessecaps Date: Tue Jan 3 17:41:23 2023 -0500 Update simulation.f90 Added timers to fluidized bed case, might be handy later on commit b78a1f39254af2d795f63d50d1e193e970446913 Author: jessecaps Date: Mon Jan 2 17:25:11 2023 -0500 Update GNUmakefile part_inject does not require IRL commit 0328a0087315cefe4e16dcf039beceabd13ffded Author: jessecaps Date: Mon Jan 2 17:03:51 2023 -0500 Part_inject makefil Makefile for part.inject requires updating .gitignore commit 12523ebf18b550502267a13139784dc7f860be40 Author: jessecaps Date: Sun Jan 1 15:32:40 2023 -0500 Update README proper reference commit 85bd226437b8784be58b7be818760df306d88e85 Author: jessecaps Date: Sat Dec 31 18:41:44 2022 -0500 ib_pipe updates Small edits to ib pipe case commit c4645dabe5ffa330d18591f87fce42be7145493c Author: jessecaps Date: Sat Dec 31 14:36:46 2022 -0500 Add fluctuations to pipe Basic idea, this can be improved commit 55478fdcbc6cd653bf0d8c27ad51645222666f0d Author: jessecaps Date: Sat Dec 31 14:27:07 2022 -0500 Simple IB pipe case A very simple implementation of pipe flow using a direct forcing-type scheme. commit 5705bd5ffc387020f9be63a81289be2e3c7c3abf Author: jessecaps Date: Sat Dec 31 14:25:27 2022 -0500 Rename variable To be consistent with other classes commit 057fa6cd932bbac13031899b7599c799aa641d2d Author: jessecaps Date: Thu Dec 29 22:58:47 2022 -0500 Update df_class.f90 Calculate center of mass and volume of each IBM object based on marker location and size. Does not work when object crosses a periodic boundary! commit 90577ffb3827e8c7973750e3e98be7fae852878f Author: jessecaps Date: Thu Dec 29 16:27:58 2022 -0500 Update simulation.f90 Important to sync U after adding IBM correction commit ab9668a30cd87e645a13aafc501d0b8fb1dd13da Author: jessecaps Date: Sun Dec 25 21:58:05 2022 -0500 LPT and DF update CFLs for particles should be based on dx not dxm commit 9d3b0bee6ffd7916e30febef5fcf65164d21d79f Author: jessecaps Date: Sun Dec 25 12:35:37 2022 -0500 IBM update Added force computation acting on each 'object' and changes interpolation subroutine to be a function commit 620e9f7ea86d0d9a4bd5baaf2cbc6def0a7b520a Author: jessecaps Date: Sun Dec 25 09:46:26 2022 -0500 Update df_class.f90 cleanup commit ea4b12b0a1ea1d957ba1de9b3fef1c585f9b1c9d Author: jessecaps Date: Fri Dec 23 16:37:35 2022 -0500 Update df_class.f90 Added levelset array to direct forcing class. This is only used for visualization and eventually collision detection with LPT commit bdba18b2843d4425695e5bd23afd5a7bade6a106 Author: jessecaps Date: Fri Dec 23 16:36:59 2022 -0500 Update mathtools.f90 Added safe arctan function commit 563b1d0f0d6cb9290884d5b33c9bc595ca35476d Author: jessecaps Date: Fri Dec 23 16:03:35 2022 -0500 direct forcing update Make ID integer not integer8, unlikely we'll have THAT many IBM objects commit d6d3e6433f6c9c775422649fed2afe409f6af817 Author: jessecaps Date: Fri Dec 23 12:46:03 2022 -0500 New direct forcing IBM solver Created a simple immersed boundary solver based on direct forcing. The marker particle ID determines the number of objects. At the moment objects cannot move, but will eventually add an advance routine to update objects. commit e3d440f82b528fee9ac785af1ee7127f9cfbed5d Author: jessecaps Date: Tue Dec 20 20:16:42 2022 -0500 Fluidize bed works! Collisions need to be properly resolved otherwise everything goes crazy... Added LPT CFL and some other small things. This case now bubbles commit 4cf450668ef53ca6450ee871f1cb6f24c20d4ae7 Author: jessecaps Date: Tue Dec 20 16:51:00 2022 -0500 Remove print statement Remove print statement commit cf9d4a1a29d0587be43ae1ab53a3c7e983302649 Author: jessecaps Date: Tue Dec 20 13:34:29 2022 -0500 More LPT changes LPT now slips over particles with id<=0 to allow for "glued" particles. Renamed p%col to p%Acol (acceleration due to collisions). Also LPT now reads in fluid stress and interpolates to particle position. commit 9180874aed385870f50a8df5bc600962c9ea4cc7 Author: jessecaps Date: Tue Dec 20 13:07:58 2022 -0500 Update lowmach_class.f90 Added routine that computes divergence of fluid stress. This will be needed by LPT to interpolate stress to particle location. commit de6f4077abd9d8517698682bc85850d5ba4b2a5f Author: Olivier Desjardins Date: Fri Dec 16 12:10:58 2022 +0100 Volume, mass, momentum conserving version of tpns. Should be KE conserving spatially too. No stabilization here. commit 802a47a2afb9da65d2e71b62667a0100773a61fb Author: Olivier Desjardins Date: Thu Dec 8 17:34:35 2022 -0500 1- started work on variable density jet case 2- rewrote strain rate calculation for compactness 3- falling drop case implements a new momentum conservation strategy - still debugging this! commit 70a97a2a91eb9265386d12652143df7f46b004fd Author: Olivier Desjardins Date: Wed Nov 16 17:07:53 2022 -0500 Added some basic postprocessing to filmKH case commit c21b48a7eeee741366d2498794834d77f51dd2cf Author: Olivier Desjardins Date: Thu Nov 10 12:59:44 2022 -0500 New filmKH case, modifications to falling drop case commit 452ae9889ce1b188ef5f04d114f4d61444cb47f5 Author: Olivier Desjardins Date: Tue Oct 11 16:15:23 2022 -0400 Minor cosmetic changes. commit 91a5f828863839900714f70e202299f4eaa45e4f Author: Olivier Desjardins Date: Tue Oct 11 10:50:11 2022 -0400 Some basic directory changes - more importantly, replaced lstdc++ (deprecated) by lc++ commit 8d45c1675123bc79384d8ffc879996e4f186dd92 Merge: 08751be 5a80cba Author: Olivier Desjardins Date: Tue Oct 4 10:36:19 2022 -0400 Merge pull request #23 from mbkuhn/LJSC commit 08751bea8e7477216a8354b6412276788332871e Merge: c89f3b8 90be61b Author: Olivier Desjardins Date: Tue Oct 4 10:27:34 2022 -0400 Merge branch 'pr/mbkuhn/22' into develop commit 5a80cba88500f74d165325ae4dbe6c699ce23978 Author: Michael Kuhn Date: Sat Sep 10 20:14:13 2022 -0600 correcting the specification of the jet BC locator. fixes the incorrect pressure solution near the base of the jet. commit c89f3b822d77a8c4a119bee5d40b231f12640f5e Author: Olivier Desjardins Date: Thu Sep 8 18:04:37 2022 -0400 In the process of adding bquick commit 8af422c88abd0ca85b3365a1de916f159ee91489 Author: Olivier Desjardins Date: Wed Aug 31 16:45:51 2022 -0400 New grad(U) implementation based on face velocities. commit f56e6c7114505488033b6215513ab15d1c7443ed Author: Michael Kuhn Date: Mon Aug 29 23:00:16 2022 -0600 Setup for liquid jet(s) in supersonic crossflow commit 90be61bdd152fd54158e193ff251ca3960871b1c Author: Michael Kuhn Date: Mon Aug 29 22:47:42 2022 -0600 simplifying how material models are referred, allowing fewer parameters commit 02c81563bbd3ee9d71c31b5001fb1cde7f92a0ce Author: Michael Kuhn Date: Mon Aug 29 22:45:09 2022 -0600 removing some left-behind code in the shock_water_cylinder case and adjusting to new BC system commit dfcaadd03c58886e53d2929078a4f91757892dc7 Author: Michael Kuhn Date: Mon Aug 29 22:43:50 2022 -0600 lots of changes to how boundary conditions work - heavy reliance on the shift array, alongside integers that specify the correct part of the array to use, based on the BC - ad-hoc BCs for VF and face pressures - BCs can be specified by face or by cell - fixing some oversights in the treatment of wall cells commit 7f45d85637f5b9d2def3c18251569785172af3d0 Author: Michael Kuhn Date: Sat Aug 20 23:48:26 2022 -0600 additional changes to fully set up the cell-centered 'c' option for iterator class commit 783742b8a7f07014b9d2b388acbf03ffcab5ad9f Author: Michael Kuhn Date: Fri Aug 12 21:22:07 2022 -0600 neumann for volume fraction at outlet. eliminates NaN issue at boundary when droplet is leaving domain. commit 04c0a12703264de8ee6b0a4cbf1b2eb782568697 Author: Michael Kuhn Date: Fri Aug 12 21:21:13 2022 -0600 setting up cell-centered option face='c' for iterator class. added to cell-centered solvers (volume fraction and scalars) when adding boundary conditions. commit 7f046c8335964a9d39015947180f4e0fa64a140c Author: Michael Kuhn Date: Wed Aug 10 22:04:00 2022 -0600 in defining SL flag, +1/-1 in loop over domain doesn't work well for non-periodic boundaries. commit 47082c263f174d39e5949f7e1b4ea05602fa7b46 Author: Michael Kuhn Date: Wed Aug 10 22:02:26 2022 -0600 changing solver for momentum equations to get rid of asymmetry commit d8a76719e14728f68dc301722b6e6bf46465d3ba Author: Michael Kuhn Date: Mon Aug 8 22:58:25 2022 -0600 correcting shock sensor definition commit 110cbe26ad456dd7cc83cc21e4089b69efbf8600 Author: Michael Kuhn Date: Mon Aug 8 22:02:59 2022 -0600 goes with previous commit commit 083b963be72f11c5009eca4d4c716465a117b8d8 Author: Michael Kuhn Date: Mon Aug 8 22:00:33 2022 -0600 better monitors and specifying pressure relaxation model in examples commit b6b7a5cc2d1e619a159fe435530c26b73c95c007 Author: Olivier Desjardins Date: Thu Aug 4 13:42:00 2022 -0400 Increased time step size for channel case. commit fad6ee3b9b6be46933f55264e0d2c77315604de7 Author: Olivier Desjardins Date: Thu Aug 4 13:37:35 2022 -0400 Fixed enormous strain rate bug... Added non-Newtonian model to channel case. commit bf7ee20950482b1207201630b32c8092cfb7138c Author: Michael Kuhn Date: Thu Jul 21 23:08:20 2022 -0600 now, relaxation models are actually required commit 8cf295e8f57c38530a3f19bcfd2593c60bf9cb41 Author: Michael Kuhn Date: Mon Jul 18 23:49:47 2022 -0600 removind unused declarations commit 26aeb7501f4c37bfa024d98611c295748cc2b4ec Author: Michael Kuhn Date: Mon Jul 18 23:43:04 2022 -0600 relaxation models can be specified and are now required commit a67f23474cb06020f40125b0a4619c65fcaab895 Author: Michael Kuhn Date: Mon Jul 18 23:24:16 2022 -0600 thermo-mechanical relaxation is working commit b9c86e41a63f5d4d621e7268e54dce95b135d527 Author: Michael Kuhn Date: Sun Jul 17 23:06:58 2022 -0600 changes to locally update Temperature where it should be updated: in pressure relax and energy fix commit 32ccda169d7f1eb1acad011f8b50dedcd66e29f9 Author: Michael Kuhn Date: Sun Jul 17 18:50:11 2022 -0600 output non-dimensional numbers upon initialization commit cddbc21e8f72083da741d86f6ccc8b1ddb644180 Author: Michael Kuhn Date: Sun Jul 17 17:32:12 2022 -0600 spurious currents input file - results look good commit 0267badb9a6276ebfca8b1f2264db817f27a10b4 Author: Michael Kuhn Date: Sat Jul 16 17:05:14 2022 -0600 gravity implementation improved - better energy terms - picking implicit solver that works for this input file - fixing level_set_drop_center - adding prompt to read gravity vector commit d20fa20f0bcfbf149f42da70a2e09c3529c7ef43 Author: Olivier Desjardins Date: Thu Jul 14 16:50:21 2022 -0400 Turbulent channel works okay commit 409c9bb709c87edb3347d313d6fecfb6bfc5bf5c Merge: 06b2cf8 900a96e Author: Olivier Desjardins Date: Thu Jul 14 09:23:55 2022 -0400 Merge pull request #21 from mbkuhn/viscous_explicit commit 06b2cf81920fffc39ea263c3ef31e30431abe575 Merge: c614fc9 96b8e02 Author: Olivier Desjardins Date: Wed Jul 13 11:08:06 2022 -0400 Merge pull request #20 from austinhan/develop commit c614fc9f843a341e94b93b64063843da514ac660 Author: Olivier Desjardins Date: Wed Jul 13 10:46:24 2022 -0400 Implementation of a channel case. Could use more refined forcing and better initial conditions. commit 900a96e019f498c1e60c6b095ee17846bdea58a1 Author: Michael Kuhn Date: Wed Jul 13 08:41:45 2022 -0600 removing duplicate of elvira reconstruction commit fdd31299c4ca716c2fad2f35220e8810bd10a2a3 Author: Michael Kuhn Date: Wed Jul 13 07:52:20 2022 -0600 changing tolerance for inertial case and ensight interval for thermal cylinder commit a4438d21148e8f9f45884b172c4798f1c32c5a1b Author: Michael Kuhn Date: Tue Jul 12 21:59:03 2022 -0600 modifying ensight output to be more useful commit 802e0fc8cfc4db1f95c62d7ad50ea79085e326f8 Author: Michael Kuhn Date: Tue Jul 12 21:57:57 2022 -0600 adding convergence monitor and tweaking simulation monitor to include max temperature commit 669a37219102abeb705460fe274257747bb1eef8 Author: Michael Kuhn Date: Tue Jul 12 19:37:14 2022 -0600 small fixes to setup of case and communicating bulk modulus for the sake of sl_face access. commit 50e3fe63722862af7ba923ec6a21b0d4016c2ce0 Author: Michael Kuhn Date: Sun Jul 10 23:05:10 2022 -0600 important update to the semi-Lagrangian flux flag (formerly sl_face). Now broken into 3 arrays, which allow it to properly be communicated using the sync function. commit ad1e3e8e8ddb95c99429b15eef791cb79fc99cbf Author: Michael Kuhn Date: Sun Jul 10 22:02:20 2022 -0600 adding monitors and fixing some loop indices commit fdffbb56820b5d05b96237c2db37bea5b16c1cea Author: Michael Kuhn Date: Wed Jul 6 22:13:26 2022 -0600 removing some redundant code commit c8302942cf4134d1e85b7f120580ebbf0620595e Author: Michael Kuhn Date: Wed Jul 6 22:12:53 2022 -0600 output functionality for temperature and density profiles, and an important fix for apply_bcond so things still work for fully periodic simulations. still in the middle of debugging and validating. commit d05b9c28f88d6e33bfcc6bb66d8831f07c267548 Author: Michael Kuhn Date: Wed Jun 29 23:49:46 2022 -0600 setting up MAST_drop case - intended for testing a variety of things. commit fa9a46fd29bea8c212c450c5602c840de38204cf Author: Michael Kuhn Date: Thu Jun 16 23:17:18 2022 -0600 calculate the viscous CFL, and use the material model to get the largest local kinematic viscosity if it is included as an argument. commit 0f36883d3a34ea562ab04caa2b1025fe45c894fc Author: Michael Kuhn Date: Thu Jun 16 22:17:55 2022 -0600 changing solvers for better convergence and incorporating a kinetic_energy monitor file for the taylor vortex commit c2fe36e234a8095dd5390b2f377b8c64151d6374 Author: Michael Kuhn Date: Thu Jun 16 21:28:09 2022 -0600 correcting indices in the viscous calculation commit fb61d49001264fdba02e8ab1d17285cc18cb22ec Author: Michael Kuhn Date: Wed Jun 15 23:23:43 2022 -0600 Taylor-vortex test case commit 6bad5dd08b11ca9419e238b209a0f1853a6521d7 Author: Michael Kuhn Date: Wed Jun 15 23:23:11 2022 -0600 fixed a big typo! this was really affecting all 2D simulations that involved y. commit 6b7174e9aa9ad186450ea3f1e8095e67b90a9b06 Author: Michael Kuhn Date: Tue Jun 14 23:33:50 2022 -0600 further changes for clarity commit f9542fa3847f61d32dfc89c773d9c6916c2f038d Author: Michael Kuhn Date: Tue Jun 14 23:22:57 2022 -0600 modifying water_air_rarefaction to compile properly with recent changes. commit 0ea59da08d087882c667b9665c2280f73424d11b Author: Michael Kuhn Date: Mon Jun 13 09:11:15 2022 -0600 explicit diffusion step implemented, with viscous and heat diffusion included. Temperature array and calculation added, along with method to select from available models for material parameters. Needs to be validated. commit fb183aa6df286fc9a35407b0adbe5e433ad57617 Author: Michael Kuhn Date: Fri Jun 3 08:57:08 2022 -0600 added ELVIRA reconstruction method. May not be desired in the long run, but should be useful in development. commit 9d653ab8b77d32cb0ae5a655ea4059d4ac0dba39 Author: Michael Kuhn Date: Wed Jul 13 07:47:40 2022 -0600 First-order moments need to be reset after the interface reconstruction and VOF have changed. Hugely important. commit a73102802c3360546cd4c8b7e8158b4be1dd2994 Author: Michael Kuhn Date: Mon May 30 14:22:21 2022 -0600 little changes commit 1f6f30ae5eaf92364990169f44481be851aa0164 Author: Michael Kuhn Date: Mon May 30 13:48:41 2022 -0600 correcting flaw in calculation - barycenters need to be primitively advected commit ac43b705323098358d54f93cd0c4fc8f20a14b23 Author: Michael Kuhn Date: Mon May 30 13:03:10 2022 -0600 minor changes to shock_water_cylinder case commit ea4271f44489a8b5c7ff09ab6f7967cfab3ce4e0 Author: Michael Kuhn Date: Mon May 30 13:01:43 2022 -0600 adding the advection of barycenters. no more segfault in debug for LVIRA reconstruction. commit 6e4d2cecc6f669c50a7d03e9793e0fd87dcd18fe Author: Olivier Desjardins Date: Tue Jul 12 09:28:20 2022 -0400 Output of PLIC mesh for film_RT case --- examples/MAST_drop/GNUmakefile | 5 +- examples/bctester/GNUmakefile | 4 +- examples/boat/GNUmakefile | 5 +- examples/boat/src/lpt_class.f90 | 4 +- examples/bus/GNUmakefile | 4 +- examples/channel/GNUmakefile | 3 +- examples/channel/src/simulation.f90 | 2 +- examples/collision/GNUmakefile | 5 +- examples/compil_test/GNUmakefile | 4 +- examples/coupler_tester/GNUmakefile | 6 +- examples/drop_breakup/GNUmakefile | 5 +- examples/drop_breakup/src/simulation.f90 | 3 +- examples/falling_drop/GNUmakefile | 5 +- examples/falling_drop/input | 16 +- examples/falling_drop/src/geometry.f90 | 10 +- examples/falling_drop/src/ignore_geometry.f90 | 76 + .../falling_drop/src/ignore_simulation.f90 | 360 ++ .../falling_drop/src/ignore_tpns_class.f90 | 2401 +++++++++++ .../ignore_tpns_class_no_rho_U_all_interp.f90 | 2303 +++++++++++ .../falling_drop/src/ignore_vfs_class.f90 | 3598 +++++++++++++++++ examples/falling_drop/src/simulation.f90 | 695 ++-- examples/film/GNUmakefile | 5 +- .../{shock_particle => filmKH}/GNUmakefile | 8 +- examples/filmKH/README | 1 + examples/filmKH/input | 35 + .../src/Make.package | 0 examples/filmKH/src/geometry.f90 | 84 + examples/filmKH/src/simulation.f90 | 568 +++ examples/filmRT/GNUmakefile | 6 +- examples/filmRT/input | 2 +- examples/filmRT/src/simulation.f90 | 55 +- examples/fluidized_bed/GNUmakefile | 4 +- examples/fluidized_bed/input | 2 +- examples/fluidized_bed/src/simulation.f90 | 52 +- examples/hit/GNUmakefile | 6 +- examples/hit/input | 10 +- examples/hit/src/simulation.f90 | 20 +- examples/ib_drop/GNUmakefile | 46 + examples/ib_drop/README | 1 + examples/ib_drop/input | 41 + examples/ib_drop/src/Make.package | 2 + examples/ib_drop/src/geometry.f90 | 70 + examples/ib_drop/src/simulation.f90 | 486 +++ examples/ib_pipe/GNUmakefile | 8 +- examples/ib_pipe/input | 32 +- examples/ib_pipe/src/geometry.f90 | 58 +- examples/ib_pipe/src/simulation.f90 | 722 ++-- examples/ib_tester/GNUmakefile | 4 +- examples/ib_tester/src/geometry.f90 | 2 +- examples/ib_tester/src/simulation.f90 | 834 ++-- examples/imbibition/GNUmakefile | 5 +- examples/internal_bc/GNUmakefile | 4 +- examples/levitating_drop/GNUmakefile | 46 + examples/levitating_drop/README | 1 + examples/levitating_drop/input | 56 + examples/levitating_drop/src/Make.package | 2 + examples/levitating_drop/src/geometry.f90 | 107 + examples/levitating_drop/src/simulation.f90 | 719 ++++ examples/ljsc/GNUmakefile | 46 + examples/ljsc/README | 1 + examples/ljsc/input_stretch | 61 + examples/ljsc/input_uniform | 48 + examples/ljsc/src/Make.package | 2 + examples/ljsc/src/geometry.f90 | 261 ++ examples/ljsc/src/simulation.f90 | 576 +++ examples/multiphaseKH/GNUmakefile | 6 +- examples/multiphaseRT/GNUmakefile | 6 +- examples/multiphase_pipe/GNUmakefile | 47 + examples/multiphase_pipe/README | 2 + examples/multiphase_pipe/input | 33 + examples/multiphase_pipe/src/Make.package | 2 + examples/multiphase_pipe/src/geometry.f90 | 136 + examples/multiphase_pipe/src/simulation.f90 | 380 ++ examples/nozzle_2grids/GNUmakefile | 5 +- examples/nozzle_2phase/GNUmakefile | 5 +- examples/nozzle_2phase/src/simulation.f90 | 3 +- examples/nozzle_3grids/GNUmakefile | 5 +- examples/nozzle_3grids/src/simulation.f90 | 3 +- examples/nozzle_internal/GNUmakefile | 4 +- examples/part_bed/GNUmakefile | 6 +- examples/part_bed/src/simulation.f90 | 3 +- examples/part_inject/GNUmakefile | 4 +- examples/part_inject/input | 2 +- examples/part_inject/src/simulation.f90 | 6 +- examples/part_tester/GNUmakefile | 6 +- examples/part_tester/src/simulation.f90 | 3 +- examples/pvessel/GNUmakefile | 5 +- examples/rayleigh-taylor/GNUmakefile | 5 +- examples/riser/GNUmakefile | 50 + examples/riser/README | 1 + examples/riser/input | 46 + examples/riser/src/Make.package | 2 + examples/riser/src/geometry.f90 | 134 + examples/riser/src/simulation.f90 | 825 ++++ examples/shock_particle/README | 1 - examples/shock_particle/input | 44 - examples/shock_particle/src/simulation.f90 | 593 --- examples/shock_water_cylinder/GNUmakefile | 5 +- examples/shock_water_cylinder/input | 2 + .../shock_water_cylinder/src/geometry.f90 | 2 +- .../shock_water_cylinder/src/simulation.f90 | 75 +- examples/spreading/GNUmakefile | 6 +- examples/swirl_atomizer/GNUmakefile | 47 + examples/swirl_atomizer/README | 1 + examples/swirl_atomizer/input | 39 + examples/swirl_atomizer/src/Make.package | 2 + .../src/geometry.f90 | 72 +- examples/swirl_atomizer/src/simulation.f90 | 515 +++ examples/vdjet/GNUmakefile | 45 + examples/vdjet/README | 2 + examples/vdjet/input | 34 + examples/vdjet/src/Make.package | 2 + examples/vdjet/src/geometry.f90 | 76 + examples/vdjet/src/simulation.f90 | 484 +++ examples/vortexTG/GNUmakefile | 46 + examples/vortexTG/README | 1 + examples/vortexTG/input | 33 + examples/vortexTG/src/Make.package | 2 + examples/vortexTG/src/geometry.f90 | 94 + examples/vortexTG/src/simulation.f90 | 364 ++ examples/water_air_rarefaction/GNUmakefile | 5 +- examples/water_air_rarefaction/input | 3 - .../water_air_rarefaction/src/simulation.f90 | 49 +- examples/zalesak/GNUmakefile | 8 +- src/config/config_class.f90 | 25 + src/constant_density/incomp_class.f90 | 337 +- src/constant_density/scalar_class.f90 | 181 +- src/grid/pgrid_class.f90 | 6 +- src/immersed/df_class.f90 | 1664 ++++---- src/libraries/precision.mod | Bin 0 -> 364 bytes src/particles/lpt_class.f90 | 605 +-- src/solver/Make.package | 2 +- src/solver/diag_class.f90 | 2369 +++++------ .../{pfft3d_class.f90 => fourier3d_class.f90} | 477 ++- src/subgrid/sgsmodel_class.f90 | 73 +- src/two_phase/mast_class.f90 | 188 +- src/two_phase/tpns_class.f90 | 416 +- src/two_phase/vfs_class.f90 | 3 +- src/variable_density/lowmach_class.f90 | 669 +-- src/variable_density/vdscalar_class.f90 | 51 +- tools/GNUMake/packages/Make.irl | 7 +- 141 files changed, 20811 insertions(+), 5262 deletions(-) create mode 100644 examples/falling_drop/src/ignore_geometry.f90 create mode 100644 examples/falling_drop/src/ignore_simulation.f90 create mode 100644 examples/falling_drop/src/ignore_tpns_class.f90 create mode 100644 examples/falling_drop/src/ignore_tpns_class_no_rho_U_all_interp.f90 create mode 100644 examples/falling_drop/src/ignore_vfs_class.f90 rename examples/{shock_particle => filmKH}/GNUmakefile (78%) create mode 100644 examples/filmKH/README create mode 100644 examples/filmKH/input rename examples/{shock_particle => filmKH}/src/Make.package (100%) create mode 100644 examples/filmKH/src/geometry.f90 create mode 100644 examples/filmKH/src/simulation.f90 create mode 100644 examples/ib_drop/GNUmakefile create mode 100644 examples/ib_drop/README create mode 100644 examples/ib_drop/input create mode 100644 examples/ib_drop/src/Make.package create mode 100644 examples/ib_drop/src/geometry.f90 create mode 100644 examples/ib_drop/src/simulation.f90 create mode 100644 examples/levitating_drop/GNUmakefile create mode 100644 examples/levitating_drop/README create mode 100644 examples/levitating_drop/input create mode 100644 examples/levitating_drop/src/Make.package create mode 100644 examples/levitating_drop/src/geometry.f90 create mode 100644 examples/levitating_drop/src/simulation.f90 create mode 100644 examples/ljsc/GNUmakefile create mode 100644 examples/ljsc/README create mode 100644 examples/ljsc/input_stretch create mode 100644 examples/ljsc/input_uniform create mode 100644 examples/ljsc/src/Make.package create mode 100644 examples/ljsc/src/geometry.f90 create mode 100644 examples/ljsc/src/simulation.f90 create mode 100644 examples/multiphase_pipe/GNUmakefile create mode 100644 examples/multiphase_pipe/README create mode 100644 examples/multiphase_pipe/input create mode 100644 examples/multiphase_pipe/src/Make.package create mode 100644 examples/multiphase_pipe/src/geometry.f90 create mode 100644 examples/multiphase_pipe/src/simulation.f90 create mode 100644 examples/riser/GNUmakefile create mode 100644 examples/riser/README create mode 100644 examples/riser/input create mode 100644 examples/riser/src/Make.package create mode 100644 examples/riser/src/geometry.f90 create mode 100644 examples/riser/src/simulation.f90 delete mode 100644 examples/shock_particle/README delete mode 100644 examples/shock_particle/input delete mode 100644 examples/shock_particle/src/simulation.f90 create mode 100644 examples/swirl_atomizer/GNUmakefile create mode 100644 examples/swirl_atomizer/README create mode 100644 examples/swirl_atomizer/input create mode 100644 examples/swirl_atomizer/src/Make.package rename examples/{shock_particle => swirl_atomizer}/src/geometry.f90 (62%) create mode 100644 examples/swirl_atomizer/src/simulation.f90 create mode 100644 examples/vdjet/GNUmakefile create mode 100644 examples/vdjet/README create mode 100644 examples/vdjet/input create mode 100644 examples/vdjet/src/Make.package create mode 100644 examples/vdjet/src/geometry.f90 create mode 100644 examples/vdjet/src/simulation.f90 create mode 100644 examples/vortexTG/GNUmakefile create mode 100644 examples/vortexTG/README create mode 100644 examples/vortexTG/input create mode 100644 examples/vortexTG/src/Make.package create mode 100644 examples/vortexTG/src/geometry.f90 create mode 100644 examples/vortexTG/src/simulation.f90 create mode 100644 src/libraries/precision.mod rename src/solver/{pfft3d_class.f90 => fourier3d_class.f90} (64%) diff --git a/examples/MAST_drop/GNUmakefile b/examples/MAST_drop/GNUmakefile index bbd127241..466227c85 100644 --- a/examples/MAST_drop/GNUmakefile +++ b/examples/MAST_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/mbk225/NGA_libs/hypre -LAPACK_DIR= /Users/mbk225/NGA_libs/lapack -IRL_DIR = /Users/mbk225/NGA_libs/interfacereconstructionlibrary/install/Release +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/bctester/GNUmakefile b/examples/bctester/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/bctester/GNUmakefile +++ b/examples/bctester/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/GNUmakefile b/examples/boat/GNUmakefile index b4a53ee9b..b83ed2464 100644 --- a/examples/boat/GNUmakefile +++ b/examples/boat/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/boat/src/lpt_class.f90 b/examples/boat/src/lpt_class.f90 index 7654753f6..3982109a9 100644 --- a/examples/boat/src/lpt_class.f90 +++ b/examples/boat/src/lpt_class.f90 @@ -752,7 +752,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -765,7 +765,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/examples/bus/GNUmakefile b/examples/bus/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/bus/GNUmakefile +++ b/examples/bus/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/channel/GNUmakefile b/examples/channel/GNUmakefile index 4cdeaeb5f..fc48c5afb 100644 --- a/examples/channel/GNUmakefile +++ b/examples/channel/GNUmakefile @@ -22,8 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/channel/src/simulation.f90 b/examples/channel/src/simulation.f90 index 7a9cd4137..ee593b26b 100644 --- a/examples/channel/src/simulation.f90 +++ b/examples/channel/src/simulation.f90 @@ -123,7 +123,7 @@ subroutine simulation_init ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg + use hypre_str_class, only: pcg_pfmg,gmres_pfmg use mathtools, only: twoPi integer :: i,j,k real(WP) :: amp,vel diff --git a/examples/collision/GNUmakefile b/examples/collision/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/collision/GNUmakefile +++ b/examples/collision/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/compil_test/GNUmakefile b/examples/compil_test/GNUmakefile index 9ad19ecfc..8e0aca067 100644 --- a/examples/compil_test/GNUmakefile +++ b/examples/compil_test/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/coupler_tester/GNUmakefile b/examples/coupler_tester/GNUmakefile index 2ad327124..e83454a63 100644 --- a/examples/coupler_tester/GNUmakefile +++ b/examples/coupler_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/drop_breakup/GNUmakefile b/examples/drop_breakup/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/drop_breakup/GNUmakefile +++ b/examples/drop_breakup/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/drop_breakup/src/simulation.f90 b/examples/drop_breakup/src/simulation.f90 index 922c9bda5..9d8162c79 100644 --- a/examples/drop_breakup/src/simulation.f90 +++ b/examples/drop_breakup/src/simulation.f90 @@ -814,7 +814,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =diam !< Assign diameter to account for full volume lp%p(np)%pos =[cc%meta_structures_list(m)%x,cc%meta_structures_list(m)%y,cc%meta_structures_list(m)%z] !< Place the drop at the liquid barycenter lp%p(np)%vel =[cc%meta_structures_list(m)%u,cc%meta_structures_list(m)%v,cc%meta_structures_list(m)%w] !< Assign mean structure velocity as drop velocity diff --git a/examples/falling_drop/GNUmakefile b/examples/falling_drop/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/falling_drop/GNUmakefile +++ b/examples/falling_drop/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/falling_drop/input b/examples/falling_drop/input index ea40e6dd5..3b84920aa 100644 --- a/examples/falling_drop/input +++ b/examples/falling_drop/input @@ -1,26 +1,26 @@ # Parallelization -Partition : 1 1 4 +Partition : 1 1 8 # Mesh definition -Lx : 0.01 -Ly : 1 -Lz : 1 +Lx : 0.001 +Ly : 0.1 +Lz : 0.1 nx : 1 ny : 100 nz : 100 # Fluid properties -Gravity : 0 -1 0 +Gravity : 0 -9.81 0 Liquid dynamic viscosity : 1.137e-3 Gas dynamic viscosity : 1.780e-5 Liquid density : 1000 Gas density : 1.226 Surface tension coefficient : 0.0728 -Static contact angle : 70 # Time integration -Max timestep size : 1e-2 +Max timestep size : 1e-3 Max cfl number : 0.9 +Max time : 5 # Pressure solver Pressure tolerance : 1e-6 @@ -31,4 +31,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 1e-1 +Ensight output period : 1e-2 \ No newline at end of file diff --git a/examples/falling_drop/src/geometry.f90 b/examples/falling_drop/src/geometry.f90 index 53adf4c1a..e69f237a9 100644 --- a/examples/falling_drop/src/geometry.f90 +++ b/examples/falling_drop/src/geometry.f90 @@ -45,7 +45,7 @@ subroutine geometry_init end do ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='FallingDrop') + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='FallingDrop') end block create_grid @@ -63,14 +63,12 @@ subroutine geometry_init ! Create masks for this config create_walls: block - ! Put walls all around - cfg%VF=0.0_WP - cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP - call cfg%sync(cfg%VF) + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP end block create_walls end subroutine geometry_init -end module geometry +end module geometry \ No newline at end of file diff --git a/examples/falling_drop/src/ignore_geometry.f90 b/examples/falling_drop/src/ignore_geometry.f90 new file mode 100644 index 000000000..53adf4c1a --- /dev/null +++ b/examples/falling_drop/src/ignore_geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='FallingDrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + ! Put walls all around + cfg%VF=0.0_WP + cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=1.0_WP + call cfg%sync(cfg%VF) + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/falling_drop/src/ignore_simulation.f90 b/examples/falling_drop/src/ignore_simulation.f90 new file mode 100644 index 000000000..0acec148f --- /dev/null +++ b/examples/falling_drop/src/ignore_simulation.f90 @@ -0,0 +1,360 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP), dimension(3) :: center + real(WP) :: radius,depth + +contains + + + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet + G=radius-sqrt(sum((xyz-center)**2)) + ! Add the pool + G=max(G,depth-xyz(2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.5_WP,0.0_WP] + radius=0.1_WP + depth =0.2_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: gmres_amg,pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + fs%psolv%maxlevel=10 + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=gmres_amg) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Initial density from VOF + fs%rho=fs%rho_l*vf%VF+fs%rho_g*(1.0_WP-vf%VF); call fs%get_staggered_density() + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_vector('momentum',fs%rhoU,fs%rhoV,fs%rhoW) + call ens_out%add_scalar('RHO',fs%rho) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('div',fs%div) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity and density + fs%rhoold=fs%rho + fs%rho_Uold=fs%rho_U + fs%rho_Vold=fs%rho_V + fs%rho_Wold=fs%rho_W + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Transfer consistent density and mass fluxes to momentum solver + fs%rho =fs%rho_l*vf%VF+fs%rho_g*(1.0_WP-vf%VF); call fs%get_staggered_density() + fs%rhoU=fs%rho_l*vf%UFl(1,:,:,:)+fs%rho_g*vf%UFg(1,:,:,:) + fs%rhoV=fs%rho_l*vf%UFl(2,:,:,:)+fs%rho_g*vf%UFg(2,:,:,:) + fs%rhoW=fs%rho_l*vf%UFl(3,:,:,:)+fs%rho_g*vf%UFg(3,:,:,:) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + + + + +end module simulation diff --git a/examples/falling_drop/src/ignore_tpns_class.f90 b/examples/falling_drop/src/ignore_tpns_class.f90 new file mode 100644 index 000000000..264b1330d --- /dev/null +++ b/examples/falling_drop/src/ignore_tpns_class.f90 @@ -0,0 +1,2401 @@ +!> Two-phase incompressible flow solver class: +!> Provides support for various BC, RHS calculation, +!> implicit solver, and pressure solution +!> Assumes constant viscosity and density in each phase. +!> Interface is represented using VOF +module tpns_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use ils_class, only: ils + use iterator_class, only: iterator + implicit none + private + + ! Expose type/constructor/methods + public :: tpns,bcond + + ! List of known available bcond for this solver + integer, parameter, public :: wall=1 !< Dirichlet at zero condition + integer, parameter, public :: dirichlet=2 !< Dirichlet condition + integer, parameter, public :: neumann=3 !< Zero normal gradient + integer, parameter, public :: convective=4 !< Convective outflow condition + integer, parameter, public :: clipped_neumann=5 !< Clipped Neumann condition (outflow only) + + ! List of available contact line models for this solver + integer, parameter, public :: static_contact=1 !< Static contact line model + + ! Parameter for switching schemes around the interface + real(WP), parameter :: rhoeps_coeff=1.0e-3_WP !< Parameter for deciding when to switch to upwinded transport + + !> Boundary conditions for the two-phase solver + type :: bcond + type(bcond), pointer :: next !< Linked list of bconds + character(len=str_medium) :: name='UNNAMED_BCOND' !< Bcond name (default=UNNAMED_BCOND) + integer :: type !< Bcond type + type(iterator) :: itr !< This is the iterator for the bcond - this identifies the (i,j,k) + character(len=1) :: face !< Bcond face (x/y/z) + integer :: dir !< Bcond direction (+1,-1,0 for interior) + real(WP) :: rdir !< Bcond direction (real variable) + logical :: canCorrect !< Can this bcond be corrected for global conservation? + end type bcond + + !> Two-phase incompressible solver object definition + type :: tpns + + ! This is our config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_TPNS' !< Solver name (default=UNNAMED_TPNS) + + ! Constant property fluids + real(WP) :: contact_angle !< This is our static contact angle + real(WP) :: sigma !< This is our constant surface tension coefficient + real(WP) :: rho_l,rho_g !< These are our constant densities in liquid and gas + real(WP) :: visc_l,visc_g !< These is our constant dynamic viscosities in liquid and gas + + ! Gravitational acceleration + real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity + + ! Boundary condition list + integer :: nbc !< Number of bcond for our solver + real(WP), dimension(:), allocatable :: mfr !< MFR through each bcond + real(WP), dimension(:), allocatable :: area !< Area for each bcond + real(WP) :: correctable_area !< Area of bcond that can be corrected + type(bcond), pointer :: first_bc !< List of bcond for our solver + + ! Density and momentum fields + real(WP), dimension(:,:,:), allocatable :: rho !< New density field + real(WP), dimension(:,:,:), allocatable :: rhoold !< Old density field + real(WP), dimension(:,:,:), allocatable :: rhoU !< U momentum array + real(WP), dimension(:,:,:), allocatable :: rhoV !< V momentum array + real(WP), dimension(:,:,:), allocatable :: rhoW !< W momentum array + + ! Staggered density fields + real(WP), dimension(:,:,:), allocatable :: rho_U !< Density field array on U-cell + real(WP), dimension(:,:,:), allocatable :: rho_V !< Density field array on V-cell + real(WP), dimension(:,:,:), allocatable :: rho_W !< Density field array on W-cell + + ! Old staggered density fields + real(WP), dimension(:,:,:), allocatable :: rho_Uold !< Old density field array on U-cell + real(WP), dimension(:,:,:), allocatable :: rho_Vold !< Old density field array on V-cell + real(WP), dimension(:,:,:), allocatable :: rho_Wold !< Old density field array on W-cell + + ! Viscosity fields + real(WP), dimension(:,:,:), allocatable :: visc !< Viscosity field on P-cell + real(WP), dimension(:,:,:), allocatable :: visc_xy !< Viscosity field on U-cell + real(WP), dimension(:,:,:), allocatable :: visc_yz !< Viscosity field on V-cell + real(WP), dimension(:,:,:), allocatable :: visc_zx !< Viscosity field on W-cell + + ! Flow variables + real(WP), dimension(:,:,:), allocatable :: U !< U velocity array + real(WP), dimension(:,:,:), allocatable :: V !< V velocity array + real(WP), dimension(:,:,:), allocatable :: W !< W velocity array + real(WP), dimension(:,:,:), allocatable :: P !< Pressure array + real(WP), dimension(:,:,:), allocatable :: Pjx !< Pressure jump to add to -dP/dx + real(WP), dimension(:,:,:), allocatable :: Pjy !< Pressure jump to add to -dP/dy + real(WP), dimension(:,:,:), allocatable :: Pjz !< Pressure jump to add to -dP/dz + real(WP), dimension(:,:,:), allocatable :: dPjx !< dPressure jump to add to -ddP/dx + real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy + real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz + + ! Old flow variables + real(WP), dimension(:,:,:), allocatable :: Uold !< Uold velocity array + real(WP), dimension(:,:,:), allocatable :: Vold !< Vold velocity array + real(WP), dimension(:,:,:), allocatable :: Wold !< Wold velocity array + + ! Flow divergence + real(WP), dimension(:,:,:), allocatable :: div !< Divergence array + + ! Pressure solver + type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + + ! Implicit velocity solver + type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + + ! Metrics + real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity + real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density + real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Second order interpolation for U + real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Second order interpolation for V + real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Second order interpolation for W + real(WP), dimension(:,:,:,:), allocatable :: divp_x,divp_y,divp_z !< Divergence for P-cell + real(WP), dimension(:,:,:,:), allocatable :: divu_x,divu_y,divu_z !< Divergence for U-cell + real(WP), dimension(:,:,:,:), allocatable :: divv_x,divv_y,divv_z !< Divergence for V-cell + real(WP), dimension(:,:,:,:), allocatable :: divw_x,divw_y,divw_z !< Divergence for W-cell + real(WP), dimension(:,:,:,:), allocatable :: grdu_x,grdu_y,grdu_z !< Velocity gradient for U + real(WP), dimension(:,:,:,:), allocatable :: grdv_x,grdv_y,grdv_z !< Velocity gradient for V + real(WP), dimension(:,:,:,:), allocatable :: grdw_x,grdw_y,grdw_z !< Velocity gradient for W + + ! Masking info for metric modification + integer, dimension(:,:,:), allocatable :: mask !< Integer array used for modifying P metrics + integer, dimension(:,:,:), allocatable :: umask !< Integer array used for modifying U metrics + integer, dimension(:,:,:), allocatable :: vmask !< Integer array used for modifying V metrics + integer, dimension(:,:,:), allocatable :: wmask !< Integer array used for modifying W metrics + + ! CFL numbers + real(WP) :: CFLst !< Surface tension CFL + real(WP) :: CFLc_x,CFLc_y,CFLc_z !< Convective CFL numbers + real(WP) :: CFLv_x,CFLv_y,CFLv_z !< Viscous CFL numbers + + ! Monitoring quantities + real(WP) :: Umax,Vmax,Wmax,Pmax,divmax !< Maximum velocity, pressure, divergence + + contains + procedure :: print=>tpns_print !< Output solver to the screen + procedure :: setup !< Finish configuring the flow solver + procedure :: add_bcond !< Add a boundary condition + procedure :: get_bcond !< Get a boundary condition + procedure :: apply_bcond !< Apply all boundary conditions + procedure :: init_metrics !< Initialize metrics + procedure :: adjust_metrics !< Adjust metrics + procedure :: get_dmomdt !< Calculate dmom/dt + procedure :: get_div !< Calculate velocity divergence + procedure :: get_pgrad !< Calculate pressure gradient + procedure :: update_laplacian !< Update the pressure Laplacian div(1/rho*grad(.)) + procedure :: get_cfl !< Calculate maximum CFL + procedure :: get_max !< Calculate maximum field values + procedure :: interp_vel !< Calculate interpolated velocity + procedure :: get_strainrate !< Calculate deviatoric part of strain rate tensor + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_mfr !< Calculate outgoing MFR through each bcond + procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation + procedure :: shift_p !< Shift pressure to have zero average + procedure :: get_viscosity !< Calculate viscosity fields from subcell phasic volume data in a vfs object + procedure :: get_staggered_density !< Calculate density on staggered cell via interpolation + procedure :: solve_implicit !< Solve for the velocity residuals implicitly + + procedure :: addsrc_gravity !< Add gravitational body force + procedure :: add_surface_tension_jump !< Add surface tension jump + procedure :: add_static_contact !< Add static contact line model to surface tension jump + + end type tpns + + + !> Declare two-phase incompressible solver constructor + interface tpns + procedure constructor + end interface tpns + +contains + + + !> Default constructor for two-phase incompressible flow solver + function constructor(cfg,name) result(self) + implicit none + type(tpns) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Nullify bcond list + self%nbc=0 + self%first_bc=>NULL() + + ! Allocate flow variables + allocate(self%U(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%U=0.0_WP + allocate(self%V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%V=0.0_WP + allocate(self%W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%W=0.0_WP + allocate(self%P(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%P=0.0_WP + allocate(self%Pjx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjx=0.0_WP + allocate(self%Pjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjy=0.0_WP + allocate(self%Pjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjz=0.0_WP + allocate(self%dPjx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjx=0.0_WP + allocate(self%dPjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjy=0.0_WP + allocate(self%dPjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjz=0.0_WP + allocate(self%visc (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc =0.0_WP + allocate(self%visc_xy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_xy=0.0_WP + allocate(self%visc_yz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_yz=0.0_WP + allocate(self%visc_zx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_zx=0.0_WP + + ! Mass conservation data around which to build momentum conservation + allocate(self%rhoU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoU =0.0_WP + allocate(self%rhoV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoV =0.0_WP + allocate(self%rhoW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoW =0.0_WP + allocate(self%rho (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho =0.0_WP + allocate(self%rhoold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoold=0.0_WP + + ! New and old staggered densities + allocate(self%rho_U (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_U =0.0_WP + allocate(self%rho_V (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_V =0.0_WP + allocate(self%rho_W (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_W =0.0_WP + allocate(self%rho_Uold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_Uold=0.0_WP + allocate(self%rho_Vold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_Vold=0.0_WP + allocate(self%rho_Wold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho_Wold=0.0_WP + + ! Allocate flow divergence + allocate(self%div(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%div=0.0_WP + + ! Allocate old flow variables + allocate(self%Uold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Uold=0.0_WP + allocate(self%Vold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Vold=0.0_WP + allocate(self%Wold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Wold=0.0_WP + + ! Create pressure solver object + self%psolv =ils(cfg=self%cfg,name='Pressure') + + ! Create implicit velocity solver object + self%implicit=ils(cfg=self%cfg,name='Momentum') + + ! Prepare default metrics + call self%init_metrics() + + ! Prepare P-cell masks + allocate(self%mask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%mask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%mask(:self%cfg%imin-1,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%mask(self%cfg%imax+1:,:,:)=2 + end if + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%mask(:,:self%cfg%jmin-1,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%mask(:,self%cfg%jmax+1:,:)=2 + end if + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%mask(:,:,:self%cfg%kmin-1)=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%mask(:,:,self%cfg%kmax+1:)=2 + end if + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) self%mask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%mask) + + ! Prepare face mask for U + allocate(self%umask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%umask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%umask(self%cfg%imin ,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%umask(self%cfg%imax+1,:,:)=2 + end if + do k=self%cfg%kmino_ ,self%cfg%kmaxo_ + do j=self%cfg%jmino_ ,self%cfg%jmaxo_ + do i=self%cfg%imino_+1,self%cfg%imaxo_ + if (minval(self%cfg%VF(i-1:i,j,k)).eq.0.0_WP) self%umask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%umask) + if (.not.self%cfg%xper.and.self%cfg%iproc.eq.1) self%umask(self%cfg%imino,:,:)=self%umask(self%cfg%imino+1,:,:) + + ! Prepare face mask for V + allocate(self%vmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%vmask=0 + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%vmask(:,self%cfg%jmin ,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%vmask(:,self%cfg%jmax+1,:)=2 + end if + do k=self%cfg%kmino_ ,self%cfg%kmaxo_ + do j=self%cfg%jmino_+1,self%cfg%jmaxo_ + do i=self%cfg%imino_ ,self%cfg%imaxo_ + if (minval(self%cfg%VF(i,j-1:j,k)).eq.0.0_WP) self%vmask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%vmask) + if (.not.self%cfg%yper.and.self%cfg%jproc.eq.1) self%vmask(:,self%cfg%jmino,:)=self%vmask(:,self%cfg%jmino+1,:) + + ! Prepare face mask for W + allocate(self%wmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%wmask=0 + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%wmask(:,:,self%cfg%kmin )=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%wmask(:,:,self%cfg%kmax+1)=2 + end if + do k=self%cfg%kmino_+1,self%cfg%kmaxo_ + do j=self%cfg%jmino_ ,self%cfg%jmaxo_ + do i=self%cfg%imino_ ,self%cfg%imaxo_ + if (minval(self%cfg%VF(i,j,k-1:k)).eq.0.0_WP) self%wmask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%wmask) + if (.not.self%cfg%zper.and.self%cfg%kproc.eq.1) self%wmask(:,:,self%cfg%kmino)=self%wmask(:,:,self%cfg%kmino+1) + + end function constructor + + + !> Metric initialization with no awareness of walls nor bcond + subroutine init_metrics(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,st1,st2 + real(WP), dimension(-1:0) :: itpx,itpy,itpz + + ! Allocate finite difference density interpolation coefficients to cell faces + allocate(this%itpr_x(-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< X-face-centered + allocate(this%itpr_y(-1:0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Y-face-centered + allocate(this%itpr_z(-1:0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Z-face-centered + ! Create density interpolation coefficients to cell face in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + end do + end do + end do + ! Create density interpolation coefficients to cell face in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + end do + end do + end do + ! Create density interpolation coefficients to cell face in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + + ! Allocate finite difference viscosity interpolation coefficients + allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%itp_xz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + ! Create viscosity interpolation coefficients to cell edge + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Prepare local 1D metrics + itpx=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] + itpy=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] + itpz=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] + ! Combine for 2D interpolations + do st1=-1,0 + do st2=-1,0 + this%itp_xy(st1,st2,i,j,k)=itpx(st1)*itpy(st2) + this%itp_yz(st1,st2,i,j,k)=itpy(st1)*itpz(st2) + this%itp_xz(st1,st2,i,j,k)=itpx(st1)*itpz(st2) + end do + end do + end do + end do + end do + + ! Allocate finite difference velocity interpolation coefficients + allocate(this%itpu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpw_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpv_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itpw_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%itpu_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itpw_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%itpu_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%itpv_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + ! Create velocity interpolation coefficients to cell center [xm,ym,zm] + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%itpu_x(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in x of U from [x ,ym,zm] + this%itpv_y(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in y of V from [xm,y ,zm] + this%itpw_z(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in z of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%itpv_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x of V from [xm,y ,zm] + this%itpw_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpu_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y of U from [x ,ym,zm] + this%itpw_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpu_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z of U from [x ,ym,zm] + this%itpv_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z of V from [xm,y ,zm] + end do + end do + end do + + ! Allocate finite volume divergence operators + allocate(this%divp_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divp_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divp_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divu_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divu_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divu_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divv_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divv_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divv_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divw_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (z) + allocate(this%divw_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (z) + allocate(this%divw_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Face-centered (z) + ! Create divergence operator to cell center [xm,ym,zm] or tangent to cell face + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%divp_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,zm] + this%divp_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,zm] + this%divp_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,z ] + + this%divu_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] + this%divu_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] + + this%divv_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] + this%divv_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] + + this%divw_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] + this%divw_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [x ,ym,zm] + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%divu_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [xm,y ,zm] + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%divv_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [xm,ym,z ] + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%divw_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + + ! Allocate finite difference velocity gradient operators + allocate(this%grdu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdw_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdv_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%grdw_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%grdu_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%grdw_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%grdu_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%grdv_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + ! Create gradient coefficients to cell center [xm,ym,zm] + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%grdu_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of U from [x ,ym,zm] + this%grdv_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of V from [xm,y ,zm] + this%grdw_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%grdv_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of V from [xm,y ,zm] + this%grdw_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%grdu_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of U from [x ,ym,zm] + this%grdw_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%grdu_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of U from [x ,ym,zm] + this%grdv_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of V from [xm,y ,zm] + end do + end do + end do + + end subroutine init_metrics + + + !> Metric adjustment accounting for bconds and walls + subroutine adjust_metrics(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,st1,st2 + real(WP) :: delta,mysum + + ! Sync up u/v/wmasks + call this%cfg%sync(this%umask) + call this%cfg%sync(this%vmask) + call this%cfg%sync(this%wmask) + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%umask(this%cfg%imino,:,:)=this%umask(this%cfg%imino+1,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) + + ! I am assuming here that we do not really need to zero out wall cells + ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) + ! or outflow condition (then the density needs to be available but it should be directly calculated) + ! or used for a real no-slip wall (then density is always multiplied by zero) + ! Adjust density interpolation coefficients to cell faces in the presence of walls (only walls!) + !do k=this%cfg%kmin_,this%cfg%kmax_+1 ! SIZES NEED TO BE ADJUSTED + ! do j=this%cfg%jmin_,this%cfg%jmax_+1 ! SIZES NEED TO BE ADJUSTED + ! do i=this%cfg%imin_,this%cfg%imax_+1 ! SIZES NEED TO BE ADJUSTED + ! ! Linear interpolation in x + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i-1,j,k).gt.0.0_WP) this%itpr_x(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i-1,j,k).eq.0.0_WP) this%itpr_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in y + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j-1,k).gt.0.0_WP) this%itpr_y(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j-1,k).eq.0.0_WP) this%itpr_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in z + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j,k-1).gt.0.0_WP) this%itpr_z(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j,k-1).eq.0.0_WP) this%itpr_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! end do + ! end do + !end do + + ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) this%itpu_x(:,i,j,k)=0.0_WP + if (this%mask(i,j,k).eq.1) this%itpv_y(:,i,j,k)=0.0_WP + if (this%mask(i,j,k).eq.1) this%itpw_z(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Adjust viscosity interpolation coefficients to cell edge in the presence of walls (only walls) + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Zero out interpolation coefficients reaching in the walls + do st1=-1,0 + do st2=-1,0 + if (this%mask(i+st1,j+st2,k).eq.1) this%itp_xy(st1,st2,i,j,k)=0.0_WP + if (this%mask(i,j+st1,k+st2).eq.1) this%itp_yz(st1,st2,i,j,k)=0.0_WP + if (this%mask(i+st1,j,k+st2).eq.1) this%itp_xz(st1,st2,i,j,k)=0.0_WP + end do + end do + ! Rescale to ensure sum(itp)=1 + mysum=sum(this%itp_xy(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_xy(:,:,i,j,k)=this%itp_xy(:,:,i,j,k)/mysum + mysum=sum(this%itp_yz(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_yz(:,:,i,j,k)=this%itp_yz(:,:,i,j,k)/mysum + mysum=sum(this%itp_xz(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_xz(:,:,i,j,k)=this%itp_xz(:,:,i,j,k)/mysum + end do + end do + end do + + ! Loop over the domain and adjust divergence for P cell + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).gt.0) then + this%divp_x(:,i,j,k)=0.0_WP + this%divp_y(:,i,j,k)=0.0_WP + this%divp_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to U metrics + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + if (this%umask(i,j,k).gt.0) then + this%divu_x(:,i,j,k)=0.0_WP + this%divu_y(:,i,j,k)=0.0_WP + this%divu_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to V metrics + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + if (this%vmask(i,j,k).gt.0) then + this%divv_x(:,i,j,k)=0.0_WP + this%divv_y(:,i,j,k)=0.0_WP + this%divv_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to W metrics + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + if (this%wmask(i,j,k).gt.0) then + this%divw_x(:,i,j,k)=0.0_WP + this%divw_y(:,i,j,k)=0.0_WP + this%divw_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! FD gradient in x of V from [xm,y ,zm] + if (maxval(this%vmask(i-1:i,j,k)).gt.0) then + delta=0.0_WP + if (this%vmask(i ,j,k).eq.0) delta=delta+(this%cfg%xm(i)-this%cfg%x (i )) + if (this%vmask(i-1,j,k).eq.0) delta=delta+(this%cfg%x (i)-this%cfg%xm(i-1)) + if (delta.gt.0.0_WP) then + this%grdv_x(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdv_x(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in x of W from [xm,ym,z ] + if (maxval(this%wmask(i-1:i,j,k)).gt.0) then + delta=0.0_WP + if (this%wmask(i ,j,k).eq.0) delta=delta+(this%cfg%xm(i)-this%cfg%x (i )) + if (this%wmask(i-1,j,k).eq.0) delta=delta+(this%cfg%x (i)-this%cfg%xm(i-1)) + if (delta.gt.0.0_WP) then + this%grdw_x(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdw_x(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! FD gradient in y of U from [x ,ym,zm] + if (maxval(this%umask(i,j-1:j,k)).gt.0) then + delta=0.0_WP + if (this%umask(i,j ,k).eq.0) delta=delta+(this%cfg%ym(j)-this%cfg%y (j )) + if (this%umask(i,j-1,k).eq.0) delta=delta+(this%cfg%y (j)-this%cfg%ym(j-1)) + if (delta.gt.0.0_WP) then + this%grdu_y(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdu_y(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in y of W from [xm,ym,z ] + if (maxval(this%wmask(i,j-1:j,k)).gt.0) then + delta=0.0_WP + if (this%wmask(i,j ,k).eq.0) delta=delta+(this%cfg%ym(j)-this%cfg%y (j )) + if (this%wmask(i,j-1,k).eq.0) delta=delta+(this%cfg%y (j)-this%cfg%ym(j-1)) + if (delta.gt.0.0_WP) then + this%grdw_y(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdw_y(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! FD gradient in z of U from [x ,ym,zm] + if (maxval(this%umask(i,j,k-1:k)).gt.0) then + delta=0.0_WP + if (this%umask(i,j,k ).eq.0) delta=delta+(this%cfg%zm(k)-this%cfg%z (k )) + if (this%umask(i,j,k-1).eq.0) delta=delta+(this%cfg%z (k)-this%cfg%zm(k-1)) + if (delta.gt.0.0_WP) then + this%grdu_z(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdu_z(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in z of V from [xm,y ,zm] + if (maxval(this%vmask(i,j,k-1:k)).gt.0) then + delta=0.0_WP + if (this%vmask(i,j,k ).eq.0) delta=delta+(this%cfg%zm(k)-this%cfg%z (k )) + if (this%vmask(i,j,k-1).eq.0) delta=delta+(this%cfg%z (k)-this%cfg%zm(k-1)) + if (delta.gt.0.0_WP) then + this%grdv_z(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdv_z(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Linear interpolation in x of V from [xm,y ,zm] + if (this%vmask(i,j,k).eq.0.and.this%vmask(i-1,j,k).gt.0) this%itpv_x(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%vmask(i,j,k).gt.0.and.this%vmask(i-1,j,k).eq.0) this%itpv_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in x of W from [xm,ym,z ] + if (this%wmask(i,j,k).eq.0.and.this%wmask(i-1,j,k).gt.0) this%itpw_x(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%wmask(i,j,k).gt.0.and.this%wmask(i-1,j,k).eq.0) this%itpw_x(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! Linear interpolation in y of U from [x ,ym,zm] + if (this%umask(i,j,k).eq.0.and.this%umask(i,j-1,k).gt.0) this%itpu_y(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%umask(i,j,k).gt.0.and.this%umask(i,j-1,k).eq.0) this%itpu_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in y of W from [xm,ym,z ] + if (this%wmask(i,j,k).eq.0.and.this%wmask(i,j-1,k).gt.0) this%itpw_y(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%wmask(i,j,k).gt.0.and.this%wmask(i,j-1,k).eq.0) this%itpw_y(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! Linear interpolation in z of U from [x ,ym,zm] + if (this%umask(i,j,k).eq.0.and.this%umask(i,j,k-1).gt.0) this%itpu_z(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%umask(i,j,k).gt.0.and.this%umask(i,j,k-1).eq.0) this%itpu_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in z of V from [xm,y ,zm] + if (this%vmask(i,j,k).eq.0.and.this%vmask(i,j,k-1).gt.0) this%itpv_z(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%vmask(i,j,k).gt.0.and.this%vmask(i,j,k-1).eq.0) this%itpv_z(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust metrics to account for lower dimensionality + if (this%cfg%nx.eq.1) then + this%divp_x=0.0_WP + this%divu_x=0.0_WP + this%divv_x=0.0_WP + this%divw_x=0.0_WP + this%grdu_x=0.0_WP + this%grdv_x=0.0_WP + this%grdw_x=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%divp_y=0.0_WP + this%divu_y=0.0_WP + this%divv_y=0.0_WP + this%divw_y=0.0_WP + this%grdu_y=0.0_WP + this%grdv_y=0.0_WP + this%grdw_y=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%divp_z=0.0_WP + this%divu_z=0.0_WP + this%divv_z=0.0_WP + this%divw_z=0.0_WP + this%grdu_z=0.0_WP + this%grdv_z=0.0_WP + this%grdw_z=0.0_WP + end if + + end subroutine adjust_metrics + + + !> Finish setting up the flow solver now that bconds have been defined + subroutine setup(this,pressure_ils,implicit_ils) + implicit none + class(tpns), intent(inout) :: this + integer, intent(in) :: pressure_ils + integer, intent(in) :: implicit_ils + + ! Adjust metrics based on bcflag array + call this%adjust_metrics() + + ! Set 7-pt stencil map for the pressure solver + this%psolv%stc(1,:)=[ 0, 0, 0] + this%psolv%stc(2,:)=[+1, 0, 0] + this%psolv%stc(3,:)=[-1, 0, 0] + this%psolv%stc(4,:)=[ 0,+1, 0] + this%psolv%stc(5,:)=[ 0,-1, 0] + this%psolv%stc(6,:)=[ 0, 0,+1] + this%psolv%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to VF to make sure all needed cells participate in solver + this%psolv%opr(1,:,:,:)=this%cfg%VF + + ! Initialize the pressure Poisson solver + call this%psolv%init(pressure_ils) + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init(implicit_ils) + + end subroutine setup + + + !> Add a boundary condition + subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) + use string, only: lowercase + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: type + external :: locator + interface + logical function locator(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator + end interface + character(len=1), intent(in) :: face + integer, intent(in) :: dir + logical, intent(in) :: canCorrect + type(bcond), pointer :: new_bc + integer :: i,j,k,n + + ! Prepare new bcond + allocate(new_bc) + new_bc%name=trim(adjustl(name)) + new_bc%type=type + select case (lowercase(face)) + case ('x'); new_bc%face='x' + case ('y'); new_bc%face='y' + case ('z'); new_bc%face='z' + case default; call die('[tpns add_bcond] Unknown bcond face - expecting x, y, or z') + end select + new_bc%itr=iterator(pg=this%cfg,name=new_bc%name,locator=locator,face=new_bc%face) + select case (dir) ! Outward-oriented + case (+1); new_bc%dir=+1 + case (-1); new_bc%dir=-1 + case ( 0); new_bc%dir= 0 + case default; call die('[tpns add_bcond] Unknown bcond dir - expecting -1, +1, or 0') + end select + new_bc%rdir=real(new_bc%dir,WP) + new_bc%canCorrect=canCorrect + + ! Insert it up front + new_bc%next=>this%first_bc + this%first_bc=>new_bc + + ! Increment bcond counter + this%nbc=this%nbc+1 + + ! Now adjust the metrics accordingly + select case (new_bc%type) + case (dirichlet) !< Dirichlet is set one face (i.e., velocit component) at the time + select case (new_bc%face) + case ('x') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%umask(i,j,k)=2 + end do + case ('y') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%vmask(i,j,k)=2 + end do + case ('z') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%wmask(i,j,k)=2 + end do + end select + + case (neumann) !< Neumann has to be at existing wall or at domain boundary! + case (clipped_neumann) + case (convective) + case default + call die('[tpns apply_bcond] Unknown bcond type') + end select + + end subroutine add_bcond + + + !> Get a boundary condition + subroutine get_bcond(this,name,my_bc) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + character(len=*), intent(in) :: name + type(bcond), pointer, intent(out) :: my_bc + my_bc=>this%first_bc + search: do while (associated(my_bc)) + if (trim(my_bc%name).eq.trim(name)) exit search + my_bc=>my_bc%next + end do search + if (.not.associated(my_bc)) call die('[tpns get_bcond] Boundary condition was not found') + end subroutine get_bcond + + + !> Enforce boundary condition + subroutine apply_bcond(this,t,dt) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: t,dt + integer :: i,j,k,n,stag + type(bcond), pointer :: my_bc + + ! ! First enfore zero velocity at walls + ! do k=this%cfg%kmin_,this%cfg%kmax_ + ! do j=this%cfg%jmin_,this%cfg%jmax_ + ! do i=this%cfg%imin_,this%cfg%imax_ + ! if (minval(this%cfg%VF(i-1:i,j,k)).lt.10.0_WP*epsilon(1.0_WP)) this%U(i,j,k)=0.0_WP + ! if (minval(this%cfg%VF(i,j-1:j,k)).lt.10.0_WP*epsilon(1.0_WP)) this%V(i,j,k)=0.0_WP + ! if (minval(this%cfg%VF(i,j,k-1:k)).lt.10.0_WP*epsilon(1.0_WP)) this%W(i,j,k)=0.0_WP + ! end do + ! end do + ! end do + ! ! Sync fields + ! call this%cfg%sync(this%U) + ! call this%cfg%sync(this%V) + ! call this%cfg%sync(this%W) + + ! Traverse bcond list + my_bc=>this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + select case (my_bc%type) + + case (dirichlet) !< Apply Dirichlet conditions + + ! This is done by the user directly + ! Unclear whether we want to do this within the solver... + + case (neumann,clipped_neumann) !< Apply Neumann condition to all 3 components + ! Handle index shift due to staggering + stag=min(my_bc%dir,0) + ! Implement based on bcond direction + select case (my_bc%face) + case ('x') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i ,j ,k )=this%U(i-my_bc%dir ,j ,k ) + this%V(i+stag,j:j+1,k )=this%V(i-my_bc%dir+stag,j:j+1,k ) + this%W(i+stag,j ,k:k+1)=this%W(i-my_bc%dir+stag,j ,k:k+1) + end do + case ('y') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i:i+1,j+stag,k )=this%U(i:i+1,j-my_bc%dir+stag,k ) + this%V(i ,j ,k )=this%V(i ,j-my_bc%dir ,k ) + this%W(i ,j+stag,k:k+1)=this%W(i ,j-my_bc%dir+stag,k:k+1) + end do + case ('z') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i:i+1,j ,k+stag)=this%U(i:i+1,j ,k-my_bc%dir+stag) + this%V(i ,j:j+1,k+stag)=this%V(i ,j:j+1,k-my_bc%dir+stag) + this%W(i ,j ,k )=this%W(i ,j ,k-my_bc%dir ) + end do + end select + ! If needed, clip + if (my_bc%type.eq.clipped_neumann) then + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%U(i,j,k)*my_bc%rdir.lt.0.0_WP) this%U(i,j,k)=0.0_WP + end do + case ('y') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%V(i,j,k)*my_bc%rdir.lt.0.0_WP) this%V(i,j,k)=0.0_WP + end do + case ('z') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%W(i,j,k)*my_bc%rdir.lt.0.0_WP) this%W(i,j,k)=0.0_WP + end do + end select + end if + + case (convective) ! Not implemented yet! + + case default + call die('[tpns apply_bcond] Unknown bcond type') + end select + + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%U) + call this%cfg%sync(this%V) + call this%cfg%sync(this%W) + + ! Move on to the next bcond + my_bc=>my_bc%next + + end do + + end subroutine apply_bcond + + + !> Calculate the explicit momentum time derivative + !> This assumes that rho, rhoold, rhoU/V/W have been updated already + subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoUdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoVdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoWdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ii,jj,kk + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Flux of rhoU + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii-1; j=jj-1; k=kk-1 + FX(i,j,k)=-sum(this%itpu_x(:,i,j,k)*this%rhoU(i:i+1,j,k))*sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) & + & +this%visc (i,j,k)*(sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))) & + & -this%P(i,j,k) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-sum(this%itpv_x(:,i,j,k)*this%rhoV(i-1:i,j,k))*sum(this%itpu_y(:,i,j,k)*this%U(i,j-1:j,k)) & + & +this%visc_xy(i,j,k)*(sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))+sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=-sum(this%itpw_x(:,i,j,k)*this%rhoW(i-1:i,j,k))*sum(this%itpu_z(:,i,j,k)*this%U(i,j,k-1:k)) & + & +this%visc_zx(i,j,k)*(sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))+sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))) + end do + end do + end do + ! Time derivative of rhoU + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoUdt(i,j,k)=sum(this%divu_x(:,i,j,k)*FX(i-1:i,j,k))+& + & sum(this%divu_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divu_z(:,i,j,k)*FZ(i,j,k:k+1))+this%Pjx(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoUdt) + + ! Flux of rhoV + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=-sum(this%itpu_y(:,i,j,k)*this%rhoU(i,j-1:j,k))*sum(this%itpv_x(:,i,j,k)*this%V(i-1:i,j,k)) & + & +this%visc_xy(i,j,k)*(sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))+sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))) + ! Fluxes on y-face + i=ii-1; j=jj-1; k=kk-1 + FY(i,j,k)=-sum(this%itpv_y(:,i,j,k)*this%rhoV(i,j:j+1,k))*sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) & + & +this%visc (i,j,k)*(sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))) & + & -this%P(i,j,k) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=-sum(this%itpw_y(:,i,j,k)*this%rhoW(i,j-1:j,k))*sum(this%itpv_z(:,i,j,k)*this%V(i,j,k-1:k)) & + & +this%visc_yz(i,j,k)*(sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))+sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))) + end do + end do + end do + ! Time derivative of rhoV + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoVdt(i,j,k)=sum(this%divv_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divv_y(:,i,j,k)*FY(i,j-1:j,k))+& + & sum(this%divv_z(:,i,j,k)*FZ(i,j,k:k+1))+this%Pjy(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoVdt) + + ! Flux of rhoW + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=-sum(this%itpu_z(:,i,j,k)*this%rhoW(i,j,k-1:k))*sum(this%itpw_x(:,i,j,k)*this%W(i-1:i,j,k)) & + & +this%visc_zx(i,j,k)*(sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))+sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-sum(this%itpv_z(:,i,j,k)*this%rhoW(i,j,k-1:k))*sum(this%itpw_y(:,i,j,k)*this%W(i,j-1:j,k)) & + & +this%visc_yz(i,j,k)*(sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))+sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))) + ! Fluxes on z-face + i=ii-1; j=jj-1; k=kk-1 + FZ(i,j,k)=-sum(this%itpw_z(:,i,j,k)*this%rhoW(i,j,k:k+1))*sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) & + & +this%visc (i,j,k)*(sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))+sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))) & + & -this%P(i,j,k) + end do + end do + end do + ! Time derivative of rhoW + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoWdt(i,j,k)=sum(this%divw_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divw_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divw_z(:,i,j,k)*FZ(i,j,k-1:k))+this%Pjz(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoWdt) + + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + + end subroutine get_dmomdt + + + !> Update pressure Poisson operator + subroutine update_laplacian(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,s1,s2 + ! Setup the scaled Laplacian operator from metrics: lap(*)=-vol.div(grad(*)/rho) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Zero out Laplacian + !this%psolv%opr(:,i,j,k)=0.0_WP + ! Tranverse the stencil and recompute Laplacian + !do s1=0,1 + ! do s2=-1,0 + ! this%psolv%opr(this%psolv%stmap(s1+s2,0,0),i,j,k)=this%psolv%opr(this%psolv%stmap(s1+s2,0,0),i,j,k)+this%divp_x(s1,i,j,k)*this%divu_x(s2,i+s1,j,k)/sum(this%itpr_x(:,i+s1,j,k)*this%rho(i+s1-1:i+s1,j,k)) + ! this%psolv%opr(this%psolv%stmap(0,s1+s2,0),i,j,k)=this%psolv%opr(this%psolv%stmap(0,s1+s2,0),i,j,k)+this%divp_y(s1,i,j,k)*this%divv_y(s2,i,j+s1,k)/sum(this%itpr_y(:,i,j+s1,k)*this%rho(i,j+s1-1:j+s1,k)) + ! this%psolv%opr(this%psolv%stmap(0,0,s1+s2),i,j,k)=this%psolv%opr(this%psolv%stmap(0,0,s1+s2),i,j,k)+this%divp_z(s1,i,j,k)*this%divw_z(s2,i,j,k+s1)/sum(this%itpr_z(:,i,j,k+s1)*this%rho(i,j,k+s1-1:k+s1)) + ! end do + !end do + ! Scale Laplacian by cell volume + !this%psolv%opr(:,i,j,k)=-this%psolv%opr(:,i,j,k)*this%cfg%vol(i,j,k) + + ! Set Laplacian + this%psolv%opr(1,i,j,k)=this%divp_x(1,i,j,k)*this%divu_x(-1,i+1,j,k)/this%rho_U(i+1,j,k)+& + & this%divp_x(0,i,j,k)*this%divu_x( 0,i ,j,k)/this%rho_U(i ,j,k)+& + & this%divp_y(1,i,j,k)*this%divv_y(-1,i,j+1,k)/this%rho_V(i,j+1,k)+& + & this%divp_y(0,i,j,k)*this%divv_y( 0,i,j ,k)/this%rho_V(i,j ,k)+& + & this%divp_z(1,i,j,k)*this%divw_z(-1,i,j,k+1)/this%rho_W(i,j,k+1)+& + & this%divp_z(0,i,j,k)*this%divw_z( 0,i,j,k )/this%rho_W(i,j,k ) + this%psolv%opr(2,i,j,k)=this%divp_x(1,i,j,k)*this%divu_x( 0,i+1,j,k)/this%rho_U(i+1,j,k) + this%psolv%opr(3,i,j,k)=this%divp_x(0,i,j,k)*this%divu_x(-1,i ,j,k)/this%rho_U(i ,j,k) + this%psolv%opr(4,i,j,k)=this%divp_y(1,i,j,k)*this%divv_y( 0,i,j+1,k)/this%rho_V(i,j+1,k) + this%psolv%opr(5,i,j,k)=this%divp_y(0,i,j,k)*this%divv_y(-1,i,j ,k)/this%rho_V(i,j ,k) + this%psolv%opr(6,i,j,k)=this%divp_z(1,i,j,k)*this%divw_z( 0,i,j,k+1)/this%rho_W(i,j,k+1) + this%psolv%opr(7,i,j,k)=this%divp_z(0,i,j,k)*this%divw_z(-1,i,j,k )/this%rho_W(i,j,k ) + ! Scale it by the cell volume + this%psolv%opr(:,i,j,k)=-this%psolv%opr(:,i,j,k)*this%cfg%vol(i,j,k) + end do + end do + end do + ! Initialize the pressure Poisson solver + call this%psolv%setup() + end subroutine update_laplacian + + + !> Calculate the velocity divergence based on U/V/W + subroutine get_div(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%div(i,j,k)=sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+& + & sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+& + & sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(this%div) + end subroutine get_div + + + !> Add surface tension jump term using CSF + subroutine add_surface_tension_jump(this,dt,div,vf,contact_model) + use messager, only: die + use vfs_class, only: vfs + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: div !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + class(vfs), intent(inout) :: vf + integer, intent(in), optional :: contact_model + integer :: i,j,k,s1 + real(WP) :: mycurv,mysurf + + ! Store old jump + this%DPjx=this%Pjx + this%DPjy=this%Pjy + this%DPjz=this%Pjz + + ! Calculate pressure jump + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + ! X face + mysurf=sum(vf%SD(i-1:i,j,k)*this%cfg%vol(i-1:i,j,k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i-1:i,j,k)*vf%curv(i-1:i,j,k)*this%cfg%vol(i-1:i,j,k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjx(i,j,k)=this%sigma*mycurv*sum(this%divu_x(:,i,j,k)*vf%VF(i-1:i,j,k)) + ! Y face + mysurf=sum(vf%SD(i,j-1:j,k)*this%cfg%vol(i,j-1:j,k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i,j-1:j,k)*vf%curv(i,j-1:j,k)*this%cfg%vol(i,j-1:j,k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjy(i,j,k)=this%sigma*mycurv*sum(this%divv_y(:,i,j,k)*vf%VF(i,j-1:j,k)) + ! Z face + mysurf=sum(vf%SD(i,j,k-1:k)*this%cfg%vol(i,j,k-1:k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i,j,k-1:k)*vf%curv(i,j,k-1:k)*this%cfg%vol(i,j,k-1:k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjz(i,j,k)=this%sigma*mycurv*sum(this%divw_z(:,i,j,k)*vf%VF(i,j,k-1:k)) + end do + end do + end do + + ! Add wall contact force to pressure jump + if (present(contact_model)) then + select case (contact_model) + case (static_contact) + call this%add_static_contact(vf=vf) + case default + call die('[tpns: add_surface_tension_jump] Unknown contact model!') + end select + end if + + ! Compute jump of DP + this%DPjx=this%Pjx-this%DPjx + this%DPjy=this%Pjy-this%DPjy + this%DPjz=this%Pjz-this%DPjz + + ! Add div(Pjump) to RP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + !do s1=0,1 + ! div(i,j,k)=div(i,j,k)+dt*this%divp_x(s1,i,j,k)*this%DPjx(i+s1,j,k)/sum(this%itpr_x(:,i+s1,j,k)*this%rho(i+s1-1:i+s1,j,k)) + ! div(i,j,k)=div(i,j,k)+dt*this%divp_y(s1,i,j,k)*this%DPjy(i,j+s1,k)/sum(this%itpr_y(:,i,j+s1,k)*this%rho(i,j+s1-1:j+s1,k)) + ! div(i,j,k)=div(i,j,k)+dt*this%divp_z(s1,i,j,k)*this%DPjz(i,j,k+s1)/sum(this%itpr_z(:,i,j,k+s1)*this%rho(i,j,k+s1-1:k+s1)) + !end do + div(i,j,k)=div(i,j,k)+dt*(sum(this%divp_x(:,i,j,k)*this%DPjx(i:i+1,j,k)/this%rho_U(i:i+1,j,k))& + & +sum(this%divp_y(:,i,j,k)*this%DPjy(i,j:j+1,k)/this%rho_V(i,j:j+1,k))& + & +sum(this%divp_z(:,i,j,k)*this%DPjz(i,j,k:k+1)/this%rho_W(i,j,k:k+1))) + end do + end do + end do + + end subroutine add_surface_tension_jump + + + !> Calculate the pressure gradient based on P + subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: P !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgradx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgrady !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgradz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + Pgradx(i,j,k)=sum(this%divu_x(:,i,j,k)*P(i-1:i,j,k))-this%dPjx(i,j,k) + Pgrady(i,j,k)=sum(this%divv_y(:,i,j,k)*P(i,j-1:j,k))-this%dPjy(i,j,k) + Pgradz(i,j,k)=sum(this%divw_z(:,i,j,k)*P(i,j,k-1:k))-this%dPjz(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(Pgradx) + call this%cfg%sync(Pgrady) + call this%cfg%sync(Pgradz) + end subroutine get_pgrad + + + !> Calculate the interpolated velocity, including overlap and ghosts + subroutine interp_vel(this,Ui,Vi,Wi) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + ! Calculate as far as possible each component + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_-1 + Ui(i,j,k)=sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + Vi(i,j,k)=sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + Wi(i,j,k)=sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + ! Add last layer in each direction + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) Ui(this%cfg%imaxo,:,:)=this%U(this%cfg%imaxo,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) Vi(:,this%cfg%jmaxo,:)=this%V(:,this%cfg%jmaxo,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) Wi(:,:,this%cfg%kmaxo)=this%W(:,:,this%cfg%kmaxo) + ! Sync it + call this%cfg%sync(Ui) + call this%cfg%sync(Vi) + call this%cfg%sync(Wi) + end subroutine interp_vel + + + !> Calculate the deviatoric part of the strain rate tensor from U/V/W + !> 1: du/dx-div/3 + !> 2: dv/dy-div/3 + !> 3: dw/dz-div/3 + !> 4: (du/dy+dv/dx)/2 + !> 5: (dv/dz+dw/dy)/2 + !> 6: (dw/dx+du/dz)/2 + subroutine get_strainrate(this,SR) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + real(WP) :: div + integer :: i,j,k + + ! Check SR's first dimension + if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + SR(2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + SR(3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + div=sum(SR(1:3,i,j,k))/3.0_WP + SR(1,i,j,k)=SR(1,i,j,k)-div + SR(2,i,j,k)=SR(2,i,j,k)-div + SR(3,i,j,k)=SR(3,i,j,k)-div + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) + SR(5,i,j,k)=0.125_WP*(sum(dvdz(i ,j:j+1,k:k+1))+sum(dwdy(i ,j:j+1,k:k+1))) + SR(6,i,j,k)=0.125_WP*(sum(dwdx(i:i+1,j ,k:k+1))+sum(dudz(i:i+1,j ,k:k+1))) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(SR) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_strainrate + + + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cflc,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cflc + real(WP), optional :: cfl + integer :: i,j,k,ierr + real(WP) :: my_CFLc_x,my_CFLc_y,my_CFLc_z,my_CFLv_x,my_CFLv_y,my_CFLv_z,my_CFLst + real(WP) :: max_nu + + ! Get surface tension CFL first + my_CFLst=huge(1.0_WP) + if (this%sigma.gt.0.0_WP) then + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_CFLst=min(my_CFLst,sqrt((this%rho_l+this%rho_g)*this%cfg%meshsize(i,j,k)**3.0_WP/(4.0_WP*Pi*this%sigma))) + end do + end do + end do + end if + call MPI_ALLREDUCE(my_CFLst,this%CFLst,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + this%CFLst=dt/this%CFLst + + ! Get largest kinematic viscosity + max_nu=max(this%visc_l/this%rho_l,this%visc_g/this%rho_g) + + ! Set the CFLs to zero + my_CFLc_x=0.0_WP; my_CFLc_y=0.0_WP; my_CFLc_z=0.0_WP + my_CFLv_x=0.0_WP; my_CFLv_y=0.0_WP; my_CFLv_z=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_CFLc_x=max(my_CFLc_x,abs(this%U(i,j,k))*this%cfg%dxmi(i)) + my_CFLc_y=max(my_CFLc_y,abs(this%V(i,j,k))*this%cfg%dymi(j)) + my_CFLc_z=max(my_CFLc_z,abs(this%W(i,j,k))*this%cfg%dzmi(k)) + my_CFLv_x=max(my_CFLv_x,4.0_WP*max_nu*this%cfg%dxi(i)**2) + my_CFLv_y=max(my_CFLv_y,4.0_WP*max_nu*this%cfg%dyi(j)**2) + my_CFLv_z=max(my_CFLv_z,4.0_WP*max_nu*this%cfg%dzi(k)**2) + end do + end do + end do + my_CFLc_x=my_CFLc_x*dt; my_CFLc_y=my_CFLc_y*dt; my_CFLc_z=my_CFLc_z*dt + my_CFLv_x=my_CFLv_x*dt; my_CFLv_y=my_CFLv_y*dt; my_CFLv_z=my_CFLv_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLc_x,this%CFLc_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLc_y,this%CFLc_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLc_z,this%CFLc_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_x,this%CFLv_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_y,this%CFLv_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_z,this%CFLv_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum convective + surface tension CFL + cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLst) + + ! If asked for, also return the maximum overall CFL + if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) + + end subroutine get_cfl + + + !> Calculate the max of our fields + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,ierr + real(WP) :: my_Umax,my_Vmax,my_Wmax,my_Pmax,my_divmax + + ! Set all to zero + my_Umax=0.0_WP; my_Vmax=0.0_WP; my_Wmax=0.0_WP; my_Pmax=0.0_WP; my_divmax=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_Umax=max(my_Umax,abs(this%U(i,j,k))) + my_Vmax=max(my_Vmax,abs(this%V(i,j,k))) + my_Wmax=max(my_Wmax,abs(this%W(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_Pmax =max(my_Pmax ,abs(this%P(i,j,k) )) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_divmax=max(my_divmax,abs(this%div(i,j,k))) + end do + end do + end do + + ! Get the parallel max + call MPI_ALLREDUCE(my_Umax ,this%Umax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Vmax ,this%Vmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Wmax ,this%Wmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Pmax ,this%Pmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_divmax,this%divmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + end subroutine get_max + + + !> Compute MFR through all bcs + subroutine get_mfr(this) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,n,ibc,ierr + type(bcond), pointer :: my_bc + real(WP), dimension(:), allocatable :: my_mfr,my_area + real(WP), dimension(:), allocatable :: canCorrect + + ! Ensure this%mfr is of proper size + if (.not.allocated(this%mfr)) then + allocate(this%mfr(this%nbc)) + else + if (size(this%mfr).ne.this%nbc) then + deallocate(this%mfr); allocate(this%mfr(this%nbc)) + end if + end if + + ! Ensure this%area is of proper size + if (.not.allocated(this%area)) then + allocate(this%area(this%nbc)) + else + if (size(this%area).ne.this%nbc) then + deallocate(this%area); allocate(this%area(this%nbc)) + end if + end if + + ! Allocate temp array for communication + allocate(my_mfr(this%nbc)) + allocate(my_area(this%nbc)) + allocate(canCorrect(this%nbc)) + + ! Traverse bcond list and integrate local outgoing MFR + my_bc=>this%first_bc; ibc=1 + do while (associated(my_bc)) + + ! Set zero local MFR and area + my_mfr(ibc)=0.0_WP + my_area(ibc)=0.0_WP + if (my_bc%canCorrect) then + canCorrect(ibc)=1.0_WP + else + canCorrect(ibc)=0.0_WP + end if + + ! Only processes inside the bcond have a non-zero MFR + if (my_bc%itr%amIn) then + + ! Implement based on bcond face and dir, loop over interior only + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%U(i,j,k)*this%cfg%dy(j)*this%cfg%dz(k) + my_area(ibc)=my_area(ibc)+this%cfg%dy(j)*this%cfg%dz(k) + end do + case ('y') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%V(i,j,k)*this%cfg%dz(k)*this%cfg%dx(i) + my_area(ibc)=my_area(ibc)+this%cfg%dz(k)*this%cfg%dx(i) + end do + case ('z') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%W(i,j,k)*this%cfg%dx(i)*this%cfg%dy(j) + my_area(ibc)=my_area(ibc)+this%cfg%dx(i)*this%cfg%dy(j) + end do + end select + + end if + + ! Move on to the next bcond + my_bc=>my_bc%next; ibc=ibc+1 + + end do + + ! Sum up all values + call MPI_ALLREDUCE(my_mfr ,this%mfr ,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_area,this%area,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + + ! Compute the correctable area + this%correctable_area=sum(this%area*canCorrect) + + ! Deallocate temp array + deallocate(my_mfr,my_area,canCorrect) + + end subroutine get_mfr + + + !> Correct MFR through correctable bconds + subroutine correct_mfr(this) + use mpi_f08, only: MPI_SUM + implicit none + class(tpns), intent(inout) :: this + real(WP) :: mfr_error,vel_correction + integer :: i,j,k,n + type(bcond), pointer :: my_bc + + ! Evaluate MFR mismatch and velocity correction + call this%get_mfr() + mfr_error=sum(this%mfr) + if (abs(mfr_error).lt.10.0_WP*epsilon(1.0_WP).or.abs(this%correctable_area).lt.10.0_WP*epsilon(1.0_WP)) return + vel_correction=-mfr_error/(this%correctable_area) + + ! Traverse bcond list and correct bcond MFR + my_bc=>this%first_bc + do while (associated(my_bc)) + + ! Only processes inside correctable bcond need to work + if (my_bc%itr%amIn.and.my_bc%canCorrect) then + + ! Implement based on bcond direction, loop over all cell + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i,j,k)=this%U(i,j,k)+my_bc%rdir*vel_correction + end do + case ('y') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%V(i,j,k)=this%V(i,j,k)+my_bc%rdir*vel_correction + end do + case ('z') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%W(i,j,k)=this%W(i,j,k)+my_bc%rdir*vel_correction + end do + end select + + end if + + ! Move on to the next bcond + my_bc=>my_bc%next + + end do + + end subroutine correct_mfr + + + !> Shift pressure to ensure zero average + subroutine shift_p(this,pressure) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(in) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot + integer :: i,j,k,ierr + + ! Loop over domain and integrate volume and pressure + my_vol_tot=0.0_WP + my_pressure_tot=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) + my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + pressure_tot=pressure_tot/vol_tot + + ! Shift the pressure + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%cfg%VF(i,j,k).gt.0.0_WP) pressure(i,j,k)=pressure(i,j,k)-pressure_tot + end do + end do + end do + call this%cfg%sync(pressure) + + end subroutine shift_p + + + !> Solve for implicit velocity residual + subroutine solve_implicit(this,dt,resU,resV,resW) + use ils_class, only: amg + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP) :: rhoUp,rhoUm,rhoVp,rhoVm,rhoWp,rhoWm + + ! Solve implicit U problem + !this%implicit%opr(1,:,:,:)=sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)); this%implicit%opr(2:,:,:,:)=0.0_WP + this%implicit%opr(1,:,:,:)=this%rho_U; this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_x(:,i ,j,k)*this%rhoU(i :i+1,j,k)) + rhoUm=sum(this%itpu_x(:,i-1,j,k)*this%rhoU(i-1:i ,j,k)) + rhoVp=sum(this%itpv_x(:,i,j+1,k)*this%rhoV(i-1:i,j+1,k)) + rhoVm=sum(this%itpv_x(:,i,j ,k)*this%rhoV(i-1:i,j ,k)) + rhoWp=sum(this%itpw_x(:,i,j,k+1)*this%rhoW(i-1:i,j,k+1)) + rhoWm=sum(this%itpw_x(:,i,j,k )*this%rhoW(i-1:i,j,k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divu_x( 0,i,j,k)*this%itpu_x( 0,i ,j,k)*rhoUp+& + & this%divu_x(-1,i,j,k)*this%itpu_x(+1,i-1,j,k)*rhoUm+& + & this%divu_y(+1,i,j,k)*this%itpu_y(-1,i,j+1,k)*rhoVp+& + & this%divu_y( 0,i,j,k)*this%itpu_y( 0,i,j ,k)*rhoVm+& + & this%divu_z(+1,i,j,k)*this%itpu_z(-1,i,j,k+1)*rhoWp+& + & this%divu_z( 0,i,j,k)*this%itpu_z( 0,i,j,k )*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divu_x( 0,i,j,k)*this%itpu_x(+1,i ,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divu_x(-1,i,j,k)*this%itpu_x( 0,i-1,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divu_y(+1,i,j,k)*this%itpu_y( 0,i,j+1,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divu_y( 0,i,j,k)*this%itpu_y(-1,i,j ,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divu_z(+1,i,j,k)*this%itpu_z( 0,i,j,k+1)*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divu_z( 0,i,j,k)*this%itpu_z(-1,i,j,k )*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divu_x( 0,i,j,k)*2.0_WP*this%visc (i ,j,k)*this%grdu_x( 0,i ,j,k)+& + & this%divu_x(-1,i,j,k)*2.0_WP*this%visc (i-1,j,k)*this%grdu_x(+1,i-1,j,k)+& + & this%divu_y(+1,i,j,k)* this%visc_xy(i,j+1,k)*this%grdu_y(-1,i,j+1,k)+& + & this%divu_y( 0,i,j,k)* this%visc_xy(i,j ,k)*this%grdu_y( 0,i,j ,k)+& + & this%divu_z(+1,i,j,k)* this%visc_zx(i,j,k+1)*this%grdu_z(-1,i,j,k+1)+& + & this%divu_z( 0,i,j,k)* this%visc_zx(i,j,k )*this%grdu_z( 0,i,j,k )) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divu_x( 0,i,j,k)*2.0_WP*this%visc (i ,j,k)*this%grdu_x(+1,i ,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divu_x(-1,i,j,k)*2.0_WP*this%visc (i-1,j,k)*this%grdu_x( 0,i-1,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divu_y(+1,i,j,k)* this%visc_xy(i,j+1,k)*this%grdu_y( 0,i,j+1,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divu_y( 0,i,j,k)* this%visc_xy(i,j ,k)*this%grdu_y(-1,i,j ,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divu_z(+1,i,j,k)* this%visc_zx(i,j,k+1)*this%grdu_z( 0,i,j,k+1)) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divu_z( 0,i,j,k)* this%visc_zx(i,j,k )*this%grdu_z(-1,i,j,k )) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resU + this%implicit%sol=0.0_WP + call this%implicit%solve() + resU=this%implicit%sol + + ! Solve implicit V problem + !this%implicit%opr(1,:,:,:)=sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)); this%implicit%opr(2:,:,:,:)=0.0_WP + this%implicit%opr(1,:,:,:)=this%rho_V; this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_y(:,i+1,j,k)*this%rhoU(i+1,j-1:j,k)) + rhoUm=sum(this%itpu_y(:,i ,j,k)*this%rhoU(i ,j-1:j,k)) + rhoVp=sum(this%itpv_y(:,i,j ,k)*this%rhoV(i,j :j+1,k)) + rhoVm=sum(this%itpv_y(:,i,j-1,k)*this%rhoV(i,j-1:j ,k)) + rhoWp=sum(this%itpw_y(:,i,j,k+1)*this%rhoW(i,j-1:j,k+1)) + rhoWm=sum(this%itpw_y(:,i,j,k )*this%rhoW(i,j-1:j,k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divv_x(+1,i,j,k)*this%itpv_x(-1,i+1,j,k)*rhoUp+& + & this%divv_x( 0,i,j,k)*this%itpv_x( 0,i ,j,k)*rhoUm+& + & this%divv_y( 0,i,j,k)*this%itpv_y( 0,i,j ,k)*rhoVp+& + & this%divv_y(-1,i,j,k)*this%itpv_y(+1,i,j-1,k)*rhoVm+& + & this%divv_z(+1,i,j,k)*this%itpv_z(-1,i,j,k+1)*rhoWp+& + & this%divv_z( 0,i,j,k)*this%itpv_z( 0,i,j,k )*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divv_x(+1,i,j,k)*this%itpv_x( 0,i+1,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divv_x( 0,i,j,k)*this%itpv_x(-1,i ,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divv_y( 0,i,j,k)*this%itpv_y(+1,i,j ,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divv_y(-1,i,j,k)*this%itpv_y( 0,i,j-1,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divv_z(+1,i,j,k)*this%itpv_z( 0,i,j,k+1)*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divv_z( 0,i,j,k)*this%itpv_z(-1,i,j,k )*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divv_x(+1,i,j,k)* this%visc_xy(i+1,j,k)*this%grdv_x(-1,i+1,j,k)+& + & this%divv_x( 0,i,j,k)* this%visc_xy(i ,j,k)*this%grdv_x( 0,i ,j,k)+& + & this%divv_y( 0,i,j,k)*2.0_WP*this%visc (i,j ,k)*this%grdv_y( 0,i,j ,k)+& + & this%divv_y(-1,i,j,k)*2.0_WP*this%visc (i,j-1,k)*this%grdv_y(+1,i,j-1,k)+& + & this%divv_z(+1,i,j,k)* this%visc_yz(i,j,k+1)*this%grdv_z(-1,i,j,k+1)+& + & this%divv_z( 0,i,j,k)* this%visc_yz(i,j,k )*this%grdv_z( 0,i,j,k )) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divv_x(+1,i,j,k)* this%visc_xy(i+1,j,k)*this%grdv_x( 0,i+1,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divv_x( 0,i,j,k)* this%visc_xy(i ,j,k)*this%grdv_x(-1,i ,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divv_y( 0,i,j,k)*2.0_WP*this%visc (i,j ,k)*this%grdv_y(+1,i,j ,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divv_y(-1,i,j,k)*2.0_WP*this%visc (i,j-1,k)*this%grdv_y( 0,i,j-1,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divv_z(+1,i,j,k)* this%visc_yz(i,j,k+1)*this%grdv_z( 0,i,j,k+1)) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divv_z( 0,i,j,k)* this%visc_yz(i,j,k )*this%grdv_z(-1,i,j,k )) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resV + this%implicit%sol=0.0_WP + call this%implicit%solve() + resV=this%implicit%sol + + ! Solve implicit W problem + !this%implicit%opr(1,:,:,:)=sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)); this%implicit%opr(2:,:,:,:)=0.0_WP + this%implicit%opr(1,:,:,:)=this%rho_W; this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_z(:,i+1,j,k)*this%rhoU(i+1,j,k-1:k)) + rhoUm=sum(this%itpu_z(:,i ,j,k)*this%rhoU(i ,j,k-1:k)) + rhoVp=sum(this%itpv_z(:,i,j+1,k)*this%rhoV(i,j+1,k-1:k)) + rhoVm=sum(this%itpv_z(:,i,j ,k)*this%rhoV(i,j ,k-1:k)) + rhoWp=sum(this%itpw_z(:,i,j,k )*this%rhoW(i,j,k :k+1)) + rhoWm=sum(this%itpw_z(:,i,j,k-1)*this%rhoW(i,j,k-1:k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divw_x(+1,i,j,k)*this%itpw_x(-1,i+1,j,k)*rhoUp+& + & this%divw_x( 0,i,j,k)*this%itpw_x( 0,i ,j,k)*rhoUm+& + & this%divw_y(+1,i,j,k)*this%itpw_y(-1,i,j+1,k)*rhoVp+& + & this%divw_y( 0,i,j,k)*this%itpw_y( 0,i,j ,k)*rhoVm+& + & this%divw_z( 0,i,j,k)*this%itpw_z( 0,i,j,k )*rhoWp+& + & this%divw_z(-1,i,j,k)*this%itpw_z(+1,i,j,k-1)*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divw_x(+1,i,j,k)*this%itpw_x( 0,i+1,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divw_x( 0,i,j,k)*this%itpw_x(-1,i ,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divw_y(+1,i,j,k)*this%itpw_y( 0,i,j+1,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divw_y( 0,i,j,k)*this%itpw_y(-1,i,j ,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divw_z( 0,i,j,k)*this%itpw_z(+1,i,j,k )*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divw_z(-1,i,j,k)*this%itpw_z( 0,i,j,k-1)*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divw_x(+1,i,j,k)* this%visc_zx(i+1,j,k)*this%grdw_x(-1,i+1,j,k)+& + & this%divw_x( 0,i,j,k)* this%visc_zx(i ,j,k)*this%grdw_x( 0,i ,j,k)+& + & this%divw_y(+1,i,j,k)* this%visc_yz(i,j+1,k)*this%grdw_y(-1,i,j+1,k)+& + & this%divw_y( 0,i,j,k)* this%visc_yz(i,j ,k)*this%grdw_y( 0,i,j ,k)+& + & this%divw_z( 0,i,j,k)*2.0_WP*this%visc (i,j,k )*this%grdw_z( 0,i,j,k )+& + & this%divw_z(-1,i,j,k)*2.0_WP*this%visc (i,j,k-1)*this%grdw_z(+1,i,j,k-1)) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divw_x(+1,i,j,k)* this%visc_zx(i+1,j,k)*this%grdw_x( 0,i+1,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divw_x( 0,i,j,k)* this%visc_zx(i ,j,k)*this%grdw_x(-1,i ,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divw_y(+1,i,j,k)* this%visc_yz(i,j+1,k)*this%grdw_y( 0,i,j+1,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divw_y( 0,i,j,k)* this%visc_yz(i,j ,k)*this%grdw_y(-1,i,j ,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divw_z( 0,i,j,k)*2.0_WP*this%visc (i,j,k )*this%grdw_z(+1,i,j,k )) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divw_z(-1,i,j,k)*2.0_WP*this%visc (i,j,k-1)*this%grdw_z( 0,i,j,k-1)) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resW + this%implicit%sol=0.0_WP + call this%implicit%solve() + resW=this%implicit%sol + + ! Sync up all residuals + call this%cfg%sync(resU) + call this%cfg%sync(resV) + call this%cfg%sync(resW) + + end subroutine solve_implicit + + + !> Prepare staggered density arrays from rho + subroutine get_staggered_density(this) + use vfs_class, only: vfs + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k + ! Calculate rho_U/V/W using interpolation + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%rho_U(i,j,k)=sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)) + end do + end do + end do + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%rho_V(i,j,k)=sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)) + end do + end do + end do + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%rho_W(i,j,k)=sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)) + end do + end do + end do + ! Handle non-periodic borders + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%rho_U(this%cfg%imino,:,:)=this%rho(this%cfg%imino,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%rho_V(:,this%cfg%jmino,:)=this%rho(:,this%cfg%jmino,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%rho_W(:,:,this%cfg%kmino)=this%rho(:,:,this%cfg%kmino) + ! Synchronize boundaries + call this%cfg%sync(this%rho_U) + call this%cfg%sync(this%rho_V) + call this%cfg%sync(this%rho_W) + end subroutine get_staggered_density + + + !> Prepare viscosity arrays from vfs object + subroutine get_viscosity(this,vf) + use vfs_class, only: vfs + implicit none + class(tpns), intent(inout) :: this + class(vfs), intent(in) :: vf + integer :: i,j,k + real(WP) :: liq_vol,gas_vol,tot_vol + ! Compute harmonically-averaged staggered viscosities using subcell phasic volumes + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! VISC at [xm,ym,zm] - direct sum in x/y/z + liq_vol=sum(vf%Lvol(:,:,:,i,j,k)) + gas_vol=sum(vf%Gvol(:,:,:,i,j,k)) + tot_vol=gas_vol+liq_vol + this%visc(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_xy at [x,y,zm] - direct sum in z, staggered sum in x/y + liq_vol=sum(vf%Lvol(0,0,:,i,j,k))+sum(vf%Lvol(1,0,:,i-1,j,k))+sum(vf%Lvol(0,1,:,i,j-1,k))+sum(vf%Lvol(1,1,:,i-1,j-1,k)) + gas_vol=sum(vf%Gvol(0,0,:,i,j,k))+sum(vf%Gvol(1,0,:,i-1,j,k))+sum(vf%Gvol(0,1,:,i,j-1,k))+sum(vf%Gvol(1,1,:,i-1,j-1,k)) + tot_vol=gas_vol+liq_vol + this%visc_xy(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_xy(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_yz at [xm,y,z] - direct sum in x, staggered sum in y/z + liq_vol=sum(vf%Lvol(:,0,0,i,j,k))+sum(vf%Lvol(:,1,0,i,j-1,k))+sum(vf%Lvol(:,0,1,i,j,k-1))+sum(vf%Lvol(:,1,1,i,j-1,k-1)) + gas_vol=sum(vf%Gvol(:,0,0,i,j,k))+sum(vf%Gvol(:,1,0,i,j-1,k))+sum(vf%Gvol(:,0,1,i,j,k-1))+sum(vf%Gvol(:,1,1,i,j-1,k-1)) + tot_vol=gas_vol+liq_vol + this%visc_yz(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_yz(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_zx at [x,ym,z] - direct sum in y, staggered sum in z/x + liq_vol=sum(vf%Lvol(0,:,0,i,j,k))+sum(vf%Lvol(0,:,1,i,j,k-1))+sum(vf%Lvol(1,:,0,i-1,j,k))+sum(vf%Lvol(1,:,1,i-1,j,k-1)) + gas_vol=sum(vf%Gvol(0,:,0,i,j,k))+sum(vf%Gvol(0,:,1,i,j,k-1))+sum(vf%Gvol(1,:,0,i-1,j,k))+sum(vf%Gvol(1,:,1,i-1,j,k-1)) + tot_vol=gas_vol+liq_vol + this%visc_zx(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_zx(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + end do + end do + end do + ! Synchronize boundaries - not really needed... + call this%cfg%sync(this%visc) + call this%cfg%sync(this%visc_xy) + call this%cfg%sync(this%visc_yz) + call this%cfg%sync(this%visc_zx) + end subroutine get_viscosity + + + !> Add gravity source term - assumes that rho has been updated before + subroutine addsrc_gravity(this,resU,resV,resW) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + !if (this%umask(i,j,k).eq.0) resU(i,j,k)=resU(i,j,k)+sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k))*this%gravity(1) + !if (this%vmask(i,j,k).eq.0) resV(i,j,k)=resV(i,j,k)+sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k))*this%gravity(2) + !if (this%wmask(i,j,k).eq.0) resW(i,j,k)=resW(i,j,k)+sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k))*this%gravity(3) + if (this%umask(i,j,k).eq.0) resU(i,j,k)=resU(i,j,k)+this%rho_U(i,j,k)*this%gravity(1) + if (this%vmask(i,j,k).eq.0) resV(i,j,k)=resV(i,j,k)+this%rho_V(i,j,k)*this%gravity(2) + if (this%wmask(i,j,k).eq.0) resW(i,j,k)=resW(i,j,k)+this%rho_W(i,j,k)*this%gravity(3) + end do + end do + end do + end subroutine addsrc_gravity + + + !> Add a static contact line model + subroutine add_static_contact(this,vf) + use mathtools, only: normalize + use vfs_class, only: vfs + use irl_fortran_interface + implicit none + class(tpns), intent(inout) :: this + class(vfs), intent(in) :: vf + integer :: i,j,k + real(WP), dimension(3) :: nw + real(WP), dimension(2) :: fvof + real(WP), dimension(:,:,:), allocatable :: GFM + real(WP) :: dd,mysurf,mycos + real(WP) :: cos_contact_angle + real(WP) :: sin_contact_angle + real(WP) :: tan_contact_angle + real(WP), parameter :: cfactor=1.0_WP + + ! Allocate and zero out binarized VF for GFM-style jump distribution + allocate(GFM(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); GFM=0.0_WP + + ! Prepare a GFM-based strategy + GFM=real(nint(vf%VF),WP) + + ! Precalculate cos/sin/tan(contact angle) + cos_contact_angle=cos(this%contact_angle) + sin_contact_angle=sin(this%contact_angle) + tan_contact_angle=tan(this%contact_angle) + + ! Loop over domain and identify cells that require contact angle model + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + + ! Check if we have an interface in the vicinity of the x-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i-1:i,j,k) + ! Check for local wall configuration - wall in y- + if (this%umask(i,j,k).eq.0.and.this%mask(i,j-1,k).eq.1.and.this%mask(i-1,j-1,k).eq.1) then + ! Define wall + nw=[0.0_WP,+1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions from PLIC + !call getMoments(vf%polyface(2,i-1,j,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i-1,j,k))) + !call getMoments(vf%polyface(2,i ,j,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i ,j,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y+ + if (this%umask(i,j,k).eq.0.and.this%mask(i,j+1,k).eq.1.and.this%mask(i-1,j+1,k).eq.1) then + ! Define wall + nw=[0.0_WP,-1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i-1,j+1,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i-1,j+1,k))) + !call getMoments(vf%polyface(2,i ,j+1,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i ,j+1,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z- + if (this%umask(i,j,k).eq.0.and.this%mask(i,j,k-1).eq.1.and.this%mask(i-1,j,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,+1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i-1,j,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i-1,j,k))) + !call getMoments(vf%polyface(3,i ,j,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i ,j,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z+ + if (this%umask(i,j,k).eq.0.and.this%mask(i,j,k+1).eq.1.and.this%mask(i-1,j,k+1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,-1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i-1,j,k+1),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i-1,j,k+1))) + !call getMoments(vf%polyface(3,i ,j,k+1),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i ,j,k+1))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + ! Check if we have an interface in the vicinity of the y-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i,j-1:j,k) + ! Check for local wall configuration - wall in x- + if (this%vmask(i,j,k).eq.0.and.this%mask(i-1,j,k).eq.1.and.this%mask(i-1,j-1,k).eq.1) then + ! Define wall + nw=[+1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i,j-1,k))) + !call getMoments(vf%polyface(1,i,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in x+ + if (this%vmask(i,j,k).eq.0.and.this%mask(i+1,j,k).eq.1.and.this%mask(i+1,j-1,k).eq.1) then + ! Define wall + nw=[-1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i+1,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i+1,j-1,k))) + !call getMoments(vf%polyface(1,i+1,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i+1,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z- + if (this%vmask(i,j,k).eq.0.and.this%mask(i,j,k-1).eq.1.and.this%mask(i,j-1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,+1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i,j-1,k))) + !call getMoments(vf%polyface(3,i,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z+ + if (this%vmask(i,j,k).eq.0.and.this%mask(i,j,k+1).eq.1.and.this%mask(i,j-1,k+1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,-1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i,j-1,k+1),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i,j-1,k+1))) + !call getMoments(vf%polyface(3,i,j ,k+1),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i,j ,k+1))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + ! Check if we have an interface in the vicinity of the z-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i,j,k-1:k) + ! Check for local wall configuration - wall in x- + if (this%wmask(i,j,k).eq.0.and.this%mask(i-1,j,k).eq.1.and.this%mask(i-1,j,k-1).eq.1) then + ! Define wall + nw=[+1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i,j,k-1))) + !call getMoments(vf%polyface(1,i,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in x+ + if (this%wmask(i,j,k).eq.0.and.this%mask(i+1,j,k).eq.1.and.this%mask(i+1,j,k-1).eq.1) then + ! Define wall + nw=[-1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i+1,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i+1,j,k-1))) + !call getMoments(vf%polyface(1,i+1,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i+1,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y- + if (this%wmask(i,j,k).eq.0.and.this%mask(i,j-1,k).eq.1.and.this%mask(i,j-1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,+1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i,j,k-1))) + !call getMoments(vf%polyface(2,i,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y+ + if (this%wmask(i,j,k).eq.0.and.this%mask(i,j+1,k).eq.1.and.this%mask(i,j+1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,-1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i,j+1,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i,j+1,k-1))) + !call getMoments(vf%polyface(2,i,j+1,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i,j+1,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + end do + end do + end do + + ! Deallocate array + deallocate(GFM) + + end subroutine add_static_contact + + + !> Print out info for two-phase incompressible flow solver + subroutine tpns_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(tpns), intent(in) :: this + + ! Output + if (this%cfg%amRoot) then + write(output_unit,'("Two-phase incompressible solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'(" > liquid density = ",es12.5)') this%rho_l + write(output_unit,'(" > liquid viscosity = ",es12.5)') this%visc_l + write(output_unit,'(" > gas density = ",es12.5)') this%rho_g + write(output_unit,'(" > gas viscosity = ",es12.5)') this%visc_g + end if + + end subroutine tpns_print + + +end module tpns_class diff --git a/examples/falling_drop/src/ignore_tpns_class_no_rho_U_all_interp.f90 b/examples/falling_drop/src/ignore_tpns_class_no_rho_U_all_interp.f90 new file mode 100644 index 000000000..432482d0d --- /dev/null +++ b/examples/falling_drop/src/ignore_tpns_class_no_rho_U_all_interp.f90 @@ -0,0 +1,2303 @@ +!> Two-phase incompressible flow solver class: +!> Provides support for various BC, RHS calculation, +!> implicit solver, and pressure solution +!> Assumes constant viscosity and density in each phase. +!> Interface is represented using VOF +module tpns_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use ils_class, only: ils + use iterator_class, only: iterator + implicit none + private + + ! Expose type/constructor/methods + public :: tpns,bcond + + ! List of known available bcond for this solver + integer, parameter, public :: wall=1 !< Dirichlet at zero condition + integer, parameter, public :: dirichlet=2 !< Dirichlet condition + integer, parameter, public :: neumann=3 !< Zero normal gradient + integer, parameter, public :: convective=4 !< Convective outflow condition + integer, parameter, public :: clipped_neumann=5 !< Clipped Neumann condition (outflow only) + + ! List of available contact line models for this solver + integer, parameter, public :: static_contact=1 !< Static contact line model + + ! Parameter for switching schemes around the interface + real(WP), parameter :: rhoeps_coeff=1.0e-3_WP !< Parameter for deciding when to switch to upwinded transport + + !> Boundary conditions for the two-phase solver + type :: bcond + type(bcond), pointer :: next !< Linked list of bconds + character(len=str_medium) :: name='UNNAMED_BCOND' !< Bcond name (default=UNNAMED_BCOND) + integer :: type !< Bcond type + type(iterator) :: itr !< This is the iterator for the bcond - this identifies the (i,j,k) + character(len=1) :: face !< Bcond face (x/y/z) + integer :: dir !< Bcond direction (+1,-1,0 for interior) + real(WP) :: rdir !< Bcond direction (real variable) + logical :: canCorrect !< Can this bcond be corrected for global conservation? + end type bcond + + !> Two-phase incompressible solver object definition + type :: tpns + + ! This is our config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_TPNS' !< Solver name (default=UNNAMED_TPNS) + + ! Constant property fluids + real(WP) :: contact_angle !< This is our static contact angle + real(WP) :: sigma !< This is our constant surface tension coefficient + real(WP) :: rho_l,rho_g !< These are our constant densities in liquid and gas + real(WP) :: visc_l,visc_g !< These is our constant dynamic viscosities in liquid and gas + + ! Gravitational acceleration + real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity + + ! Boundary condition list + integer :: nbc !< Number of bcond for our solver + real(WP), dimension(:), allocatable :: mfr !< MFR through each bcond + real(WP), dimension(:), allocatable :: area !< Area for each bcond + real(WP) :: correctable_area !< Area of bcond that can be corrected + type(bcond), pointer :: first_bc !< List of bcond for our solver + + ! Density and momentum fields + real(WP), dimension(:,:,:), allocatable :: rho !< New density field + real(WP), dimension(:,:,:), allocatable :: rhoold !< Old density field + real(WP), dimension(:,:,:), allocatable :: rhoU !< U momentum array + real(WP), dimension(:,:,:), allocatable :: rhoV !< V momentum array + real(WP), dimension(:,:,:), allocatable :: rhoW !< W momentum array + + ! Viscosity fields + real(WP), dimension(:,:,:), allocatable :: visc !< Viscosity field on P-cell + real(WP), dimension(:,:,:), allocatable :: visc_xy !< Viscosity field on U-cell + real(WP), dimension(:,:,:), allocatable :: visc_yz !< Viscosity field on V-cell + real(WP), dimension(:,:,:), allocatable :: visc_zx !< Viscosity field on W-cell + + ! Flow variables + real(WP), dimension(:,:,:), allocatable :: U !< U velocity array + real(WP), dimension(:,:,:), allocatable :: V !< V velocity array + real(WP), dimension(:,:,:), allocatable :: W !< W velocity array + real(WP), dimension(:,:,:), allocatable :: P !< Pressure array + real(WP), dimension(:,:,:), allocatable :: Pjx !< Pressure jump to add to -dP/dx + real(WP), dimension(:,:,:), allocatable :: Pjy !< Pressure jump to add to -dP/dy + real(WP), dimension(:,:,:), allocatable :: Pjz !< Pressure jump to add to -dP/dz + real(WP), dimension(:,:,:), allocatable :: dPjx !< dPressure jump to add to -ddP/dx + real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy + real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz + + ! Old flow variables + real(WP), dimension(:,:,:), allocatable :: Uold !< Uold velocity array + real(WP), dimension(:,:,:), allocatable :: Vold !< Vold velocity array + real(WP), dimension(:,:,:), allocatable :: Wold !< Wold velocity array + + ! Flow divergence + real(WP), dimension(:,:,:), allocatable :: div !< Divergence array + + ! Pressure solver + type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + + ! Implicit velocity solver + type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + + ! Metrics + real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity + real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density + real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Second order interpolation for U + real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Second order interpolation for V + real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Second order interpolation for W + real(WP), dimension(:,:,:,:), allocatable :: divp_x,divp_y,divp_z !< Divergence for P-cell + real(WP), dimension(:,:,:,:), allocatable :: divu_x,divu_y,divu_z !< Divergence for U-cell + real(WP), dimension(:,:,:,:), allocatable :: divv_x,divv_y,divv_z !< Divergence for V-cell + real(WP), dimension(:,:,:,:), allocatable :: divw_x,divw_y,divw_z !< Divergence for W-cell + real(WP), dimension(:,:,:,:), allocatable :: grdu_x,grdu_y,grdu_z !< Velocity gradient for U + real(WP), dimension(:,:,:,:), allocatable :: grdv_x,grdv_y,grdv_z !< Velocity gradient for V + real(WP), dimension(:,:,:,:), allocatable :: grdw_x,grdw_y,grdw_z !< Velocity gradient for W + + ! Masking info for metric modification + integer, dimension(:,:,:), allocatable :: mask !< Integer array used for modifying P metrics + integer, dimension(:,:,:), allocatable :: umask !< Integer array used for modifying U metrics + integer, dimension(:,:,:), allocatable :: vmask !< Integer array used for modifying V metrics + integer, dimension(:,:,:), allocatable :: wmask !< Integer array used for modifying W metrics + + ! CFL numbers + real(WP) :: CFLst !< Surface tension CFL + real(WP) :: CFLc_x,CFLc_y,CFLc_z !< Convective CFL numbers + real(WP) :: CFLv_x,CFLv_y,CFLv_z !< Viscous CFL numbers + + ! Monitoring quantities + real(WP) :: Umax,Vmax,Wmax,Pmax,divmax !< Maximum velocity, pressure, divergence + + contains + procedure :: print=>tpns_print !< Output solver to the screen + procedure :: setup !< Finish configuring the flow solver + procedure :: add_bcond !< Add a boundary condition + procedure :: get_bcond !< Get a boundary condition + procedure :: apply_bcond !< Apply all boundary conditions + procedure :: init_metrics !< Initialize metrics + procedure :: adjust_metrics !< Adjust metrics + procedure :: get_dmomdt !< Calculate dmom/dt + procedure :: get_div !< Calculate velocity divergence + procedure :: get_pgrad !< Calculate pressure gradient + procedure :: update_laplacian !< Update the pressure Laplacian div(1/rho*grad(.)) + procedure :: get_cfl !< Calculate maximum CFL + procedure :: get_max !< Calculate maximum field values + procedure :: interp_vel !< Calculate interpolated velocity + procedure :: get_strainrate !< Calculate deviatoric part of strain rate tensor + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_mfr !< Calculate outgoing MFR through each bcond + procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation + procedure :: shift_p !< Shift pressure to have zero average + procedure :: get_viscosity !< Calculate viscosity fields from subcell phasic volume data in a vfs object + procedure :: solve_implicit !< Solve for the velocity residuals implicitly + + procedure :: addsrc_gravity !< Add gravitational body force + procedure :: add_surface_tension_jump !< Add surface tension jump + procedure :: add_static_contact !< Add static contact line model to surface tension jump + + end type tpns + + + !> Declare two-phase incompressible solver constructor + interface tpns + procedure constructor + end interface tpns + +contains + + + !> Default constructor for two-phase incompressible flow solver + function constructor(cfg,name) result(self) + implicit none + type(tpns) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Nullify bcond list + self%nbc=0 + self%first_bc=>NULL() + + ! Allocate flow variables + allocate(self%U(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%U=0.0_WP + allocate(self%V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%V=0.0_WP + allocate(self%W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%W=0.0_WP + allocate(self%P(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%P=0.0_WP + allocate(self%Pjx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjx=0.0_WP + allocate(self%Pjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjy=0.0_WP + allocate(self%Pjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Pjz=0.0_WP + allocate(self%dPjx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjx=0.0_WP + allocate(self%dPjy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjy=0.0_WP + allocate(self%dPjz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%dPjz=0.0_WP + allocate(self%visc (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc =0.0_WP + allocate(self%visc_xy(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_xy=0.0_WP + allocate(self%visc_yz(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_yz=0.0_WP + allocate(self%visc_zx(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc_zx=0.0_WP + + ! Mass conservation data around which to build momentum conservation + allocate(self%rhoU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoU =0.0_WP + allocate(self%rhoV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoV =0.0_WP + allocate(self%rhoW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoW =0.0_WP + allocate(self%rho (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rho =0.0_WP + allocate(self%rhoold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhoold=0.0_WP + + ! Allocate flow divergence + allocate(self%div(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%div=0.0_WP + + ! Allocate old flow variables + allocate(self%Uold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Uold=0.0_WP + allocate(self%Vold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Vold=0.0_WP + allocate(self%Wold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Wold=0.0_WP + + ! Create pressure solver object + self%psolv =ils(cfg=self%cfg,name='Pressure') + + ! Create implicit velocity solver object + self%implicit=ils(cfg=self%cfg,name='Momentum') + + ! Prepare default metrics + call self%init_metrics() + + ! Prepare P-cell masks + allocate(self%mask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%mask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%mask(:self%cfg%imin-1,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%mask(self%cfg%imax+1:,:,:)=2 + end if + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%mask(:,:self%cfg%jmin-1,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%mask(:,self%cfg%jmax+1:,:)=2 + end if + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%mask(:,:,:self%cfg%kmin-1)=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%mask(:,:,self%cfg%kmax+1:)=2 + end if + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) self%mask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%mask) + + ! Prepare face mask for U + allocate(self%umask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%umask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%umask(self%cfg%imin ,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%umask(self%cfg%imax+1,:,:)=2 + end if + do k=self%cfg%kmino_ ,self%cfg%kmaxo_ + do j=self%cfg%jmino_ ,self%cfg%jmaxo_ + do i=self%cfg%imino_+1,self%cfg%imaxo_ + if (minval(self%cfg%VF(i-1:i,j,k)).eq.0.0_WP) self%umask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%umask) + if (.not.self%cfg%xper.and.self%cfg%iproc.eq.1) self%umask(self%cfg%imino,:,:)=self%umask(self%cfg%imino+1,:,:) + + ! Prepare face mask for V + allocate(self%vmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%vmask=0 + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%vmask(:,self%cfg%jmin ,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%vmask(:,self%cfg%jmax+1,:)=2 + end if + do k=self%cfg%kmino_ ,self%cfg%kmaxo_ + do j=self%cfg%jmino_+1,self%cfg%jmaxo_ + do i=self%cfg%imino_ ,self%cfg%imaxo_ + if (minval(self%cfg%VF(i,j-1:j,k)).eq.0.0_WP) self%vmask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%vmask) + if (.not.self%cfg%yper.and.self%cfg%jproc.eq.1) self%vmask(:,self%cfg%jmino,:)=self%vmask(:,self%cfg%jmino+1,:) + + ! Prepare face mask for W + allocate(self%wmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%wmask=0 + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%wmask(:,:,self%cfg%kmin )=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%wmask(:,:,self%cfg%kmax+1)=2 + end if + do k=self%cfg%kmino_+1,self%cfg%kmaxo_ + do j=self%cfg%jmino_ ,self%cfg%jmaxo_ + do i=self%cfg%imino_ ,self%cfg%imaxo_ + if (minval(self%cfg%VF(i,j,k-1:k)).eq.0.0_WP) self%wmask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%wmask) + if (.not.self%cfg%zper.and.self%cfg%kproc.eq.1) self%wmask(:,:,self%cfg%kmino)=self%wmask(:,:,self%cfg%kmino+1) + + end function constructor + + + !> Metric initialization with no awareness of walls nor bcond + subroutine init_metrics(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,st1,st2 + real(WP), dimension(-1:0) :: itpx,itpy,itpz + + ! Allocate finite difference density interpolation coefficients + allocate(this%itpr_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%itpr_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%itpr_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + ! Create density interpolation coefficients to cell face + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + + ! Allocate finite difference viscosity interpolation coefficients + allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%itp_xz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + ! Create viscosity interpolation coefficients to cell edge + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Prepare local 1D metrics + itpx=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] + itpy=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] + itpz=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] + ! Combine for 2D interpolations + do st1=-1,0 + do st2=-1,0 + this%itp_xy(st1,st2,i,j,k)=itpx(st1)*itpy(st2) + this%itp_yz(st1,st2,i,j,k)=itpy(st1)*itpz(st2) + this%itp_xz(st1,st2,i,j,k)=itpx(st1)*itpz(st2) + end do + end do + end do + end do + end do + + ! Allocate finite difference velocity interpolation coefficients + allocate(this%itpu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpw_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%itpv_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itpw_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%itpu_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%itpw_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%itpu_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%itpv_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + ! Create velocity interpolation coefficients to cell center [xm,ym,zm] + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%itpu_x(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in x of U from [x ,ym,zm] + this%itpv_y(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in y of V from [xm,y ,zm] + this%itpw_z(:,i,j,k)=[+0.5_WP,+0.5_WP] !< Linear interpolation in z of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%itpv_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x of V from [xm,y ,zm] + this%itpw_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpu_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y of U from [x ,ym,zm] + this%itpw_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y of W from [xm,ym,z ] + end do + end do + end do + ! Create velocity interpolation coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpu_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z of U from [x ,ym,zm] + this%itpv_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z of V from [xm,y ,zm] + end do + end do + end do + + ! Allocate finite volume divergence operators + allocate(this%divp_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divp_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divp_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%divu_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divu_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divu_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (x) + allocate(this%divv_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divv_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divv_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (y) + allocate(this%divw_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (z) + allocate(this%divw_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Face-centered (z) + allocate(this%divw_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Face-centered (z) + ! Create divergence operator to cell center [xm,ym,zm] or tangent to cell face + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%divp_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,zm] + this%divp_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,zm] + this%divp_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,z ] + + this%divu_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] + this%divu_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] + + this%divv_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] + this%divv_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] + + this%divw_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] + this%divw_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [x ,ym,zm] + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%divu_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [xm,y ,zm] + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%divv_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + ! Create divergence operator perpendicular to cell face [xm,ym,z ] + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%divw_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,zm] + end do + end do + end do + + ! Allocate finite difference velocity gradient operators + allocate(this%grdu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdw_z( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered + allocate(this%grdv_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%grdw_x(-1: 0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%grdu_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (xy) + allocate(this%grdw_y(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Edge-centered (yz) + allocate(this%grdu_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (zx) + allocate(this%grdv_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) + ! Create gradient coefficients to cell center [xm,ym,zm] + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%grdu_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of U from [x ,ym,zm] + this%grdv_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of V from [xm,y ,zm] + this%grdw_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%grdv_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of V from [xm,y ,zm] + this%grdw_x(:,i,j,k)=this%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< FD gradient in x of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%grdu_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of U from [x ,ym,zm] + this%grdw_y(:,i,j,k)=this%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< FD gradient in y of W from [xm,ym,z ] + end do + end do + end do + ! Create gradient coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%grdu_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of U from [x ,ym,zm] + this%grdv_z(:,i,j,k)=this%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< FD gradient in z of V from [xm,y ,zm] + end do + end do + end do + + end subroutine init_metrics + + + !> Metric adjustment accounting for bconds and walls + subroutine adjust_metrics(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,st1,st2 + real(WP) :: delta,mysum + + ! Sync up u/v/wmasks + call this%cfg%sync(this%umask) + call this%cfg%sync(this%vmask) + call this%cfg%sync(this%wmask) + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%umask(this%cfg%imino,:,:)=this%umask(this%cfg%imino+1,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) + + ! I am assuming here that we do not really need to zero out wall cells + ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) + ! or outflow condition (then the density needs to be available but it should be directly calculated) + ! or used for a real no-slip wall (then density is always multiplied by zero) + ! Adjust density interpolation coefficients to cell faces in the presence of walls (only walls!) + !do k=this%cfg%kmin_,this%cfg%kmax_+1 + ! do j=this%cfg%jmin_,this%cfg%jmax_+1 + ! do i=this%cfg%imin_,this%cfg%imax_+1 + ! ! Linear interpolation in x + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i-1,j,k).gt.0.0_WP) this%itpr_x(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i-1,j,k).eq.0.0_WP) this%itpr_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in y + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j-1,k).gt.0.0_WP) this%itpr_y(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j-1,k).eq.0.0_WP) this%itpr_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in z + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j,k-1).gt.0.0_WP) this%itpr_z(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j,k-1).eq.0.0_WP) this%itpr_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! end do + ! end do + !end do + + ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) this%itpu_x(:,i,j,k)=0.0_WP + if (this%mask(i,j,k).eq.1) this%itpv_y(:,i,j,k)=0.0_WP + if (this%mask(i,j,k).eq.1) this%itpw_z(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Adjust viscosity interpolation coefficients to cell edge in the presence of walls (only walls) + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Zero out interpolation coefficients reaching in the walls + do st1=-1,0 + do st2=-1,0 + if (this%mask(i+st1,j+st2,k).eq.1) this%itp_xy(st1,st2,i,j,k)=0.0_WP + if (this%mask(i,j+st1,k+st2).eq.1) this%itp_yz(st1,st2,i,j,k)=0.0_WP + if (this%mask(i+st1,j,k+st2).eq.1) this%itp_xz(st1,st2,i,j,k)=0.0_WP + end do + end do + ! Rescale to ensure sum(itp)=1 + mysum=sum(this%itp_xy(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_xy(:,:,i,j,k)=this%itp_xy(:,:,i,j,k)/mysum + mysum=sum(this%itp_yz(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_yz(:,:,i,j,k)=this%itp_yz(:,:,i,j,k)/mysum + mysum=sum(this%itp_xz(:,:,i,j,k)); if (mysum.gt.0.0_WP) this%itp_xz(:,:,i,j,k)=this%itp_xz(:,:,i,j,k)/mysum + end do + end do + end do + + ! Loop over the domain and adjust divergence for P cell + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).gt.0) then + this%divp_x(:,i,j,k)=0.0_WP + this%divp_y(:,i,j,k)=0.0_WP + this%divp_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to U metrics + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + if (this%umask(i,j,k).gt.0) then + this%divu_x(:,i,j,k)=0.0_WP + this%divu_y(:,i,j,k)=0.0_WP + this%divu_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to V metrics + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + if (this%vmask(i,j,k).gt.0) then + this%divv_x(:,i,j,k)=0.0_WP + this%divv_y(:,i,j,k)=0.0_WP + this%divv_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Loop over the domain and apply masked conditions to W metrics + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + if (this%wmask(i,j,k).gt.0) then + this%divw_x(:,i,j,k)=0.0_WP + this%divw_y(:,i,j,k)=0.0_WP + this%divw_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! FD gradient in x of V from [xm,y ,zm] + if (maxval(this%vmask(i-1:i,j,k)).gt.0) then + delta=0.0_WP + if (this%vmask(i ,j,k).eq.0) delta=delta+(this%cfg%xm(i)-this%cfg%x (i )) + if (this%vmask(i-1,j,k).eq.0) delta=delta+(this%cfg%x (i)-this%cfg%xm(i-1)) + if (delta.gt.0.0_WP) then + this%grdv_x(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdv_x(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in x of W from [xm,ym,z ] + if (maxval(this%wmask(i-1:i,j,k)).gt.0) then + delta=0.0_WP + if (this%wmask(i ,j,k).eq.0) delta=delta+(this%cfg%xm(i)-this%cfg%x (i )) + if (this%wmask(i-1,j,k).eq.0) delta=delta+(this%cfg%x (i)-this%cfg%xm(i-1)) + if (delta.gt.0.0_WP) then + this%grdw_x(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdw_x(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! FD gradient in y of U from [x ,ym,zm] + if (maxval(this%umask(i,j-1:j,k)).gt.0) then + delta=0.0_WP + if (this%umask(i,j ,k).eq.0) delta=delta+(this%cfg%ym(j)-this%cfg%y (j )) + if (this%umask(i,j-1,k).eq.0) delta=delta+(this%cfg%y (j)-this%cfg%ym(j-1)) + if (delta.gt.0.0_WP) then + this%grdu_y(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdu_y(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in y of W from [xm,ym,z ] + if (maxval(this%wmask(i,j-1:j,k)).gt.0) then + delta=0.0_WP + if (this%wmask(i,j ,k).eq.0) delta=delta+(this%cfg%ym(j)-this%cfg%y (j )) + if (this%wmask(i,j-1,k).eq.0) delta=delta+(this%cfg%y (j)-this%cfg%ym(j-1)) + if (delta.gt.0.0_WP) then + this%grdw_y(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdw_y(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust gradient coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! FD gradient in z of U from [x ,ym,zm] + if (maxval(this%umask(i,j,k-1:k)).gt.0) then + delta=0.0_WP + if (this%umask(i,j,k ).eq.0) delta=delta+(this%cfg%zm(k)-this%cfg%z (k )) + if (this%umask(i,j,k-1).eq.0) delta=delta+(this%cfg%z (k)-this%cfg%zm(k-1)) + if (delta.gt.0.0_WP) then + this%grdu_z(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdu_z(:,i,j,k)=0.0_WP + end if + end if + ! FD gradient in z of V from [xm,y ,zm] + if (maxval(this%vmask(i,j,k-1:k)).gt.0) then + delta=0.0_WP + if (this%vmask(i,j,k ).eq.0) delta=delta+(this%cfg%zm(k)-this%cfg%z (k )) + if (this%vmask(i,j,k-1).eq.0) delta=delta+(this%cfg%z (k)-this%cfg%zm(k-1)) + if (delta.gt.0.0_WP) then + this%grdv_z(:,i,j,k)=[-1.0_WP,+1.0_WP]/delta + else + this%grdv_z(:,i,j,k)=0.0_WP + end if + end if + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! Linear interpolation in x of V from [xm,y ,zm] + if (this%vmask(i,j,k).eq.0.and.this%vmask(i-1,j,k).gt.0) this%itpv_x(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%vmask(i,j,k).gt.0.and.this%vmask(i-1,j,k).eq.0) this%itpv_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in x of W from [xm,ym,z ] + if (this%wmask(i,j,k).eq.0.and.this%wmask(i-1,j,k).gt.0) this%itpw_x(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%wmask(i,j,k).gt.0.and.this%wmask(i-1,j,k).eq.0) this%itpw_x(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! Linear interpolation in y of U from [x ,ym,zm] + if (this%umask(i,j,k).eq.0.and.this%umask(i,j-1,k).gt.0) this%itpu_y(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%umask(i,j,k).gt.0.and.this%umask(i,j-1,k).eq.0) this%itpu_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in y of W from [xm,ym,z ] + if (this%wmask(i,j,k).eq.0.and.this%wmask(i,j-1,k).gt.0) this%itpw_y(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%wmask(i,j,k).gt.0.and.this%wmask(i,j-1,k).eq.0) this%itpw_y(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust interpolation coefficients to cell edge in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + ! Linear interpolation in z of U from [x ,ym,zm] + if (this%umask(i,j,k).eq.0.and.this%umask(i,j,k-1).gt.0) this%itpu_z(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%umask(i,j,k).gt.0.and.this%umask(i,j,k-1).eq.0) this%itpu_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! Linear interpolation in z of V from [xm,y ,zm] + if (this%vmask(i,j,k).eq.0.and.this%vmask(i,j,k-1).gt.0) this%itpv_z(:,i,j,k)=[1.0_WP,0.0_WP] + if (this%vmask(i,j,k).gt.0.and.this%vmask(i,j,k-1).eq.0) this%itpv_z(:,i,j,k)=[0.0_WP,1.0_WP] + end do + end do + end do + + ! Adjust metrics to account for lower dimensionality + if (this%cfg%nx.eq.1) then + this%divp_x=0.0_WP + this%divu_x=0.0_WP + this%divv_x=0.0_WP + this%divw_x=0.0_WP + this%grdu_x=0.0_WP + this%grdv_x=0.0_WP + this%grdw_x=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%divp_y=0.0_WP + this%divu_y=0.0_WP + this%divv_y=0.0_WP + this%divw_y=0.0_WP + this%grdu_y=0.0_WP + this%grdv_y=0.0_WP + this%grdw_y=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%divp_z=0.0_WP + this%divu_z=0.0_WP + this%divv_z=0.0_WP + this%divw_z=0.0_WP + this%grdu_z=0.0_WP + this%grdv_z=0.0_WP + this%grdw_z=0.0_WP + end if + + end subroutine adjust_metrics + + + !> Finish setting up the flow solver now that bconds have been defined + subroutine setup(this,pressure_ils,implicit_ils) + implicit none + class(tpns), intent(inout) :: this + integer, intent(in) :: pressure_ils + integer, intent(in) :: implicit_ils + + ! Adjust metrics based on bcflag array + call this%adjust_metrics() + + ! Set 7-pt stencil map for the pressure solver + this%psolv%stc(1,:)=[ 0, 0, 0] + this%psolv%stc(2,:)=[+1, 0, 0] + this%psolv%stc(3,:)=[-1, 0, 0] + this%psolv%stc(4,:)=[ 0,+1, 0] + this%psolv%stc(5,:)=[ 0,-1, 0] + this%psolv%stc(6,:)=[ 0, 0,+1] + this%psolv%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to VF to make sure all needed cells participate in solver + this%psolv%opr(1,:,:,:)=this%cfg%VF + + ! Initialize the pressure Poisson solver + call this%psolv%init(pressure_ils) + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init(implicit_ils) + + end subroutine setup + + + !> Add a boundary condition + subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) + use string, only: lowercase + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: type + external :: locator + interface + logical function locator(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator + end interface + character(len=1), intent(in) :: face + integer, intent(in) :: dir + logical, intent(in) :: canCorrect + type(bcond), pointer :: new_bc + integer :: i,j,k,n + + ! Prepare new bcond + allocate(new_bc) + new_bc%name=trim(adjustl(name)) + new_bc%type=type + select case (lowercase(face)) + case ('x'); new_bc%face='x' + case ('y'); new_bc%face='y' + case ('z'); new_bc%face='z' + case default; call die('[tpns add_bcond] Unknown bcond face - expecting x, y, or z') + end select + new_bc%itr=iterator(pg=this%cfg,name=new_bc%name,locator=locator,face=new_bc%face) + select case (dir) ! Outward-oriented + case (+1); new_bc%dir=+1 + case (-1); new_bc%dir=-1 + case ( 0); new_bc%dir= 0 + case default; call die('[tpns add_bcond] Unknown bcond dir - expecting -1, +1, or 0') + end select + new_bc%rdir=real(new_bc%dir,WP) + new_bc%canCorrect=canCorrect + + ! Insert it up front + new_bc%next=>this%first_bc + this%first_bc=>new_bc + + ! Increment bcond counter + this%nbc=this%nbc+1 + + ! Now adjust the metrics accordingly + select case (new_bc%type) + case (dirichlet) !< Dirichlet is set one face (i.e., velocit component) at the time + select case (new_bc%face) + case ('x') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%umask(i,j,k)=2 + end do + case ('y') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%vmask(i,j,k)=2 + end do + case ('z') + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%wmask(i,j,k)=2 + end do + end select + + case (neumann) !< Neumann has to be at existing wall or at domain boundary! + case (clipped_neumann) + case (convective) + case default + call die('[tpns apply_bcond] Unknown bcond type') + end select + + end subroutine add_bcond + + + !> Get a boundary condition + subroutine get_bcond(this,name,my_bc) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + character(len=*), intent(in) :: name + type(bcond), pointer, intent(out) :: my_bc + my_bc=>this%first_bc + search: do while (associated(my_bc)) + if (trim(my_bc%name).eq.trim(name)) exit search + my_bc=>my_bc%next + end do search + if (.not.associated(my_bc)) call die('[tpns get_bcond] Boundary condition was not found') + end subroutine get_bcond + + + !> Enforce boundary condition + subroutine apply_bcond(this,t,dt) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: t,dt + integer :: i,j,k,n,stag + type(bcond), pointer :: my_bc + + ! ! First enfore zero velocity at walls + ! do k=this%cfg%kmin_,this%cfg%kmax_ + ! do j=this%cfg%jmin_,this%cfg%jmax_ + ! do i=this%cfg%imin_,this%cfg%imax_ + ! if (minval(this%cfg%VF(i-1:i,j,k)).lt.10.0_WP*epsilon(1.0_WP)) this%U(i,j,k)=0.0_WP + ! if (minval(this%cfg%VF(i,j-1:j,k)).lt.10.0_WP*epsilon(1.0_WP)) this%V(i,j,k)=0.0_WP + ! if (minval(this%cfg%VF(i,j,k-1:k)).lt.10.0_WP*epsilon(1.0_WP)) this%W(i,j,k)=0.0_WP + ! end do + ! end do + ! end do + ! ! Sync fields + ! call this%cfg%sync(this%U) + ! call this%cfg%sync(this%V) + ! call this%cfg%sync(this%W) + + ! Traverse bcond list + my_bc=>this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + select case (my_bc%type) + + case (dirichlet) !< Apply Dirichlet conditions + + ! This is done by the user directly + ! Unclear whether we want to do this within the solver... + + case (neumann,clipped_neumann) !< Apply Neumann condition to all 3 components + ! Handle index shift due to staggering + stag=min(my_bc%dir,0) + ! Implement based on bcond direction + select case (my_bc%face) + case ('x') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i ,j ,k )=this%U(i-my_bc%dir ,j ,k ) + this%V(i+stag,j:j+1,k )=this%V(i-my_bc%dir+stag,j:j+1,k ) + this%W(i+stag,j ,k:k+1)=this%W(i-my_bc%dir+stag,j ,k:k+1) + end do + case ('y') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i:i+1,j+stag,k )=this%U(i:i+1,j-my_bc%dir+stag,k ) + this%V(i ,j ,k )=this%V(i ,j-my_bc%dir ,k ) + this%W(i ,j+stag,k:k+1)=this%W(i ,j-my_bc%dir+stag,k:k+1) + end do + case ('z') + stag=min(my_bc%dir,0) + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i:i+1,j ,k+stag)=this%U(i:i+1,j ,k-my_bc%dir+stag) + this%V(i ,j:j+1,k+stag)=this%V(i ,j:j+1,k-my_bc%dir+stag) + this%W(i ,j ,k )=this%W(i ,j ,k-my_bc%dir ) + end do + end select + ! If needed, clip + if (my_bc%type.eq.clipped_neumann) then + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%U(i,j,k)*my_bc%rdir.lt.0.0_WP) this%U(i,j,k)=0.0_WP + end do + case ('y') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%V(i,j,k)*my_bc%rdir.lt.0.0_WP) this%V(i,j,k)=0.0_WP + end do + case ('z') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + if (this%W(i,j,k)*my_bc%rdir.lt.0.0_WP) this%W(i,j,k)=0.0_WP + end do + end select + end if + + case (convective) ! Not implemented yet! + + case default + call die('[tpns apply_bcond] Unknown bcond type') + end select + + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%U) + call this%cfg%sync(this%V) + call this%cfg%sync(this%W) + + ! Move on to the next bcond + my_bc=>my_bc%next + + end do + + end subroutine apply_bcond + + + !> Calculate the explicit momentum time derivative + !> This assumes that rho, rhoold, rhoU/V/W have been updated already + subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoUdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoVdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoWdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ii,jj,kk + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Flux of rhoU + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii-1; j=jj-1; k=kk-1 + FX(i,j,k)=-sum(this%itpu_x(:,i,j,k)*this%rhoU(i:i+1,j,k))*sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) & + & +this%visc (i,j,k)*(sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))+sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k))) & + & -this%P(i,j,k) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-sum(this%itpv_x(:,i,j,k)*this%rhoV(i-1:i,j,k))*sum(this%itpu_y(:,i,j,k)*this%U(i,j-1:j,k)) & + & +this%visc_xy(i,j,k)*(sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))+sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=-sum(this%itpw_x(:,i,j,k)*this%rhoW(i-1:i,j,k))*sum(this%itpu_z(:,i,j,k)*this%U(i,j,k-1:k)) & + & +this%visc_zx(i,j,k)*(sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))+sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))) + end do + end do + end do + ! Time derivative of rhoU + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoUdt(i,j,k)=sum(this%divu_x(:,i,j,k)*FX(i-1:i,j,k))+& + & sum(this%divu_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divu_z(:,i,j,k)*FZ(i,j,k:k+1))+this%Pjx(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoUdt) + + ! Flux of rhoV + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=-sum(this%itpu_y(:,i,j,k)*this%rhoU(i,j-1:j,k))*sum(this%itpv_x(:,i,j,k)*this%V(i-1:i,j,k)) & + & +this%visc_xy(i,j,k)*(sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k))+sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k))) + ! Fluxes on y-face + i=ii-1; j=jj-1; k=kk-1 + FY(i,j,k)=-sum(this%itpv_y(:,i,j,k)*this%rhoV(i,j:j+1,k))*sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) & + & +this%visc (i,j,k)*(sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))+sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k))) & + & -this%P(i,j,k) + ! Fluxes on z-face + i=ii; j=jj; k=kk + FZ(i,j,k)=-sum(this%itpw_y(:,i,j,k)*this%rhoW(i,j-1:j,k))*sum(this%itpv_z(:,i,j,k)*this%V(i,j,k-1:k)) & + & +this%visc_yz(i,j,k)*(sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))+sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))) + end do + end do + end do + ! Time derivative of rhoV + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoVdt(i,j,k)=sum(this%divv_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divv_y(:,i,j,k)*FY(i,j-1:j,k))+& + & sum(this%divv_z(:,i,j,k)*FZ(i,j,k:k+1))+this%Pjy(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoVdt) + + ! Flux of rhoW + do kk=this%cfg%kmin_,this%cfg%kmax_+1 + do jj=this%cfg%jmin_,this%cfg%jmax_+1 + do ii=this%cfg%imin_,this%cfg%imax_+1 + ! Fluxes on x-face + i=ii; j=jj; k=kk + FX(i,j,k)=-sum(this%itpu_z(:,i,j,k)*this%rhoW(i,j,k-1:k))*sum(this%itpw_x(:,i,j,k)*this%W(i-1:i,j,k)) & + & +this%visc_zx(i,j,k)*(sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k))+sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k))) + ! Fluxes on y-face + i=ii; j=jj; k=kk + FY(i,j,k)=-sum(this%itpv_z(:,i,j,k)*this%rhoW(i,j,k-1:k))*sum(this%itpw_y(:,i,j,k)*this%W(i,j-1:j,k)) & + & +this%visc_yz(i,j,k)*(sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k))+sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k))) + ! Fluxes on z-face + i=ii-1; j=jj-1; k=kk-1 + FZ(i,j,k)=-sum(this%itpw_z(:,i,j,k)*this%rhoW(i,j,k:k+1))*sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) & + & +this%visc (i,j,k)*(sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))+sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1))) & + & -this%P(i,j,k) + end do + end do + end do + ! Time derivative of rhoW + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + drhoWdt(i,j,k)=sum(this%divw_x(:,i,j,k)*FX(i:i+1,j,k))+& + & sum(this%divw_y(:,i,j,k)*FY(i,j:j+1,k))+& + & sum(this%divw_z(:,i,j,k)*FZ(i,j,k-1:k))+this%Pjz(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(drhoWdt) + + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + + end subroutine get_dmomdt + + + !> Update pressure Poisson operator + subroutine update_laplacian(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,s1,s2 + ! Setup the scaled Laplacian operator from metrics: lap(*)=-vol.div(grad(*)/rho) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Zero out Laplacian + this%psolv%opr(:,i,j,k)=0.0_WP + ! Tranverse the stencil and recompute Laplacian + do s1=0,1 + do s2=-1,0 + this%psolv%opr(this%psolv%stmap(s1+s2,0,0),i,j,k)=this%psolv%opr(this%psolv%stmap(s1+s2,0,0),i,j,k)+this%divp_x(s1,i,j,k)*this%divu_x(s2,i+s1,j,k)/sum(this%itpr_x(:,i+s1,j,k)*this%rho(i+s1-1:i+s1,j,k)) + this%psolv%opr(this%psolv%stmap(0,s1+s2,0),i,j,k)=this%psolv%opr(this%psolv%stmap(0,s1+s2,0),i,j,k)+this%divp_y(s1,i,j,k)*this%divv_y(s2,i,j+s1,k)/sum(this%itpr_y(:,i,j+s1,k)*this%rho(i,j+s1-1:j+s1,k)) + this%psolv%opr(this%psolv%stmap(0,0,s1+s2),i,j,k)=this%psolv%opr(this%psolv%stmap(0,0,s1+s2),i,j,k)+this%divp_z(s1,i,j,k)*this%divw_z(s2,i,j,k+s1)/sum(this%itpr_z(:,i,j,k+s1)*this%rho(i,j,k+s1-1:k+s1)) + end do + end do + ! Scale Laplacian by cell volume + this%psolv%opr(:,i,j,k)=-this%psolv%opr(:,i,j,k)*this%cfg%vol(i,j,k) + end do + end do + end do + ! Initialize the pressure Poisson solver + call this%psolv%setup() + end subroutine update_laplacian + + + !> Calculate the velocity divergence based on U/V/W + subroutine get_div(this) + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%div(i,j,k)=sum(this%divp_x(:,i,j,k)*this%U(i:i+1,j,k))+& + & sum(this%divp_y(:,i,j,k)*this%V(i,j:j+1,k))+& + & sum(this%divp_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + ! Sync it + call this%cfg%sync(this%div) + end subroutine get_div + + + !> Add surface tension jump term using CSF + subroutine add_surface_tension_jump(this,dt,div,vf,contact_model) + use messager, only: die + use vfs_class, only: vfs + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: div !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + class(vfs), intent(inout) :: vf + integer, intent(in), optional :: contact_model + integer :: i,j,k,s1 + real(WP) :: mycurv,mysurf + + ! Store old jump + this%DPjx=this%Pjx + this%DPjy=this%Pjy + this%DPjz=this%Pjz + + ! Calculate pressure jump + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + ! X face + mysurf=sum(vf%SD(i-1:i,j,k)*this%cfg%vol(i-1:i,j,k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i-1:i,j,k)*vf%curv(i-1:i,j,k)*this%cfg%vol(i-1:i,j,k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjx(i,j,k)=this%sigma*mycurv*sum(this%divu_x(:,i,j,k)*vf%VF(i-1:i,j,k)) + ! Y face + mysurf=sum(vf%SD(i,j-1:j,k)*this%cfg%vol(i,j-1:j,k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i,j-1:j,k)*vf%curv(i,j-1:j,k)*this%cfg%vol(i,j-1:j,k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjy(i,j,k)=this%sigma*mycurv*sum(this%divv_y(:,i,j,k)*vf%VF(i,j-1:j,k)) + ! Z face + mysurf=sum(vf%SD(i,j,k-1:k)*this%cfg%vol(i,j,k-1:k)) + if (mysurf.gt.0.0_WP) then + mycurv=sum(vf%SD(i,j,k-1:k)*vf%curv(i,j,k-1:k)*this%cfg%vol(i,j,k-1:k))/mysurf + else + mycurv=0.0_WP + end if + this%Pjz(i,j,k)=this%sigma*mycurv*sum(this%divw_z(:,i,j,k)*vf%VF(i,j,k-1:k)) + end do + end do + end do + + ! Add wall contact force to pressure jump + if (present(contact_model)) then + select case (contact_model) + case (static_contact) + call this%add_static_contact(vf=vf) + case default + call die('[tpns: add_surface_tension_jump] Unknown contact model!') + end select + end if + + ! Compute jump of DP + this%DPjx=this%Pjx-this%DPjx + this%DPjy=this%Pjy-this%DPjy + this%DPjz=this%Pjz-this%DPjz + + ! Add div(Pjump) to RP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + do s1=0,1 + div(i,j,k)=div(i,j,k)+dt*this%divp_x(s1,i,j,k)*this%DPjx(i+s1,j,k)/sum(this%itpr_x(:,i+s1,j,k)*this%rho(i+s1-1:i+s1,j,k)) + div(i,j,k)=div(i,j,k)+dt*this%divp_y(s1,i,j,k)*this%DPjy(i,j+s1,k)/sum(this%itpr_y(:,i,j+s1,k)*this%rho(i,j+s1-1:j+s1,k)) + div(i,j,k)=div(i,j,k)+dt*this%divp_z(s1,i,j,k)*this%DPjz(i,j,k+s1)/sum(this%itpr_z(:,i,j,k+s1)*this%rho(i,j,k+s1-1:k+s1)) + end do + end do + end do + end do + + end subroutine add_surface_tension_jump + + + !> Calculate the pressure gradient based on P + subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: P !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgradx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgrady !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Pgradz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + Pgradx(i,j,k)=sum(this%divu_x(:,i,j,k)*P(i-1:i,j,k))-this%dPjx(i,j,k) + Pgrady(i,j,k)=sum(this%divv_y(:,i,j,k)*P(i,j-1:j,k))-this%dPjy(i,j,k) + Pgradz(i,j,k)=sum(this%divw_z(:,i,j,k)*P(i,j,k-1:k))-this%dPjz(i,j,k) + end do + end do + end do + ! Sync it + call this%cfg%sync(Pgradx) + call this%cfg%sync(Pgrady) + call this%cfg%sync(Pgradz) + end subroutine get_pgrad + + + !> Calculate the interpolated velocity, including overlap and ghosts + subroutine interp_vel(this,Ui,Vi,Wi) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + ! Calculate as far as possible each component + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_-1 + Ui(i,j,k)=sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + Vi(i,j,k)=sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + Wi(i,j,k)=sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + ! Add last layer in each direction + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) Ui(this%cfg%imaxo,:,:)=this%U(this%cfg%imaxo,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) Vi(:,this%cfg%jmaxo,:)=this%V(:,this%cfg%jmaxo,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) Wi(:,:,this%cfg%kmaxo)=this%W(:,:,this%cfg%kmaxo) + ! Sync it + call this%cfg%sync(Ui) + call this%cfg%sync(Vi) + call this%cfg%sync(Wi) + end subroutine interp_vel + + + !> Calculate the deviatoric part of the strain rate tensor from U/V/W + !> 1: du/dx-div/3 + !> 2: dv/dy-div/3 + !> 3: dw/dz-div/3 + !> 4: (du/dy+dv/dx)/2 + !> 5: (dv/dz+dw/dy)/2 + !> 6: (dw/dx+du/dz)/2 + subroutine get_strainrate(this,SR) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + real(WP) :: div + integer :: i,j,k + + ! Check SR's first dimension + if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + SR(2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + SR(3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + div=sum(SR(1:3,i,j,k))/3.0_WP + SR(1,i,j,k)=SR(1,i,j,k)-div + SR(2,i,j,k)=SR(2,i,j,k)-div + SR(3,i,j,k)=SR(3,i,j,k)-div + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) + SR(5,i,j,k)=0.125_WP*(sum(dvdz(i ,j:j+1,k:k+1))+sum(dwdy(i ,j:j+1,k:k+1))) + SR(6,i,j,k)=0.125_WP*(sum(dwdx(i:i+1,j ,k:k+1))+sum(dudz(i:i+1,j ,k:k+1))) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(SR) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_strainrate + + + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cflc,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cflc + real(WP), optional :: cfl + integer :: i,j,k,ierr + real(WP) :: my_CFLc_x,my_CFLc_y,my_CFLc_z,my_CFLv_x,my_CFLv_y,my_CFLv_z,my_CFLst + real(WP) :: max_nu + + ! Get surface tension CFL first + my_CFLst=huge(1.0_WP) + if (this%sigma.gt.0.0_WP) then + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_CFLst=min(my_CFLst,sqrt((this%rho_l+this%rho_g)*this%cfg%meshsize(i,j,k)**3.0_WP/(4.0_WP*Pi*this%sigma))) + end do + end do + end do + end if + call MPI_ALLREDUCE(my_CFLst,this%CFLst,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + this%CFLst=dt/this%CFLst + + ! Get largest kinematic viscosity + max_nu=max(this%visc_l/this%rho_l,this%visc_g/this%rho_g) + + ! Set the CFLs to zero + my_CFLc_x=0.0_WP; my_CFLc_y=0.0_WP; my_CFLc_z=0.0_WP + my_CFLv_x=0.0_WP; my_CFLv_y=0.0_WP; my_CFLv_z=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_CFLc_x=max(my_CFLc_x,abs(this%U(i,j,k))*this%cfg%dxmi(i)) + my_CFLc_y=max(my_CFLc_y,abs(this%V(i,j,k))*this%cfg%dymi(j)) + my_CFLc_z=max(my_CFLc_z,abs(this%W(i,j,k))*this%cfg%dzmi(k)) + my_CFLv_x=max(my_CFLv_x,4.0_WP*max_nu*this%cfg%dxi(i)**2) + my_CFLv_y=max(my_CFLv_y,4.0_WP*max_nu*this%cfg%dyi(j)**2) + my_CFLv_z=max(my_CFLv_z,4.0_WP*max_nu*this%cfg%dzi(k)**2) + end do + end do + end do + my_CFLc_x=my_CFLc_x*dt; my_CFLc_y=my_CFLc_y*dt; my_CFLc_z=my_CFLc_z*dt + my_CFLv_x=my_CFLv_x*dt; my_CFLv_y=my_CFLv_y*dt; my_CFLv_z=my_CFLv_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLc_x,this%CFLc_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLc_y,this%CFLc_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLc_z,this%CFLc_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_x,this%CFLv_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_y,this%CFLv_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLv_z,this%CFLv_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum convective + surface tension CFL + cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLst) + + ! If asked for, also return the maximum overall CFL + if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) + + end subroutine get_cfl + + + !> Calculate the max of our fields + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,ierr + real(WP) :: my_Umax,my_Vmax,my_Wmax,my_Pmax,my_divmax + + ! Set all to zero + my_Umax=0.0_WP; my_Vmax=0.0_WP; my_Wmax=0.0_WP; my_Pmax=0.0_WP; my_divmax=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_Umax=max(my_Umax,abs(this%U(i,j,k))) + my_Vmax=max(my_Vmax,abs(this%V(i,j,k))) + my_Wmax=max(my_Wmax,abs(this%W(i,j,k))) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_Pmax =max(my_Pmax ,abs(this%P(i,j,k) )) + if (this%cfg%VF(i,j,k).gt.0.0_WP) my_divmax=max(my_divmax,abs(this%div(i,j,k))) + end do + end do + end do + + ! Get the parallel max + call MPI_ALLREDUCE(my_Umax ,this%Umax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Vmax ,this%Vmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Wmax ,this%Wmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_Pmax ,this%Pmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_divmax,this%divmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + end subroutine get_max + + + !> Compute MFR through all bcs + subroutine get_mfr(this) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(inout) :: this + integer :: i,j,k,n,ibc,ierr + type(bcond), pointer :: my_bc + real(WP), dimension(:), allocatable :: my_mfr,my_area + real(WP), dimension(:), allocatable :: canCorrect + + ! Ensure this%mfr is of proper size + if (.not.allocated(this%mfr)) then + allocate(this%mfr(this%nbc)) + else + if (size(this%mfr).ne.this%nbc) then + deallocate(this%mfr); allocate(this%mfr(this%nbc)) + end if + end if + + ! Ensure this%area is of proper size + if (.not.allocated(this%area)) then + allocate(this%area(this%nbc)) + else + if (size(this%area).ne.this%nbc) then + deallocate(this%area); allocate(this%area(this%nbc)) + end if + end if + + ! Allocate temp array for communication + allocate(my_mfr(this%nbc)) + allocate(my_area(this%nbc)) + allocate(canCorrect(this%nbc)) + + ! Traverse bcond list and integrate local outgoing MFR + my_bc=>this%first_bc; ibc=1 + do while (associated(my_bc)) + + ! Set zero local MFR and area + my_mfr(ibc)=0.0_WP + my_area(ibc)=0.0_WP + if (my_bc%canCorrect) then + canCorrect(ibc)=1.0_WP + else + canCorrect(ibc)=0.0_WP + end if + + ! Only processes inside the bcond have a non-zero MFR + if (my_bc%itr%amIn) then + + ! Implement based on bcond face and dir, loop over interior only + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%U(i,j,k)*this%cfg%dy(j)*this%cfg%dz(k) + my_area(ibc)=my_area(ibc)+this%cfg%dy(j)*this%cfg%dz(k) + end do + case ('y') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%V(i,j,k)*this%cfg%dz(k)*this%cfg%dx(i) + my_area(ibc)=my_area(ibc)+this%cfg%dz(k)*this%cfg%dx(i) + end do + case ('z') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + my_mfr(ibc)=my_mfr(ibc)+my_bc%rdir*this%W(i,j,k)*this%cfg%dx(i)*this%cfg%dy(j) + my_area(ibc)=my_area(ibc)+this%cfg%dx(i)*this%cfg%dy(j) + end do + end select + + end if + + ! Move on to the next bcond + my_bc=>my_bc%next; ibc=ibc+1 + + end do + + ! Sum up all values + call MPI_ALLREDUCE(my_mfr ,this%mfr ,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_area,this%area,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + + ! Compute the correctable area + this%correctable_area=sum(this%area*canCorrect) + + ! Deallocate temp array + deallocate(my_mfr,my_area,canCorrect) + + end subroutine get_mfr + + + !> Correct MFR through correctable bconds + subroutine correct_mfr(this) + use mpi_f08, only: MPI_SUM + implicit none + class(tpns), intent(inout) :: this + real(WP) :: mfr_error,vel_correction + integer :: i,j,k,n + type(bcond), pointer :: my_bc + + ! Evaluate MFR mismatch and velocity correction + call this%get_mfr() + mfr_error=sum(this%mfr) + if (abs(mfr_error).lt.10.0_WP*epsilon(1.0_WP).or.abs(this%correctable_area).lt.10.0_WP*epsilon(1.0_WP)) return + vel_correction=-mfr_error/(this%correctable_area) + + ! Traverse bcond list and correct bcond MFR + my_bc=>this%first_bc + do while (associated(my_bc)) + + ! Only processes inside correctable bcond need to work + if (my_bc%itr%amIn.and.my_bc%canCorrect) then + + ! Implement based on bcond direction, loop over all cell + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i,j,k)=this%U(i,j,k)+my_bc%rdir*vel_correction + end do + case ('y') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%V(i,j,k)=this%V(i,j,k)+my_bc%rdir*vel_correction + end do + case ('z') + do n=1,my_bc%itr%no_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%W(i,j,k)=this%W(i,j,k)+my_bc%rdir*vel_correction + end do + end select + + end if + + ! Move on to the next bcond + my_bc=>my_bc%next + + end do + + end subroutine correct_mfr + + + !> Shift pressure to ensure zero average + subroutine shift_p(this,pressure) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + implicit none + class(tpns), intent(in) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot + integer :: i,j,k,ierr + + ! Loop over domain and integrate volume and pressure + my_vol_tot=0.0_WP + my_pressure_tot=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) + my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + pressure_tot=pressure_tot/vol_tot + + ! Shift the pressure + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%cfg%VF(i,j,k).gt.0.0_WP) pressure(i,j,k)=pressure(i,j,k)-pressure_tot + end do + end do + end do + call this%cfg%sync(pressure) + + end subroutine shift_p + + + !> Solve for implicit velocity residual + subroutine solve_implicit(this,dt,resU,resV,resW) + use ils_class, only: amg + implicit none + class(tpns), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP) :: rhoUp,rhoUm,rhoVp,rhoVm,rhoWp,rhoWm + + ! Solve implicit U problem + this%implicit%opr(1,:,:,:)=sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)); this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_x(:,i ,j,k)*this%rhoU(i :i+1,j,k)) + rhoUm=sum(this%itpu_x(:,i-1,j,k)*this%rhoU(i-1:i ,j,k)) + rhoVp=sum(this%itpv_x(:,i,j+1,k)*this%rhoV(i-1:i,j+1,k)) + rhoVm=sum(this%itpv_x(:,i,j ,k)*this%rhoV(i-1:i,j ,k)) + rhoWp=sum(this%itpw_x(:,i,j,k+1)*this%rhoW(i-1:i,j,k+1)) + rhoWm=sum(this%itpw_x(:,i,j,k )*this%rhoW(i-1:i,j,k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divu_x( 0,i,j,k)*this%itpu_x( 0,i ,j,k)*rhoUp+& + & this%divu_x(-1,i,j,k)*this%itpu_x(+1,i-1,j,k)*rhoUm+& + & this%divu_y(+1,i,j,k)*this%itpu_y(-1,i,j+1,k)*rhoVp+& + & this%divu_y( 0,i,j,k)*this%itpu_y( 0,i,j ,k)*rhoVm+& + & this%divu_z(+1,i,j,k)*this%itpu_z(-1,i,j,k+1)*rhoWp+& + & this%divu_z( 0,i,j,k)*this%itpu_z( 0,i,j,k )*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divu_x( 0,i,j,k)*this%itpu_x(+1,i ,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divu_x(-1,i,j,k)*this%itpu_x( 0,i-1,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divu_y(+1,i,j,k)*this%itpu_y( 0,i,j+1,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divu_y( 0,i,j,k)*this%itpu_y(-1,i,j ,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divu_z(+1,i,j,k)*this%itpu_z( 0,i,j,k+1)*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divu_z( 0,i,j,k)*this%itpu_z(-1,i,j,k )*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divu_x( 0,i,j,k)*2.0_WP*this%visc (i ,j,k)*this%grdu_x( 0,i ,j,k)+& + & this%divu_x(-1,i,j,k)*2.0_WP*this%visc (i-1,j,k)*this%grdu_x(+1,i-1,j,k)+& + & this%divu_y(+1,i,j,k)* this%visc_xy(i,j+1,k)*this%grdu_y(-1,i,j+1,k)+& + & this%divu_y( 0,i,j,k)* this%visc_xy(i,j ,k)*this%grdu_y( 0,i,j ,k)+& + & this%divu_z(+1,i,j,k)* this%visc_zx(i,j,k+1)*this%grdu_z(-1,i,j,k+1)+& + & this%divu_z( 0,i,j,k)* this%visc_zx(i,j,k )*this%grdu_z( 0,i,j,k )) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divu_x( 0,i,j,k)*2.0_WP*this%visc (i ,j,k)*this%grdu_x(+1,i ,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divu_x(-1,i,j,k)*2.0_WP*this%visc (i-1,j,k)*this%grdu_x( 0,i-1,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divu_y(+1,i,j,k)* this%visc_xy(i,j+1,k)*this%grdu_y( 0,i,j+1,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divu_y( 0,i,j,k)* this%visc_xy(i,j ,k)*this%grdu_y(-1,i,j ,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divu_z(+1,i,j,k)* this%visc_zx(i,j,k+1)*this%grdu_z( 0,i,j,k+1)) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divu_z( 0,i,j,k)* this%visc_zx(i,j,k )*this%grdu_z(-1,i,j,k )) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resU + this%implicit%sol=0.0_WP + call this%implicit%solve() + resU=this%implicit%sol + + ! Solve implicit V problem + this%implicit%opr(1,:,:,:)=sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)); this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_y(:,i+1,j,k)*this%rhoU(i+1,j-1:j,k)) + rhoUm=sum(this%itpu_y(:,i ,j,k)*this%rhoU(i ,j-1:j,k)) + rhoVp=sum(this%itpv_y(:,i,j ,k)*this%rhoV(i,j :j+1,k)) + rhoVm=sum(this%itpv_y(:,i,j-1,k)*this%rhoV(i,j-1:j ,k)) + rhoWp=sum(this%itpw_y(:,i,j,k+1)*this%rhoW(i,j-1:j,k+1)) + rhoWm=sum(this%itpw_y(:,i,j,k )*this%rhoW(i,j-1:j,k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divv_x(+1,i,j,k)*this%itpv_x(-1,i+1,j,k)*rhoUp+& + & this%divv_x( 0,i,j,k)*this%itpv_x( 0,i ,j,k)*rhoUm+& + & this%divv_y( 0,i,j,k)*this%itpv_y( 0,i,j ,k)*rhoVp+& + & this%divv_y(-1,i,j,k)*this%itpv_y(+1,i,j-1,k)*rhoVm+& + & this%divv_z(+1,i,j,k)*this%itpv_z(-1,i,j,k+1)*rhoWp+& + & this%divv_z( 0,i,j,k)*this%itpv_z( 0,i,j,k )*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divv_x(+1,i,j,k)*this%itpv_x( 0,i+1,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divv_x( 0,i,j,k)*this%itpv_x(-1,i ,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divv_y( 0,i,j,k)*this%itpv_y(+1,i,j ,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divv_y(-1,i,j,k)*this%itpv_y( 0,i,j-1,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divv_z(+1,i,j,k)*this%itpv_z( 0,i,j,k+1)*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divv_z( 0,i,j,k)*this%itpv_z(-1,i,j,k )*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divv_x(+1,i,j,k)* this%visc_xy(i+1,j,k)*this%grdv_x(-1,i+1,j,k)+& + & this%divv_x( 0,i,j,k)* this%visc_xy(i ,j,k)*this%grdv_x( 0,i ,j,k)+& + & this%divv_y( 0,i,j,k)*2.0_WP*this%visc (i,j ,k)*this%grdv_y( 0,i,j ,k)+& + & this%divv_y(-1,i,j,k)*2.0_WP*this%visc (i,j-1,k)*this%grdv_y(+1,i,j-1,k)+& + & this%divv_z(+1,i,j,k)* this%visc_yz(i,j,k+1)*this%grdv_z(-1,i,j,k+1)+& + & this%divv_z( 0,i,j,k)* this%visc_yz(i,j,k )*this%grdv_z( 0,i,j,k )) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divv_x(+1,i,j,k)* this%visc_xy(i+1,j,k)*this%grdv_x( 0,i+1,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divv_x( 0,i,j,k)* this%visc_xy(i ,j,k)*this%grdv_x(-1,i ,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divv_y( 0,i,j,k)*2.0_WP*this%visc (i,j ,k)*this%grdv_y(+1,i,j ,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divv_y(-1,i,j,k)*2.0_WP*this%visc (i,j-1,k)*this%grdv_y( 0,i,j-1,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divv_z(+1,i,j,k)* this%visc_yz(i,j,k+1)*this%grdv_z( 0,i,j,k+1)) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divv_z( 0,i,j,k)* this%visc_yz(i,j,k )*this%grdv_z(-1,i,j,k )) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resV + this%implicit%sol=0.0_WP + call this%implicit%solve() + resV=this%implicit%sol + + ! Solve implicit W problem + this%implicit%opr(1,:,:,:)=sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)); this%implicit%opr(2:,:,:,:)=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + rhoUp=sum(this%itpu_z(:,i+1,j,k)*this%rhoU(i+1,j,k-1:k)) + rhoUm=sum(this%itpu_z(:,i ,j,k)*this%rhoU(i ,j,k-1:k)) + rhoVp=sum(this%itpv_z(:,i,j+1,k)*this%rhoV(i,j+1,k-1:k)) + rhoVm=sum(this%itpv_z(:,i,j ,k)*this%rhoV(i,j ,k-1:k)) + rhoWp=sum(this%itpw_z(:,i,j,k )*this%rhoW(i,j,k :k+1)) + rhoWm=sum(this%itpw_z(:,i,j,k-1)*this%rhoW(i,j,k-1:k )) + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)+0.5_WP*dt*(this%divw_x(+1,i,j,k)*this%itpw_x(-1,i+1,j,k)*rhoUp+& + & this%divw_x( 0,i,j,k)*this%itpw_x( 0,i ,j,k)*rhoUm+& + & this%divw_y(+1,i,j,k)*this%itpw_y(-1,i,j+1,k)*rhoVp+& + & this%divw_y( 0,i,j,k)*this%itpw_y( 0,i,j ,k)*rhoVm+& + & this%divw_z( 0,i,j,k)*this%itpw_z( 0,i,j,k )*rhoWp+& + & this%divw_z(-1,i,j,k)*this%itpw_z(+1,i,j,k-1)*rhoWm) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)+0.5_WP*dt*(this%divw_x(+1,i,j,k)*this%itpw_x( 0,i+1,j,k)*rhoUp) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)+0.5_WP*dt*(this%divw_x( 0,i,j,k)*this%itpw_x(-1,i ,j,k)*rhoUm) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)+0.5_WP*dt*(this%divw_y(+1,i,j,k)*this%itpw_y( 0,i,j+1,k)*rhoVp) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)+0.5_WP*dt*(this%divw_y( 0,i,j,k)*this%itpw_y(-1,i,j ,k)*rhoVm) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)+0.5_WP*dt*(this%divw_z( 0,i,j,k)*this%itpw_z(+1,i,j,k )*rhoWp) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)+0.5_WP*dt*(this%divw_z(-1,i,j,k)*this%itpw_z( 0,i,j,k-1)*rhoWm) + end do + end do + end do + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%implicit%opr(1,i,j,k)=this%implicit%opr(1,i,j,k)-0.5_WP*dt*(this%divw_x(+1,i,j,k)* this%visc_zx(i+1,j,k)*this%grdw_x(-1,i+1,j,k)+& + & this%divw_x( 0,i,j,k)* this%visc_zx(i ,j,k)*this%grdw_x( 0,i ,j,k)+& + & this%divw_y(+1,i,j,k)* this%visc_yz(i,j+1,k)*this%grdw_y(-1,i,j+1,k)+& + & this%divw_y( 0,i,j,k)* this%visc_yz(i,j ,k)*this%grdw_y( 0,i,j ,k)+& + & this%divw_z( 0,i,j,k)*2.0_WP*this%visc (i,j,k )*this%grdw_z( 0,i,j,k )+& + & this%divw_z(-1,i,j,k)*2.0_WP*this%visc (i,j,k-1)*this%grdw_z(+1,i,j,k-1)) + this%implicit%opr(2,i,j,k)=this%implicit%opr(2,i,j,k)-0.5_WP*dt*(this%divw_x(+1,i,j,k)* this%visc_zx(i+1,j,k)*this%grdw_x( 0,i+1,j,k)) + this%implicit%opr(3,i,j,k)=this%implicit%opr(3,i,j,k)-0.5_WP*dt*(this%divw_x( 0,i,j,k)* this%visc_zx(i ,j,k)*this%grdw_x(-1,i ,j,k)) + this%implicit%opr(4,i,j,k)=this%implicit%opr(4,i,j,k)-0.5_WP*dt*(this%divw_y(+1,i,j,k)* this%visc_yz(i,j+1,k)*this%grdw_y( 0,i,j+1,k)) + this%implicit%opr(5,i,j,k)=this%implicit%opr(5,i,j,k)-0.5_WP*dt*(this%divw_y( 0,i,j,k)* this%visc_yz(i,j ,k)*this%grdw_y(-1,i,j ,k)) + this%implicit%opr(6,i,j,k)=this%implicit%opr(6,i,j,k)-0.5_WP*dt*(this%divw_z( 0,i,j,k)*2.0_WP*this%visc (i,j,k )*this%grdw_z(+1,i,j,k )) + this%implicit%opr(7,i,j,k)=this%implicit%opr(7,i,j,k)-0.5_WP*dt*(this%divw_z(-1,i,j,k)*2.0_WP*this%visc (i,j,k-1)*this%grdw_z( 0,i,j,k-1)) + end do + end do + end do + call this%implicit%setup() + this%implicit%rhs=resW + this%implicit%sol=0.0_WP + call this%implicit%solve() + resW=this%implicit%sol + + ! Sync up all residuals + call this%cfg%sync(resU) + call this%cfg%sync(resV) + call this%cfg%sync(resW) + + end subroutine solve_implicit + + + !> Prepare viscosity arrays from vfs object + subroutine get_viscosity(this,vf) + use vfs_class, only: vfs + implicit none + class(tpns), intent(inout) :: this + class(vfs), intent(in) :: vf + integer :: i,j,k + real(WP) :: liq_vol,gas_vol,tot_vol + ! Compute harmonically-averaged staggered viscosities using subcell phasic volumes + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + ! VISC at [xm,ym,zm] - direct sum in x/y/z + liq_vol=sum(vf%Lvol(:,:,:,i,j,k)) + gas_vol=sum(vf%Gvol(:,:,:,i,j,k)) + tot_vol=gas_vol+liq_vol + this%visc(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_xy at [x,y,zm] - direct sum in z, staggered sum in x/y + liq_vol=sum(vf%Lvol(0,0,:,i,j,k))+sum(vf%Lvol(1,0,:,i-1,j,k))+sum(vf%Lvol(0,1,:,i,j-1,k))+sum(vf%Lvol(1,1,:,i-1,j-1,k)) + gas_vol=sum(vf%Gvol(0,0,:,i,j,k))+sum(vf%Gvol(1,0,:,i-1,j,k))+sum(vf%Gvol(0,1,:,i,j-1,k))+sum(vf%Gvol(1,1,:,i-1,j-1,k)) + tot_vol=gas_vol+liq_vol + this%visc_xy(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_xy(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_yz at [xm,y,z] - direct sum in x, staggered sum in y/z + liq_vol=sum(vf%Lvol(:,0,0,i,j,k))+sum(vf%Lvol(:,1,0,i,j-1,k))+sum(vf%Lvol(:,0,1,i,j,k-1))+sum(vf%Lvol(:,1,1,i,j-1,k-1)) + gas_vol=sum(vf%Gvol(:,0,0,i,j,k))+sum(vf%Gvol(:,1,0,i,j-1,k))+sum(vf%Gvol(:,0,1,i,j,k-1))+sum(vf%Gvol(:,1,1,i,j-1,k-1)) + tot_vol=gas_vol+liq_vol + this%visc_yz(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_yz(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + ! VISC_zx at [x,ym,z] - direct sum in y, staggered sum in z/x + liq_vol=sum(vf%Lvol(0,:,0,i,j,k))+sum(vf%Lvol(0,:,1,i,j,k-1))+sum(vf%Lvol(1,:,0,i-1,j,k))+sum(vf%Lvol(1,:,1,i-1,j,k-1)) + gas_vol=sum(vf%Gvol(0,:,0,i,j,k))+sum(vf%Gvol(0,:,1,i,j,k-1))+sum(vf%Gvol(1,:,0,i-1,j,k))+sum(vf%Gvol(1,:,1,i-1,j,k-1)) + tot_vol=gas_vol+liq_vol + this%visc_zx(i,j,k)=0.0_WP + if (tot_vol.gt.0.0_WP) this%visc_zx(i,j,k)=this%visc_g*this%visc_l/(this%visc_l*gas_vol/tot_vol+this%visc_g*liq_vol/tot_vol+epsilon(1.0_WP)) + end do + end do + end do + ! Synchronize boundaries - not really needed... + call this%cfg%sync(this%visc) + call this%cfg%sync(this%visc_xy) + call this%cfg%sync(this%visc_yz) + call this%cfg%sync(this%visc_zx) + end subroutine get_viscosity + + + !> Add gravity source term - assumes that rho has been updated before + subroutine addsrc_gravity(this,resU,resV,resW) + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (this%umask(i,j,k).eq.0) resU(i,j,k)=resU(i,j,k)+sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k))*this%gravity(1) + if (this%vmask(i,j,k).eq.0) resV(i,j,k)=resV(i,j,k)+sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k))*this%gravity(2) + if (this%wmask(i,j,k).eq.0) resW(i,j,k)=resW(i,j,k)+sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k))*this%gravity(3) + end do + end do + end do + end subroutine addsrc_gravity + + + !> Add a static contact line model + subroutine add_static_contact(this,vf) + use mathtools, only: normalize + use vfs_class, only: vfs + use irl_fortran_interface + implicit none + class(tpns), intent(inout) :: this + class(vfs), intent(in) :: vf + integer :: i,j,k + real(WP), dimension(3) :: nw + real(WP), dimension(2) :: fvof + real(WP), dimension(:,:,:), allocatable :: GFM + real(WP) :: dd,mysurf,mycos + real(WP) :: cos_contact_angle + real(WP) :: sin_contact_angle + real(WP) :: tan_contact_angle + real(WP), parameter :: cfactor=1.0_WP + + ! Allocate and zero out binarized VF for GFM-style jump distribution + allocate(GFM(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); GFM=0.0_WP + + ! Prepare a GFM-based strategy + GFM=real(nint(vf%VF),WP) + + ! Precalculate cos/sin/tan(contact angle) + cos_contact_angle=cos(this%contact_angle) + sin_contact_angle=sin(this%contact_angle) + tan_contact_angle=tan(this%contact_angle) + + ! Loop over domain and identify cells that require contact angle model + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + + ! Check if we have an interface in the vicinity of the x-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i-1:i,j,k) + ! Check for local wall configuration - wall in y- + if (this%umask(i,j,k).eq.0.and.this%mask(i,j-1,k).eq.1.and.this%mask(i-1,j-1,k).eq.1) then + ! Define wall + nw=[0.0_WP,+1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions from PLIC + !call getMoments(vf%polyface(2,i-1,j,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i-1,j,k))) + !call getMoments(vf%polyface(2,i ,j,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i ,j,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y+ + if (this%umask(i,j,k).eq.0.and.this%mask(i,j+1,k).eq.1.and.this%mask(i-1,j+1,k).eq.1) then + ! Define wall + nw=[0.0_WP,-1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i-1,j+1,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i-1,j+1,k))) + !call getMoments(vf%polyface(2,i ,j+1,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i ,j+1,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z- + if (this%umask(i,j,k).eq.0.and.this%mask(i,j,k-1).eq.1.and.this%mask(i-1,j,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,+1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i-1,j,k),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i-1,j,k))) + !call getMoments(vf%polyface(3,i ,j,k),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i ,j,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z+ + if (this%umask(i,j,k).eq.0.and.this%mask(i,j,k+1).eq.1.and.this%mask(i-1,j,k+1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,-1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i-1,j,k+1),vf%liquid_gas_interface(i-1,j,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i-1,j,k+1))) + !call getMoments(vf%polyface(3,i ,j,k+1),vf%liquid_gas_interface(i ,j,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i ,j,k+1))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i-1,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i-1,j,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i ,j,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i ,j,k)),nw))/mysurf + ! Add source term + this%Pjx(i,j,k)=this%Pjx(i,j,k)+this%sigma*sum(this%divu_x(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + ! Check if we have an interface in the vicinity of the y-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i,j-1:j,k) + ! Check for local wall configuration - wall in x- + if (this%vmask(i,j,k).eq.0.and.this%mask(i-1,j,k).eq.1.and.this%mask(i-1,j-1,k).eq.1) then + ! Define wall + nw=[+1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i,j-1,k))) + !call getMoments(vf%polyface(1,i,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in x+ + if (this%vmask(i,j,k).eq.0.and.this%mask(i+1,j,k).eq.1.and.this%mask(i+1,j-1,k).eq.1) then + ! Define wall + nw=[-1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i+1,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i+1,j-1,k))) + !call getMoments(vf%polyface(1,i+1,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i+1,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z- + if (this%vmask(i,j,k).eq.0.and.this%mask(i,j,k-1).eq.1.and.this%mask(i,j-1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,+1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i,j-1,k),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i,j-1,k))) + !call getMoments(vf%polyface(3,i,j ,k),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i,j ,k))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in z+ + if (this%vmask(i,j,k).eq.0.and.this%mask(i,j,k+1).eq.1.and.this%mask(i,j-1,k+1).eq.1) then + ! Define wall + nw=[0.0_WP,0.0_WP,-1.0_WP]; dd=cfactor*this%cfg%dz(k) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(3,i,j-1,k+1),vf%liquid_gas_interface(i,j-1,k),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(3,i,j-1,k+1))) + !call getMoments(vf%polyface(3,i,j ,k+1),vf%liquid_gas_interface(i,j ,k),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(3,i,j ,k+1))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j-1,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j-1,k)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j ,k)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j ,k)),nw))/mysurf + ! Add source term + this%Pjy(i,j,k)=this%Pjy(i,j,k)+this%sigma*sum(this%divv_y(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + ! Check if we have an interface in the vicinity of the z-face + mysurf=abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))+abs(calculateVolume(vf%interface_polygon(1,i,j,k))) + if (mysurf.gt.0.0_WP) then + ! Compute the liquid area fractions from GFM + fvof=GFM(i,j,k-1:k) + ! Check for local wall configuration - wall in x- + if (this%wmask(i,j,k).eq.0.and.this%mask(i-1,j,k).eq.1.and.this%mask(i-1,j,k-1).eq.1) then + ! Define wall + nw=[+1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i,j,k-1))) + !call getMoments(vf%polyface(1,i,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in x+ + if (this%wmask(i,j,k).eq.0.and.this%mask(i+1,j,k).eq.1.and.this%mask(i+1,j,k-1).eq.1) then + ! Define wall + nw=[-1.0_WP,0.0_WP,0.0_WP]; dd=cfactor*this%cfg%dx(i) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(1,i+1,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(1,i+1,j,k-1))) + !call getMoments(vf%polyface(1,i+1,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(1,i+1,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y- + if (this%wmask(i,j,k).eq.0.and.this%mask(i,j-1,k).eq.1.and.this%mask(i,j-1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,+1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i,j,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i,j,k-1))) + !call getMoments(vf%polyface(2,i,j,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i,j,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + ! Check for local wall configuration - wall in y+ + if (this%wmask(i,j,k).eq.0.and.this%mask(i,j+1,k).eq.1.and.this%mask(i,j+1,k-1).eq.1) then + ! Define wall + nw=[0.0_WP,-1.0_WP,0.0_WP]; dd=cfactor*this%cfg%dy(j) + ! Compute the liquid area fractions + !call getMoments(vf%polyface(2,i,j+1,k-1),vf%liquid_gas_interface(i,j,k-1),fvof(1)); fvof(1)=abs(fvof(1))/abs(calculateVolume(vf%polyface(2,i,j+1,k-1))) + !call getMoments(vf%polyface(2,i,j+1,k ),vf%liquid_gas_interface(i,j,k ),fvof(2)); fvof(2)=abs(fvof(2))/abs(calculateVolume(vf%polyface(2,i,j+1,k ))) + ! Surface-averaged local cos(CA) + mycos=(abs(calculateVolume(vf%interface_polygon(1,i,j,k-1)))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k-1)),nw)+& + & abs(calculateVolume(vf%interface_polygon(1,i,j,k )))*dot_product(calculateNormal(vf%interface_polygon(1,i,j,k )),nw))/mysurf + ! Add source term + this%Pjz(i,j,k)=this%Pjz(i,j,k)+this%sigma*sum(this%divw_z(:,i,j,k)*fvof(:))*(mycos-cos_contact_angle)/dd + end if + end if + + end do + end do + end do + + ! Deallocate array + deallocate(GFM) + + end subroutine add_static_contact + + + !> Print out info for two-phase incompressible flow solver + subroutine tpns_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(tpns), intent(in) :: this + + ! Output + if (this%cfg%amRoot) then + write(output_unit,'("Two-phase incompressible solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'(" > liquid density = ",es12.5)') this%rho_l + write(output_unit,'(" > liquid viscosity = ",es12.5)') this%visc_l + write(output_unit,'(" > gas density = ",es12.5)') this%rho_g + write(output_unit,'(" > gas viscosity = ",es12.5)') this%visc_g + end if + + end subroutine tpns_print + + +end module tpns_class diff --git a/examples/falling_drop/src/ignore_vfs_class.f90 b/examples/falling_drop/src/ignore_vfs_class.f90 new file mode 100644 index 000000000..34d8721ca --- /dev/null +++ b/examples/falling_drop/src/ignore_vfs_class.f90 @@ -0,0 +1,3598 @@ +!> Volume fraction solver class: +!> Provides support for various BC, semi-Lagrangian geometric advancement, +!> curvature calculation, interface reconstruction. +module vfs_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use iterator_class, only: iterator + use irl_fortran_interface + implicit none + private + + ! Expose type/constructor/methods + public :: vfs,bcond + + ! Also expose the min and max VF values + public :: VFhi,VFlo + + ! List of known available bcond for this solver + integer, parameter, public :: dirichlet=2 !< Dirichlet condition + integer, parameter, public :: neumann=3 !< Zero normal gradient + + ! List of available interface reconstructions schemes for VF + integer, parameter, public :: lvira=1 !< LVIRA scheme + integer, parameter, public :: elvira=2 !< ELVIRA scheme + !integer, parameter, public :: mof=3 !< MOF scheme + integer, parameter, public :: r2p=4 !< R2P scheme + integer, parameter, public :: swartz=5 !< Swartz scheme + integer, parameter, public :: art=6 !< ART scheme + integer, parameter, public :: youngs=7 !< Youngs' scheme + integer, parameter, public :: lvlset=8 !< Levelset-based scheme + + ! IRL cutting moment calculation method + integer, parameter, public :: recursive_simplex=0 !< Recursive simplex cutting + integer, parameter, public :: half_edge=1 !< Half-edge cutting + integer, parameter, public :: nonrecurs_simplex=2 !< Non-recursive simplex cutting + + ! Default parameters for volume fraction solver + integer, parameter :: nband=3 !< Number of cells around the interfacial cells on which localized work is performed + integer, parameter :: advect_band=2 !< How far we do the transport + integer, parameter :: distance_band=2 !< How far we build the distance + integer, parameter :: max_interface_planes=2 !< Maximum number of interfaces allowed (2 for R2P) + real(WP), parameter :: VFlo=1.0e-12_WP !< Minimum VF value considered + real(WP), parameter :: VFhi=1.0_WP-VFlo !< Maximum VF value considered + real(WP), parameter :: volume_epsilon_factor =1.0e-15_WP !< Minimum volume to consider for computational geometry (normalized by min_meshsize**3) + real(WP), parameter :: surface_epsilon_factor=1.0e-15_WP !< Minimum surface to consider for computational geometry (normalized by min_meshsize**2) + real(WP), parameter :: iterative_distfind_tol=1.0e-12_WP !< Tolerance for iterative plane distance finding + + !> Boundary conditions for the volume fraction solver + type :: bcond + type(bcond), pointer :: next !< Linked list of bconds + character(len=str_medium) :: name='UNNAMED_BCOND' !< Bcond name (default=UNNAMED_BCOND) + integer :: type !< Bcond type + integer :: dir !< Bcond direction (1 to 6) + type(iterator) :: itr !< This is the iterator for the bcond + end type bcond + + !> Bcond shift value + integer, dimension(3,6), parameter :: shift=reshape([+1,0,0,-1,0,0,0,+1,0,0,-1,0,0,0,+1,0,0,-1],shape(shift)) + + !> Volume fraction solver object definition + type :: vfs + + ! This is our config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_VFS' !< Solver name (default=UNNAMED_VFS) + + ! Boundary condition list + integer :: nbc !< Number of bcond for our solver + type(bcond), pointer :: first_bc !< List of bcond for our solver + + ! Volume fraction data + real(WP), dimension(:,:,:), allocatable :: VF !< VF array + real(WP), dimension(:,:,:), allocatable :: VFold !< VFold array + + ! Superficial fluxing velocities + real(WP), dimension(:,:,:,:), allocatable :: UFl !< Superficial liquid fluxing velocity + real(WP), dimension(:,:,:,:), allocatable :: UFg !< Superficial gas fluxing velocity + + ! Phase barycenter data + real(WP), dimension(:,:,:,:), allocatable :: Lbary !< Liquid barycenter + real(WP), dimension(:,:,:,:), allocatable :: Gbary !< Gas barycenter + + ! Subcell phasic volume fields + real(WP), dimension(:,:,:,:,:,:), allocatable :: Lvol !< Subcell liquid volume + real(WP), dimension(:,:,:,:,:,:), allocatable :: Gvol !< Subcell gas volume + + ! Surface density data + real(WP), dimension(:,:,:), allocatable :: SD !< Surface density array + + ! Distance level set + real(WP) :: Gclip !< Min/max distance + real(WP), dimension(:,:,:), allocatable :: G !< Distance level set array + + ! Curvature + real(WP), dimension(:,:,:), allocatable :: curv !< Interface mean curvature + + ! Band strategy + integer, dimension(:,:,:), allocatable :: band !< Band to localize workload around the interface + integer, dimension(:,:), allocatable :: band_map !< Unstructured band mapping + integer, dimension(0:nband) :: band_count !< Number of cells per band value + + ! Interface reconstruction method + integer :: reconstruction_method !< Interface reconstruction method + real(WP) :: twoplane_threshold=0.95_WP !< Threshold for r2p to switch from one-plane to two-planes + real(WP) :: art_threshold=1.30_WP !< Threshold for art to switch from r2p to lvira + + ! Curvature clipping parameter + real(WP) :: maxcurv_times_mesh=1.0_WP !< Clipping parameter for maximum curvature (classically set to 1, but should be larger since we resolve more) + + ! Flotsam removal parameter - turned off by default + real(WP) :: VFflot=0.0_WP !< Threshold VF parameter for flotsam removal (0.0=off) + real(WP) :: VFsheet=0.0_WP !< Threshold VF parameter for sheet removal (0.0=off) + + ! IRL objects + type(ByteBuffer_type) :: send_byte_buffer + type(ByteBuffer_type) :: recv_byte_buffer + type(ObjServer_PlanarSep_type) :: planar_separator_allocation + type(ObjServer_PlanarLoc_type) :: planar_localizer_allocation + type(ObjServer_LocSepLink_type) :: localized_separator_link_allocation + type(ObjServer_LocLink_type) :: localizer_link_allocation + type(PlanarLoc_type), dimension(:,:,:), allocatable :: localizer + type(PlanarSep_type), dimension(:,:,:), allocatable :: liquid_gas_interface + type(LocSepLink_type), dimension(:,:,:), allocatable :: localized_separator_link + type(ListVM_VMAN_type), dimension(:,:,:), allocatable :: triangle_moments_storage + type(LocLink_type), dimension(:,:,:), allocatable :: localizer_link + type(Poly_type), dimension(:,:,:,:), allocatable :: interface_polygon + type(Poly_type), dimension(:,:,:,:), allocatable :: polyface + type(SepVM_type), dimension(:,:,:,:), allocatable :: face_flux + + ! Masking info for metric modification + integer, dimension(:,:,:), allocatable :: mask !< Integer array used for enforcing bconds + integer, dimension(:,:,:), allocatable :: vmask !< Integer array used for enforcing bconds - for vertices + + ! Monitoring quantities + real(WP) :: VFmax,VFmin,VFint,SDint !< Maximum, minimum, and integral volume fraction and surface density + + ! Old arrays that are needed for the compressible MAST solver + real(WP), dimension(:,:,:,:), allocatable :: Lbaryold !< Liquid barycenter + real(WP), dimension(:,:,:,:), allocatable :: Gbaryold !< Gas barycenter + type(PlanarSep_type), dimension(:,:,:), allocatable :: liquid_gas_interfaceold + type(LocSepLink_type), dimension(:,:,:), allocatable :: localized_separator_linkold + type(ObjServer_PlanarSep_type) :: planar_separatorold_allocation + type(ObjServer_LocSepLink_type) :: localized_separator_linkold_allocation + + contains + procedure :: print=>vfs_print !< Output solver to the screen + procedure :: initialize_irl !< Initialize the IRL objects + procedure :: add_bcond !< Add a boundary condition + procedure :: get_bcond !< Get a boundary condition + procedure :: apply_bcond !< Apply all boundary conditions + procedure :: update_band !< Update the band info given the VF values + procedure :: sync_interface !< Synchronize the IRL objects + procedure :: remove_flotsams !< Remove flotsams manually - not conservative, should be avoided! + procedure :: remove_sheets !< Remove R2P sheets manually - not conservative, should be avoided! + procedure :: clean_irl_and_band !< After a manual change in VF (maybe due to transfer to drops), update IRL and band info + procedure :: sync_and_clean_barycenters !< Synchronize and clean up phasic barycenters + procedure, private :: sync_side !< Synchronize the IRL objects across one side - another I/O helper + procedure, private :: sync_ByteBuffer !< Communicate byte packets across one side - another I/O helper + procedure, private :: calculate_offset_to_planes !< Helper routine for I/O + procedure, private :: crude_phase_test !< Helper function that rapidly assess if a mixed cell might be present + procedure :: project !< Function that performs a Lagrangian projection of a vertex + procedure :: read_interface !< Read an IRL interface from a file + procedure :: write_interface !< Write an IRL interface to a file + procedure :: advance !< Advance VF to next step + procedure :: advect_interface !< Advance IRL surface to next step + procedure :: build_interface !< Reconstruct IRL interface from VF field + procedure :: build_elvira !< ELVIRA reconstruction of the interface from VF field + procedure :: build_lvira !< LVIRA reconstruction of the interface from VF field + procedure :: build_r2p !< R2P reconstruction of the interface from VF field + procedure :: build_art !< ART reconstruction of the interface from VF field + procedure :: build_youngs !< Youngs' reconstruction of the interface from VF field + !procedure :: build_lvlset !< LVLSET-based reconstruction of the interface from VF field + procedure :: smooth_interface !< Interface smoothing based on Swartz idea + procedure :: set_full_bcond !< Full liq/gas plane-setting for boundary cells - this is stair-stepped + procedure :: polygonalize_interface !< Build a discontinuous polygonal representation of the IRL interface + procedure :: distance_from_polygon !< Build a signed distance field from the polygonalized interface + procedure :: subcell_vol !< Build subcell phasic volumes from reconstructed interface + procedure :: reset_volume_moments !< Reconstruct volume moments from IRL interfaces + procedure :: reset_moments !< Reconstruct first-order moments from IRL interfaces + procedure :: update_surfmesh !< Update a surfmesh object using current polygons + procedure :: get_curvature !< Compute curvature from IRL surface polygons + procedure :: paraboloid_fit !< Perform local paraboloid fit of IRL surface using IRL barycenter data + procedure :: paraboloid_integral_fit !< Perform local paraboloid fit of IRL surface using surface-integrated IRL data + procedure :: get_max !< Calculate maximum field values + procedure :: get_cfl !< Get CFL for the VF solver + + procedure :: allocate_supplement !< Allocate arrays and initialize objects needed for compressible MAST solver + procedure :: copy_interface_to_old !< Copy interface variables at beginning of timestep + procedure :: fluxpoly_project_getmoments !< Project face to get flux volume and output its moments + procedure :: fluxpoly_cell_getvolcentr !< Get the volume and centroid during generalized SL advection + + end type vfs + + + !> Declare volume fraction solver constructor + interface vfs + procedure constructor + end interface vfs + +contains + + + !> Default constructor for volume fraction solver + function constructor(cfg,reconstruction_method,name) result(self) + use messager, only: die + implicit none + type(vfs) :: self + class(config), target, intent(in) :: cfg + integer, intent(in) :: reconstruction_method + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Check that we have at least 3 overlap cells - we can push that to 2 with limited work! + if (cfg%no.lt.3) call die('[vfs constructor] The config requires at least 3 overlap cells') + + ! Point to pgrid object + self%cfg=>cfg + + ! Nullify bcond list + self%nbc=0 + self%first_bc=>NULL() + + ! Allocate variables + allocate(self%VF ( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%VFold( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VFold=0.0_WP + allocate(self%Lbary(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Lbary=0.0_WP + allocate(self%Gbary(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Gbary=0.0_WP + allocate(self%SD ( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%SD =0.0_WP + allocate(self%G ( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G =0.0_WP + allocate(self%curv ( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%curv =0.0_WP + + ! Superificial fluxing velocities for liquid and gas + allocate(self%UFl(1:3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%UFl=0.0_WP + allocate(self%UFg(1:3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%UFg=0.0_WP + + ! Set clipping distance + self%Gclip=real(distance_band+1,WP)*self%cfg%min_meshsize + + ! Subcell phasic volumes + allocate(self%Lvol(0:1,0:1,0:1,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Lvol=0.0_WP + allocate(self%Gvol(0:1,0:1,0:1,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Gvol=0.0_WP + + ! Prepare the band arrays + allocate(self%band(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%band=0 + if (allocated(self%band_map)) deallocate(self%band_map) + + ! Set reconstruction method + self%reconstruction_method=reconstruction_method + + ! Initialize IRL + call self%initialize_irl() + + ! Prepare mask for VF + allocate(self%mask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%mask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%mask(:self%cfg%imin-1,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%mask(self%cfg%imax+1:,:,:)=2 + end if + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%mask(:,:self%cfg%jmin-1,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%mask(:,self%cfg%jmax+1:,:)=2 + end if + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%mask(:,:,:self%cfg%kmin-1)=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%mask(:,:,self%cfg%kmax+1:)=2 + end if + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) self%mask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%mask) + + ! Prepare mask for vertices + allocate(self%vmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%vmask=0 + if (.not.self%cfg%xper) then + if (self%cfg%iproc.eq. 1) self%vmask( :self%cfg%imin,:,:)=2 + if (self%cfg%iproc.eq.self%cfg%npx) self%vmask(self%cfg%imax+1: ,:,:)=2 + end if + if (.not.self%cfg%yper) then + if (self%cfg%jproc.eq. 1) self%vmask(:, :self%cfg%jmin,:)=2 + if (self%cfg%jproc.eq.self%cfg%npy) self%vmask(:,self%cfg%jmax+1: ,:)=2 + end if + if (.not.self%cfg%zper) then + if (self%cfg%kproc.eq. 1) self%vmask(:,:, :self%cfg%kmin)=2 + if (self%cfg%kproc.eq.self%cfg%npz) self%vmask(:,:,self%cfg%kmax+1: )=2 + end if + do k=self%cfg%kmino_+1,self%cfg%kmaxo_ + do j=self%cfg%jmino_+1,self%cfg%jmaxo_ + do i=self%cfg%imino_+1,self%cfg%imaxo_ + if (minval(self%cfg%VF(i-1:i,j-1:j,k-1:k)).eq.0.0_WP) self%vmask(i,j,k)=1 + end do + end do + end do + call self%cfg%sync(self%vmask) + if (.not.self%cfg%xper.and.self%cfg%iproc.eq.1) self%vmask(self%cfg%imino,:,:)=self%vmask(self%cfg%imino+1,:,:) + if (.not.self%cfg%yper.and.self%cfg%jproc.eq.1) self%vmask(:,self%cfg%jmino,:)=self%vmask(:,self%cfg%jmino+1,:) + if (.not.self%cfg%zper.and.self%cfg%kproc.eq.1) self%vmask(:,:,self%cfg%kmino)=self%vmask(:,:,self%cfg%kmino+1) + + end function constructor + + + !> Initialize the IRL representation of our interfaces + subroutine initialize_irl(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,n,tag + real(WP), dimension(3,4) :: vert + integer(IRL_LargeOffsetIndex_t) :: total_cells + + ! Transfer small constants to IRL + call setVFBounds(VFlo) + call setVFTolerance_IterativeDistanceFinding(iterative_distfind_tol) + call setMinimumVolToTrack(volume_epsilon_factor*this%cfg%min_meshsize**3) + call setMinimumSAToTrack(surface_epsilon_factor*this%cfg%min_meshsize**2) + + ! Set IRL's moment calculation method + call getMoments_setMethod(half_edge) + + ! Allocate IRL arrays + allocate(this%localizer (this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%liquid_gas_interface (this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%localized_separator_link(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%triangle_moments_storage(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%localizer_link (this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%interface_polygon(1:max_interface_planes,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%polyface (1:3,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Work arrays for face fluxes + allocate(this%face_flux(1:3,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + do n=1,3 + call new(this%face_flux(n,i,j,k)) + end do + end do + end do + end do + + ! Precomputed face correction velocities + !> allocate(face_correct_velocity(1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)) + + ! Initialize size for IRL + total_cells=int(this%cfg%nxo_,8)*int(this%cfg%nyo_,8)*int(this%cfg%nzo_,8) + call new(this%planar_localizer_allocation,total_cells) + call new(this%planar_separator_allocation,total_cells) + call new(this%localized_separator_link_allocation,total_cells) + call new(this%localizer_link_allocation,total_cells) + + ! Initialize arrays and setup linking + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Transfer cell to IRL + call new(this%localizer(i,j,k),this%planar_localizer_allocation) + call setFromRectangularCuboid(this%localizer(i,j,k),[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + ! PLIC interface(s) + call new(this%liquid_gas_interface(i,j,k),this%planar_separator_allocation) + ! PLIC+mesh with connectivity (i.e., link) + call new(this%localized_separator_link(i,j,k),this%localized_separator_link_allocation,this%localizer(i,j,k),this%liquid_gas_interface(i,j,k)) + ! For transport surface + call new(this%triangle_moments_storage(i,j,k)) + ! Mesh with connectivity + call new(this%localizer_link(i,j,k),this%localizer_link_allocation,this%localizer(i,j,k)) + end do + end do + end do + + ! Polygonal representation of the surface + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + do n=1,max_interface_planes + call new(this%interface_polygon(n,i,j,k)) + end do + end do + end do + end do + + ! Polygonal representation of cell faces + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Polygonal representation of the x-face + call new(this%polyface(1,i,j,k)) + vert(:,1)=[this%cfg%x(i),this%cfg%y(j ),this%cfg%z(k )] + vert(:,2)=[this%cfg%x(i),this%cfg%y(j+1),this%cfg%z(k )] + vert(:,3)=[this%cfg%x(i),this%cfg%y(j+1),this%cfg%z(k+1)] + vert(:,4)=[this%cfg%x(i),this%cfg%y(j ),this%cfg%z(k+1)] + call construct(this%polyface(1,i,j,k),4,vert) + call setPlaneOfExistence(this%polyface(1,i,j,k),[1.0_WP,0.0_WP,0.0_WP,this%cfg%x(i)]) + ! Polygonal representation of the y-face + call new(this%polyface(2,i,j,k)) + vert(:,1)=[this%cfg%x(i ),this%cfg%y(j),this%cfg%z(k )] + vert(:,2)=[this%cfg%x(i ),this%cfg%y(j),this%cfg%z(k+1)] + vert(:,3)=[this%cfg%x(i+1),this%cfg%y(j),this%cfg%z(k+1)] + vert(:,4)=[this%cfg%x(i+1),this%cfg%y(j),this%cfg%z(k )] + call construct(this%polyface(2,i,j,k),4,vert) + call setPlaneOfExistence(this%polyface(2,i,j,k),[0.0_WP,1.0_WP,0.0_WP,this%cfg%y(j)]) + ! Polygonal representation of the z-face + call new(this%polyface(3,i,j,k)) + vert(:,1)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k)] + vert(:,2)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k)] + vert(:,3)=[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k)] + vert(:,4)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k)] + call construct(this%polyface(3,i,j,k),4,vert) + call setPlaneOfExistence(this%polyface(3,i,j,k),[0.0_WP,0.0_WP,1.0_WP,this%cfg%z(k)]) + end do + end do + end do + + ! Give each link a unique lexicographic tag (per processor) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + tag=this%cfg%get_lexico_from_ijk([i,j,k]) + call setId(this%localized_separator_link(i,j,k),tag) + call setId(this%localizer_link(i,j,k),tag) + end do + end do + end do + + ! Set the connectivity + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! In the x- direction + if (i.gt.this%cfg%imino_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),0,this%localized_separator_link(i-1,j,k)) + call setEdgeConnectivity(this%localizer_link(i,j,k),0,this%localizer_link(i-1,j,k)) + end if + ! In the x+ direction + if (i.lt.this%cfg%imaxo_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),1,this%localized_separator_link(i+1,j,k)) + call setEdgeConnectivity(this%localizer_link(i,j,k),1,this%localizer_link(i+1,j,k)) + end if + ! In the y- direction + if (j.gt.this%cfg%jmino_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),2,this%localized_separator_link(i,j-1,k)) + call setEdgeConnectivity(this%localizer_link(i,j,k),2,this%localizer_link(i,j-1,k)) + end if + ! In the y+ direction + if (j.lt.this%cfg%jmaxo_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),3,this%localized_separator_link(i,j+1,k)) + call setEdgeConnectivity(this%localizer_link(i,j,k),3,this%localizer_link(i,j+1,k)) + end if + ! In the z- direction + if (k.gt.this%cfg%kmino_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),4,this%localized_separator_link(i,j,k-1)) + call setEdgeConnectivity(this%localizer_link(i,j,k),4,this%localizer_link(i,j,k-1)) + end if + ! In the z+ direction + if (k.lt.this%cfg%kmaxo_) then + call setEdgeConnectivity(this%localized_separator_link(i,j,k),5,this%localized_separator_link(i,j,k+1)) + call setEdgeConnectivity(this%localizer_link(i,j,k),5,this%localizer_link(i,j,k+1)) + end if + end do + end do + end do + + ! Prepare byte storage for synchronization + call new(this%send_byte_buffer) + call new(this%recv_byte_buffer) + + end subroutine initialize_irl + + + ! Set up additional arrays needed for the compressible MAST solver + subroutine allocate_supplement(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,tag + integer(IRL_LargeOffsetIndex_t) :: total_cells + + ! Allocate arrays for storing old variables + allocate(this%liquid_gas_interfaceold (this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(this%localized_separator_linkold(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + total_cells=int(this%cfg%nxo_,8)*int(this%cfg%nyo_,8)*int(this%cfg%nzo_,8) + call new(this%planar_separatorold_allocation,total_cells) + call new(this%localized_separator_linkold_allocation,total_cells) + + ! Initialize arrays and setup linking + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! PLIC interface(s) + call new(this%liquid_gas_interfaceold(i,j,k),this%planar_separatorold_allocation) + ! PLIC+mesh with connectivity (i.e., link) + call new(this%localized_separator_linkold(i,j,k),this%localized_separator_linkold_allocation,this%localizer(i,j,k),this%liquid_gas_interfaceold(i,j,k)) + end do + end do + end do + + ! Give each link a unique lexicographic tag (per processor) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + tag=this%cfg%get_lexico_from_ijk([i,j,k]) + call setId(this%localized_separator_linkold(i,j,k),tag) + end do + end do + end do + + ! Set the connectivity + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! In the x- direction + if (i.gt.this%cfg%imino_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),0,this%localized_separator_linkold(i-1,j,k)) + end if + ! In the x+ direction + if (i.lt.this%cfg%imaxo_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),1,this%localized_separator_linkold(i+1,j,k)) + end if + ! In the y- direction + if (j.gt.this%cfg%jmino_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),2,this%localized_separator_linkold(i,j-1,k)) + end if + ! In the y+ direction + if (j.lt.this%cfg%jmaxo_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),3,this%localized_separator_linkold(i,j+1,k)) + end if + ! In the z- direction + if (k.gt.this%cfg%kmino_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),4,this%localized_separator_linkold(i,j,k-1)) + end if + ! In the z+ direction + if (k.lt.this%cfg%kmaxo_) then + call setEdgeConnectivity(this%localized_separator_linkold(i,j,k),5,this%localized_separator_linkold(i,j,k+1)) + end if + end do + end do + end do + + + ! Deallocate memory-intensive arrays that are not used + deallocate(this%face_flux) + + end subroutine allocate_supplement + + + ! Store old liquid_gas_interface at the beginning of every timestep + subroutine copy_interface_to_old(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + + ! Copy interface + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call copy(this%liquid_gas_interfaceold(i,j,k),this%liquid_gas_interface(i,j,k)) + end do + end do + end do + + ! Copy volume fraction + this%VFold = this%VF + + ! Copy barycenters + this%Gbaryold = this%Gbary + this%Lbaryold = this%Lbary + + return + end subroutine copy_interface_to_old + + + !> Add a boundary condition + subroutine add_bcond(this,name,type,locator,dir) + use string, only: lowercase + use messager, only: die + implicit none + class(vfs), intent(inout) :: this + character(len=*), intent(in) :: name + integer, intent(in) :: type + external :: locator + interface + logical function locator(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator + end interface + character(len=2), optional :: dir + type(bcond), pointer :: new_bc + integer :: i,j,k,n + + ! Prepare new bcond + allocate(new_bc) + new_bc%name=trim(adjustl(name)) + new_bc%type=type + if (present(dir)) then + select case (lowercase(dir)) + case ('+x','x+','xp','px'); new_bc%dir=1 + case ('-x','x-','xm','mx'); new_bc%dir=2 + case ('+y','y+','yp','py'); new_bc%dir=3 + case ('-y','y-','ym','my'); new_bc%dir=4 + case ('+z','z+','zp','pz'); new_bc%dir=5 + case ('-z','z-','zm','mz'); new_bc%dir=6 + case default; call die('[vfs add_bcond] Unknown bcond direction') + end select + else + if (new_bc%type.eq.neumann) call die('[vfs apply_bcond] Neumann requires a direction') + new_bc%dir=0 + end if + new_bc%itr=iterator(this%cfg,new_bc%name,locator,'c') + + ! Insert it up front + new_bc%next=>this%first_bc + this%first_bc=>new_bc + + ! Increment bcond counter + this%nbc=this%nbc+1 + + ! Now adjust the metrics accordingly + select case (new_bc%type) + case (dirichlet) + do n=1,new_bc%itr%n_ + i=new_bc%itr%map(1,n); j=new_bc%itr%map(2,n); k=new_bc%itr%map(3,n) + this%mask(i,j,k)=2 + end do + case (neumann) + ! No modification - this assumes Neumann is only applied at walls or domain boundaries + case default + call die('[vfs apply_bcond] Unknown bcond type') + end select + + end subroutine add_bcond + + + !> Get a boundary condition + subroutine get_bcond(this,name,my_bc) + use messager, only: die + implicit none + class(vfs), intent(inout) :: this + character(len=*), intent(in) :: name + type(bcond), pointer, intent(out) :: my_bc + my_bc=>this%first_bc + search: do while (associated(my_bc)) + if (trim(my_bc%name).eq.trim(name)) exit search + my_bc=>my_bc%next + end do search + if (.not.associated(my_bc)) call die('[vfs get_bcond] Boundary condition was not found') + end subroutine get_bcond + + + !> Enforce boundary condition + subroutine apply_bcond(this,t,dt) + use messager, only: die + use mpi_f08, only: MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(vfs), intent(inout) :: this + real(WP), intent(in) :: t,dt + integer :: i,j,k,n + type(bcond), pointer :: my_bc + + ! Traverse bcond list + my_bc=>this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + select case (my_bc%type) + + case (dirichlet) ! Apply Dirichlet conditions + + ! This is done by the user directly + ! Unclear whether we want to do this within the solver... + + case (neumann) ! Apply Neumann condition + + ! Implement based on bcond direction + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%VF(i,j,k)=this%VF(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) + end do + + case default + call die('[vfs apply_bcond] Unknown bcond type') + end select + + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%VF) + + ! Move on to the next bcond + my_bc=>my_bc%next + + end do + + end subroutine apply_bcond + + + !> Calculate the new VF based on U/V/W and dt + subroutine advance(this,dt,U,V,W) + implicit none + class(vfs), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,index + real(IRL_double), dimension(3,9) :: face + type(CapDod_type) :: flux_polyhedron + real(WP) :: Lvolold,Gvolold + real(WP) :: Lvolinc,Gvolinc + real(WP) :: Lvolnew,Gvolnew + real(WP) :: vol_now,crude_VF + real(WP), dimension(3) :: ctr_now + real(WP), dimension(3,2) :: bounding_pts + integer, dimension(3,2) :: bb_indices + + ! Allocate + call new(flux_polyhedron) + + ! Loop over the domain and compute fluxes using semi-Lagrangian algorithm + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + + ! X flux + if (minval(abs(this%band(i-1:i,j,k))).le.advect_band) then + ! Construct and project face + face(:,1)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k+1)]; face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W); if (this%vmask(i ,j ,k+1).eq.1) face(:,5)=face(:,1) + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )]; face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W); if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + face(:,3)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k )]; face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W); if (this%vmask(i ,j+1,k ).eq.1) face(:,7)=face(:,3) + face(:,4)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k+1)]; face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W); if (this%vmask(i ,j+1,k+1).eq.1) face(:,8)=face(:,4) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Form flux polyhedron + call construct(flux_polyhedron,face) + ! Add solenoidal correction + call adjustCapToMatchVolume(flux_polyhedron,dt*U(i,j,k)*this%cfg%dy(j)*this%cfg%dz(k)) + ! Get bounds for flux polyhedron + call getBoundingPts(flux_polyhedron,bounding_pts(:,1),bounding_pts(:,2)) + bb_indices(:,1)=this%cfg%get_ijk_local(bounding_pts(:,1),[i,j,k]) + bb_indices(:,2)=this%cfg%get_ijk_local(bounding_pts(:,2),[i,j,k]) + ! Crudely check phase information for flux polyhedron + crude_VF=this%crude_phase_test(bb_indices) + if (crude_VF.lt.0.0_WP) then + ! Need full geometric flux + call getMoments(flux_polyhedron,this%localized_separator_link(i,j,k),this%face_flux(1,i,j,k)) + else + ! Simpler flux calculation + vol_now=calculateVolume(flux_polyhedron); ctr_now=calculateCentroid(flux_polyhedron) + call construct(this%face_flux(1,i,j,k),[crude_VF*vol_now,crude_VF*vol_now*ctr_now,(1.0_WP-crude_VF)*vol_now,(1.0_WP-crude_VF)*vol_now*ctr_now]) + end if + ! Store superficial liquid and gas fluxing velocities for momentum solver + this%UFl(1,i,j,k)=getVolumePtr(this%face_flux(1,i,j,k),0)/(this%cfg%dy(j)*this%cfg%dz(k)*dt) + this%UFg(1,i,j,k)=getVolumePtr(this%face_flux(1,i,j,k),1)/(this%cfg%dy(j)*this%cfg%dz(k)*dt) + else + ! Simple superficial velocity + if (maxval(this%band(i-1:i,j,k)).lt.0) then + this%UFl(1,i,j,k)=0.0_WP + this%UFg(1,i,j,k)=U(i,j,k) + else if (minval(this%band(i-1:i,j,k)).gt.0) then + this%UFl(1,i,j,k)=U(i,j,k) + this%UFg(1,i,j,k)=0.0_WP + end if + end if + + ! Y flux + if (minval(abs(this%band(i,j-1:j,k))).le.advect_band) then + ! Construct and project face + face(:,1)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k )]; face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W); if (this%vmask(i+1,j ,k ).eq.1) face(:,5)=face(:,1) + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )]; face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W); if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + face(:,3)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k+1)]; face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W); if (this%vmask(i ,j ,k+1).eq.1) face(:,7)=face(:,3) + face(:,4)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k+1)]; face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W); if (this%vmask(i+1,j ,k+1).eq.1) face(:,8)=face(:,4) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Form flux polyhedron + call construct(flux_polyhedron,face) + ! Add solenoidal correction + call adjustCapToMatchVolume(flux_polyhedron,dt*V(i,j,k)*this%cfg%dx(i)*this%cfg%dz(k)) + ! Get bounds for flux polyhedron + call getBoundingPts(flux_polyhedron,bounding_pts(:,1),bounding_pts(:,2)) + bb_indices(:,1)=this%cfg%get_ijk_local(bounding_pts(:,1),[i,j,k]) + bb_indices(:,2)=this%cfg%get_ijk_local(bounding_pts(:,2),[i,j,k]) + ! Crudely check phase information for flux polyhedron + crude_VF=this%crude_phase_test(bb_indices) + if (crude_VF.lt.0.0_WP) then + ! Need full geometric flux + call getMoments(flux_polyhedron,this%localized_separator_link(i,j,k),this%face_flux(2,i,j,k)) + else + ! Simpler flux calculation + vol_now=calculateVolume(flux_polyhedron); ctr_now=calculateCentroid(flux_polyhedron) + call construct(this%face_flux(2,i,j,k),[crude_VF*vol_now,crude_VF*vol_now*ctr_now,(1.0_WP-crude_VF)*vol_now,(1.0_WP-crude_VF)*vol_now*ctr_now]) + end if + ! Store superficial liquid and gas fluxing velocities for momentum solver + this%UFl(2,i,j,k)=getVolumePtr(this%face_flux(2,i,j,k),0)/(this%cfg%dz(k)*this%cfg%dx(i)*dt) + this%UFg(2,i,j,k)=getVolumePtr(this%face_flux(2,i,j,k),1)/(this%cfg%dz(k)*this%cfg%dx(i)*dt) + else + ! Simple superficial velocity + if (maxval(this%band(i,j-1:j,k)).lt.0) then + this%UFl(2,i,j,k)=0.0_WP + this%UFg(2,i,j,k)=V(i,j,k) + else if (minval(this%band(i,j-1:j,k)).gt.0) then + this%UFl(2,i,j,k)=V(i,j,k) + this%UFg(2,i,j,k)=0.0_WP + end if + end if + + ! Z flux + if (minval(abs(this%band(i,j,k-1:k))).le.advect_band) then + ! Construct and project face + face(:,1)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k )]; face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W); if (this%vmask(i ,j+1,k ).eq.1) face(:,5)=face(:,1) + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )]; face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W); if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + face(:,3)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k )]; face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W); if (this%vmask(i+1,j ,k ).eq.1) face(:,7)=face(:,3) + face(:,4)=[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k )]; face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W); if (this%vmask(i+1,j+1,k ).eq.1) face(:,8)=face(:,4) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Form flux polyhedron + call construct(flux_polyhedron,face) + ! Add solenoidal correction + call adjustCapToMatchVolume(flux_polyhedron,dt*W(i,j,k)*this%cfg%dx(i)*this%cfg%dy(j)) + ! Get bounds for flux polyhedron + call getBoundingPts(flux_polyhedron,bounding_pts(:,1),bounding_pts(:,2)) + bb_indices(:,1)=this%cfg%get_ijk_local(bounding_pts(:,1),[i,j,k]) + bb_indices(:,2)=this%cfg%get_ijk_local(bounding_pts(:,2),[i,j,k]) + ! Crudely check phase information for flux polyhedron + crude_VF=this%crude_phase_test(bb_indices) + if (crude_VF.lt.0.0_WP) then + ! Need full geometric flux + call getMoments(flux_polyhedron,this%localized_separator_link(i,j,k),this%face_flux(3,i,j,k)) + else + ! Simpler flux calculation + vol_now=calculateVolume(flux_polyhedron); ctr_now=calculateCentroid(flux_polyhedron) + call construct(this%face_flux(3,i,j,k),[crude_VF*vol_now,crude_VF*vol_now*ctr_now,(1.0_WP-crude_VF)*vol_now,(1.0_WP-crude_VF)*vol_now*ctr_now]) + end if + ! Store superficial liquid and gas fluxing velocities for momentum solver + this%UFl(3,i,j,k)=getVolumePtr(this%face_flux(3,i,j,k),0)/(this%cfg%dx(i)*this%cfg%dy(j)*dt) + this%UFg(3,i,j,k)=getVolumePtr(this%face_flux(3,i,j,k),1)/(this%cfg%dx(i)*this%cfg%dy(j)*dt) + else + ! Simple superficial velocity + if (maxval(this%band(i,j,k-1:k)).lt.0) then + this%UFl(3,i,j,k)=0.0_WP + this%UFg(3,i,j,k)=W(i,j,k) + else if (minval(this%band(i,j,k-1:k)).gt.0) then + this%UFl(3,i,j,k)=W(i,j,k) + this%UFg(3,i,j,k)=0.0_WP + end if + end if + + end do + + end do + end do + + ! Compute transported moments + do index=1,sum(this%band_count(0:advect_band)) + i=this%band_map(1,index) + j=this%band_map(2,index) + k=this%band_map(3,index) + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Old liquid and gas volumes + Lvolold= this%VFold(i,j,k) *this%cfg%vol(i,j,k) + Gvolold=(1.0_WP-this%VFold(i,j,k))*this%cfg%vol(i,j,k) + + ! Compute incoming liquid and gas volumes + Lvolinc=-getVolumePtr(this%face_flux(1,i+1,j,k),0)+getVolumePtr(this%face_flux(1,i,j,k),0) & + & -getVolumePtr(this%face_flux(2,i,j+1,k),0)+getVolumePtr(this%face_flux(2,i,j,k),0) & + & -getVolumePtr(this%face_flux(3,i,j,k+1),0)+getVolumePtr(this%face_flux(3,i,j,k),0) + Gvolinc=-getVolumePtr(this%face_flux(1,i+1,j,k),1)+getVolumePtr(this%face_flux(1,i,j,k),1) & + & -getVolumePtr(this%face_flux(2,i,j+1,k),1)+getVolumePtr(this%face_flux(2,i,j,k),1) & + & -getVolumePtr(this%face_flux(3,i,j,k+1),1)+getVolumePtr(this%face_flux(3,i,j,k),1) + + ! Compute new liquid and gas volumes + Lvolnew=Lvolold+Lvolinc + Gvolnew=Gvolold+Gvolinc + + ! Compute new liquid volume fraction + this%VF(i,j,k)=Lvolnew/(Lvolnew+Gvolnew) + + ! Only work on higher order moments if VF is in [VFlo,VFhi] + if (this%VF(i,j,k).lt.VFlo) then + this%VF(i,j,k)=0.0_WP + else if (this%VF(i,j,k).gt.VFhi) then + this%VF(i,j,k)=1.0_WP + else + ! Compute old phase barycenters + this%Lbary(:,i,j,k)=(this%Lbary(:,i,j,k)*Lvolold-getCentroidPtr(this%face_flux(1,i+1,j,k),0)+getCentroidPtr(this%face_flux(1,i,j,k),0) & + & -getCentroidPtr(this%face_flux(2,i,j+1,k),0)+getCentroidPtr(this%face_flux(2,i,j,k),0) & + & -getCentroidPtr(this%face_flux(3,i,j,k+1),0)+getCentroidPtr(this%face_flux(3,i,j,k),0))/Lvolnew + this%Gbary(:,i,j,k)=(this%Gbary(:,i,j,k)*Gvolold-getCentroidPtr(this%face_flux(1,i+1,j,k),1)+getCentroidPtr(this%face_flux(1,i,j,k),1) & + & -getCentroidPtr(this%face_flux(2,i,j+1,k),1)+getCentroidPtr(this%face_flux(2,i,j,k),1) & + & -getCentroidPtr(this%face_flux(3,i,j,k+1),1)+getCentroidPtr(this%face_flux(3,i,j,k),1))/Gvolnew + ! Project forward in time + this%Lbary(:,i,j,k)=this%project(this%Lbary(:,i,j,k),i,j,k,dt,U,V,W) + this%Gbary(:,i,j,k)=this%project(this%Gbary(:,i,j,k),i,j,k,dt,U,V,W) + end if + end do + + ! Synchronize VF field + call this%cfg%sync(this%VF) + + ! Synchronize fluxing velocities + call this%cfg%sync(this%UFl) + call this%cfg%sync(this%UFg) + + ! Remove flotsams if needed + call this%remove_flotsams() + + ! Synchronize and clean-up barycenter fields + call this%sync_and_clean_barycenters() + + ! Advect interface polygons + call this%advect_interface(dt,U,V,W) + + ! Update the band + call this%update_band() + + ! Perform interface reconstruction from transported moments + call this%build_interface() + + ! Remove thin sheets if needed + call this%remove_sheets() + + ! Create discontinuous polygon mesh from IRL interface + call this%polygonalize_interface() + + ! Calculate distance from polygons + call this%distance_from_polygon() + + ! Calculate subcell phasic volumes + call this%subcell_vol() + + ! Calculate curvature + call this%get_curvature() + + ! Reset moments to guarantee compatibility with interface reconstruction + call this%reset_volume_moments() + + end subroutine advance + + + !> Project a single face to get flux polyhedron and get its moments + subroutine fluxpoly_project_getmoments(this,i,j,k,dt,dir,U,V,W,a_flux_polyhedron,a_locseplink,some_face_flux_moments) + implicit none + class(vfs), intent(inout) :: this + integer, intent(in) :: i,j,k !< Index + real(WP), intent(in) :: dt !< Timestep size over which to advance + character(len=1), intent(in) :: dir !< Orientation of current face + type(CapDod_type) :: a_flux_polyhedron + type(LocSepLink_type) :: a_locseplink + type(TagAccVM_SepVM_type) :: some_face_flux_moments + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(IRL_double), dimension(3,9) :: face !< Points on face being projected to form flux volume + real(WP) :: vol_f !< Consistent volume according to face velocity and mesh + + ! Project points, form flux volume, set directional parameters + select case(trim(dir)) + case('x') + ! Construct and project left x(i) face + face(:,1)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k+1)] + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )] + face(:,3)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k )] + face(:,4)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k+1)] + face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W) + face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W) + face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W) + face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Limit projection in the case of walls + if (this%vmask(i ,j ,k+1).eq.1) face(:,5)=face(:,1) + if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + if (this%vmask(i ,j+1,k ).eq.1) face(:,7)=face(:,3) + if (this%vmask(i ,j+1,k+1).eq.1) face(:,8)=face(:,4) + ! Calculate consistent volume + vol_f = dt*U(i,j,k)*this%cfg%dy(j)*this%cfg%dz(k) + case ('y') + ! Construct and project bottom y(j) face + face(:,1)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k )] + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )] + face(:,3)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k+1)] + face(:,4)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k+1)] + face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W) + face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W) + face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W) + face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Limit projection in the case of walls + if (this%vmask(i+1,j ,k ).eq.1) face(:,5)=face(:,1) + if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + if (this%vmask(i ,j ,k+1).eq.1) face(:,7)=face(:,3) + if (this%vmask(i+1,j ,k+1).eq.1) face(:,8)=face(:,4) + ! Calculate consistent volume + vol_f = dt*V(i,j,k)*this%cfg%dx(i)*this%cfg%dz(k) + case('z') + ! Construct and project bottom z(k) face + face(:,1)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k )] + face(:,2)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k )] + face(:,3)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k )] + face(:,4)=[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k )] + face(:,5)=this%project(face(:,1),i,j,k,-dt,U,V,W) + face(:,6)=this%project(face(:,2),i,j,k,-dt,U,V,W) + face(:,7)=this%project(face(:,3),i,j,k,-dt,U,V,W) + face(:,8)=this%project(face(:,4),i,j,k,-dt,U,V,W) + face(:,9)=0.25_WP*[sum(face(1,1:4)),sum(face(2,1:4)),sum(face(3,1:4))] + face(:,9)=this%project(face(:,9),i,j,k,-dt,U,V,W) + ! Limit projection in the case of walls + if (this%vmask(i ,j+1,k ).eq.1) face(:,5)=face(:,1) + if (this%vmask(i ,j ,k ).eq.1) face(:,6)=face(:,2) + if (this%vmask(i+1,j ,k ).eq.1) face(:,7)=face(:,3) + if (this%vmask(i+1,j+1,k ).eq.1) face(:,8)=face(:,4) + ! Calculate consistent volume + vol_f = dt*W(i,j,k)*this%cfg%dx(i)*this%cfg%dy(j) + end select + + ! Form flux polyhedron + call construct(a_flux_polyhedron,face) + ! Add volume-consistent correction + call adjustCapToMatchVolume(a_flux_polyhedron,vol_f) + ! Get all volumetric fluxes + call getNormMoments(a_flux_polyhedron,a_locseplink,some_face_flux_moments) + + end subroutine fluxpoly_project_getmoments + + + !> From the moments object in a single cell, get the volume and centroid out of IRL + subroutine fluxpoly_cell_getvolcentr(this,f_moments,n,ii,jj,kk,my_Lbary,my_Gbary,my_Lvol,my_Gvol,skip_flag) + implicit none + class(vfs), intent(inout) :: this + type(TagAccVM_SepVM_type) :: f_moments + integer, intent(in) :: n + integer :: ii,jj,kk,localizer_id + integer, dimension(3) :: ind + type(SepVM_type) :: my_SepVM + real(WP) :: my_Gvol,my_Lvol + real(WP), dimension(3) :: my_Gbary,my_Lbary + logical :: skip_flag + + skip_flag = .false. + ! Get unique id of current cell + localizer_id = getTagForIndex(f_moments,n) + ! Convert unique id to indices ii,jj,kk + ind=this%cfg%get_ijk_from_lexico(localizer_id) + ii = ind(1); jj = ind(2); kk = ind(3) + + ! If inside wall, nothing should be added to flux + if (this%mask(ii,jj,kk).eq.1) then + skip_flag = .true. + return + end if + + ! If bringing material back from beyond outflow boundary, skip + !if (backflow_flux_flag(ii,jj,kk)) cycle + + ! Get barycenter and volume of tets in current cell + call getSepVMAtIndex(f_moments,n,my_SepVM) + my_Lbary = getCentroid(my_SepVM, 0) + my_Gbary = getCentroid(my_SepVM, 1) + my_Lvol = getVolume(my_SepVM, 0) + my_Gvol = getVolume(my_SepVM, 1) + + end subroutine fluxpoly_cell_getvolcentr + + + !> Remove flotsams explicitly - careful, this is not conservative! + subroutine remove_flotsams(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,ii,jj,kk + real(WP) :: FSlo,FShi + ! Do not do anything if VFflot<=0.0_WP + if (this%VFflot.le.0.0_WP) return + ! Build lo and hi values + FSlo=this%VFflot + FShi=1.0_WP-this%VFflot + ! Loop inside and remove flotsams + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + oloop: do i=this%cfg%imin_,this%cfg%imax_ + ! Handle liquid flotsams + if (this%VF(i,j,k).ge.VFlo.and.this%VF(i,j,k).lt.FSlo) then + ! Check for fuller neighbors + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + if (this%VF(ii,jj,kk).ge.FSlo) cycle oloop + end do + end do + end do + ! None was found, everything is below FSlo + this%VF(i,j,k)=0.0_WP + end if + ! Handle gas flotsams + if (this%VF(i,j,k).le.VFhi.and.this%VF(i,j,k).gt.FShi) then + ! Check for fuller neighbors + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + if (this%VF(ii,jj,kk).le.FShi) cycle oloop + end do + end do + end do + ! None was found, everything is above FShi + this%VF(i,j,k)=1.0_WP + end if + end do oloop + end do + end do + ! Synchronize VF field + call this%cfg%sync(this%VF) + end subroutine remove_flotsams + + + !> Remove thin R2P sheets explicitly - careful, this is not conservative! + subroutine remove_sheets(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + real(WP) :: sheet_lo,sheet_hi + ! Do not do anything if VFsheet<=0.0_WP + if (this%VFsheet.le.0.0_WP) return + ! Build lo and hi values + sheet_lo=this%VFsheet + sheet_hi=1.0_WP-this%VFsheet + ! Loop everywhere and remove sheets + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Only work on 2-plane or more reconstructions + if (getNumberOfPlanes(this%liquid_gas_interface(i,j,k)).gt.1) then + if (this%VF(i,j,k).lt.sheet_lo) then + this%VF(i,j,k)=0.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + else if (this%VF(i,j,k).gt.sheet_hi) then + this%VF(i,j,k)=1.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end if + end if + end do + end do + end do + ! Update the band + call this%update_band() + end subroutine remove_sheets + + + !> Clean up after VF change removal + subroutine clean_irl_and_band(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,n + ! Loop everywhere and remove leftover IRL objects + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%VF(i,j,k).lt.VFlo) then + ! Pure gas moments + this%VF(i,j,k)=0.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + ! Provide default interface + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + ! Zero out the polygons + do n=1,max_interface_planes + call zeroPolygon(this%interface_polygon(n,i,j,k)) + end do + else if (this%VF(i,j,k).gt.VFhi) then + ! Pure liquid moments + this%VF(i,j,k)=1.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + ! Provide default interface + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + ! Zero out the polygons + do n=1,max_interface_planes + call zeroPolygon(this%interface_polygon(n,i,j,k)) + end do + end if + end do + end do + end do + ! Update the band + call this%update_band() + end subroutine clean_irl_and_band + + + !> Synchronize and clean up barycenter fields + subroutine sync_and_clean_barycenters(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + ! Clean up barycenters everywhere + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + end do + end do + end do + ! Synchronize barycenters + call this%cfg%sync(this%Lbary) + call this%cfg%sync(this%Gbary) + ! Fix barycenter synchronization across periodic boundaries + if (this%cfg%xper.and.this%cfg%iproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino,this%cfg%imin-1 + this%Lbary(1,i,j,k)=this%Lbary(1,i,j,k)-this%cfg%xL + this%Gbary(1,i,j,k)=this%Gbary(1,i,j,k)-this%cfg%xL + end do + end do + end do + end if + if (this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imax+1,this%cfg%imaxo + this%Lbary(1,i,j,k)=this%Lbary(1,i,j,k)+this%cfg%xL + this%Gbary(1,i,j,k)=this%Gbary(1,i,j,k)+this%cfg%xL + end do + end do + end do + end if + if (this%cfg%yper.and.this%cfg%jproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino,this%cfg%jmin-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + this%Lbary(2,i,j,k)=this%Lbary(2,i,j,k)-this%cfg%yL + this%Gbary(2,i,j,k)=this%Gbary(2,i,j,k)-this%cfg%yL + end do + end do + end do + end if + if (this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmax+1,this%cfg%jmaxo + do i=this%cfg%imino_,this%cfg%imaxo_ + this%Lbary(2,i,j,k)=this%Lbary(2,i,j,k)+this%cfg%yL + this%Gbary(2,i,j,k)=this%Gbary(2,i,j,k)+this%cfg%yL + end do + end do + end do + end if + if (this%cfg%zper.and.this%cfg%kproc.eq.1) then + do k=this%cfg%kmino,this%cfg%kmin-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%Lbary(3,i,j,k)=this%Lbary(3,i,j,k)-this%cfg%zL + this%Gbary(3,i,j,k)=this%Gbary(3,i,j,k)-this%cfg%zL + end do + end do + end do + end if + if (this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) then + do k=this%cfg%kmax+1,this%cfg%kmaxo + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + this%Lbary(3,i,j,k)=this%Lbary(3,i,j,k)+this%cfg%zL + this%Gbary(3,i,j,k)=this%Gbary(3,i,j,k)+this%cfg%zL + end do + end do + end do + end if + ! Handle 2D barycenters + if (this%cfg%nx.eq.1) then + do i=this%cfg%imino_,this%cfg%imaxo_ + this%Lbary(1,i,:,:)=this%cfg%xm(i) + this%Gbary(1,i,:,:)=this%cfg%xm(i) + end do + end if + if (this%cfg%ny.eq.1) then + do j=this%cfg%jmino_,this%cfg%jmaxo_ + this%Lbary(2,:,j,:)=this%cfg%ym(j) + this%Gbary(2,:,j,:)=this%cfg%ym(j) + end do + end if + if (this%cfg%nz.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + this%Lbary(3,:,:,k)=this%cfg%zm(k) + this%Gbary(3,:,:,k)=this%cfg%zm(k) + end do + end if + end subroutine sync_and_clean_barycenters + + + !> Lagrangian advection of the IRL surface using U,V,W and dt + subroutine advect_interface(this,dt,U,V,W) + implicit none + class(vfs), intent(inout) :: this + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ii,n,t,vt + integer :: list_size,localizer_id + type(TagAccListVM_VMAN_type) :: accumulated_moments_from_tri + type(ListVM_VMAN_type) :: moments_list_from_tri + type(DivPoly_type) :: divided_polygon + type(Tri_type) :: triangle + real(IRL_double), dimension(1:4) :: plane_data + integer, dimension(3) :: ind + real(IRL_double), dimension(1:3,1:3) :: tri_vert + + ! Clear moments from before + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call clear(this%triangle_moments_storage(i,j,k)) + end do + end do + end do + + ! Allocate IRL data + call new(accumulated_moments_from_tri) + call new(moments_list_from_tri) + call new(divided_polygon) + call new(triangle) + + ! Loop over domain to forward transport interface + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + + ! Skip if no interface + if (this%VFold(i,j,k).lt.VFlo.or.this%VFold(i,j,k).gt.VFhi) cycle + + ! Construct triangulation of each interface plane + do n=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + + ! Skip planes outside of the cell + if (getNumberOfVertices(this%interface_polygon(n,i,j,k)).eq.0) cycle + + ! Get DividedPolygon from the plane + call constructFromPolygon(divided_polygon,this%interface_polygon(n,i,j,k)) + + ! Check if point ordering correct, flip if not + plane_data=getPlane(this%liquid_gas_interface(i,j,k),n-1) + if (abs(1.0_WP-dot_product(calculateNormal(divided_polygon),plane_data(1:3))).gt.1.0_WP) call reversePtOrdering(divided_polygon) + + ! Loop over triangles from DividedPolygon + do t=1,getNumberOfSimplicesInDecomposition(divided_polygon) + ! Get the triangle + call getSimplexFromDecomposition(divided_polygon,t-1,triangle) + ! Forward project triangle vertices + tri_vert=getVertices(triangle) + do vt=1,3 + tri_vert(:,vt)=this%project(tri_vert(:,vt),i,j,k,dt,U,V,W) + end do + call construct(triangle,tri_vert) + call calculateAndSetPlaneOfExistence(triangle) + ! Cut it by the mesh + call getMoments(triangle,this%localizer_link(i,j,k),accumulated_moments_from_tri) + ! Loop through each cell and append to triangle_moments_storage in each cell + list_size=getSize(accumulated_moments_from_tri) + do ii=1,list_size + localizer_id=getTagForIndex(accumulated_moments_from_tri,ii-1) + ind=this%cfg%get_ijk_from_lexico(localizer_id) + call getListAtIndex(accumulated_moments_from_tri,ii-1,moments_list_from_tri) + call append(this%triangle_moments_storage(ind(1),ind(2),ind(3)),moments_list_from_tri) + end do + end do + + end do + + end do + end do + end do + + end subroutine advect_interface + + + !> Band update from VF dataset + subroutine update_band(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,ii,jj,kk,dir,n,index + integer, dimension(3) :: ind + integer :: ibmin_,ibmax_,jbmin_,jbmax_,kbmin_,kbmax_ + integer, dimension(0:nband) :: band_size + + ! Loop extents + ibmin_=this%cfg%imin_; if (this%cfg%iproc.eq.1 .and..not.this%cfg%xper) ibmin_=this%cfg%imin-1 + ibmax_=this%cfg%imax_; if (this%cfg%iproc.eq.this%cfg%npx.and..not.this%cfg%xper) ibmax_=this%cfg%imax+1 + jbmin_=this%cfg%jmin_; if (this%cfg%jproc.eq.1 .and..not.this%cfg%yper) jbmin_=this%cfg%jmin-1 + jbmax_=this%cfg%jmax_; if (this%cfg%jproc.eq.this%cfg%npy.and..not.this%cfg%yper) jbmax_=this%cfg%jmax+1 + kbmin_=this%cfg%kmin_; if (this%cfg%kproc.eq.1 .and..not.this%cfg%zper) kbmin_=this%cfg%kmin-1 + kbmax_=this%cfg%kmax_; if (this%cfg%kproc.eq.this%cfg%npz.and..not.this%cfg%zper) kbmax_=this%cfg%kmax+1 + + ! Reset band + this%band=(nband+1)*int(sign(1.0_WP,this%VF-0.5_WP)) + + ! First sweep to identify cells with interface + do k=kbmin_,kbmax_ + do j=jbmin_,jbmax_ + do i=ibmin_,ibmax_ + ! Skip *real* wall cells + if (this%mask(i,j,k).eq.1) cycle + ! Identify cells with interface + if (this%VF(i,j,k).ge.VFlo.and.this%VF(i,j,k).le.VFhi) this%band(i,j,k)=0 + ! Check if cell-face is an interface + do dir=1,3 + do n=-1,+1,2 + ind=[i,j,k]; ind(dir)=ind(dir)+n + if (this%mask(ind(1),ind(2),ind(3)).ne.1) then + if (this%VF(i,j,k).lt.VFlo.and.this%VF(ind(1),ind(2),ind(3)).gt.VFhi.or.& + & this%VF(i,j,k).gt.VFhi.and.this%VF(ind(1),ind(2),ind(3)).lt.VFlo) this%band(i,j,k)=0 + end if + end do + end do + end do + end do + end do + call this%cfg%sync(this%band) + + ! Sweep to identify the bands up to nband + do n=1,nband + ! For each band + do k=kbmin_,kbmax_ + do j=jbmin_,jbmax_ + do i=ibmin_,ibmax_ + ! Skip wall cells + if (this%mask(i,j,k).eq.1) cycle + ! Work on one band at a time + if (abs(this%band(i,j,k)).gt.n) then + ! Loop over 26 neighbors + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip wall cells + if (this%mask(ii,jj,kk).eq.1) cycle + ! Extend the band + if (abs(this%band(ii,jj,kk)).eq.n-1) this%band(i,j,k)=int(sign(real(n,WP),this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + end do + end do + end do + call this%cfg%sync(this%band) + end do + + ! Count the number of cells in each band value + band_size=0 + do k=kbmin_,kbmax_ + do j=jbmin_,jbmax_ + do i=ibmin_,ibmax_ + if (abs(this%band(i,j,k)).le.nband) band_size(abs(this%band(i,j,k)))=band_size(abs(this%band(i,j,k)))+1 + end do + end do + end do + + ! Rebuild the unstructured mapping + if (allocated(this%band_map)) deallocate(this%band_map); allocate(this%band_map(3,sum(band_size))) + this%band_count=0 + do k=kbmin_,kbmax_ + do j=jbmin_,jbmax_ + do i=ibmin_,ibmax_ + if (abs(this%band(i,j,k)).le.nband) then + this%band_count(abs(this%band(i,j,k)))=this%band_count(abs(this%band(i,j,k)))+1 + index=sum(band_size(0:abs(this%band(i,j,k))-1))+this%band_count(abs(this%band(i,j,k))) + this%band_map(:,index)=[i,j,k] + end if + end do + end do + end do + + end subroutine update_band + + + !> Reconstruct an IRL interface from the VF field distribution + subroutine build_interface(this) + use messager, only: die + implicit none + class(vfs), intent(inout) :: this + ! Reconstruct interface - will need to support various methods + select case (this%reconstruction_method) + case (elvira); call this%build_elvira() + case (lvira) ; call this%build_lvira() + case (r2p) ; call this%build_r2p() + case (art) ; call this%build_art() + case (swartz) + call this%build_lvira() + call this%smooth_interface() + case (youngs); call this%build_youngs() + !case (lvlset); call this%build_lvlset() + case default; call die('[vfs build interface] Unknown interface reconstruction scheme') + end select + end subroutine build_interface + + + !> ELVIRA reconstruction of a planar interface in mixed cells + subroutine build_elvira(this) + implicit none + class(vfs), intent(inout) :: this + integer(IRL_SignedIndex_t) :: i,j,k + integer :: ind,ii,jj,kk + type(ELVIRANeigh_type) :: neighborhood + type(RectCub_type), dimension(0:26) :: neighborhood_cells + real(IRL_double), dimension(0:26) :: liquid_volume_fraction + + ! Give ourselves a ELVIRA neighborhood of 27 cells + call new(neighborhood) + do i=0,26 + call new(neighborhood_cells(i)) + end do + call setSize(neighborhood,27) + ind=0 + do k=-1,+1 + do j=-1,+1 + do i=-1,+1 + call setMember(neighborhood,neighborhood_cells(ind),liquid_volume_fraction(ind),i,j,k) + ind=ind+1 + end do + end do + end do + + ! Traverse domain and reconstruct interface + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Handle full cells differently + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + cycle + end if + + ! Set neighborhood_cells and liquid_volume_fraction to current correct values + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + ! Assign volume fraction + liquid_volume_fraction(ind)=this%VF(ii,jj,kk) + ! Increment counter + ind=ind+1 + end do + end do + end do + ! Perform the reconstruction + call reconstructELVIRA3D(neighborhood,this%liquid_gas_interface(i,j,k)) + end do + end do + end do + + ! Synchronize across boundaries + call this%sync_interface() + + end subroutine build_elvira + + + !> Smoothing of an IRL interface based on Swartz-like algorithm + subroutine smooth_interface(this) + use mathtools, only: cross_product,normalize,Pi,qrotate + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,ii,jj,kk,ierr,ite,count + real(WP) :: myres,res,mag + real(WP), dimension(3) :: mynorm,mybary,bary,norm,newnorm,r + real(WP), dimension(4) :: plane,q + type(RectCub_type) :: cell + !real(WP), parameter :: norm_threshold=0.85_WP ! About 30 degrees + real(WP), parameter :: norm_threshold=0.0_WP ! 0 degrees + real(WP), parameter :: maxres=1.0e-6_WP + integer , parameter :: maxite=5 + + ! Allocate cell + call new(cell) + + ! Iterate until convergence criterion is met + res=huge(1.0_WP); ite=0 + do while (res.ge.maxres.and.ite.lt.maxite) + + ! Create discontinuous polygon mesh from IRL interface + call this%polygonalize_interface() + + ! Traverse domain and form new normal + myres=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Skip wall/bcond cells + if (this%mask(i,j,k).ne.0) cycle + ! Skip cells without interface + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) cycle + ! Compute polygon barycenter and normal + mybary=calculateCentroid(this%interface_polygon(1,i,j,k)) + mynorm=calculateNormal (this%interface_polygon(1,i,j,k)) + ! Loop over our neighbors and form new normal + newnorm=0.0_WP; count=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) cycle + ! Skip cells without polygons + if (getNumberOfVertices(this%interface_polygon(1,ii,jj,kk)).eq.0) cycle + ! Increment neighbor counter + count=count+1 + ! Compute polygon barycenter and normal + bary=calculateCentroid(this%interface_polygon(1,ii,jj,kk))-mybary + norm=calculateNormal (this%interface_polygon(1,ii,jj,kk)) + ! Skip polygons with normal too different from ours + if (dot_product(mynorm,norm).lt.norm_threshold) cycle + ! Build a quaternion to rotate Pi/2 around r axis + r=cross_product(bary,mynorm) + q(1)=cos(0.25_WP*Pi); q(2:4)=sin(0.25_WP*Pi)*normalize(r) + ! Increment our normal estimate using a barycenter-based normal + newnorm=newnorm+qrotate(v=bary,q=q) + end do + end do + end do + ! Set minimum number of neighbors to 1 + if (count.eq.0) cycle + ! Normalize new normal vector + newnorm=normalize(newnorm) + ! Adjust plane orientation (not position yet) + plane=getPlane(this%liquid_gas_interface(i,j,k),0) + call setPlane(this%liquid_gas_interface(i,j,k),0,newnorm,plane(4)) + call construct_2pt(cell,[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + call matchVolumeFraction(cell,this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + ! Monitor convergence + myres=max(myres,1.0_WP-dot_product(mynorm,newnorm)) + end do + end do + end do + + ! Collect maximum residual and increment iteration counter + call MPI_ALLREDUCE(myres,res,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); ite=ite+1 + if (this%cfg%amRoot) print*,'ite=',ite,'residual=',res + + ! Synchronize across boundaries + call this%sync_interface() + + end do + + end subroutine smooth_interface + + + !> Youngs' algorithm for reconstructing a planar interface + subroutine build_youngs(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + + ! Traverse domain and reconstruct interface + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Handle full cells differently + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + cycle + end if + + ! Apply Youngs' method to get normal + + + end do + end do + end do + + ! Synchronize across boundaries + call this%sync_interface() + + end subroutine build_youngs + + + !> LVIRA reconstruction of a planar interface in mixed cells + subroutine build_lvira(this) + use mathtools, only: normalize + implicit none + class(vfs), intent(inout) :: this + integer(IRL_SignedIndex_t) :: i,j,k + integer :: ind,ii,jj,kk,icenter + type(LVIRANeigh_RectCub_type) :: neighborhood + type(RectCub_type), dimension(0:26) :: neighborhood_cells + real(IRL_double) , dimension(0:26) :: liquid_volume_fraction + real(IRL_double), dimension(3) :: initial_norm + real(IRL_double) :: initial_dist + + ! Give ourselves an LVIRA neighborhood of 27 cells + call new(neighborhood) + do i=0,26 + call new(neighborhood_cells(i)) + end do + + ! Traverse domain and reconstruct interface + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Handle full cells differently + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + cycle + end if + + ! Set neighborhood_cells and liquid_volume_fraction to current correct values + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip true wall cells - bconds can be used here + if (this%mask(ii,jj,kk).eq.1) cycle + ! Add cell to neighborhood + call addMember(neighborhood,neighborhood_cells(ind),liquid_volume_fraction(ind)) + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + ! Assign volume fraction + liquid_volume_fraction(ind)=this%VF(ii,jj,kk) + ! Trap and set stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) then + icenter=ind + call setCenterOfStencil(neighborhood,icenter) + end if + ! Increment counter + ind=ind+1 + end do + end do + end do + + ! Formulate initial guess + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + initial_norm=normalize(this%Gbary(:,i,j,k)-this%Lbary(:,i,j,k)) + initial_dist=dot_product(initial_norm,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)]) + call setPlane(this%liquid_gas_interface(i,j,k),0,initial_norm,initial_dist) + call matchVolumeFraction(neighborhood_cells(icenter),this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + + ! Perform the reconstruction + call reconstructLVIRA3D(neighborhood,this%liquid_gas_interface(i,j,k)) + + ! Clean up neighborhood + call emptyNeighborhood(neighborhood) + + end do + end do + end do + + ! Synchronize across boundaries + call this%sync_interface() + + end subroutine build_lvira + + + !> R2P reconstruction of a planar interface in mixed cells + subroutine build_r2p(this) + use mathtools, only: normalize + implicit none + class(vfs), intent(inout) :: this + integer(IRL_SignedIndex_t) :: i,j,k + integer :: ind,ii,jj,kk,icenter + type(LVIRANeigh_RectCub_type) :: nh_lvr + type(R2PNeigh_RectCub_type) :: nh_r2p + type(RectCub_type), dimension(0:26) :: neighborhood_cells + real(IRL_double) , dimension(0:26) :: liquid_volume_fraction + type(SepVM_type), dimension(0:26) :: separated_volume_moments + type(VMAN_type) :: volume_moments_and_normal + real(WP) :: surface_area + real(IRL_double), dimension(3) :: initial_norm + real(IRL_double) :: initial_dist + logical :: is_wall + + ! Get storage for voluem moments and normal + call new(volume_moments_and_normal) + + ! Give ourselves an R2P and an LVIRA neighborhood of 27 cells along with separated volume moments + call new(nh_r2p) + call new(nh_lvr) + do i=0,26 + call new(neighborhood_cells(i)) + call new(separated_volume_moments(i)) + end do + + ! Traverse domain and reconstruct interface + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Handle full cells differently + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + cycle + end if + + ! Check whether a wall is in our neighborhood + is_wall=.false. + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + if (this%mask(ii,jj,kk).eq.1) is_wall=.true. + end do + end do + end do + + ! Apply LVIRA if there is a wall, otherwise use R2P + if (is_wall) then + + ! Set neighborhood_cells and liquid_volume_fraction to current correct values + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip true wall cells - bconds can be used here + if (this%mask(ii,jj,kk).eq.1) cycle + ! Add cell to neighborhood + call addMember(nh_lvr,neighborhood_cells(ind),liquid_volume_fraction(ind)) + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + ! Assign volume fraction + liquid_volume_fraction(ind)=this%VF(ii,jj,kk) + ! Trap and set stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) then + icenter=ind + call setCenterOfStencil(nh_lvr,icenter) + end if + ! Increment counter + ind=ind+1 + end do + end do + end do + + ! Formulate initial guess + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + initial_norm=normalize(this%Gbary(:,i,j,k)-this%Lbary(:,i,j,k)) + initial_dist=dot_product(initial_norm,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)]) + call setPlane(this%liquid_gas_interface(i,j,k),0,initial_norm,initial_dist) + call matchVolumeFraction(neighborhood_cells(icenter),this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + + ! Perform the reconstruction + call reconstructLVIRA3D(nh_lvr,this%liquid_gas_interface(i,j,k)) + + ! Clean up neighborhood + call emptyNeighborhood(nh_lvr) + + else + + ! Prepare R2P neighborhood + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip true wall cells - bconds can be used here + if (this%mask(ii,jj,kk).eq.1) cycle + ! Add cell to our neighborhood + call addMember(nh_r2p,neighborhood_cells(ind),separated_volume_moments(ind)) + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + call construct(separated_volume_moments(ind),[this%VF(ii,jj,kk)*this%cfg%vol(ii,jj,kk),this%Lbary(:,ii,jj,kk),(1.0_WP-this%VF(ii,jj,kk))*this%cfg%vol(ii,jj,kk),this%Gbary(:,ii,jj,kk)]) + ! Trap and set stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) then + icenter=ind + call setCenterOfStencil(nh_r2p,icenter) + end if + ! Increment counter + ind=ind+1 + end do + end do + end do + surface_area=0.0_WP + do ind=0,getSize(this%triangle_moments_storage(i,j,k))-1 + call getMoments(this%triangle_moments_storage(i,j,k),ind,volume_moments_and_normal) + surface_area=surface_area+getVolume(volume_moments_and_normal) + end do + call setSurfaceArea(nh_r2p,surface_area) + + ! Made it this far, we need a reconstruction - this builds the initial guess + if (getSize(this%triangle_moments_storage(i,j,k)).gt.0) then + call reconstructAdvectedNormals(this%triangle_moments_storage(i,j,k),nh_r2p,this%twoplane_threshold,this%liquid_gas_interface(i,j,k)) + if (getNumberOfPlanes(this%liquid_gas_interface(i,j,k)).eq.1) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + initial_norm=normalize(this%Gbary(:,i,j,k)-this%Lbary(:,i,j,k)) + initial_dist=dot_product(initial_norm,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)]) + call setPlane(this%liquid_gas_interface(i,j,k),0,initial_norm,initial_dist) + call matchVolumeFraction(neighborhood_cells(icenter),this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + end if + else + ! No interface was advected in our cell, use MoF + call reconstructMOF3D(neighborhood_cells(icenter),separated_volume_moments(icenter),this%liquid_gas_interface(i,j,k)) + ! Surface area not set cause no advected moments, set for current MOF reconstruction + call setSurfaceArea(nh_r2p,getSA(neighborhood_cells(icenter),this%liquid_gas_interface(i,j,k))) + end if + + ! Perform R2P reconstruction + call reconstructR2P3D(nh_r2p,this%liquid_gas_interface(i,j,k)) + + ! Clean up neighborhood + call emptyNeighborhood(nh_r2p) + end if + + end do + end do + end do + + ! Synchronize across boundaries + call this%sync_interface() + + end subroutine build_r2p + + + !> ART reconstruction of a planar interface in mixed cells + subroutine build_art(this) + use mathtools, only: normalize + implicit none + class(vfs), intent(inout) :: this + integer(IRL_SignedIndex_t) :: i,j,k + integer :: ind,ii,jj,kk,icenter,info + type(LVIRANeigh_RectCub_type) :: nh_lvr + type(R2PNeigh_RectCub_type) :: nh_r2p + type(RectCub_type), dimension(0:26) :: neighborhood_cells + real(IRL_double) , dimension(0:26) :: liquid_volume_fraction + type(SepVM_type), dimension(0:26) :: separated_volume_moments + type(VMAN_type) :: volume_moments_and_normal + real(WP) :: surface_area + real(IRL_double), dimension(3) :: initial_norm + real(IRL_double) :: initial_dist + real(WP) :: fvol,xtmp,ytmp,ztmp + real(WP), dimension(3) :: fbary + real(WP), dimension(3,3) :: Imom + real(WP), dimension(3) :: d + integer , parameter :: order=3 + integer , parameter :: lwork=102 ! dsyev optimal length (nb+2)*order, where block size nb=32 + real(WP), dimension(lwork) :: work + + ! Get storage for voluem moments and normal + call new(volume_moments_and_normal) + + ! Give ourselves an R2P and an LVIRA neighborhood of 27 cells along with separated volume moments + call new(nh_r2p) + call new(nh_lvr) + do i=0,26 + call new(neighborhood_cells(i)) + call new(separated_volume_moments(i)) + end do + + ! Traverse domain and reconstruct interface + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + + ! Skip wall/bcond cells - bconds need to be provided elsewhere directly! + if (this%mask(i,j,k).ne.0) cycle + + ! Handle full cells differently + if (this%VF(i,j,k).lt.VFlo.or.this%VF(i,j,k).gt.VFhi) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + cycle + end if + + ! Now identify the local topology from moments of inertia + fvol=0.0_WP; fbary=0.0_WP; Imom=0.0_WP + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + fvol =fvol +this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + fbary=fbary+this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk)*this%Lbary(:,ii,jj,kk) + end do + end do + end do + fbary=fbary/fvol + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + xtmp=this%Lbary(1,ii,jj,kk)-fbary(1) + ytmp=this%Lbary(2,ii,jj,kk)-fbary(2) + ztmp=this%Lbary(3,ii,jj,kk)-fbary(3) + Imom(1,1)=Imom(1,1)+(ytmp**2+ztmp**2)*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + Imom(2,2)=Imom(2,2)+(xtmp**2+ztmp**2)*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + Imom(3,3)=Imom(3,3)+(xtmp**2+ytmp**2)*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + Imom(1,2)=Imom(1,2)-xtmp*ytmp*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + Imom(1,3)=Imom(1,3)-xtmp*ztmp*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + Imom(2,3)=Imom(2,3)-ytmp*ztmp*this%cfg%vol(ii,jj,kk)*this%VF(ii,jj,kk) + end do + end do + end do + call dsyev('V','U',order,Imom,order,d,work,lwork,info); d=max(0.0_WP,d) + + ! Apply different reconstruction for different topologies + if (d(2).lt.this%art_threshold*sqrt(d(1)*d(3))) then + + ! ==================================================== ! + ! THE SHAPE COULD BE SPHEROIDAL OR SHEET-LIKE, USE R2P ! + ! ==================================================== ! + ! Prepare R2P neighborhood + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip true wall cells - bconds can be used here + if (this%mask(ii,jj,kk).eq.1) cycle + ! Add cell to our neighborhood + call addMember(nh_r2p,neighborhood_cells(ind),separated_volume_moments(ind)) + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + call construct(separated_volume_moments(ind),[this%VF(ii,jj,kk)*this%cfg%vol(ii,jj,kk),this%Lbary(:,ii,jj,kk),(1.0_WP-this%VF(ii,jj,kk))*this%cfg%vol(ii,jj,kk),this%Gbary(:,ii,jj,kk)]) + ! Trap and set stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) then + icenter=ind + call setCenterOfStencil(nh_r2p,icenter) + end if + ! Increment counter + ind=ind+1 + end do + end do + end do + surface_area=0.0_WP + do ind=0,getSize(this%triangle_moments_storage(i,j,k))-1 + call getMoments(this%triangle_moments_storage(i,j,k),ind,volume_moments_and_normal) + surface_area=surface_area+getVolume(volume_moments_and_normal) + end do + call setSurfaceArea(nh_r2p,surface_area) + + ! Made it this far, we need a reconstruction - this builds the initial guess + if (getSize(this%triangle_moments_storage(i,j,k)).gt.0) then + call reconstructAdvectedNormals(this%triangle_moments_storage(i,j,k),nh_r2p,this%twoplane_threshold,this%liquid_gas_interface(i,j,k)) + if (getNumberOfPlanes(this%liquid_gas_interface(i,j,k)).eq.1) then + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + initial_norm=normalize(this%Gbary(:,i,j,k)-this%Lbary(:,i,j,k)) + initial_dist=dot_product(initial_norm,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)]) + call setPlane(this%liquid_gas_interface(i,j,k),0,initial_norm,initial_dist) + call matchVolumeFraction(neighborhood_cells(icenter),this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + end if + else + ! No interface was advected in our cell, use MoF + call reconstructMOF3D(neighborhood_cells(icenter),separated_volume_moments(icenter),this%liquid_gas_interface(i,j,k)) + ! Surface area not set cause no advected moments, set for current MOF reconstruction + call setSurfaceArea(nh_r2p,getSA(neighborhood_cells(icenter),this%liquid_gas_interface(i,j,k))) + end if + + ! Perform R2P reconstruction + call reconstructR2P3D(nh_r2p,this%liquid_gas_interface(i,j,k)) + + ! Clean up neighborhood + call emptyNeighborhood(nh_r2p) + + else + + ! ===================================== ! + ! THE SHAPE IS LIGAMENT-LIKE, USE LVIRA ! + ! ===================================== ! + ! Set neighborhood_cells and liquid_volume_fraction to current correct values + ind=0 + do kk=k-1,k+1 + do jj=j-1,j+1 + do ii=i-1,i+1 + ! Skip true wall cells - bconds can be used here + if (this%mask(ii,jj,kk).eq.1) cycle + ! Add cell to neighborhood + call addMember(nh_lvr,neighborhood_cells(ind),liquid_volume_fraction(ind)) + ! Build the cell + call construct_2pt(neighborhood_cells(ind),[this%cfg%x(ii),this%cfg%y(jj),this%cfg%z(kk)],[this%cfg%x(ii+1),this%cfg%y(jj+1),this%cfg%z(kk+1)]) + ! Assign volume fraction + liquid_volume_fraction(ind)=this%VF(ii,jj,kk) + ! Trap and set stencil center + if (ii.eq.i.and.jj.eq.j.and.kk.eq.k) then + icenter=ind + call setCenterOfStencil(nh_lvr,icenter) + end if + ! Increment counter + ind=ind+1 + end do + end do + end do + + ! Formulate initial guess + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + initial_norm=normalize(this%Gbary(:,i,j,k)-this%Lbary(:,i,j,k)) + initial_dist=dot_product(initial_norm,[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)]) + call setPlane(this%liquid_gas_interface(i,j,k),0,initial_norm,initial_dist) + call matchVolumeFraction(neighborhood_cells(icenter),this%VF(i,j,k),this%liquid_gas_interface(i,j,k)) + + ! Perform the reconstruction + call reconstructLVIRA3D(nh_lvr,this%liquid_gas_interface(i,j,k)) + + ! Clean up neighborhood + call emptyNeighborhood(nh_lvr) + + end if + + end do + end do + end do + + ! Synchronize across boundaries + call this%sync_interface() + + end subroutine build_art + + + !> Set all domain boundaries to full liquid/gas based on VOF value + subroutine set_full_bcond(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + ! In X- + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino,this%cfg%imin-1 + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + ! In X+ + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imax+1,this%cfg%imaxo + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + ! In Y- + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino,this%cfg%jmin-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + ! In Y+ + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmax+1,this%cfg%jmaxo + do i=this%cfg%imino_,this%cfg%imaxo_ + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + ! In Z- + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) then + do k=this%cfg%kmino,this%cfg%kmin-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + ! In Z+ + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) then + do k=this%cfg%kmax+1,this%cfg%kmaxo + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,[0.0_WP,0.0_WP,0.0_WP],sign(1.0_WP,this%VF(i,j,k)-0.5_WP)) + end do + end do + end do + end if + end subroutine set_full_bcond + + + !> Polygonalization of the IRL interface (calculates SD at the same time) + !> Here, only mask=1 is skipped (i.e., real walls), so bconds should be handled + subroutine polygonalize_interface(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,n + real(WP) :: tsd + type(RectCub_type) :: cell + real(WP), dimension(1:3,1:4) :: vert + real(WP), dimension(1:3) :: norm + + ! Create a cell object + call new(cell) + + ! Loop over full domain and form polygon + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Zero out the polygons + do n=1,max_interface_planes + call zeroPolygon(this%interface_polygon(n,i,j,k)) + end do + ! Skip wall cells only here + if (this%mask(i,j,k).eq.1) cycle + ! Create polygons for cells with interfaces, zero for those without + if (this%VF(i,j,k).ge.VFlo.and.this%VF(i,j,k).le.VFhi) then + call construct_2pt(cell,[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + do n=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + call getPoly(cell,this%liquid_gas_interface(i,j,k),n-1,this%interface_polygon(n,i,j,k)) + end do + end if + end do + end do + end do + + ! Find inferface between filled and empty cells on x-face + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + if (this%VF(i,j,k).lt.VFlo.and.this%VF(i-1,j,k).gt.VFhi.or.this%VF(i,j,k).gt.VFhi.and.this%VF(i-1,j,k).lt.VFlo) then + if (this%mask(i,j,k).eq.1.or.this%mask(i-1,j,k).eq.1) cycle + norm=[sign(1.0_WP,0.5_WP-this%VF(i,j,k)),0.0_WP,0.0_WP] + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,norm,sign(1.0_WP,0.5_WP-this%VF(i,j,k))*this%cfg%x(i)) + vert(:,1)=[this%cfg%x(i),this%cfg%y(j ),this%cfg%z(k )] + vert(:,2)=[this%cfg%x(i),this%cfg%y(j+1),this%cfg%z(k )] + vert(:,3)=[this%cfg%x(i),this%cfg%y(j+1),this%cfg%z(k+1)] + vert(:,4)=[this%cfg%x(i),this%cfg%y(j ),this%cfg%z(k+1)] + call construct(this%interface_polygon(1,i,j,k),4,vert) + call setPlaneOfExistence(this%interface_polygon(1,i,j,k),getPlane(this%liquid_gas_interface(i,j,k),0)) + if (this%VF(i,j,k).gt.VFhi) call reversePtOrdering(this%interface_polygon(1,i,j,k)) + end if + end do + end do + end do + + ! Find inferface between filled and empty cells on y-face + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%VF(i,j,k).lt.VFlo.and.this%VF(i,j-1,k).gt.VFhi.or.this%VF(i,j,k).gt.VFhi.and.this%VF(i,j-1,k).lt.VFlo) then + if (this%mask(i,j,k).eq.1.or.this%mask(i,j-1,k).eq.1) cycle + norm=[0.0_WP,sign(1.0_WP,0.5_WP-this%VF(i,j,k)),0.0_WP] + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,norm,sign(1.0_WP,0.5_WP-this%VF(i,j,k))*this%cfg%y(j)) + vert(:,1)=[this%cfg%x(i ),this%cfg%y(j),this%cfg%z(k )] + vert(:,2)=[this%cfg%x(i ),this%cfg%y(j),this%cfg%z(k+1)] + vert(:,3)=[this%cfg%x(i+1),this%cfg%y(j),this%cfg%z(k+1)] + vert(:,4)=[this%cfg%x(i+1),this%cfg%y(j),this%cfg%z(k )] + call construct(this%interface_polygon(1,i,j,k),4,vert) + call setPlaneOfExistence(this%interface_polygon(1,i,j,k),getPlane(this%liquid_gas_interface(i,j,k),0)) + if (this%VF(i,j,k).gt.VFhi) call reversePtOrdering(this%interface_polygon(1,i,j,k)) + end if + end do + end do + end do + + ! Find inferface between filled and empty cells on z-face + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%VF(i,j,k).lt.VFlo.and.this%VF(i,j,k-1).gt.VFhi.or.this%VF(i,j,k).gt.VFhi.and.this%VF(i,j,k-1).lt.VFlo) then + if (this%mask(i,j,k).eq.1.or.this%mask(i,j,k-1).eq.1) cycle + norm=[0.0_WP,0.0_WP,sign(1.0_WP,0.5_WP-this%VF(i,j,k))] + call setNumberOfPlanes(this%liquid_gas_interface(i,j,k),1) + call setPlane(this%liquid_gas_interface(i,j,k),0,norm,sign(1.0_WP,0.5_WP-this%VF(i,j,k))*this%cfg%z(k)) + vert(:,1)=[this%cfg%x(i ),this%cfg%y(j ),this%cfg%z(k)] + vert(:,2)=[this%cfg%x(i+1),this%cfg%y(j ),this%cfg%z(k)] + vert(:,3)=[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k)] + vert(:,4)=[this%cfg%x(i ),this%cfg%y(j+1),this%cfg%z(k)] + call construct(this%interface_polygon(1,i,j,k),4,vert) + call setPlaneOfExistence(this%interface_polygon(1,i,j,k),getPlane(this%liquid_gas_interface(i,j,k),0)) + if (this%VF(i,j,k).gt.VFhi) call reversePtOrdering(this%interface_polygon(1,i,j,k)) + end if + end do + end do + end do + + ! Now compute surface area divided by cell volume + this%SD=0.0_WP + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) cycle + tsd=0.0_WP + do n=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(this%interface_polygon(n,i,j,k)).gt.0) then + tsd=tsd+abs(calculateVolume(this%interface_polygon(n,i,j,k))) + end if + end do + this%SD(i,j,k)=tsd/this%cfg%vol(i,j,k) + end do + end do + end do + + end subroutine polygonalize_interface + + + !> Update a surfmesh object from our current polygons + subroutine update_surfmesh(this,smesh) + use surfmesh_class, only: surfmesh + implicit none + class(vfs), intent(inout) :: this + class(surfmesh), intent(inout) :: smesh + integer :: i,j,k,n,shape,nv,np,nplane + real(WP), dimension(3) :: tmp_vert + + ! Reset surface mesh storage + call smesh%reset() + + ! First pass to count how many vertices and polygons are inside our processor + nv=0; np=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + do nplane=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + shape=getNumberOfVertices(this%interface_polygon(nplane,i,j,k)) + if (shape.gt.0) then + nv=nv+shape + np=np+1 + end if + end do + end do + end do + end do + + ! Reallocate storage and fill out arrays + if (np.gt.0) then + call smesh%set_size(nvert=nv,npoly=np) + allocate(smesh%polyConn(smesh%nVert)) ! Also allocate naive connectivity + nv=0; np=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + do nplane=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + shape=getNumberOfVertices(this%interface_polygon(nplane,i,j,k)) + if (shape.gt.0) then + ! Increment polygon counter + np=np+1 + smesh%polySize(np)=shape + ! Loop over its vertices and add them + do n=1,shape + tmp_vert=getPt(this%interface_polygon(nplane,i,j,k),n-1) + ! Increment node counter + nv=nv+1 + smesh%xVert(nv)=tmp_vert(1) + smesh%yVert(nv)=tmp_vert(2) + smesh%zVert(nv)=tmp_vert(3) + smesh%polyConn(nv)=nv + end do + end if + end do + end do + end do + end do + else + ! Add a zero-area triangle if this proc doesn't have one + np=1; nv=3 + call smesh%set_size(nvert=nv,npoly=np) + allocate(smesh%polyConn(smesh%nVert)) ! Also allocate naive connectivity + smesh%xVert(1:3)=this%cfg%x(this%cfg%imin) + smesh%yVert(1:3)=this%cfg%y(this%cfg%jmin) + smesh%zVert(1:3)=this%cfg%z(this%cfg%kmin) + smesh%polySize(1)=3 + smesh%polyConn(1:3)=[1,2,3] + end if + + end subroutine update_surfmesh + + + !> Calculate distance from polygonalized interface inside the band + !> Domain edges are not done here + subroutine distance_from_polygon(this) + implicit none + class(vfs), intent(inout) :: this + integer :: ni,i,j,k,ii,jj,kk,index + real(IRL_double), dimension(3) :: pos,nearest_pt + + ! First reset distance + this%G=huge(1.0_WP) + + ! Loop over 1/2-band + do index=1,sum(this%band_count(0:distance_band)) + i=this%band_map(1,index) + j=this%band_map(2,index) + k=this%band_map(3,index) + ! Get cell centroid location + pos=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + ! Loop over neighboring polygons and compute distance + do kk=k-2,k+2 + do jj=j-2,j+2 + do ii=i-2,i+2 + do ni=1,getNumberOfPlanes(this%liquid_gas_interface(ii,jj,kk)) + if (getNumberOfVertices(this%interface_polygon(ni,ii,jj,kk)).ne.0) then + nearest_pt=calculateNearestPtOnSurface(this%interface_polygon(ni,ii,jj,kk),pos) + nearest_pt=pos-nearest_pt + this%G(i,j,k)=min(this%G(i,j,k),dot_product(nearest_pt,nearest_pt)) + end if + end do + end do + end do + end do + this%G(i,j,k)=sqrt(this%G(i,j,k)) + ! Only need to consult planes in own cell to know sign + ! Even "empty" cells have one plane, which is really far away from it.. + if (.not.isPtInt(pos,this%liquid_gas_interface(i,j,k))) this%G(i,j,k)=-this%G(i,j,k) + end do + + ! Clip distance field and sign it properly + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (abs(this%G(i,j,k)).gt.this%Gclip) this%G(i,j,k)=sign(this%Gclip,this%VF(i,j,k)-0.5_WP) + end do + end do + end do + + ! Sync boundaries + call this%cfg%sync(this%G) + + end subroutine distance_from_polygon + + + !> Calculate subcell phasic volumes from reconstructed interface + !> Here, only mask=1 is skipped (i.e., real walls), so bconds are handled + subroutine subcell_vol(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,ii,jj,kk + real(WP), dimension(0:2) :: subx,suby,subz + type(RectCub_type) :: cell + type(SepVM_type) :: separated_volume_moments + + ! Allocate IRL objects for moment calculation + call new(cell) + call new(separated_volume_moments) + + ! Compute subcell liquid and gas information + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Deal with walls only - we do compute inside bconds here + if (this%mask(i,j,k).eq.1) then + this%Lvol(:,:,:,i,j,k)=0.0_WP + this%Gvol(:,:,:,i,j,k)=0.0_WP + cycle + end if + ! Deal with other cells + if (this%VF(i,j,k).gt.VFhi) then + this%Lvol(:,:,:,i,j,k)=0.125_WP*this%cfg%vol(i,j,k) + this%Gvol(:,:,:,i,j,k)=0.0_WP + else if (this%VF(i,j,k).lt.VFlo) then + this%Lvol(:,:,:,i,j,k)=0.0_WP + this%Gvol(:,:,:,i,j,k)=0.125_WP*this%cfg%vol(i,j,k) + else + ! Prepare subcell extent + subx=[this%cfg%x(i),this%cfg%xm(i),this%cfg%x(i+1)] + suby=[this%cfg%y(j),this%cfg%ym(j),this%cfg%y(j+1)] + subz=[this%cfg%z(k),this%cfg%zm(k),this%cfg%z(k+1)] + ! Loop over sub-cells + do kk=0,1 + do jj=0,1 + do ii=0,1 + call construct_2pt(cell,[subx(ii),suby(jj),subz(kk)],[subx(ii+1),suby(jj+1),subz(kk+1)]) + call getNormMoments(cell,this%liquid_gas_interface(i,j,k),separated_volume_moments) + this%Lvol(ii,jj,kk,i,j,k)=getVolume(separated_volume_moments,0) + this%Gvol(ii,jj,kk,i,j,k)=getVolume(separated_volume_moments,1) + end do + end do + end do + end if + end do + end do + end do + + end subroutine subcell_vol + + + !> Reset volumetric moments based on reconstructed interface + !> NGA finishes this with a comm - I removed it as it does not seem useful + subroutine reset_volume_moments(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + type(RectCub_type) :: cell + type(SepVM_type) :: separated_volume_moments + + ! Calculate volume moments and store + call new(cell) + call new(separated_volume_moments) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Handle pure wall cells + if (this%mask(i,j,k).eq.1) then + this%VF(i,j,k) =0.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + cycle + end if + ! Form the grid cell + call construct_2pt(cell,[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + ! Cut it by the current interface(s) + call getNormMoments(cell,this%liquid_gas_interface(i,j,k),separated_volume_moments) + ! Recover relevant moments + this%VF(i,j,k) =getVolumePtr(separated_volume_moments,0)/this%cfg%vol(i,j,k) + this%Lbary(:,i,j,k)=getCentroid(separated_volume_moments,0) + this%Gbary(:,i,j,k)=getCentroid(separated_volume_moments,1) + ! Clean up + if (this%VF(i,j,k).lt.VFlo) then + this%VF(i,j,k) =0.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + if (this%VF(i,j,k).gt.VFhi) then + this%VF(i,j,k) =1.0_WP + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + end do + end do + end do + + ! NGA had comms here: unclear to me why it would be necessary... + ! Synchronize VF field + !call this%cfg%sync(this%VF) + ! Synchronize and clean-up barycenter fields + !call this%sync_and_clean_barycenters() + + end subroutine reset_volume_moments + + ! Reset only moments, leave VF unchanged + subroutine reset_moments(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k + type(RectCub_type) :: cell + type(SepVM_type) :: separated_volume_moments + + ! Calculate volume moments and store + call new(cell) + call new(separated_volume_moments) + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Handle pure wall cells + if (this%mask(i,j,k).eq.1) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + cycle + end if + ! Form the grid cell + call construct_2pt(cell,[this%cfg%x(i),this%cfg%y(j),this%cfg%z(k)],[this%cfg%x(i+1),this%cfg%y(j+1),this%cfg%z(k+1)]) + ! Cut it by the current interface(s) + call getNormMoments(cell,this%liquid_gas_interface(i,j,k),separated_volume_moments) + ! Recover relevant moments + this%Lbary(:,i,j,k)=getCentroid(separated_volume_moments,0) + this%Gbary(:,i,j,k)=getCentroid(separated_volume_moments,1) + ! Clean up + if (this%VF(i,j,k).lt.VFlo) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + if (this%VF(i,j,k).gt.VFhi) then + this%Lbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + this%Gbary(:,i,j,k)=[this%cfg%xm(i),this%cfg%ym(j),this%cfg%zm(k)] + end if + end do + end do + end do + + end subroutine reset_moments + + + !> Compute curvature from a least squares fit of the IRL surface + subroutine get_curvature(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,n + real(WP), dimension(max_interface_planes) :: mycurv,mysurf + real(WP), dimension(max_interface_planes,3) :: mynorm + real(WP), dimension(3) :: csn,sn + ! Reset curvature + this%curv=0.0_WP + ! Traverse interior domain and compute curvature in cells with polygons + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Zero out curvature and surface storage + mycurv=0.0_WP; mysurf=0.0_WP; mynorm=0.0_WP + ! Get a curvature for each plane + do n=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + ! Skip empty polygon + if (getNumberOfVertices(this%interface_polygon(n,i,j,k)).eq.0) cycle + ! Perform LSQ PLIC barycenter fitting to get curvature + call this%paraboloid_fit(i,j,k,n,mycurv(n)) + ! Perform PLIC surface fitting to get curvature + !call this%paraboloid_integral_fit(i,j,k,n,mycurv(n)) + ! Also store surface and normal + mysurf(n) =abs(calculateVolume(this%interface_polygon(n,i,j,k))) + mynorm(n,:)= calculateNormal(this%interface_polygon(n,i,j,k)) + end do + ! Oriented-surface-average curvature + !csn=0.0_WP; sn=0.0_WP + !do n=1,getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + ! csn=csn+mysurf(n)*mynorm(n,:)*mycurv(n) + ! sn = sn+mysurf(n)*mynorm(n,:) + !end do + !if (dot_product(sn,sn).gt.10.0_WP*tiny(1.0_WP)) this%curv(i,j,k)=dot_product(csn,sn)/dot_product(sn,sn) + ! Surface-averaged curvature + if (sum(mysurf).gt.0.0_WP) this%curv(i,j,k)=sum(mysurf*mycurv)/sum(mysurf) + ! Curvature of largest surface + !if (mysurf(maxloc(mysurf,1)).gt.0.0_WP) this%curv(i,j,k)=mycurv(maxloc(mysurf,1)) + ! Largest curvature + !this%curv(i,j,k)=mycurv(maxloc(abs(mycurv),1)) + ! Smallest curvature + !if (getNumberOfPlanes(this%liquid_gas_interface(i,j,k)).eq.2) then + ! this%curv(i,j,k)=mycurv(minloc(abs(mycurv),1)) + !else + ! this%curv(i,j,k)=mycurv(1) + !end if + ! Clip curvature - may not be needed if we select polygons carefully + this%curv(i,j,k)=max(min(this%curv(i,j,k),this%maxcurv_times_mesh/this%cfg%meshsize(i,j,k)),-this%maxcurv_times_mesh/this%cfg%meshsize(i,j,k)) + end do + end do + end do + ! Synchronize boundaries + call this%cfg%sync(this%curv) + end subroutine get_curvature + + + !> Perform local paraboloid fit of IRL surface in pointwise sense + subroutine paraboloid_fit(this,i,j,k,iplane,mycurv) + use mathtools, only: normalize,cross_product + implicit none + ! In/out variables + class(vfs), intent(inout) :: this + integer, intent(in) :: i,j,k,iplane + real(WP), intent(out) :: mycurv + ! Variables used to process the polygonal surface + real(WP), dimension(3) :: pref,nref,tref,sref + real(WP), dimension(3) :: ploc,nloc + real(WP), dimension(3) :: buf + real(WP) :: surf,ww + integer :: n,ii,jj,kk,ndata,info + ! Storage for least squares problem + real(WP), dimension(125,6) :: A=0.0_WP + real(WP), dimension(125) :: b=0.0_WP + real(WP), dimension(6) :: sol + real(WP), dimension(200) :: work + ! Curvature evaluation + real(WP) :: dF_dt,dF_ds,ddF_dtdt,ddF_dsds,ddF_dtds + + ! Store polygon centroid - this is our reference point + pref=calculateCentroid(this%interface_polygon(iplane,i,j,k)) + + ! Create local basis from polygon normal + nref=calculateNormal(this%interface_polygon(iplane,i,j,k)) + select case (maxloc(abs(nref),1)) + case (1); tref=normalize([+nref(2),-nref(1),0.0_WP]) + case (2); tref=normalize([0.0_WP,+nref(3),-nref(2)]) + case (3); tref=normalize([-nref(3),0.0_WP,+nref(1)]) + end select; sref=cross_product(nref,tref) + + ! Collect all data + ndata=0 + do kk=k-2,k+2 + do jj=j-2,j+2 + do ii=i-2,i+2 + + ! Skip the cell if it's a true wall + if (this%mask(ii,jj,kk).eq.1) cycle + + ! Check all planes + do n=1,getNumberOfPlanes(this%liquid_gas_interface(ii,jj,kk)) + + ! Skip empty polygon + if (getNumberOfVertices(this%interface_polygon(n,ii,jj,kk)).eq.0) cycle + + ! Get local polygon normal + nloc=calculateNormal(this%interface_polygon(n,ii,jj,kk)) + + ! Store triangle centroid, and surface + ploc= calculateCentroid(this%interface_polygon(n,ii,jj,kk)) + surf=abs(calculateVolume (this%interface_polygon(n,ii,jj,kk)))/this%cfg%meshsize(i,j,k)**2 + + ! Transform polygon barycenter to a local coordinate system + buf=(ploc-pref)/this%cfg%meshsize(i,j,k); ploc=[dot_product(buf,nref),dot_product(buf,tref),dot_product(buf,sref)] + + ! Distance from ref point AND projected surface weighting (clipped to ensure positivity) + ww=surf*max(dot_product(nloc,nref),0.0_WP)*wgauss(sqrt(dot_product(ploc,ploc)),2.5_WP) + + ! If we have data, add it to the LS problem + if (ww.gt.0.0_WP) then + ! Increment counter + ndata=ndata+1 + ! Store least squares matrix and RHS + A(ndata,1)=sqrt(ww)*1.0_WP + A(ndata,2)=sqrt(ww)*ploc(2) + A(ndata,3)=sqrt(ww)*ploc(3) + A(ndata,4)=sqrt(ww)*0.5_WP*ploc(2)*ploc(2) + A(ndata,5)=sqrt(ww)*0.5_WP*ploc(3)*ploc(3) + A(ndata,6)=sqrt(ww)*1.0_WP*ploc(2)*ploc(3) + b(ndata )=sqrt(ww)*ploc(1) + end if + + end do + + end do + end do + end do + + ! Solve for surface as n=F(t,s)=b1+b2*t+b3*s+b4*t^2+b5*s^2+b6*t*s using Lapack + call dgels('N',ndata,6,1,A,125,b,125,work,200,info); sol=b(1:6) + + ! Get the curvature at (t,s)=(0,0) + dF_dt=sol(2)+sol(4)*0.0_WP+sol(6)*0.0_WP; ddF_dtdt=sol(4) + dF_ds=sol(3)+sol(5)*0.0_WP+sol(6)*0.0_WP; ddF_dsds=sol(5) + ddF_dtds=sol(6) + mycurv=-((1.0_WP+dF_dt**2)*ddF_dsds-2.0_WP*dF_dt*dF_ds*ddF_dtds+(1.0_WP+dF_ds**2)*ddF_dtdt)/(1.0_WP+dF_dt**2+dF_ds**2)**(1.5_WP) + mycurv=mycurv/this%cfg%meshsize(i,j,k) + + contains + + ! Some weighting function - h=0.75 looks okay + real(WP) function wkernel(d,h) + implicit none + real(WP), intent(in) :: d,h + wkernel=(1.0_WP+(d/h)**2)**(-1.4_WP) + end function wkernel + + ! Tri-cubic Weighting function - h=2 looks okay + real(WP) function tricubic(d,h) + implicit none + real(WP), intent(in) :: d,h + if (d.ge.h) then + tricubic=0.0_WP + else + tricubic=(1.0_WP-(d/h)**3)**3 + end if + end function tricubic + + ! Quasi-Gaussian weighting function - h=2.5 looks okay + real(WP) function wgauss(d,h) + implicit none + real(WP), intent(in) :: d,h + if (d.ge.h) then + wgauss=0.0_WP + else + wgauss=(1.0_WP+4.0_WP*d/h)*(1.0_WP-d/h)**4 + end if + end function wgauss + + end subroutine paraboloid_fit + + + !> Perform local paraboloid fit of IRL surface in integral sense + subroutine paraboloid_integral_fit(this,i,j,k,iplane,mycurv) + use mathtools, only: normalize,cross_product + implicit none + ! In/out variables + class(vfs), intent(inout) :: this + integer, intent(in) :: i,j,k,iplane + real(WP), intent(out) :: mycurv + ! Variables used to process the polygons + real(WP), dimension(3) :: pref,nref,tref,sref + real(WP), dimension(3) :: vert1,vert2,ploc,nloc + real(WP), dimension(3) :: buf,reconst_plane_coeffs + integer :: nplane,shape,n,ii,jj,kk,ai,aj + real(WP), dimension(6) :: integrals + real(WP) :: xv,xvn,yv,yvn,ww,b_dot_sum + ! Storage for symmetric problem + real(WP), dimension(6,6) :: A + integer , dimension(6) :: ipiv + real(WP), dimension(6) :: b + real(WP), dimension(6) :: sol + real(WP), dimension(:), allocatable :: work + real(WP), dimension(1) :: lwork_query + integer :: lwork,info + ! Curvature evaluation + real(WP) :: dF_dt,dF_ds,ddF_dtdt,ddF_dsds,ddF_dtds + + ! Store polygon centroid - this is our reference point + pref=calculateCentroid(this%interface_polygon(iplane,i,j,k)) + + ! Create local basis from polygon normal + nref=calculateNormal(this%interface_polygon(iplane,i,j,k)) + select case (maxloc(abs(nref),1)) + case (1); tref=normalize([+nref(2),-nref(1),0.0_WP]) + case (2); tref=normalize([0.0_WP,+nref(3),-nref(2)]) + case (3); tref=normalize([-nref(3),0.0_WP,+nref(1)]) + end select; sref=cross_product(nref,tref) + + ! Collect all data + A=0.0_WP + b=0.0_WP + do kk=k-2,k+2 + do jj=j-2,j+2 + do ii=i-2,i+2 + + ! Skip the cell if it's a true wall + if (this%mask(ii,jj,kk).eq.1) cycle + + ! Check all planes + do nplane=1,getNumberOfPlanes(this%liquid_gas_interface(ii,jj,kk)) + + ! Skip empty polygon + shape=getNumberOfVertices(this%interface_polygon(nplane,ii,jj,kk)) + if (shape.eq.0) cycle + + ! Get local polygon normal and skip if normal is not aligned with center polygon normal + nloc=calculateNormal(this%interface_polygon(nplane,ii,jj,kk)) + if (dot_product(nloc,nref).le.0.0_WP) cycle + + ! Get local polygon centroid + ploc=calculateCentroid(this%interface_polygon(nplane,ii,jj,kk)) + + ! Transform normal and centroid to a local coordinate system + buf=(ploc-pref)/this%cfg%meshsize(i,j,k); ploc=[dot_product(buf,tref),dot_product(buf,sref),dot_product(buf,nref)] + buf=nloc; nloc=[dot_product(buf,tref),dot_product(buf,sref),dot_product(buf,nref)] + + ! Get plane coefficients + reconst_plane_coeffs(1)=-dot_product(nloc,ploc) + reconst_plane_coeffs(2)=nloc(1) + reconst_plane_coeffs(3)=nloc(2) + reconst_plane_coeffs=reconst_plane_coeffs/(-nloc(3)) + + ! Get integrals + integrals=0.0_WP + b_dot_sum=0.0_WP + do n=1,shape + vert1=getPt(this%interface_polygon(nplane,ii,jj,kk),n-1) + vert2=getPt(this%interface_polygon(nplane,ii,jj,kk),modulo(n,shape)) + ! Transform vertices to a local coordinate system + buf=(vert1-pref)/this%cfg%meshsize(i,j,k); vert1=[dot_product(buf,tref),dot_product(buf,sref),dot_product(buf,nref)] + buf=(vert2-pref)/this%cfg%meshsize(i,j,k); vert2=[dot_product(buf,tref),dot_product(buf,sref),dot_product(buf,nref)] + ! Add to area integral + xv=vert1(1); xvn=vert2(1); yv=vert1(2); yvn=vert2(2) + integrals = integrals + [& + (xv*yvn - xvn*yv) / 2.0_WP, & + (xv + xvn)*(xv*yvn - xvn*yv) / 6.0_WP, & + (yv + yvn)*(xv*yvn - xvn*yv) / 6.0_WP, & + (xv + xvn)*(xv**2 + xvn**2)*(yvn - yv) / 12.0_WP, & + (yvn - yv)*(3.0_WP*xv**2*yv + xv**2*yvn + 2.0_WP*xv*xvn*yv + 2.0_WP*xv*xvn*yvn + xvn**2*yv + 3.0_WP*xvn**2*yvn)/24.0_WP, & + (xv - xvn)*(yv + yvn)*(yv**2 + yvn**2) / 12.0_WP] + end do + b_dot_sum=b_dot_sum+dot_product(reconst_plane_coeffs,integrals(1:3)) + + ! Get weighting + ww=wgauss(sqrt(dot_product(ploc,ploc)),2.5_WP) + + ! Add to symmetric matrix and RHS + do aj=1,6 + do ai=1,aj + A(ai,aj)=A(ai,aj)+ww*integrals(ai)*integrals(aj) + end do + end do + b=b+ww*integrals*b_dot_sum + + end do + end do + end do + end do + + ! Query optimal work array size then solve for paraboloid as n=F(t,s)=b1+b2*t+b3*s+b4*t^2+b5*t*s+b6*s^2 + call dsysv('U',6,1,A,6,ipiv,b,6,lwork_query,-1,info); lwork=int(lwork_query(1)); allocate(work(lwork)) + call dsysv('U',6,1,A,6,ipiv,b,6,work,lwork,info); sol=b(1:6) + + ! Get the curvature at (t,s)=(0,0) + dF_dt=sol(2)+2.0_WP*sol(4)*0.0_WP+sol(5)*0.0_WP; ddF_dtdt=2.0_WP*sol(4) + dF_ds=sol(3)+2.0_WP*sol(6)*0.0_WP+sol(5)*0.0_WP; ddF_dsds=2.0_WP*sol(6) + ddF_dtds=sol(5) + mycurv=-((1.0_WP+dF_dt**2)*ddF_dsds-2.0_WP*dF_dt*dF_ds*ddF_dtds+(1.0_WP+dF_ds**2)*ddF_dtdt)/(1.0_WP+dF_dt**2+dF_ds**2)**(1.5_WP) + mycurv=mycurv/this%cfg%meshsize(i,j,k) + + contains + + ! Quasi-Gaussian weighting function - h=2.5 looks okay + real(WP) function wgauss(d,h) + implicit none + real(WP), intent(in) :: d,h + if (d.ge.h) then + wgauss=0.0_WP + else + wgauss=(1.0_WP+4.0_WP*d/h)*(1.0_WP-d/h)**4 + end if + end function wgauss + + end subroutine paraboloid_integral_fit + + + !> Private function to rapidly assess if a mixed cell is possible + pure function crude_phase_test(this,b_ind) result(crude_phase) + implicit none + class(vfs), intent(in) :: this + integer, dimension(3,2), intent(in) :: b_ind + real(WP) :: crude_phase + integer :: i,j,k + ! Check if originating cell is mixed, continue if not + crude_phase=this%VF(b_ind(1,2),b_ind(2,2),b_ind(3,2)) + if (crude_phase.ge.VFlo.and.crude_phase.le.VFhi) then + ! Already have a mixed cell, we need the full geometry + crude_phase=-1.0_WP; return + end if + ! Check cells in bounding box + do k=b_ind(3,1),b_ind(3,2) + do j=b_ind(2,1),b_ind(2,2) + do i=b_ind(1,1),b_ind(1,2) + if (this%VF(i,j,k).ne.crude_phase) then + ! We could have changed phase, we need the full geometry + crude_phase=-1.0_WP; return + end if + end do + end do + end do + ! Ensure proper values + if (crude_phase.gt.VFhi) then + crude_phase=1.0_WP + else if (crude_phase.lt.VFlo) then + crude_phase=0.0_WP + end if + end function crude_phase_test + + + !> Private function that performs a Lagrangian projection of a vertex p1 to position p2 + !> using the provided velocity U/V/W, time step dt, and a guess of the i/j/k + function project(this,p1,i,j,k,dt,U,V,W) result(p2) + implicit none + class(vfs), intent(inout) :: this + real(WP), dimension(3), intent(in) :: p1 + integer, intent(in) :: i,j,k + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(3) :: p2 + ! Explicit RK4 + !real(WP), dimension(3) :: v1,v2,v3,v4 + !v1=this%cfg%get_velocity(p1 ,i,j,k,U,V,W) + !v2=this%cfg%get_velocity(p1+0.5_WP*dt*v1,i,j,k,U,V,W) + !v3=this%cfg%get_velocity(p1+0.5_WP*dt*v2,i,j,k,U,V,W) + !v4=this%cfg%get_velocity(p1+ dt*v3,i,j,k,U,V,W) + !p2=p1+dt/6.0_WP*(v1+2.0_WP*v2+2.0_WP*v3+v4) + ! For implicit RK2 + real(WP), dimension(3) :: p2old,v1 + real(WP) :: tolerance + integer :: iter + p2=p1 + tolerance=(1.0e-3_WP*this%cfg%min_meshsize)*(1.0e-3_WP*this%cfg%min_meshsize) + do iter=1,10 + v1=this%cfg%get_velocity(0.5_WP*(p1+p2),i,j,k,U,V,W) + p2old=p2 + p2=p1+dt*v1 + if (dot_product(p2-p2old,p2-p2old).lt.tolerance) exit + end do + end function project + + + !> Calculate the min/max/int of our VF field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN + use parallel, only: MPI_REAL_WP + implicit none + class(vfs), intent(inout) :: this + integer :: ierr + real(WP) :: my_VFmax,my_VFmin + my_VFmax=maxval(this%VF); call MPI_ALLREDUCE(my_VFmax,this%VFmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + my_VFmin=minval(this%VF); call MPI_ALLREDUCE(my_VFmin,this%VFmin,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) + call this%cfg%integrate(this%VF,integral=this%VFint) + call this%cfg%integrate(this%SD,integral=this%SDint) + end subroutine get_max + + + !> Write an IRL interface to a file + subroutine write_interface(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(vfs), intent(inout) :: this + character(len=*), intent(in) :: filename + logical :: file_is_there + integer :: i,j,k,ind,ierr + type(MPI_File) :: ifile + type(MPI_Status) :: status + integer(kind=MPI_OFFSET_KIND) :: disp + integer :: size_to_write + integer, dimension(3) :: dims + integer, dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: number_of_planes + integer(kind=MPI_OFFSET_KIND), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: offset_to_planes + integer, dimension(this%cfg%ny_*this%cfg%nz ) :: array_of_block_lengths + integer(kind=MPI_ADDRESS_KIND), dimension(this%cfg%ny_*this%cfg%nz_) :: array_of_displacements + type(MPI_Datatype) :: MPI_OFFSET_ARRAY_TYPE + type(ByteBuffer_type) :: byte_buffer + + ! Open the file + inquire(file=trim(filename),exist=file_is_there) + if (file_is_there.and.this%cfg%amRoot) call MPI_FILE_DELETE(trim(filename),info_mpiio,ierr) + call MPI_FILE_OPEN(this%cfg%comm,trim(adjustl(filename)),IOR(MPI_MODE_WRONLY,MPI_MODE_CREATE),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[vfs interface write] Problem encountered while opening IRL data file: '//trim(filename)) + + ! Write dimensions in header + if (this%cfg%amRoot) then + dims=[this%cfg%nx,this%cfg%ny,this%cfg%nz] + call MPI_FILE_WRITE(ifile,dims,3,MPI_INTEGER,status,ierr) + end if + + ! Calculate and store number of planes in each cell + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + number_of_planes(i,j,k)=getNumberOfPlanes(this%liquid_gas_interface(i,j,k)) + end do + end do + end do + + ! Write out number of planes in each cell + disp=int(4,8)*int(3,8) !< Only 3 int(4) - would need two more r(8) if we add time and dt + call MPI_FILE_SET_VIEW(ifile,disp,MPI_INTEGER,this%cfg%Iview,'native',info_mpiio,ierr) + call MPI_FILE_WRITE_ALL(ifile,number_of_planes(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%nx_*this%cfg%ny_*this%cfg%nz_,MPI_INTEGER,status,ierr) + + ! Calculate the offset to each plane, needed for reading + call this%calculate_offset_to_planes(number_of_planes,offset_to_planes) + + ! Make custom offset vector type for offsets + ind=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + ind=ind+1 + array_of_block_lengths(ind)=int((offset_to_planes(this%cfg%imax_,j,k)-offset_to_planes(this%cfg%imin_,j,k)),4)+4+number_of_planes(this%cfg%imax_,j,k)*4*8+8 + array_of_displacements(ind)=int(offset_to_planes(this%cfg%imin_,j,k),MPI_ADDRESS_KIND) + end do + end do + call MPI_TYPE_CREATE_HINDEXED(this%cfg%ny_*this%cfg%nz_,array_of_block_lengths,array_of_displacements,MPI_BYTE,MPI_OFFSET_ARRAY_TYPE,ierr) + call MPI_TYPE_COMMIT(MPI_OFFSET_ARRAY_TYPE,ierr) + + ! Write out the actual PlanarSeps as packed bytes + call new(byte_buffer) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + call serializeAndPack(this%liquid_gas_interface(i,j,k),byte_buffer) + end do + end do + end do + disp=disp+int(4*this%cfg%nx*this%cfg%ny*this%cfg%nz,MPI_OFFSET_KIND) + call MPI_FILE_SET_VIEW(ifile,disp,MPI_BYTE,MPI_OFFSET_ARRAY_TYPE,'native',info_mpiio,ierr) + size_to_write=int(getSize(byte_buffer),4) + call MPI_FILE_WRITE_ALL(ifile,dataPtr(byte_buffer),size_to_write,MPI_BYTE,status,ierr) + + ! Close file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Free the type + call MPI_TYPE_FREE(MPI_OFFSET_ARRAY_TYPE,ierr) + + end subroutine write_interface + + + !> Read an IRL interface from a file + subroutine read_interface(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(vfs), intent(inout) :: this + character(len=*), intent(in) :: filename + integer :: i,j,k,ind,ierr + type(MPI_File) :: ifile + type(MPI_Status) :: status + integer(kind=MPI_OFFSET_KIND) :: disp,size_to_read + integer, dimension(3) :: dims + integer, dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: number_of_planes + integer(kind=MPI_OFFSET_KIND), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: offset_to_planes + integer, dimension(this%cfg%ny_*this%cfg%nz ) :: array_of_block_lengths + integer(kind=MPI_ADDRESS_KIND), dimension(this%cfg%ny_*this%cfg%nz_) :: array_of_displacements + type(MPI_Datatype) :: MPI_OFFSET_ARRAY_TYPE + type(ByteBuffer_type) :: byte_buffer + + ! Open the file + call MPI_FILE_OPEN(this%cfg%comm,trim(adjustl(filename)),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[vfs interface read] Problem encountered while reading IRL data file: '//trim(filename)) + + ! Read dimensions from header + call MPI_FILE_READ_ALL(ifile,dims,4,MPI_INTEGER,status,ierr) + + ! Throw error if size mismatch + if ((dims(1).ne.this%cfg%nx).or.(dims(2).ne.this%cfg%ny).or.(dims(3).ne.this%cfg%nz)) then + if (this%cfg%amRoot) then + print*, ' grid size = ',this%cfg%nx,this%cfg%ny,this%cfg%nz + print*, 'IRL file size = ',dims(1),dims(2),dims(3) + end if + call die('[vfs interface read] The size of the interface file does not correspond to the grid') + end if + + ! Read in number of planes + call MPI_FILE_GET_POSITION(ifile,disp,ierr) + call MPI_FILE_SET_VIEW(ifile,disp,MPI_INTEGER,this%cfg%Iview,'native',info_mpiio,ierr) + call MPI_FILE_READ_ALL(ifile,number_of_planes(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%nx_*this%cfg%ny_*this%cfg%nz_,MPI_INTEGER,status,ierr) + + ! Fill in ghost cells for number of planes + call this%cfg%sync(number_of_planes) + + ! Calculate the offset to each plane, needed for reading + call this%calculate_offset_to_planes(number_of_planes,offset_to_planes) + + ! Make custom offset vector type for offsets + ind=0 + size_to_read=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + ind=ind+1 + array_of_block_lengths(ind)=int((offset_to_planes(this%cfg%imax_,j,k)-offset_to_planes(this%cfg%imin_,j,k)),4)+4+number_of_planes(this%cfg%imax_,j,k)*4*8+8 + size_to_read=size_to_read+int(array_of_block_lengths(ind),MPI_OFFSET_KIND) + array_of_displacements(ind)=int(offset_to_planes(this%cfg%imin_,j,k),MPI_ADDRESS_KIND) + end do + end do + call MPI_TYPE_CREATE_HINDEXED(this%cfg%ny_*this%cfg%nz_,array_of_block_lengths,array_of_displacements,MPI_BYTE,MPI_OFFSET_ARRAY_TYPE,ierr) + call MPI_TYPE_COMMIT(MPI_OFFSET_ARRAY_TYPE,ierr) + + ! Read in the bytes and pack in to buffer, then loop through and unpack to PlanarSep + call new(byte_buffer); call setSize(byte_buffer,size_to_read) + if (size_to_read.ne.int(size_to_read,4)) call die('[vfs read interface] Cannot read that much data using the current I/O strategy') !< I/O WILL CRASH FOR IRL DATA >2Go/PROCESS + disp=disp+int(4*this%cfg%nx*this%cfg%ny*this%cfg%nz,MPI_OFFSET_KIND) + call MPI_FILE_SET_VIEW(ifile,disp,MPI_BYTE,MPI_OFFSET_ARRAY_TYPE,'native',info_mpiio,ierr) + call MPI_FILE_READ_ALL(ifile,dataPtr(byte_buffer),int(size_to_read,4),MPI_BYTE,status,ierr) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + call unpackAndStore(this%liquid_gas_interface(i,j,k),byte_buffer) + end do + end do + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Free the type + call MPI_TYPE_FREE(MPI_OFFSET_ARRAY_TYPE,ierr) + + ! Communicate interfaces + call this%sync_interface() + + end subroutine read_interface + + + !> Find byte offset for I/O of interface + subroutine calculate_offset_to_planes(this,number_of_planes,offset_to_planes) + use mpi_f08 + implicit none + class(vfs), intent(in) :: this + integer, dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: number_of_planes !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer(kind=MPI_OFFSET_KIND), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: offset_to_planes !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + integer(IRL_LargeOffsetIndex_t) :: nbytes + integer :: isrc,idst,ierr + type(MPI_Status) :: status + + ! Zero the offset to planes + offset_to_planes=int(0,MPI_OFFSET_KIND) + + ! Calculate offsets in x direction + isrc=this%cfg%xrank-1 + idst=this%cfg%xrank+1 + ! If leftmost processor, calculate offsets + if (this%cfg%iproc.eq.1) then + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + nbytes=0 + do i=this%cfg%imin_,this%cfg%imax_+1 + offset_to_planes(i,j,k)=nbytes + nbytes=nbytes+int(4,MPI_OFFSET_KIND)+int(number_of_planes(i,j,k),MPI_OFFSET_KIND)*int(4,MPI_OFFSET_KIND)*int(8,MPI_OFFSET_KIND)+int(8,MPI_OFFSET_KIND) + end do + end do + end do + if (this%cfg%iproc.ne.this%cfg%npx) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%ny_*this%cfg%nz_,MPI_INTEGER8,idst,0,this%cfg%xcomm,ierr) + else + ! Receive from the left processor + call MPI_RECV(offset_to_planes(this%cfg%imin_-1,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%ny_*this%cfg%nz_,MPI_INTEGER8,isrc,0,this%cfg%xcomm,status,ierr) + ! Calculate my offsets now that I know where my neighbor ended + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + nbytes=offset_to_planes(this%cfg%imin_-1,j,k) + do i=this%cfg%imin_,this%cfg%imax_+1 + offset_to_planes(i,j,k)=nbytes + nbytes=nbytes+int(4,MPI_OFFSET_KIND)+int(number_of_planes(i,j,k),MPI_OFFSET_KIND)*int(4,MPI_OFFSET_KIND)*int(8,MPI_OFFSET_KIND)+int(8,MPI_OFFSET_KIND) + end do + end do + end do + ! If not rightmost processor, send to next processor on the right + if (this%cfg%iproc.ne.this%cfg%npx) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%ny_*this%cfg%nz_,MPI_INTEGER8,idst,0,this%cfg%xcomm,ierr) + end if + + ! Calculate offsets in y direction + if (this%cfg%iproc.eq.this%cfg%npx) then + isrc=this%cfg%yrank-1 + idst=this%cfg%yrank+1 + ! If bottom processor, calculate offsets + if (this%cfg%jproc.eq.1) then + do k=this%cfg%kmin_,this%cfg%kmax_ + nbytes=0 + do j=this%cfg%jmin_,this%cfg%jmax_ + offset_to_planes(this%cfg%imax_+1,j,k)=offset_to_planes(this%cfg%imax_+1,j,k)+nbytes + nbytes=offset_to_planes(this%cfg%imax_+1,j,k) + end do + end do + if (this%cfg%jproc.ne.this%cfg%npy) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%nz_,MPI_INTEGER8,idst,0,this%cfg%ycomm,ierr) + else + ! Receive from the bottom processor + call MPI_RECV(offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_-1,this%cfg%kmin_:this%cfg%kmax_),this%cfg%nz_,MPI_INTEGER8,isrc,0,this%cfg%ycomm,status,ierr) + ! Calculate my offsets now that I know where my neighbor ended + do k=this%cfg%kmin_,this%cfg%kmax_ + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_-1,k) + do j=this%cfg%jmin_,this%cfg%jmax_ + offset_to_planes(this%cfg%imax_+1,j,k)=offset_to_planes(this%cfg%imax_+1,j,k)+nbytes + nbytes=offset_to_planes(this%cfg%imax_+1,j,k) + end do + end do + ! Send to the top processor, sent to next processor above + if (this%cfg%jproc.ne.this%cfg%npy) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),this%cfg%nz_,MPI_INTEGER8,idst,0,this%cfg%ycomm,ierr) + end if + end if + + ! Calculate offsets in z direction + if (this%cfg%iproc.eq.this%cfg%npx.and.this%cfg%jproc.eq.this%cfg%npy) then + isrc=this%cfg%zrank-1 + idst=this%cfg%zrank+1 + ! If first processor in z, calculate offsets + if (this%cfg%kproc.eq.1) then + nbytes=0 + do k=this%cfg%kmin_,this%cfg%kmax_ + offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k)=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k)+nbytes + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k) + end do + if (this%cfg%kproc.ne.this%cfg%npz) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmax_),1,MPI_INTEGER8,idst,0,this%cfg%zcomm,ierr) + else + ! Receive from the previous processor + call MPI_RECV(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_-1),1,MPI_INTEGER8,isrc,0,this%cfg%zcomm,status,ierr) + ! Calculate my offsets now that I know where my neighbor ended + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_-1) + do k=this%cfg%kmin_,this%cfg%kmax_ + offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k)=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k)+nbytes + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k) + end do + ! If not last processor in z, send to the next proc in z + if (this%cfg%kproc.ne.this%cfg%npz) call MPI_SEND(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmax_),1,MPI_INTEGER8,idst,0,this%cfg%zcomm,ierr) + end if + end if + + ! Now need to unravel all this to update all of the offsets + ! Be informed and add the j-offsets + call MPI_BCAST(offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_-1:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_),(this%cfg%ny_+1)*this%cfg%nz_,MPI_INTEGER8,this%cfg%npx-1,this%cfg%xcomm,ierr) + do k=this%cfg%kmin_,this%cfg%kmax_ + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmin_-1,k) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + offset_to_planes(i,j,k)=offset_to_planes(i,j,k)+nbytes + end do + nbytes=offset_to_planes(this%cfg%imax_+1,j,k) + end do + end do + ! Be informed and add the z-offsets + if (this%cfg%jproc.eq.this%cfg%npy) call MPI_BCAST(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_-1:this%cfg%kmax_),this%cfg%nz_+1,MPI_INTEGER8,this%cfg%npx-1,this%cfg%xcomm,ierr) + call MPI_BCAST(offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_-1:this%cfg%kmax_),this%cfg%nz_+1,MPI_INTEGER8,this%cfg%npy-1,this%cfg%ycomm,ierr) + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,this%cfg%kmin_-1) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + offset_to_planes(i,j,k)=offset_to_planes(i,j,k)+nbytes + end do + end do + nbytes=offset_to_planes(this%cfg%imax_+1,this%cfg%jmax_,k) + end do + + end subroutine calculate_offset_to_planes + + + !> Synchronize IRL objects across processors + subroutine sync_interface(this) + implicit none + class(vfs), intent(inout) :: this + integer :: i,j,k,ni + real(WP), dimension(1:4) :: plane + integer , dimension(2,3) :: send_range,recv_range + ! Synchronize in x + if (this%cfg%nx.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call copy(this%liquid_gas_interface(i,j,k),this%liquid_gas_interface(this%cfg%imin,j,k)) + end do + end do + end do + else + ! Send minus + send_range(1:2,1)=[this%cfg%imin_ ,this%cfg%imin_ +this%cfg%no-1] + send_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + send_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + recv_range(1:2,1)=[this%cfg%imax_ +1,this%cfg%imaxo_ ] + recv_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + recv_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + call this%sync_side(send_range,recv_range,0,-1) + ! Send plus + send_range(1:2,1)=[this%cfg%imax_ -this%cfg%no+1,this%cfg%imax_ ] + send_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + send_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + recv_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imin_ -1] + recv_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + recv_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + call this%sync_side(send_range,recv_range,0,+1) + end if + ! Synchronize in y + if (this%cfg%ny.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call copy(this%liquid_gas_interface(i,j,k),this%liquid_gas_interface(i,this%cfg%jmin,k)) + end do + end do + end do + else + ! Send minus side + send_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + send_range(1:2,2)=[this%cfg%jmin_ ,this%cfg%jmin_ +this%cfg%no-1] + send_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + recv_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + recv_range(1:2,2)=[this%cfg%jmax_ +1,this%cfg%jmaxo_ ] + recv_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + call this%sync_side(send_range,recv_range,1,-1) + ! Send plus side + send_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + send_range(1:2,2)=[this%cfg%jmax_ -this%cfg%no+1,this%cfg%jmax_ ] + send_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + recv_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + recv_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmin_ -1] + recv_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmaxo_ ] + call this%sync_side(send_range,recv_range,1,+1) + end if + ! Synchronize in z + if (this%cfg%nz.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + call copy(this%liquid_gas_interface(i,j,k),this%liquid_gas_interface(i,j,this%cfg%kmin)) + end do + end do + end do + else + ! Send minus side + send_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + send_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + send_range(1:2,3)=[this%cfg%kmin_ ,this%cfg%kmin_ +this%cfg%no-1] + recv_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + recv_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + recv_range(1:2,3)=[this%cfg%kmax_ +1,this%cfg%kmaxo_ ] + call this%sync_side(send_range,recv_range,2,-1) + ! Send plus side + send_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + send_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + send_range(1:2,3)=[this%cfg%kmax_ -this%cfg%no+1,this%cfg%kmax_ ] + recv_range(1:2,1)=[this%cfg%imino_ ,this%cfg%imaxo_ ] + recv_range(1:2,2)=[this%cfg%jmino_ ,this%cfg%jmaxo_ ] + recv_range(1:2,3)=[this%cfg%kmino_ ,this%cfg%kmin_ -1] + call this%sync_side(send_range,recv_range,2,+1) + end if + ! Fix plane posistion if we are periodic in x + if (this%cfg%xper.and.this%cfg%iproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino,this%cfg%imin-1 + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)-plane(1)*this%cfg%xL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + if (this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imax+1,this%cfg%imaxo + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)+plane(1)*this%cfg%xL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + ! Fix plane position if we are periodic in y + if (this%cfg%yper.and.this%cfg%jproc.eq.1) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino,this%cfg%jmin-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)-plane(2)*this%cfg%yL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + if (this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) then + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmax+1,this%cfg%jmaxo + do i=this%cfg%imino_,this%cfg%imaxo_ + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)+plane(2)*this%cfg%yL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + ! Fix plane posistion if we are periodic in z + if (this%cfg%zper.and.this%cfg%kproc.eq.1) then + do k=this%cfg%kmino,this%cfg%kmin-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)-plane(3)*this%cfg%zL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + if (this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) then + do k=this%cfg%kmax+1,this%cfg%kmaxo + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + do ni=0,getNumberOfPlanes(this%liquid_gas_interface(i,j,k))-1 + plane=getPlane(this%liquid_gas_interface(i,j,k),ni) + plane(4)=plane(4)+plane(3)*this%cfg%zL + call setPlane(this%liquid_gas_interface(i,j,k),ni,plane(1:3),plane(4)) + end do + end do + end do + end do + end if + end subroutine sync_interface + + + !> Private procedure to perform communication across one boundary + subroutine sync_side(this,a_send_range,a_recv_range,a_dimension,a_direction) + implicit none + class(vfs), intent(inout) :: this + integer, dimension(2,3), intent(in) :: a_send_range + integer, dimension(2,3), intent(in) :: a_recv_range + integer, intent(in) :: a_dimension + integer, intent(in) :: a_direction + integer :: i,j,k + logical :: something_received + ! Pack the buffer + call resetBufferPointer(this%send_byte_buffer) + call setSize(this%send_byte_buffer,int(0,8)) + do k=a_send_range(1,3),a_send_range(2,3) + do j=a_send_range(1,2),a_send_range(2,2) + do i=a_send_range(1,1),a_send_range(2,1) + call serializeAndPack(this%liquid_gas_interface(i,j,k),this%send_byte_buffer) + end do + end do + end do + ! Communicate + call this%sync_ByteBuffer(this%send_byte_buffer,a_dimension,a_direction,this%recv_byte_buffer,something_received) + ! If something was received, unpack it: traversal order is important and must be aligned with how the sent data was packed + if (something_received) then + call resetBufferPointer(this%recv_byte_buffer) + do k=a_recv_range(1,3),a_recv_range(2,3) + do j=a_recv_range(1,2),a_recv_range(2,2) + do i=a_recv_range(1,1),a_recv_range(2,1) + call unpackAndStore(this%liquid_gas_interface(i,j,k),this%recv_byte_buffer) + end do + end do + end do + end if + end subroutine sync_side + + + !> Private procedure to communicate a package of bytes across one boundary + subroutine sync_ByteBuffer(this,a_send_buffer,a_dimension,a_direction,a_receive_buffer,a_received_something) + use mpi_f08 + implicit none + class(vfs), intent(inout) :: this + type(ByteBuffer_type), intent(inout) :: a_send_buffer !< Inout needed because it is preallocated + integer, intent(in) :: a_dimension !< Should be 0/1/2 for x/y/z + integer, intent(in) :: a_direction !< Should be -1 for left or +1 for right + type(ByteBuffer_type), intent(inout) :: a_receive_buffer !< Inout needed because it is preallocated + logical, intent(out) :: a_received_something + type(MPI_Status) :: status + integer :: isrc,idst,ierr + integer(IRL_LargeOffsetIndex_t) :: my_size + integer(IRL_LargeOffsetIndex_t) :: incoming_size + integer :: my_size_small,incoming_size_small + ! Figure out source and destination + call MPI_CART_SHIFT(this%cfg%comm,a_dimension,a_direction,isrc,idst,ierr) + ! Communicate sizes so that each processor knows what to expect in main communication + my_size=getSize(a_send_buffer) + call MPI_SENDRECV(my_size,1,MPI_INTEGER8,idst,0,incoming_size,1,MPI_INTEGER8,isrc,0,this%cfg%comm,status,ierr) + ! Set size of recv buffer to appropriate size and perform send-receive + if (isrc.ne.MPI_PROC_NULL) then + a_received_something=.true. + call setSize(a_receive_buffer,incoming_size) + else + a_received_something=.false. + incoming_size=0 + call setSize(a_receive_buffer,int(1,8)) + end if + ! Convert integers + my_size_small=int(my_size,4) + incoming_size_small=int(incoming_size,4) + call MPI_SENDRECV(dataPtr(a_send_buffer),my_size_small,MPI_BYTE,idst,0,dataPtr(a_receive_buffer),incoming_size_small,MPI_BYTE,isrc,0,this%cfg%comm,status,ierr) + end subroutine sync_ByteBuffer + + + !> Calculate the CFL + subroutine get_cfl(this,dt,U,V,W,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(vfs), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(out) :: cfl + integer :: i,j,k,ierr + real(WP) :: my_CFL + + ! Set the CFL to zero + my_CFL=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + my_CFL=max(my_CFL,abs(U(i,j,k))*this%cfg%dxmi(i)) + my_CFL=max(my_CFL,abs(V(i,j,k))*this%cfg%dymi(j)) + my_CFL=max(my_CFL,abs(W(i,j,k))*this%cfg%dzmi(k)) + end do + end do + end do + my_CFL=my_CFL*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFL,cfl,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + end subroutine get_cfl + + + !> Print out info for vf solver + subroutine vfs_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(vfs), intent(in) :: this + ! Output + if (this%cfg%amRoot) then + write(output_unit,'("Volume fraction solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + end if + end subroutine vfs_print + + +end module vfs_class diff --git a/examples/falling_drop/src/simulation.f90 b/examples/falling_drop/src/simulation.f90 index 53be1f136..ba8ca3c82 100644 --- a/examples/falling_drop/src/simulation.f90 +++ b/examples/falling_drop/src/simulation.f90 @@ -1,352 +1,353 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use tpns_class, only: tpns - use vfs_class, only: vfs - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Single two-phase flow solver and volume fraction solver and corresponding time tracker - type(tpns), public :: fs - type(vfs), public :: vf - type(timetracker), public :: time - - !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - - public :: simulation_init,simulation_run,simulation_final - - !> Private work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - - !> Problem definition - real(WP), dimension(3) :: center - real(WP) :: radius,depth - + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP), dimension(3) :: center + real(WP) :: radius,depth + contains - - + + !> Function that defines a level set function for a falling drop problem - function levelset_falling_drop(xyz,t) result(G) - implicit none - real(WP), dimension(3),intent(in) :: xyz - real(WP), intent(in) :: t - real(WP) :: G - ! Create the droplet - G=radius-sqrt(sum((xyz-center)**2)) - ! Add the pool - G=max(G,depth-xyz(2)) - end function levelset_falling_drop - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: lvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver - vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') - ! Initialize to a droplet and a pool - center=[0.0_WP,0.5_WP,0.0_WP] - radius=0.1_WP - depth =0.2_WP - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - ! Call adaptive refinement code to get volume and barycenters recursively - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) - vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) - if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then - vf%Lbary(:,i,j,k)=v_cent - vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) - else - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end if - end do - end do - end do - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a two-phase flow solver without bconds - create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg - use mathtools, only: Pi - ! Create flow solver - fs=tpns(cfg=cfg,name='Two-phase NS') - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l) - call param_read('Gas dynamic viscosity',fs%visc_g) - ! Assign constant density to each phase - call param_read('Liquid density',fs%rho_l) - call param_read('Gas density',fs%rho_g) - ! Read in surface tension coefficient - call param_read('Surface tension coefficient',fs%sigma) - call param_read('Static contact angle',fs%contact_angle) - fs%contact_angle=fs%contact_angle*Pi/180.0_WP - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet + G=radius-sqrt(sum((xyz-center)**2)) + ! Add the pool + G=max(G,depth-xyz(2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.05_WP,0.0_WP] + radius=0.01_WP + depth =0.02_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=gmres_amg,implicit_ils=gmres_amg) - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Calculate cell-centered velocities and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='FallingDrop') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VOF',vf%VF) - call ens_out%add_scalar('curvature',vf%curv) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call vf%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLst,'STension CFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old VOF - vf%VFold=vf%VF - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Apply time-varying Dirichlet conditions - ! This is where time-dpt Dirichlet would be enforced - - ! Prepare old staggered density (at n) - call fs%get_olddensity(vf=vf) - - ! VOF solver step - call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) - - ! Prepare new staggered viscosity (at n+1) - call fs%get_viscosity(vf=vf) - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Preliminary mass and momentum transport step at the interface - call fs%prepare_advection_upwind(dt=time%dt) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU - resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV - resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply other boundary conditions - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%update_laplacian() - call fs%correct_mfr() - call fs%get_div() - call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho_U - fs%V=fs%V-time%dt*resV/fs%rho_V - fs%W=fs%W-time%dt*resW/fs%rho_W - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call vf%get_max() - call mfile%write() - call cflfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - - - - - -end module simulation + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + +end module simulation \ No newline at end of file diff --git a/examples/film/GNUmakefile b/examples/film/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/film/GNUmakefile +++ b/examples/film/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/shock_particle/GNUmakefile b/examples/filmKH/GNUmakefile similarity index 78% rename from examples/shock_particle/GNUmakefile rename to examples/filmKH/GNUmakefile index 676358efc..c4825c881 100644 --- a/examples/shock_particle/GNUmakefile +++ b/examples/filmKH/GNUmakefile @@ -7,6 +7,7 @@ USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE USE_IRL = TRUE +USE_ODRPACK=FALSE PROFILE = FALSE DEBUG = FALSE COMP = gnu @@ -22,16 +23,13 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre -IRL_DIR = /Users/jcaps/Research/Codes/Builds/IRL -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := core two_phase particles data solver config grid libraries +Bdirs := core two_phase data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/filmKH/README b/examples/filmKH/README new file mode 100644 index 000000000..9b6f62bec --- /dev/null +++ b/examples/filmKH/README @@ -0,0 +1 @@ +This is an implementation of an immiscible (two-phase) Kelvin-Helmholtz problem. diff --git a/examples/filmKH/input b/examples/filmKH/input new file mode 100644 index 000000000..ee460fa86 --- /dev/null +++ b/examples/filmKH/input @@ -0,0 +1,35 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Lx : 32 +Liquid Ly : 4 +Gas Ly : 12 +Lz : 1e-1 +nx : 320 +ny : 160 +nz : 1 + +# Fluid properties and inital profile +Gas Reynolds number : 1000 +Gas Weber number : 1 +Viscosity ratio : 10 !< This is mu_l/mu_g +Density ratio : 50 !< This is rho_l/rho_g +Static contact angle : 60 + +# Time integration +Max timestep size : 1e-1 +Max cfl number : 0.9 +Max time : 400 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 +Postproc output period : 10 diff --git a/examples/shock_particle/src/Make.package b/examples/filmKH/src/Make.package similarity index 100% rename from examples/shock_particle/src/Make.package rename to examples/filmKH/src/Make.package diff --git a/examples/filmKH/src/geometry.f90 b/examples/filmKH/src/geometry.f90 new file mode 100644 index 000000000..1d9d0bac1 --- /dev/null +++ b/examples/filmKH/src/geometry.f90 @@ -0,0 +1,84 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Lyl,Lyg,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Liquid Ly',Lyl); call param_read('Gas Ly',Lyg); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*(Lyl+Lyg)-Lyl + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='MPKH') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + if (j.lt.cfg%jmin) then + cfg%VF(i,j,k)=0.0_WP + else + cfg%VF(i,j,k)=1.0_WP + end if + end do + end do + end do + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/filmKH/src/simulation.f90 b/examples/filmKH/src/simulation.f90 new file mode 100644 index 000000000..d293a2ab3 --- /dev/null +++ b/examples/filmKH/src/simulation.f90 @@ -0,0 +1,568 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP) :: Reg,Weg,r_visc,r_rho + integer :: nwaveX,nwaveZ + real(WP), dimension(:), allocatable :: wnumbX,wshiftX,wampX,wnumbZ,wshiftZ,wampZ + + !> Post-processing + type(event) :: ppevt + +contains + + + !> Function that defines a level set function for a initial wavy interface + function levelset_wavy(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + integer :: nX,nZ + G=-xyz(2) + do nX=1,nwaveX + do nZ=1,nwaveZ + G=G+wampX(nX)*cos(wnumbX(nX)*(xyz(1)-wshiftX(nX)))*wampZ(nZ)*cos(wnumbZ(nZ)*(xyz(3)-wshiftZ(nZ))) + end do + end do + end function levelset_wavy + + + !> Specialized subroutine that outputs the vertical liquid distribution + subroutine postproc_data() + use mathtools, only: Pi + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: myVOF,VOF + real(WP), dimension(:), allocatable :: myVEL,VEL + character(len=str_medium) :: filename,timestamp + ! Allocate vertical line storage + allocate(myVOF(vf%cfg%jmin:vf%cfg%jmax)); myVOF=0.0_WP + allocate(myVEL(vf%cfg%jmin:vf%cfg%jmax)); myVEL=0.0_WP + allocate( VOF(vf%cfg%jmin:vf%cfg%jmax)); VOF=0.0_WP + allocate( VEL(vf%cfg%jmin:vf%cfg%jmax)); VEL=0.0_WP + ! Initialize local data to zero + myVOF=0.0_WP; myVEL=0.0_WP + ! Integrate all data over x and z + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + myVOF(j)=myVOF(j)+vf%VF(i,j,k) + myVEL(j)=myVEL(j)+fs%U(i,j,k) + end do + end do + end do + ! All-reduce the data + call MPI_ALLREDUCE(myVOF,VOF,vf%cfg%ny,MPI_REAL_WP,MPI_SUM,vf%cfg%comm,ierr); VOF=VOF/real(vf%cfg%nx*vf%cfg%nz,WP) + call MPI_ALLREDUCE(myVEL,VEL,vf%cfg%ny,MPI_REAL_WP,MPI_SUM,vf%cfg%comm,ierr); VEL=VEL/real(vf%cfg%nx*vf%cfg%nz,WP) + ! If root, print it out + if (vf%cfg%amRoot) then + call execute_command_line('mkdir -p stats') + filename='profile_' + write(timestamp,'(es12.5)') time%t + open(newunit=iunit,file='stats/'//trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) + write(iunit,'(a12,3x,a12,3x,a12)') 'Height','VOF','VEL' + do j=vf%cfg%jmin,vf%cfg%jmax + write(iunit,'(es12.5,3x,es12.5,3x,es12.5)') vf%cfg%ym(j),VOF(j),VEL(j) + end do + close(iunit) + end if + ! Deallocate work arrays + deallocate(myVOF,VOF) + deallocate(myVEL,VEL) + end subroutine postproc_data + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + use mathtools, only: twoPi + use random, only: random_uniform + use parallel, only: MPI_REAL_WP + use mpi_f08 + integer :: i,j,k,n,si,sj,sk,ierr + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Prepare initialize interface parameters + nwaveX=6 + allocate(wnumbX(nwaveX),wshiftX(nwaveX),wampX(nwaveX)) + wampX=0.3_WP/real(nwaveX,WP) + wnumbX=[3.0_WP,4.0_WP,5.0_WP,6.0_WP,7.0_WP,8.0_WP]*twoPi/cfg%xL + if (cfg%amRoot) then + do n=1,nwaveX + wshiftX(n)=random_uniform(lo=-0.5_WP*cfg%xL,hi=+0.5_WP*cfg%xL) + end do + end if + call MPI_BCAST(wshiftX,nwaveX,MPI_REAL_WP,0,cfg%comm,ierr) + nwaveZ=6 + allocate(wnumbZ(nwaveZ),wshiftZ(nwaveZ),wampZ(nwaveZ)) + wampZ=0.3_WP/real(nwaveZ,WP) + wnumbZ=[3.0_WP,4.0_WP,5.0_WP,6.0_WP,7.0_WP,8.0_WP]*twoPi/cfg%zL + if (cfg%amRoot) then + do n=1,nwaveZ + wshiftZ(n)=random_uniform(lo=-0.5_WP*cfg%zL,hi=+0.5_WP*cfg%zL) + end do + end if + call MPI_BCAST(wshiftZ,nwaveZ,MPI_REAL_WP,0,cfg%comm,ierr) + ! Create the wavy interface + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_wavy,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: pcg_pfmg + use mathtools, only: Pi + integer :: i,j,k + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Read in flow conditions + call param_read('Gas Reynolds number',Reg); fs%visc_g=1.0_WP/(Reg+epsilon(Reg)) + call param_read('Viscosity ratio',r_visc); fs%visc_l=r_visc*fs%visc_g + call param_read('Density ratio',r_rho); fs%rho_g=1.0_WP; fs%rho_l=r_rho*fs%rho_g + call param_read('Gas Weber number',Weg); fs%sigma=1.0_WP/(Weg+epsilon(Weg)) + call param_read('Static contact angle',fs%contact_angle) + fs%contact_angle=fs%contact_angle*Pi/180.0_WP + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + ! Set initial velocity field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (fs%cfg%ym(j).le.0.0_WP) then + ! Use the liquid profile + fs%U(i,j,k)=0.0_WP + else + ! Use the gas profile + fs%U(i,j,k)=erf(fs%cfg%ym(j)) + end if + end do + end do + end do + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='MPKH') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(vf%SDint,'SD integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + ! Create specialized post-processing + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc_data() + end block create_postproc + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + use tpns_class, only: static_contact + implicit none + + ! Perform time integration + do while (.not.time%done())!.and.amp.lt.0.1_WP*vf%cfg%yL.and.time%t.lt.20.0_WP*tau) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf,contact_model=static_contact) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + ! Specialized post-processing + if (ppevt%occurs()) call postproc_data() + + end do + + ! Post-process growth rate using ODRPACK + ! odr_fit: block + ! use, intrinsic :: iso_fortran_env, only: output_unit + ! use mathtools, only: twoPi + ! use messager, only: log + ! use string, only: str_long + ! character(len=str_long) :: message + ! integer :: i + ! ! ODRPACK variables - explicit model based on exponential of time + ! integer :: N !> Number of observations (number of polygons) + ! integer , parameter :: M=1 !> Number of elements per explanatory variables (1 time) + ! integer , parameter :: NP=2 !> Number of parameters in our model (2 for a normalized exponential in time with time shift) + ! integer , parameter :: NQ=1 !> Number of response per observation (only 1, the normalized amplitude) + ! real(WP), dimension(NP) :: BETA=0.0_WP !> Array of model parameter values (the growth rate and time shift) + ! real(WP), dimension(:,:) , allocatable :: YY !> Value of response variable (of size LDYYxNQ) + ! integer :: LDYY !> Leading dimension of YY (equals N since an explicit model is used) + ! real(WP), dimension(:,:) , allocatable :: XX !> Value of explanatory variable (of size LDXXxM) + ! integer :: LDXX !> Leading dimension of XX (equals N) + ! real(WP), dimension(:,:,:), allocatable :: WE !> Weighting of response data (of size LDWExLD2WExNQ) + ! integer :: LDWE !> Leading dimension of WE (equals N since an explicit model is used) + ! integer :: LD2WE !> Second dimension of WE (equals NQ) + ! real(WP), dimension(:,:,:), allocatable :: WD !> Weighting of explanatory data (of size LDWDxLD2WDxM) + ! integer :: LDWD !> Leading dimension of WD (equals N) + ! integer :: LD2WD !> Second dimension of WD (equals 1) + ! integer , dimension(NP) :: IFIXB=-1 !> Whether any model parameters has to be kept constant + ! integer , parameter :: LDIFX=1 !> Leading dimension of IFIXX (equals 1) + ! integer , dimension(LDIFX,M) :: IFIXX=-1 !> Whether any explanatory variable data is to be treated as "fixed" + ! integer :: JOB=00030 !> 5-digit parameter flag that controls execution (this invokes analytical Jacobian with explicit model) + ! integer :: NDIGIT=1 !> Number of reliable digits in our model - let ODRPACK figure it out on its own + ! real(WP) :: TAUFAC=0.0_WP !> To control size of first step (ignored here) + ! real(WP) :: SSTOL=-1.0_WP !> Relative cvg of sum of squares: this sets it to 1e-8 ********* Need to change to sth else + ! real(WP) :: PARTOL=-1.0_WP !> Relative cvg for model parameters: this sets it to 1e-11 ********* Need to change to sth else + ! integer :: MAXIT=-1 !> Maximum number of iterations ********* Need to change to sth else + ! integer :: IPRINT=0 !> 4-digit parameter flag for controlling printing (default is -1) + ! integer :: LUNERR=10 !> Logical unit for error reporting (6 by default) + ! integer :: LUNRPT=10 !> Logical unit for reporting + ! real(WP), dimension(NP) :: STPB=0.0_WP !> Relative step sizes for Jacobian for model parameters (here, default) + ! integer , parameter :: LDSTPD=1 !> Leading dimension of STPD, either 1 or N (here, 1) + ! real(WP), dimension(LDSTPD,1) :: STPD=0.0_WP !> Relative step sizes for Jacobian for input errors (here, default) + ! real(WP), dimension(NP) :: SCLB=1.0_WP !> Scaling for the model parameters (here, not default but set to 1.0 to avoid rescaling 0 coefficients) + ! real(WP), dimension(:,:) , allocatable :: SCLD !> Scaling for the input errors (here, not default but set to 1.0 to avoid rescaling 0 coefficients) + ! integer :: LDSCLD !> Leading dimension of SCLD, either 1 or N (here, N) + ! integer :: LWORK !> Size of WORK array + ! real(WP), dimension(:) , allocatable :: WORK !> WORK array + ! integer , parameter :: LiWORK=20+NP+NQ*(NP+M) !> Size of IWORK array + ! integer , dimension(LiWORK) :: iWORK !> iWORK array + ! integer :: INFO !> Why the calculations stopped + ! ! Copy over data and sizes + ! N=size(all_time,dim=1) + ! LDYY=N; allocate(YY(LDYY,NQ)); YY(:,1)=all_amp/amp0 + ! LDXX=N; allocate(XX(LDXX,M )); XX(:,1)=all_time + ! LDWE=N; LD2WE=NQ; allocate(WE(LDWE,LD2WE,NQ)); WE=1.0_WP + ! LDWD=N; LD2WD=1 ; allocate(WD(LDWD,LD2WD,M )); WD=1.0_WP + ! LDSCLD=N; allocate(SCLD(LDSCLD,M)); SCLD=1.0_WP + ! LWORK=18+11*NP+NP**2+M+M**2+4*N*NQ+6*N*M+2*N*NQ*NP+2*N*NQ*M+NQ**2+5*NQ+NQ*(NP+M)+(LDWE*LD2WE)*NQ; allocate(WORK(LWORK)) + ! ! Call ODRPACK to find time shift + ! call DODRC(exponential_model,N,M,NP,NQ,BETA,YY,LDYY,XX,LDXX,WE,LDWE,LD2WE,WD,LDWD,LD2WD,IFIXB,IFIXX,LDIFX,JOB,NDIGIT,TAUFAC,& + ! & SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,STPB,STPD,LDSTPD,SCLB,SCLD,LDSCLD,WORK,LWORK,iWORK,LiWORK,INFO) + ! ! Adjust weights to eliminate the early non-exponential part + ! do i=1,size(all_time,dim=1) + ! if (all_time(i).le.2.0_WP*BETA(2)) then + ! WE(i,1,1)=0.0_WP + ! WD(i,1,1)=0.0_WP + ! end if + ! end do + ! ! Call ODRPACK again to find growth rate + ! call DODRC(exponential_model,N,M,NP,NQ,BETA,YY,LDYY,XX,LDXX,WE,LDWE,LD2WE,WD,LDWD,LD2WD,IFIXB,IFIXX,LDIFX,JOB,NDIGIT,TAUFAC,& + ! & SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,STPB,STPD,LDSTPD,SCLB,SCLD,LDSCLD,WORK,LWORK,iWORK,LiWORK,INFO) + ! ! Get back growth rate + ! if (fs%cfg%amRoot) then + ! write(output_unit,'(es12.5,x,es12.5,x,es12.5,x,es12.5)') lc,tau,twoPi/fs%cfg%xL*lc,BETA(1)*tau + ! write(message ,'("Reference time scale = ",es12.5)') tau ; call log(message) + ! write(message ,'("Cut-off length scale = ",es12.5)') lc ; call log(message) + ! write(message ,'("Normalized growth rate = ",es12.5)') BETA(1)*tau ; call log(message) + ! write(message ,'("Normalized wave number = ",es12.5)') twoPi/fs%cfg%xL*lc; call log(message) + ! end if + ! end block odr_fit + + + end subroutine simulation_run + + + !> Definition of our exponential function of time model + subroutine exponential_model(N,M,NP,NQ,LDN,LDM,LDNP,BETA,XPLUSD,IFIXB,IFIXX,LDFIX,IDEVAL,F,FJACB,FJACD,ISTOP) + implicit none + ! Input parameters + integer , intent(in) :: IDEVAL,LDFIX,LDM,LDN,LDNP,M,N,NP,NQ + integer , dimension(NP) , intent(in) :: IFIXB + integer , dimension(LDFIX,M), intent(in) :: IFIXX + real(WP), dimension(NP) , intent(in) :: BETA + real(WP), dimension(LDN,M) , intent(in) :: XPLUSD + ! Output parameters + real(WP), dimension(LDN,NQ) :: F + real(WP), dimension(LDN,LDNP,NQ) :: FJACB + real(WP), dimension(LDN,LDM ,NQ) :: FJACD + integer :: ISTOP,i + ! Check stopping condition - all values are acceptable + ISTOP=0 + ! Compute model value + if (mod(IDEVAL,10).ge.1) then + do i=1,N + F(i,1)=exp(BETA(1)*(XPLUSD(i,1)-BETA(2))) + end do + end if + ! Compute model derivatives with respect to BETA + if (mod(IDEVAL/10,10).GE.1) then + do i=1,N + FJACB(i,1,1)=(XPLUSD(i,1)-BETA(2))*exp(BETA(1)*(XPLUSD(i,1)-BETA(2))) + FJACB(i,2,1)= -BETA(1) *exp(BETA(1)*(XPLUSD(i,1)-BETA(2))) + end do + end if + ! Compute model derivatives with respect to input + if (mod(IDEVAL/100,10).GE.1) then + do i=1,N + FJACD(i,1,1)=BETA(1)*exp(BETA(1)*(XPLUSD(i,1)-BETA(2))) + end do + end if + end subroutine exponential_model + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + +end module simulation diff --git a/examples/filmRT/GNUmakefile b/examples/filmRT/GNUmakefile index 0fa3aaa03..258639eff 100644 --- a/examples/filmRT/GNUmakefile +++ b/examples/filmRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/filmRT/input b/examples/filmRT/input index d34b97514..c6473e25c 100644 --- a/examples/filmRT/input +++ b/examples/filmRT/input @@ -18,7 +18,7 @@ Liquid dynamic viscosity : 1 Gas dynamic viscosity : 0.01 Liquid density : 1000 Gas density : 1 -Surface tension coefficient : 0.3 +Surface tension coefficient : 1 # Time integration Max timestep size : 5e-3 diff --git a/examples/filmRT/src/simulation.f90 b/examples/filmRT/src/simulation.f90 index 01d2c59fb..a060555db 100644 --- a/examples/filmRT/src/simulation.f90 +++ b/examples/filmRT/src/simulation.f90 @@ -6,6 +6,7 @@ module simulation use vfs_class, only: vfs use timetracker_class, only: timetracker use ensight_class, only: ensight + use surfmesh_class, only: surfmesh use event_class, only: event use monitor_class, only: monitor implicit none @@ -19,6 +20,7 @@ module simulation !> Ensight postprocessing type(ensight) :: ens_out type(event) :: ens_evt + type(surfmesh) :: smesh !> Simulation monitor file type(monitor) :: mfile,cflfile @@ -88,7 +90,7 @@ subroutine simulation_init vf=vfs(cfg=cfg,reconstruction_method=r2p,name='VOF') ! Initialize to a thin film call param_read('Film thickness',Hfilm) - amp0=1.0e-5_WP + amp0=1.0e-3_WP do k=vf%cfg%kmino_,vf%cfg%kmaxo_ do j=vf%cfg%jmino_,vf%cfg%jmaxo_ do i=vf%cfg%imino_,vf%cfg%imaxo_ @@ -119,6 +121,8 @@ subroutine simulation_init call vf%update_band() ! Perform interface reconstruction from VOF field call vf%build_interface() + ! Set interface planes at the boundaries + call vf%set_full_bcond() ! Create discontinuous polygon mesh from IRL interface call vf%polygonalize_interface() ! Calculate distance from polygons @@ -162,6 +166,32 @@ subroutine simulation_init call fs%get_div() end block create_and_initialize_flow_solver + + ! Create surfmesh object for interface polygon output + create_smesh: block + use irl_fortran_interface + integer :: i,j,k,nplane,np + ! Include an extra variable for number of planes + smesh=surfmesh(nvar=1,name='plic') + smesh%varname(1)='nplane' + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block create_smesh + ! Add Ensight output create_ensight: block @@ -174,6 +204,7 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('VOF',vf%VF) call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_surface('vofplic',smesh) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -311,6 +342,28 @@ subroutine simulation_run call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() + ! Update surfmesh object + update_smesh: block + use irl_fortran_interface + integer :: nplane,np,i,j,k + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block update_smesh + ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/examples/fluidized_bed/GNUmakefile b/examples/fluidized_bed/GNUmakefile index 818048416..663465958 100644 --- a/examples/fluidized_bed/GNUmakefile +++ b/examples/fluidized_bed/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/fluidized_bed/input b/examples/fluidized_bed/input index 424988008..f506dfbd8 100644 --- a/examples/fluidized_bed/input +++ b/examples/fluidized_bed/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 2 1 1 +Partition : 8 1 1 # Mesh definition Lx : .0256 diff --git a/examples/fluidized_bed/src/simulation.f90 b/examples/fluidized_bed/src/simulation.f90 index 8006e426f..c0491e429 100644 --- a/examples/fluidized_bed/src/simulation.f90 +++ b/examples/fluidized_bed/src/simulation.f90 @@ -3,6 +3,8 @@ module simulation use precision, only: WP use geometry, only: cfg use lpt_class, only: lpt + use hypre_uns_class, only: hypre_uns + use hypre_str_class, only: hypre_str use lowmach_class, only: lowmach use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -11,33 +13,35 @@ module simulation use monitor_class, only: monitor implicit none private - - !> Get an LPT solver, a lowmach solver, and corresponding time tracker + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker, plus a couple of linear solvers + type(hypre_uns), public :: ps + type(hypre_str), public :: vs type(lowmach), public :: fs type(lpt), public :: lp type(timetracker), public :: time - + !> Ensight postprocessing type(partmesh) :: pmesh type(ensight) :: ens_out type(event) :: ens_evt - + !> Simulation monitor file type(monitor) :: mfile,cflfile,lptfile,tfile - + public :: simulation_init,simulation_run,simulation_final - + !> Work arrays and fluid properties real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp real(WP) :: visc,rho,inlet_velocity - + !> Wallclock time for monitoring type :: timer - real(WP) :: time_in - real(WP) :: time - real(WP) :: percent + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent end type timer type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest @@ -96,14 +100,14 @@ subroutine simulation_init ! Create a low Mach flow solver with bconds create_flow_solver: block - use ils_class, only: pcg_pfmg,pcg_amg - use lowmach_class, only: dirichlet,clipped_neumann + use hypre_uns_class, only: gmres_amg + use hypre_str_class, only: pcg_pfmg + use lowmach_class, only: dirichlet,clipped_neumann ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) - ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity @@ -111,13 +115,15 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) + ps=hypre_uns(cfg=cfg,name='Pressure',method=gmres_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) ! Setup the solver - call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_pfmg) + call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_flow_solver @@ -286,8 +292,9 @@ subroutine simulation_init ! Create monitor filea create_monitor: block ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + real(WP) :: cfl + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -356,6 +363,7 @@ subroutine simulation_run use mathtools, only: twoPi use parallel, only: parallel_time implicit none + real(WP) :: cfl ! Perform time integration do while (.not.time%done()) @@ -364,8 +372,8 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f61dc7ef2..52dbd4c18 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -5,6 +5,7 @@ NGA_HOME ?= ../.. PRECISION = DOUBLE USE_MPI = TRUE USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE PROFILE = FALSE @@ -22,10 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /usr/local/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/rgrawe/NGA2hypre -FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/input b/examples/hit/input index 0c376b4a8..563066350 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -14,19 +14,11 @@ Eddy turnover time : 0.1 # Particle properties Particle density : 0.018 Particle diameter : 1 -Number of particles : 100000 +Number of particles : 0!100000 # Time integration Max timestep size : 1e-3 Max cfl number : 0.9 -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - # Ensight output Ensight output period : 0.01 diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index c906814b1..be6cbba4e 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,8 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg - use pfft3d_class, only: pfft3d - use hypre_str_class, only: hypre_str + use fourier3d_class, only: fourier3d use incomp_class, only: incomp use lpt_class, only: lpt use timetracker_class, only: timetracker @@ -15,8 +14,7 @@ module simulation private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - !type(pfft3d), public :: ps - type(hypre_str), public :: ps + type(fourier3d), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp @@ -80,11 +78,7 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=pfft3d(cfg=cfg,name='Pressure') - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -185,7 +179,7 @@ subroutine simulation_init ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') + pmesh=partmesh(nvar=0,nvec=0,name='lpt') call lp%update_partmesh(pmesh) end block create_pmesh @@ -316,9 +310,9 @@ subroutine simulation_run end do call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) ! Calculate mean velocity - call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%fluid_vol + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%fluid_vol ! Add forcing term resU=resU+time%dt*KE0/KE*(fs%U-meanU)/(2.0_WP*tau_eddy) resV=resV+time%dt*KE0/KE*(fs%V-meanV)/(2.0_WP*tau_eddy) diff --git a/examples/ib_drop/GNUmakefile b/examples/ib_drop/GNUmakefile new file mode 100644 index 000000000..14a82a163 --- /dev/null +++ b/examples/ib_drop/GNUmakefile @@ -0,0 +1,46 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := two_phase immersed core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/ib_drop/README b/examples/ib_drop/README new file mode 100644 index 000000000..40018fe6e --- /dev/null +++ b/examples/ib_drop/README @@ -0,0 +1 @@ +This is a direct forcing IBM case that tests the interaction between IB and the two-phase flow solvers. It simulates a drop impacting a bumpy cylinder. diff --git a/examples/ib_drop/input b/examples/ib_drop/input new file mode 100644 index 000000000..1710ec8eb --- /dev/null +++ b/examples/ib_drop/input @@ -0,0 +1,41 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Lx : 0.1 +Ly : 0.1 +Lz : 0.000390625 +nx : 256 +ny : 256 +nz : 1 + +# IBM properties +Number of markers : 200 +Cylinder diameter : 0.01 +Cylinder position : 0.03 +Perturbation amp : 0.0005 +Perturbation freq : 6 + +# Fluid properties +Gravity : 0 -9.81 0 +Liquid dynamic viscosity : 1.137e-3 +Gas dynamic viscosity : 1.780e-5 +Liquid density : 1000 +Gas density : 1.226 +Surface tension coefficient : 0.0728 + +# Time integration +Max timestep size : 5e-4 +Max cfl number : 0.9 +Max time : 5 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 5e-3 \ No newline at end of file diff --git a/examples/ib_drop/src/Make.package b/examples/ib_drop/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ib_drop/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ib_drop/src/geometry.f90 b/examples/ib_drop/src/geometry.f90 new file mode 100644 index 000000000..c4d9ee6bd --- /dev/null +++ b/examples/ib_drop/src/geometry.f90 @@ -0,0 +1,70 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='ib_drop') + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + if (cfg%jproc.eq.1) cfg%VF(:,cfg%jmino:cfg%jmin-1,:)=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ib_drop/src/simulation.f90 b/examples/ib_drop/src/simulation.f90 new file mode 100644 index 000000000..f5c61ecf3 --- /dev/null +++ b/examples/ib_drop/src/simulation.f90 @@ -0,0 +1,486 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use df_class, only: dfibm + use vfs_class, only: vfs + use tpns_class, only: tpns + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, a vfs and tpns solver, and corresponding time tracker + type(vfs), public :: vf + type(tpns), public :: fs + type(dfibm), public :: df + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Problem definition + real(WP), dimension(3) :: center + real(WP) :: radius + +contains + + + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=radius-sqrt(sum((xyz-center)**2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.06_WP,0.0_WP] + radius=0.01_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use ils_class, only: gmres_amg,pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi,arctan + integer :: i,j,k,np + real(WP) :: Dcyl,Ycyl,amp,freq,theta,r + + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + + ! Read cylinder properties + call param_read('Number of markers',np) + call param_read('Cylinder diameter',Dcyl) + call param_read('Cylinder position',Ycyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =1 + df%p(i)%vel=0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm=df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(2)=df%p(i)%pos(2)+Ycyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)-Ycyl) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%G(i,j,k)=sqrt((df%cfg%xm(i))**2+(df%cfg%ym(j)-Ycyl)**2)-r + end do + end do + end do + call df%cfg%sync(df%G) + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%min_meshsize + end if + + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ib_drop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('markers',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('GIB',df%G) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + ! Get IB source terms + resU=vf%VF*fs%rho_l+(1.0_WP-vf%VF)*fs%rho_g + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) + ! Interpolate to the staggered cells and synchronize + resU=0.0_WP; resV=0.0_WP; resW=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=sum(fs%itpr_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + resV(i,j,k)=sum(fs%itpr_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + resW(i,j,k)=sum(fs%itpr_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + ! Increment velocity field + fs%U=fs%U+resU + fs%V=fs%V+resV + fs%W=fs%W+resW + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + +end module simulation diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index 936d89562..bdb62cb2b 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -6,6 +6,8 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE DEBUG = FALSE @@ -22,15 +24,13 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := constant_density core data solver config grid libraries +Bdirs := subgrid constant_density core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/ib_pipe/input b/examples/ib_pipe/input index 84a9b75be..3a98424db 100644 --- a/examples/ib_pipe/input +++ b/examples/ib_pipe/input @@ -1,33 +1,33 @@ # Parallelization -Partition : 4 1 1 +Partition : 8 1 1 # Mesh definition Pipe diameter : 1 Pipe length : 4 -nx : 256 -ny : 96 -nz : 1 +nx : 256 +ny : 64 +nz : 64 # Pipe properties -Bulk velocity : 1 -Fluctuation amp : 0.2 +Bulk velocity : 1 +Fluctuation amp : 0.2 # Time integration -Max timestep size : 0.008 -Max cfl number : 0.9 -Max time : 1000 +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 # Fluid properties -Dynamic viscosity : .001 -Density : 1 +Dynamic viscosity : 2e-4 +Density : 1 # Pressure solver -Pressure tolerance : 1e-5 -Pressure iteration : 100 +Pressure tolerance : 1e-4 +Pressure iteration : 100 # Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 +Implicit tolerance : 1e-4 +Implicit iteration : 100 # Ensight output -Ensight output period : 1 \ No newline at end of file +Ensight output period : 1 diff --git a/examples/ib_pipe/src/geometry.f90 b/examples/ib_pipe/src/geometry.f90 index 27a956cad..e9cd3b5cc 100644 --- a/examples/ib_pipe/src/geometry.f90 +++ b/examples/ib_pipe/src/geometry.f90 @@ -8,8 +8,12 @@ module geometry !> Single config type(config), public :: cfg - public :: geometry_init + !> Pipe diameter + real(WP), public :: D + public :: geometry_init,get_VF + + contains @@ -25,7 +29,7 @@ subroutine geometry_init create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz,no - real(WP) :: Lx,Ly,Lz,D,dx + real(WP) :: Lx,Ly,Lz,dx real(WP), dimension(:), allocatable :: x,y,z ! Read in grid definition @@ -34,7 +38,7 @@ subroutine geometry_init call param_read('ny',ny); allocate(y(ny+1)) call param_read('nx',nx); allocate(x(nx+1)) call param_read('nz',nz); allocate(z(nz+1)) - + dx=Lx/real(nx,WP) no=6 if (ny.gt.1) then @@ -47,7 +51,7 @@ subroutine geometry_init else Lz=dx end if - + ! Create simple rectilinear grid do i=1,nx+1 x(i)=real(i-1,WP)/real(nx,WP)*Lx @@ -63,7 +67,7 @@ subroutine geometry_init grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') end block create_grid - + ! Create a config from that grid on our entire group create_cfg: block @@ -81,11 +85,51 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=1.0_WP + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() end block create_walls end subroutine geometry_init -end module geometry + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U','u') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V','v') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W','w') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry \ No newline at end of file diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index 56c68aa1b..c767cf64b 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,363 +1,383 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use hypre_str_class, only: hypre_str - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(timetracker), public :: time - - !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP), dimension(:,:,:), allocatable :: G,VF - real(WP) :: Ubulk,Umean,Dpipe - + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use fourier3d_class, only: fourier3d + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + !type(hypre_str), public :: ps + type(fourier3d), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + contains - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create an incompressible flow solver without bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg - real(WP) :: visc - ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(VF (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our velocity field - initialize_velocity: block - use mathtools, only: twoPi - use random, only: random_uniform - integer :: i,j,k - real(WP) :: amp - ! Initial fields - call param_read('Pipe diameter',Dpipe) - call param_read('Bulk velocity',Ubulk); Umean=Ubulk - call param_read('Fluctuation amp',amp,default=0.0_WP) - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! For faster transition - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=Ubulk*(1.0_WP+random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)) - fs%V(i,j,k)=Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp) - fs%U(i,j,k)=fs%U(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) - fs%V(i,j,k)=fs%V(i,j,k)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do end do end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - ! Compute cell-centered velocity - call fs%interp_vel(Ui,Vi,Wi) - ! Compute divergence - call fs%get_div() - end block initialize_velocity - - - ! Initialize IBM fields - initialize_ibm: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - G(i,j,k)=0.5_WP*Dpipe-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do end do end do - end do - call fs%cfg%sync(VF) - call fs%cfg%sync(G) - end block initialize_ibm - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='pipe') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',VF) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(Umean,'Umean') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - - ! Add body forcing - forcing: block - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - integer :: i,j,k,ierr - real(WP) :: myU,myUvol,Uvol,VFx - myU=0.0_WP; myUvol=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - myU =myU +fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k)) - myUvol=myUvol+fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*VFx - end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + !ps%maxlevel=14 + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) end do end do - call MPI_ALLREDUCE(myUvol,Uvol ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myU ,Umean,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Umean=Umean/Uvol - resU=resU+Ubulk-Umean - end block forcing - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply direct forcing to enforce BC at the pipe walls - ibm_correction: block - integer :: i,j,k - real(WP) :: VFx,VFy,VFz - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - VF(i,j,k)=get_VF(i,j,k,'SC') - VFx =get_VF(i,j,k,'U') - VFy =get_VF(i,j,k,'V') - VFz =get_VF(i,j,k,'W') - fs%U(i,j,k)=VFx*fs%U(i,j,k) - fs%V(i,j,k)=VFy*fs%V(i,j,k) - fs%W(i,j,k)=VFz*fs%W(i,j,k) - end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) end do end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - call fs%cfg%sync(VF) - end block ibm_correction - - ! Apply other boundary conditions on the resulting fields - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho - - ! Increment sub-iteration counter - time%it=time%it+1 - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call mfile%write() - call cflfile%write() - - end do - - end subroutine simulation_run - - - !> Get volume fraction for direct forcing - function get_VF(i,j,k,dir) result(VF) - implicit none - integer, intent(in) :: i,j,k - character(len=*) :: dir - real(WP) :: VF - real(WP) :: r,eta,lam,delta,VFx,VFy,VFz - real(WP), dimension(3) :: norm - select case(trim(dir)) - case('U') - delta=(fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - case('V') - delta=(fs%cfg%dx(i)*fs%cfg%dym(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%y(j)**2+fs%cfg%zm(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%y(j)/r; norm(3)=fs%cfg%zm(k)/r - case('W') - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dzm(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%z(k)**2)+epsilon(1.0_WP) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%z(k)/r - case default - delta=(fs%cfg%dx(i)*fs%cfg%dy(j)*fs%cfg%dz(k))**(1.0_WP/3.0_WP) - r=sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) - norm(1)=0.0_WP; norm(2)=fs%cfg%ym(j)/r; norm(3)=fs%cfg%zm(k)/r - end select - lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP - VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*Dpipe)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) - end function get_VF - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + end module simulation diff --git a/examples/ib_tester/GNUmakefile b/examples/ib_tester/GNUmakefile index ac96a691d..5b291856a 100644 --- a/examples/ib_tester/GNUmakefile +++ b/examples/ib_tester/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/ -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/ib_tester/src/geometry.f90 b/examples/ib_tester/src/geometry.f90 index bbad77ef3..2dfb3488d 100644 --- a/examples/ib_tester/src/geometry.f90 +++ b/examples/ib_tester/src/geometry.f90 @@ -66,7 +66,7 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=1.0_WP + cfg%VF=1.0_WP end block create_walls diff --git a/examples/ib_tester/src/simulation.f90 b/examples/ib_tester/src/simulation.f90 index 4b781948d..31d4aebd2 100644 --- a/examples/ib_tester/src/simulation.f90 +++ b/examples/ib_tester/src/simulation.f90 @@ -1,434 +1,434 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use hypre_str_class, only: hypre_str - use df_class, only: dfibm - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get a direct forcing solver, an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(dfibm), public :: df - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,ibmfile - - public :: simulation_init,simulation_run,simulation_final - - !> Work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - real(WP) :: inlet_velocity + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use df_class, only: dfibm + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a direct forcing solver, an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(dfibm), public :: df + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,ibmfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP) :: inlet_velocity contains - - + + !> Function that localizes the left (x-) of the domain function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. end function left_of_domain !> Function that localizes the right (x+) of the domain function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. end function right_of_domain - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 1 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max time',time%tmax) - call param_read('Max cfl number',time%cflmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Create an incompressible flow solver with bconds - create_flow_solver: block - use hypre_str_class, only: pcg_pfmg,gmres_pfmg - use incomp_class, only: dirichlet,clipped_neumann - real(WP) :: visc - ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Define boundary conditions - call fs%add_bcond(name='inflow', type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=10 - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - end block create_flow_solver - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our direct forcing solver - initialize_df: block - use mathtools, only: twoPi,arctan - integer :: i,j,k,np - real(WP) :: Dcyl,Xcyl,amp,freq,theta,r - ! Create solver - df=dfibm(cfg=cfg,name='IBM') - ! Read cylinder properties - call param_read('Number of markers',np) - call param_read('Diameter',Dcyl) - call param_read('Position',Xcyl) - call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) - call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) - ! Root process initializes marker particles - if (df%cfg%amRoot) then - call df%resize(np) - ! Distribute marker particles - do i=1,np - ! Set various parameters for the marker - df%p(i)%id =1 - df%p(i)%vel =0.0_WP - ! Set position - theta=real(i-1,WP)*twoPi/real(np,WP) - r=0.5_WP*Dcyl+amp*sin(freq*theta) - df%p(i)%pos(1)=r*cos(theta) - df%p(i)%pos(2)=r*sin(theta) - df%p(i)%pos(3)=0.0_WP - ! Assign element area - df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL - ! Assign outward normal vector - df%p(i)%norm = df%p(i)%pos/r - ! Shift cylinder - df%p(i)%pos(1)=df%p(i)%pos(1)+Xcyl - ! Locate the particle on the mesh - df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) - ! Activate the particle - df%p(i)%flag=0 - end do - end if - call df%sync() - - ! Get initial volume fraction - call df%update_VF() - - ! All processes initialize IBM objects - call df%setup_obj() - - ! Define levelset (only used for visualization) - do k=df%cfg%kmin_,df%cfg%kmax_ - do j=df%cfg%jmin_,df%cfg%jmax_ - do i=df%cfg%imin_,df%cfg%imax_ - theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg,gmres_pfmg + use incomp_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define boundary conditions + call fs%add_bcond(name='inflow', type=dirichlet ,locator=left_of_domain ,face='x',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1,canCorrect=.true. ) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=10 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=gmres_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our direct forcing solver + initialize_df: block + use mathtools, only: twoPi,arctan + integer :: i,j,k,np + real(WP) :: Dcyl,Xcyl,amp,freq,theta,r + ! Create solver + df=dfibm(cfg=cfg,name='IBM') + ! Read cylinder properties + call param_read('Number of markers',np) + call param_read('Diameter',Dcyl) + call param_read('Position',Xcyl) + call param_read('Perturbation amp',amp,default=0.05_WP*Dcyl) + call param_read('Perturbation freq',freq,default=0.0_WP*Dcyl) + ! Root process initializes marker particles + if (df%cfg%amRoot) then + call df%resize(np) + ! Distribute marker particles + do i=1,np + ! Set various parameters for the marker + df%p(i)%id =1 + df%p(i)%vel =0.0_WP + ! Set position + theta=real(i-1,WP)*twoPi/real(np,WP) r=0.5_WP*Dcyl+amp*sin(freq*theta) - df%G(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r + df%p(i)%pos(1)=r*cos(theta) + df%p(i)%pos(2)=r*sin(theta) + df%p(i)%pos(3)=0.0_WP + ! Assign element area + df%p(i)%dA=twoPi*r/real(np,WP)*df%cfg%zL + ! Assign outward normal vector + df%p(i)%norm = df%p(i)%pos/r + ! Shift cylinder + df%p(i)%pos(1)=df%p(i)%pos(1)+Xcyl + ! Locate the particle on the mesh + df%p(i)%ind=df%cfg%get_ijk_global(df%p(i)%pos,[df%cfg%imin,df%cfg%jmin,df%cfg%kmin]) + ! Activate the particle + df%p(i)%flag=0 + end do + end if + call df%sync() + + ! Get initial volume fraction + call df%update_VF() + + ! All processes initialize IBM objects + call df%setup_obj() + + ! Define levelset (only used for visualization) + do k=df%cfg%kmin_,df%cfg%kmax_ + do j=df%cfg%jmin_,df%cfg%jmax_ + do i=df%cfg%imin_,df%cfg%imax_ + theta=arctan(df%cfg%xm(i),df%cfg%ym(j)) + r=0.5_WP*Dcyl+amp*sin(freq*theta) + df%G(i,j,k)=sqrt((df%cfg%xm(i)-Xcyl)**2+df%cfg%ym(j)**2)-r + end do end do end do - end do - call df%cfg%sync(df%G) - - if (df%cfg%amRoot) then - print*,"===== Direct Forcing Setup Description =====" - print*,'Number of marker particles', df%np - print*,'Number of IBM objects', df%nobj - print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%xL*real(df%cfg%nx,WP) - end if - end block initialize_df - - - ! Create partmesh object for marker particle output - create_pmesh: block - integer :: i - pmesh=partmesh(nvar=1,nvec=1,name='ibm') - pmesh%varname(1)='area' - pmesh%vecname(1)='velocity' - call df%update_partmesh(pmesh) - do i=1,df%np_ - pmesh%var(1,i)=df%p(i)%dA - pmesh%vec(:,1,i)=df%p(i)%vel - end do - end block create_pmesh - - - ! Initialize our velocity field - initialize_velocity: block - use incomp_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - ! Initial fields - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! Set inflow velocity/momentum - call param_read('Inlet velocity',inlet_velocity) - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=inlet_velocity - end do - ! Compute MFR through all boundary conditions - call fs%get_mfr() - ! Adjust MFR for global mass balance - call fs%correct_mfr() - ! Compute cell-centered velocity - call fs%interp_vel(Ui,Vi,Wi) - ! Compute divergence - call fs%get_div() - end block initialize_velocity - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ibm') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_particle('markers',pmesh) - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VF',df%VF) - call ens_out%add_scalar('levelset',df%G) - call ens_out%add_scalar('pressure',fs%P) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call df%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create IBM monitor - ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') - call ibmfile%add_column(time%n,'Timestep number') - call ibmfile%add_column(time%t,'Time') - call ibmfile%add_column(df%VFmin,'VF min') - call ibmfile%add_column(df%VFmax,'VF max') - call ibmfile%add_column(df%Fx,'Fx') - call ibmfile%add_column(df%Fy,'Fy') - call ibmfile%add_column(df%Fz,'Fz') - call ibmfile%add_column(df%np,'Marker number') - call ibmfile%add_column(df%Umin,'Marker Umin') - call ibmfile%add_column(df%Umax,'Marker Umax') - call ibmfile%add_column(df%Vmin,'Marker Vmin') - call ibmfile%add_column(df%Vmax,'Marker Vmax') - call ibmfile%add_column(df%Wmin,'Marker Wmin') - call ibmfile%add_column(df%Wmax,'Marker Wmax') - call ibmfile%write() - end block create_monitor - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Add momentum source term from direct forcing - ibm_correction: block - integer :: i,j,k - resU=fs%rho - call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=fs%U(i,j,k)+sum(fs%itpi_x(:,i,j,k)*df%srcU(i-1:i,j,k)) - fs%V(i,j,k)=fs%V(i,j,k)+sum(fs%itpi_y(:,i,j,k)*df%srcV(i,j-1:j,k)) - fs%W(i,j,k)=fs%W(i,j,k)+sum(fs%itpi_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + call df%cfg%sync(df%G) + + if (df%cfg%amRoot) then + print*,"===== Direct Forcing Setup Description =====" + print*,'Number of marker particles', df%np + print*,'Number of IBM objects', df%nobj + print*,'Particle spacing / dx', twoPi*r/real(np,WP)/df%cfg%xL*real(df%cfg%nx,WP) + end if + end block initialize_df + + + ! Create partmesh object for marker particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='ibm') + pmesh%varname(1)='area' + pmesh%vecname(1)='velocity' + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + ! Initial fields + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! Set inflow velocity/momentum + call param_read('Inlet velocity',inlet_velocity) + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='ibm') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('markers',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VF',df%VF) + call ens_out%add_scalar('levelset',df%G) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call df%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create IBM monitor + ibmfile=monitor(amroot=df%cfg%amRoot,name='ibm') + call ibmfile%add_column(time%n,'Timestep number') + call ibmfile%add_column(time%t,'Time') + call ibmfile%add_column(df%VFmin,'VF min') + call ibmfile%add_column(df%VFmax,'VF max') + call ibmfile%add_column(df%Fx,'Fx') + call ibmfile%add_column(df%Fy,'Fy') + call ibmfile%add_column(df%Fz,'Fz') + call ibmfile%add_column(df%np,'Marker number') + call ibmfile%add_column(df%Umin,'Marker Umin') + call ibmfile%add_column(df%Umax,'Marker Umax') + call ibmfile%add_column(df%Vmin,'Marker Vmin') + call ibmfile%add_column(df%Vmax,'Marker Vmax') + call ibmfile%add_column(df%Wmin,'Marker Wmin') + call ibmfile%add_column(df%Wmax,'Marker Wmax') + call ibmfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Add momentum source term from direct forcing + ibm_correction: block + integer :: i,j,k + resU=fs%rho + call df%get_source(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+sum(fs%itpr_x(:,i,j,k)*df%srcU(i-1:i,j,k)) + fs%V(i,j,k)=fs%V(i,j,k)+sum(fs%itpr_y(:,i,j,k)*df%srcV(i,j-1:j,k)) + fs%W(i,j,k)=fs%W(i,j,k)+sum(fs%itpr_z(:,i,j,k)*df%srcW(i,j,k-1:k)) + end do end do end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibm_correction - - ! Apply other boundary conditions on the resulting fields - call fs%apply_bcond(time%t,time%dt) - - ! Reset Dirichlet BCs - dirichlet_velocity: block - use incomp_class, only: bcond - type(bcond), pointer :: mybc - integer :: n,i,j,k - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%no_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=inlet_velocity - end do - end block dirichlet_velocity - - ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call df%update_partmesh(pmesh) - do i=1,df%np_ - pmesh%var(1,i)=df%p(i)%dA - pmesh%vec(:,1,i)=df%p(i)%vel - end do - end block update_pmesh - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call df%get_max() - call mfile%write() - call cflfile%write() - call ibmfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibm_correction + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use incomp_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=inlet_velocity + end do + end block dirichlet_velocity + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call df%update_partmesh(pmesh) + do i=1,df%np_ + pmesh%var(1,i)=df%p(i)%dA + pmesh%vec(:,1,i)=df%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call df%get_max() + call mfile%write() + call cflfile%write() + call ibmfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + end module simulation diff --git a/examples/imbibition/GNUmakefile b/examples/imbibition/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/imbibition/GNUmakefile +++ b/examples/imbibition/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/internal_bc/GNUmakefile b/examples/internal_bc/GNUmakefile index 6f90a907b..68f202cd3 100644 --- a/examples/internal_bc/GNUmakefile +++ b/examples/internal_bc/GNUmakefile @@ -20,9 +20,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/levitating_drop/GNUmakefile b/examples/levitating_drop/GNUmakefile new file mode 100644 index 000000000..466227c85 --- /dev/null +++ b/examples/levitating_drop/GNUmakefile @@ -0,0 +1,46 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/levitating_drop/README b/examples/levitating_drop/README new file mode 100644 index 000000000..40eb63055 --- /dev/null +++ b/examples/levitating_drop/README @@ -0,0 +1 @@ +This test case replicates the experiments of Anilkumar et al. (1991), which are also simulated in Michael Kuhn's thesis. Intended as an example of acoustic forcing implementation. \ No newline at end of file diff --git a/examples/levitating_drop/input b/examples/levitating_drop/input new file mode 100644 index 000000000..c89a5efe1 --- /dev/null +++ b/examples/levitating_drop/input @@ -0,0 +1,56 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 24e-3 +Ly : 24e-3 +Lz : 3e-3 +nx : 80 +ny : 80 +nz : 1 +Stretching ratio in y: 1.1 +Stretching begins at y: 8e-3 + +# Flow setup +Droplet diameter : 2.917e-3 +Droplet relative location : 0 -0.0375 0 +Background pressure : 1.01325e5 +Gravity : 0 -9.81 0 + +# Initial condition and sponge forcing +Wave frequency : 21.76e3 +Sponge max pressure : 4200 +Sponge length : 7e-3 +Liquid density : 998 +Gas density : 1.2 + +# Fluid properties +Gas gamma : 1.4 +Gas dynamic viscosity : 1.813e-5 +Liquid dynamic viscosity : 9e-3 +Liquid gamma : 1.19 +Liquid Pref : 7.028e8 +Liquid q : -1.178e6 +Liquid b : 6.61e-4 +Surface tension coefficient : 0.0726 + +# Time integration +Max timestep size : 8e-7 +Max cfl number : 0.9 +Max time : 1 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 0.9999999e-4 + +# Case specific monitor +Probe relative location: 0 0.25 0 +Probe diameter: 1e-3 \ No newline at end of file diff --git a/examples/levitating_drop/src/Make.package b/examples/levitating_drop/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/levitating_drop/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/levitating_drop/src/geometry.f90 b/examples/levitating_drop/src/geometry.f90 new file mode 100644 index 000000000..a5366def6 --- /dev/null +++ b/examples/levitating_drop/src/geometry.f90 @@ -0,0 +1,107 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read,param_exists + use parallel, only: amRoot + use mathtools, only: pi + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,ny_uni + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + real(WP) :: ry, y_uni, dy, dy_tmp, y_tmp + + ! Read in grid definition: can be 2D or 3D + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid in x and z + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! Create grid in y, with stretching if specified + dy = Ly/ny + if (param_exists('Stretching ratio in y')) then + call param_read('Stretching ratio in y',ry) + call param_read('Stretching begins at y',y_uni) + + ! Determine actual number of points to be used + ny = 0 + y_tmp = 0.0_WP + dy_tmp = dy + do while (y_tmp.lt.0.5_WP*Ly) + ny = ny+2 ! Symmetric + if (y_tmp.gt.y_uni) dy_tmp = dy_tmp*ry + y_tmp = y_tmp + dy_tmp + end do + ny_uni = ceiling(y_uni/dy) + if (amRoot) print*,'ny with stretched mesh',ny + allocate(y(ny+1)) + y(ny/2+1) = 0.0_WP + do j=ny/2+2,ny/2+ny_uni+1 + y(j) = y(j-1)+dy + end do + do j=ny/2+ny_uni+2,ny+1 + dy = dy*ry + y(j) = y(j-1)+dy + end do + do j=1,ny/2 + y(j) = -y(ny+2-j) + end do + else + ! Uniform mesh + allocate(y(ny+1)) + do j=1,ny+1 + y(j)=real(j-1,WP)*dy-0.5_WP*Ly + end do + end if + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='LevDrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/levitating_drop/src/simulation.f90 b/examples/levitating_drop/src/simulation.f90 new file mode 100644 index 000000000..0100c64a5 --- /dev/null +++ b/examples/levitating_drop/src/simulation.f90 @@ -0,0 +1,719 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use mast_class, only: mast + use vfs_class, only: vfs, VFhi, VFlo + use matm_class, only: matm + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver, volume fraction solver, and material model set + !> With corresponding time tracker + type(mast), public :: fs + type(vfs), public :: vf + type(matm), public :: matmod + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,dfile,cflfile,consfile,cvgfile + + public :: simulation_init,simulation_run,simulation_final + + !> Choice of relaxation model + integer :: relax_model + !> Problem definition + real(WP), dimension(3) :: dctr + real(WP) :: ddrop, Pref, lam_wave, Grho0, gamm_g, Pmax, Ls, f_wave, c0 + + !> Monitor input variables + real(WP), dimension(3) :: prob_loc = (/0.0_WP,0.25_WP,0.0_WP/) + real(WP) :: prob_diam = 1.0e-3_WP + !> Monitor output variables + real(WP) :: r_drop, Prms_probe, y_drop, Fx_avg, Fy_avg, Fz_avg + !> Monitor working variables + integer :: n_sample + + + +contains + + !> Function that localizes the top (y+) of the domain + function top_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.eq.pg%jmax+1) isIn=.true. + end function top_of_domain + + !> Function that localizes the bottom (y-) of the domain + function btm_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.eq.pg%jmin-1) isIn=.true. + end function btm_of_domain + + !> Function that localizes top sponge + function top_sponge(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (pg%y(pg%jmax+1)-pg%ym(j).le.Ls) isIn=.true. + end function top_sponge + + !> Function that localizes bottom sponge + function btm_sponge(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (pg%ym(j)-pg%y(pg%jmin).le.Ls) isIn=.true. + end function btm_sponge + + subroutine apply_sponges(t) + use mathtools, only: Pi + implicit none + real(WP), intent(in) :: t + integer :: i,j,k + logical :: in_sponge + real(WP) :: swt, ps, rhos, us, vs, ws + + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + in_sponge = .false. + ! Check top sponge + if (top_sponge(fs%cfg,i,j,k)) then + in_sponge = .true. + ! Get sponge coefficient + swt = min(1.0_WP,max(0.0_WP,1.0_WP/Ls*(fs%cfg%ym(j)-Ls)+0.5_WP))**2 + end if + ! Check bottom sponge + if (btm_sponge(fs%cfg,i,j,k)) then + in_sponge = .true. + ! Get sponge coefficient + swt = min(1.0_WP,max(0.0_WP,1.0_WP/Ls*(-fs%cfg%ym(j)-Ls)+0.5_WP))**2 + end if + if (in_sponge) then + ! Get sponge solution if within a sponge + ps = Pref + Pmax*sin(2.0_WP*pi*fs%cfg%ym(j)/(c0/f_wave))*cos(2.0_WP*pi*f_wave*t) + rhos = Grho0 + (ps-Pref)/(gamm_g*ps/Grho0) + us = 0.0_WP; ws = 0.0_WP + vs = 0.0_WP - Pmax/sqrt(rhos*gamm_g*ps)*cos(2.0_WP*pi*fs%cfg%ym(j)/(c0/f_wave))*sin(2.0_WP*pi*f_wave*t) + ! Apply changes to variables + fs%Grho (i,j,k) = fs%Grho (i,j,k) - swt*(fs%Grho(i,j,k)-rhos) + fs%Ui (i,j,k) = fs%Ui (i,j,k) - swt*(fs%Ui(i,j,k)-us) + fs%Vi (i,j,k) = fs%Vi (i,j,k) - swt*(fs%Vi(i,j,k)-vs) + fs%Wi (i,j,k) = fs%Wi (i,j,k) - swt*(fs%Wi(i,j,k)-ws) + fs%GP (i,j,k) = fs%GP (i,j,k) - swt*(fs%GP(i,j,k)-ps) + fs%GrhoE(i,j,k) = fs%GrhoE(i,j,k) - swt*(fs%GrhoE(i,j,k)-matmod%EOS_energy(ps,rhos,us,vs,ws,'gas')) + ! Update related quantities + fs%RHO (i,j,k) = fs%Grho(i,j,k) + fs%rhoUi(i,j,k) = fs%RHO(i,j,k)*fs%Ui(i,j,k) + fs%rhoVi(i,j,k) = fs%RHO(i,j,k)*fs%Vi(i,j,k) + fs%rhoWi(i,j,k) = fs%RHO(i,j,k)*fs%Wi(i,j,k) + ! Remove liquid + vf%VF (i,j,k) = 0.0_WP + fs%Lrho (i,j,k) = 0.0_WP + fs%LP (i,j,k) = 0.0_WP + fs%LrhoE(i,j,k) = 0.0_WP + end if + + end do + end do + end do + + ! Reset interface-based quantities due to VF changes + call vf%remove_flotsams() + call vf%advect_interface(0.0_WP,fs%U,fs%V,fs%W) + call vf%build_interface() + call vf%remove_sheets() + call vf%polygonalize_interface() + call vf%subcell_vol() + call vf%get_curvature() + call vf%reset_moments() + + end subroutine + + !> Updates quantities specific to the monitor of this case + subroutine lev_drop_update() + use irl_fortran_interface, only: calculateNormal, calculateVolume, getNumberOfPlanes, getNumberOfVertices, calculateCentroid + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + real(WP) :: buf,Lvol_buf,p_buf,A_buf,A_tmp,G,r_eq,pgas,area,x_drop,z_drop + real(WP), dimension(3) :: pctr, norm, f_vec + integer, parameter :: nF = 20 + integer :: ierr,i,j,k,ii,jj,kk,nplane,n + + ! Initialize + Lvol_buf = 0.0_WP; r_drop = 0.0_WP + p_buf = 0.0_WP; A_buf = 0.0_WP + x_drop = 0.0_WP; y_drop = 0.0_WP; z_drop = 0.0_WP + f_vec = 0.0_WP + + ! Increment number of samples + n_sample = n_sample+1 + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + + ! Calculate the mean pressure measurement at the probe for the current timestep + if (fs%cfg%y(j+1).ge.prob_loc(2).and.fs%cfg%y(j).le.prob_loc(2)) then ! check cells in y + ! get interpolation quantities for y + if (fs%cfg%ym(j).gt.prob_loc(2)) then + jj = j-1 + else + jj = j + end if + if (fs%cfg%nz.eq.1) then + ! Check if x is within specs + if (fs%cfg%x(i).le.prob_loc(1)+prob_diam/2.0_WP.and.fs%cfg%x(i+1).ge.prob_loc(1)-prob_diam/2.0_WP) then + A_tmp = fs%cfg%dz(k)*(min(fs%cfg%x(i+1),prob_loc(1)+prob_diam/2.0_WP) & + - max(fs%cfg%x(i),prob_loc(1)-prob_diam/2.0_WP)) + p_buf = p_buf+A_tmp*(fs%P(i,jj,k)-Pref+(fs%P(i,jj+1,k)-fs%P(i,jj,k)) / & + (fs%cfg%ym(jj+1)-fs%cfg%ym(jj))*(prob_loc(2)-fs%cfg%ym(jj))) + A_buf = A_buf+A_tmp + end if + else + ! Check if x,z are near enough to or within area + G = sqrt((fs%cfg%xm(i)-prob_loc(1))**2+(fs%cfg%zm(k)-prob_loc(3))**2)-prob_diam/2.0_WP + if (G.lt.2.0_WP*max(fs%cfg%dx(i),fs%cfg%dz(k))) then + ! Create inner fine grid to get area within probe + A_tmp = 0.0_WP + do ii=1,nF + do kk=1,nF + G = sqrt((fs%cfg%x(i)+fs%cfg%dx(i)/real(nF,WP)*(real(ii,WP)-0.5_WP)-prob_loc(1))**2 & + +(fs%cfg%z(k)+fs%cfg%dz(k)/real(nF,WP)*(real(kk,WP)-0.5_WP)-prob_loc(3))**2) & + -prob_diam/2.0_WP + if (G.le.0.0_WP) then + A_tmp = A_tmp+fs%cfg%dx(i)*fs%cfg%dz(k)/real(nF,WP)**2 + end if + end do + end do + ! Accumulate pressure and area + p_buf = p_buf+A_tmp*(fs%P(i,jj,k)-Pref+(fs%P(i,jj+1,k)-fs%P(i,jj,k)) / & + (fs%cfg%ym(jj+1)-fs%cfg%ym(jj))*(prob_loc(2)-fs%cfg%ym(jj))) + A_buf = A_buf+A_tmp + end if + end if + end if + + ! Calculate the location of drop center of gravity + Lvol_buf = Lvol_buf + fs%cfg%vol(i,j,k)*vf%VF(i,j,k) + if (vf%VF(i,j,k).gt.VFhi) then + ! add entire volume of cell to calculation of center of mass + x_drop = x_drop + fs%cfg%vol(i,j,k)*fs%cfg%xm(i) + y_drop = y_drop + fs%cfg%vol(i,j,k)*fs%cfg%ym(j) + z_drop = z_drop + fs%cfg%vol(i,j,k)*fs%cfg%zm(k) + elseif (vf%VF(i,j,k).ge.VFlo) then + ! add liquid volume multiplied by liquid barycenter location + x_drop = x_drop + fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*vf%Lbary(1,i,j,k) + y_drop = y_drop + fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*vf%Lbary(2,i,j,k) + z_drop = z_drop + fs%cfg%vol(i,j,k)*vf%VF(i,j,k)*vf%Lbary(3,i,j,k) + + ! Calculate the radiation force by integrating over the droplet surface + ! get local gas pressure + pgas = fs%P(i,j,k) - vf%VF(i,j,k)*fs%hpjump(i,j,k) + ! multiply by local plane area vector, add to force + nplane = getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + do n=1,nplane + if (getNumberOfVertices(vf%interface_polygon(n,i,j,k)).gt.0) then + norm = calculateNormal(vf%interface_polygon(n,i,j,k)) + area = abs(calculateVolume(vf%interface_polygon(n,i,j,k))) + f_vec = f_vec - pgas*norm*area + ! negative because vector direction should be opposite of outward normal + end if + end do + end if + end do + end do + end do + + ! Get x and z centers for radius calculation + call MPI_ALLREDUCE(Lvol_buf,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); Lvol_buf = buf + call MPI_ALLREDUCE(x_drop,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); x_drop = buf/(Lvol_buf+tiny(1.0_WP)) + call MPI_ALLREDUCE(z_drop,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); z_drop = buf/(Lvol_buf+tiny(1.0_WP)) + + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + if ((vf%VF(i,j,k).ge.VFlo).and.(vf%VF(i,j,k).le.VFhi)) then + ! Get plane information + nplane = getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + do n=1,nplane + if (getNumberOfVertices(vf%interface_polygon(n,i,j,k)).gt.0) then + ! Get intersection of plane with line from center + pctr = calculateCentroid(vf%interface_polygon(n,i,j,k)) + ! Calculate radius in xz plane + r_eq = sqrt((pctr(1)-x_drop)**2+(pctr(3)-z_drop)**2) + r_drop = max(r_drop,r_eq) + end if + end do + end if + end do + end do + end do + !> Outputs: Function that defines a level set function for a spherical droplet at center + function levelset_drop_center(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=1.0_WP-sqrt((xyz(1)-dctr(1))**2+(xyz(2)-dctr(2))**2+(xyz(3)-dctr(3))**2)/(ddrop/2.0) + end function levelset_drop_center + + function levelset_cyl_center(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=1.0_WP-sqrt((xyz(1)-dctr(1))**2+(xyz(2)-dctr(2))**2)/(ddrop/2.0) + end function levelset_cyl_center + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read,param_exists + implicit none + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + call param_read('Max steps',time%nmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo + use parallel, only: amRoot + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver with lvira reconstruction + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') + ! Droplet information + call param_read('Droplet diameter',ddrop) + call param_read('Droplet relative location',dctr) + ! Set the energy based on background pressure + call param_read('Background pressure', Pref) + ! Calculate the corresponding speed of sound + call param_read('Gas gamma',gamm_g) + call param_read('Gas density',Grho0) + c0 = sqrt(gamm_g*Pref/Grho0) + ! Get wave frequency + call param_read('Wave frequency',f_wave) + ! Calculate wavelength + lam_wave = c0/f_wave + if (amRoot) print*, 'standing wavelength', lam_wave + ! Reference center scaled by wavelength + dctr = dctr*lam_wave + ! Droplet always initialized at center + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + if (vf%cfg%nz.eq.1) then + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_cyl_center,0.0_WP,amr_ref_lvl) + else + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_drop_center,0.0_WP,amr_ref_lvl) + end if + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + if (vf%cfg%nz.eq.1) vf%Gbary(3,i,j,k)=v_cent(3); + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Set interface at the boundaries + call vf%set_full_bcond() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a compressible two-phase flow solver + create_and_initialize_flow_solver: block + use mast_class, only: clipped_neumann,bc_scope,bcond,thermmech_egy_mech_hhz,mech_egy_mech_hhz + use ils_class, only: pcg_bbox,gmres_smg + use mathtools, only: Pi + use parallel, only: amRoot + use string, only: str_medium + integer :: i,j,k + real(WP) :: gamm_l,Pref_l,visc_l,visc_g,hdff_l,hdff_g,cv_l,cv_g,b_l,q_l + real(WP) :: LP0, Lrho0, ps, rhos + ! Create material model class + matmod=matm(cfg=cfg,name='Liquid-gas models') + ! Get EOS parameters from input + call param_read('Liquid gamma',gamm_l) + call param_read('Liquid Pref', Pref_l) + call param_read('Liquid b', b_l) + call param_read('Liquid q', q_l) + ! Register equations of state + call matmod%register_NobleAbelstiffenedgas('liquid',gamm_l,Pref_l,q_l,b_l) + call matmod%register_idealgas('gas',gamm_g) + ! Create flow solver + fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) + ! Register flow solver variables with material models + call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) + call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',visc_l) + call param_read('Gas dynamic viscosity',visc_g) + ! Set heat diffusion to 0 unless specified + hdff_l = 0.0_WP; hdff_g = 0.0_WP + if (param_exists('Liquid therm cond')) then + call param_read('Liquid therm cond', hdff_l) + call param_read('Gas therm cond', hdff_g) + end if + ! Set specific heat to default + cv_l = matmod%cv_l0; cv_g = matmod%cv_g0 + call matmod%register_diffusion_thermo_models(viscconst_gas=visc_g,& + viscconst_liquid=visc_l, hdffconst_gas=hdff_g, hdffconst_liquid=hdff_l, & + sphtconst_gas=cv_g, sphtconst_liquid=cv_l) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit momentum solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) + + ! Calculate liquid pressure + if (fs%cfg%nz.eq.1) then + ! Cylinder configuration, curv = 1/r + LP0 = Pref + 2.0/ddrop*fs%sigma + else + ! Sphere configuration, curv = 1/r + 1/r + LP0 = Pref + 4.0/ddrop*fs%sigma + end if + ! Set liquid density + call param_read('Liquid density',Lrho0) + fs%Lrho = Lrho0 + ! Set liquid energy + fs%LrhoE = matmod%EOS_energy(LP0,Lrho0,0.0_WP,0.0_WP,0.0_WP,'liquid') + + ! Get sponge parameters + call param_read('Sponge max pressure',Pmax) + call param_read('Sponge length',Ls) + + ! Initialize velocity and gas phase + fs%Ui = 0.0_WP; fs%Vi = 0.0_WP; fs%Wi = 0.0_WP + fs%U = 0.0_WP; fs%V = 0.0_WP; fs%W = 0.0_WP + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + ! standing wave, node at center + ps = Pref + Pmax*sin(2.0_WP*pi*fs%cfg%ym(j)/lam_wave) + rhos = Grho0 + (ps-Pref)/(gamm_g*ps/Grho0) + ! store values + fs%Grho (:,j,:) = rhos + fs%GrhoE(:,j,:) = matmod%EOS_energy(ps,rhos,0.0_WP,0.0_WP,0.0_WP,'gas') + end do + + ! Define BCs at top and bottom - though sponges will determine bdy behavior + call fs%add_bcond(name='top_y' ,type=clipped_neumann,locator=top_of_domain ,celldir='yp') + call fs%add_bcond(name='btm_y' ,type=clipped_neumann,locator=btm_of_domain ,celldir='ym') + + ! Choose relaxation model + if (abs(cv_l)+abs(cv_g).gt.0.0_WP) then + ! Use thermo-mechanical if heat conduction is considered + relax_model = thermmech_egy_mech_hhz + else + ! Use mechanical otherwise + relax_model = mech_egy_mech_hhz + end if + + ! Calculate mixture density and momenta + fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho + fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi + ! Perform initial pressure relax + call fs%pressure_relax(vf,matmod,relax_model) + ! Calculate initial phase and bulk moduli + call fs%init_phase_bulkmod(vf,matmod) + call fs%reinit_phase_pressure(vf,matmod) + call fs%harmonize_advpressure_bulkmod(vf,matmod) + ! Set initial pressure to harmonized field based on internal energy + fs%P = fs%PA + ! Calculate initial temperature + call matmod%update_temperature(vf,fs%Tmptr) + ! Initialize first guess for pressure (0 works best) + fs%psolv%sol=0.0_WP + + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='lev_drop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) + call ens_out%add_scalar('P',fs%P) + call ens_out%add_scalar('Peos',fs%PA) + call ens_out%add_scalar('Grho',fs%Grho) + call ens_out%add_scalar('Lrho',fs%Lrho) + call ens_out%add_scalar('Density',fs%RHO) + call ens_out%add_scalar('Temperature',fs%Tmptr) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%Tmax,'Tmax') + call mfile%write() + ! Check input file for monitor specs + if (param_exists('Probe relative location')) then + call param_read('Probe relative location',prob_loc) + end if + if (param_exists('Probe diameter')) then + call param_read('Probe diameter',prob_diam) + end if + prob_loc = lam_wave * prob_loc ! scale by wavelength + ! Initialize monoitor variables + Prms_probe = 0.0_WP + Fx_avg = 0.0_WP; Fy_avg = 0.0_WP; Fz_avg = 0.0_WP + n_sample = 0 + ! Create levitating drop monitor + ! Normalized radius, RMS pressure at probe, droplet y position, time-averaged force + dfile=monitor(fs%cfg%amRoot,'levdrop') + call dfile%add_column(time%n,'Timestep number') + call dfile%add_column(time%t,'Time') + call dfile%add_column(r_drop,'R^*') + call dfile%add_column(Prms_probe,'Prms_p') + call dfile%add_column(y_drop,'y_drop') + call dfile%add_column(Fx_avg,'Fx_avg') + call dfile%add_column(Fy_avg,'Fy_avg') + call dfile%add_column(Fz_avg,'Fz_avg') + call lev_drop_update() + call dfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') + + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Reinitialize phase pressure by syncing it with conserved phase energy + call fs%reinit_phase_pressure(vf,matmod) + fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi + fs%RHOold = fs%RHO + ! Remember old flow variables (phase) + fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho + fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE + fs%GPold = fs%GP; fs%LPold = fs%LP + + ! Remember old interface, including VF and barycenters + call vf%copy_interface_to_old() + + ! Create in-cell reconstruction + call fs%flow_reconstruct(vf) + + ! Zero variables that will change during subiterations + fs%P = 0.0_WP + fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP + fs%Hpjump = 0.0_WP + + ! Determine semi-Lagrangian advection flag + call fs%flag_sl(time%dt,vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Predictor step, involving advection and pressure terms + call fs%advection_step(time%dt,vf,matmod) + + ! Diffusion and built-in source term (gravity) step + call fs%diffusion_src_explicit_step(time%dt,vf,matmod) + + ! Perform sponge forcing + call apply_sponges(time%t) + + ! Prepare pressure projection + call fs%pressureproj_prepare(time%dt,vf,matmod) + ! Initialize and solve Helmholtz equation + call fs%psolv%setup() + call fs%psolv%solve() + call fs%cfg%sync(fs%psolv%sol) + ! Perform corrector step using solution + fs%P=fs%P+fs%psolv%sol + call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + + ! Record convergence monitor + call cvgfile%write() + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Pressure relaxation + call fs%pressure_relax(vf,matmod,relax_model) + + ! Output to ensight + fs%PA = matmod%EOS_all(vf); + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call lev_drop_update() + call dfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + ! Nothing to do + end subroutine simulation_final + +end module simulation diff --git a/examples/ljsc/GNUmakefile b/examples/ljsc/GNUmakefile new file mode 100644 index 000000000..466227c85 --- /dev/null +++ b/examples/ljsc/GNUmakefile @@ -0,0 +1,46 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/ljsc/README b/examples/ljsc/README new file mode 100644 index 000000000..eb962646e --- /dev/null +++ b/examples/ljsc/README @@ -0,0 +1 @@ +This is a test case for a liquid jet in supersonic crossflow. Intended as a 3D case that can be 2D for small debugging runs. diff --git a/examples/ljsc/input_stretch b/examples/ljsc/input_stretch new file mode 100644 index 000000000..75d31c3e9 --- /dev/null +++ b/examples/ljsc/input_stretch @@ -0,0 +1,61 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 0.03 +Ly : 0.0158 +Lz : 0.0181 + +Cells per jet diameter : 5 +Stretching bdy in x pre : 0.005 +Stretching ratio in x pre : 1.3 +Stretching bdy in x post : 0.025 +Stretching ratio in x post : 1.05 + +Cell height at wall : 1e-5 +Stretching ratio in y pre : 1.3 +Stretching bdy in y post : 0.012 +Stretching ratio in y post : 1.1 + +Stretching bdy in z : 0.005 +Stretching ratio in z : 1.3 + +Wall cells in domain : 1 + +# Flow setup - Crossflow +Mach number : 2 +Stagnation pressure : 307e3 +Stagnation temperature : 300 +Crossflow BL thickness : 0.001 + +# Flow setup - Liquid Jet +Jet diameter : 0.00076 +Jet location : 0.011 +Mass flowrate : 0.0182 +Liquid temperature : 357 +Liquid density : 1000 + +# Fluid properties +Liquid gamma : 1.19 +Liquid Pref : 7.028e8 +Liquid q : -1.178e6 +Liquid b : 6.61e-4 +Gas gamma : 1.4 +Surface tension coefficient : 0.078 + +# Time integration +Max timestep size : 5e-7 +Max cfl number : 0.9 +Max time : 1e-3 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1.99999e-6 diff --git a/examples/ljsc/input_uniform b/examples/ljsc/input_uniform new file mode 100644 index 000000000..93445b18b --- /dev/null +++ b/examples/ljsc/input_uniform @@ -0,0 +1,48 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 0.03 +nx : 128 +Ly : 0.0158 +ny : 64 +nz : 1 +Wall cells in domain : 1 + +# Flow setup - Crossflow +Mach number : 2 +Stagnation pressure : 307e3 +Stagnation temperature : 300 +Crossflow BL thickness : 0.001 + +# Flow setup - Liquid Jet +Jet diameter : 0.00076 +Jet location : 0.007 0.02 +Mass flowrate : 0.0182 +Liquid temperature : 357 +Liquid density : 1000 + +# Fluid properties +Liquid gamma : 1.19 +Liquid Pref : 7.028e8 +Liquid q : -1.178e6 +Liquid b : 6.61e-4 +Gas gamma : 1.4 +Surface tension coefficient : 0.078 + +# Time integration +Max timestep size : 5e-7 +Max cfl number : 0.9 +Max time : 1e-3 +Max steps : 100000 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1.99999e-6 diff --git a/examples/ljsc/src/Make.package b/examples/ljsc/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/ljsc/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/ljsc/src/geometry.f90 b/examples/ljsc/src/geometry.f90 new file mode 100644 index 000000000..e2138449b --- /dev/null +++ b/examples/ljsc/src/geometry.f90 @@ -0,0 +1,261 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read, param_exists + use parallel, only: amRoot + use messager, only: die + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,jj + integer :: cpd,n_prev,n_mid,n_post,n_wall + real(WP) :: rdx,box_xl,box_xr,box_yl,box_yr,box_z,djet + real(WP) :: rx1,rx2,ry1,ry2,rz + real(WP) :: Lx,Ly,Lz + real(WP) :: resx_1,resx_2,resy_1,resy_2,dymin + real(WP), dimension(:), allocatable :: x,y,z + logical :: is_sx,is_sy,is_sz,zper + + ! Get mesh dimensions + call param_read('Lx',Lx) + call param_read('Ly',Ly) + + ! Incorporate stretching + is_sx = param_exists('Stretching ratio in x pre') + is_sy = param_exists('Stretching ratio in y post') + is_sz = param_exists('Stretching ratio in z') + + ! Jet properties + call param_read('Jet diameter',djet) + call param_read('Wall cells in domain', n_wall, default=1) + + ! Ask for desired resolution + if (is_sx.or.is_sy.or.is_sz) then + call param_read('Cells per jet diameter', cpd) + rdx = djet/cpd + end if + ! rdx = refined dx, used for refined region when mesh stretching + + ! Initialize markers + resx_1 = -1.0_WP; resy_1 = -1.0_WP + ! -1 is used as an unrealistic value to be replaced + + ! Create the grid + ! Grid in X + if (is_sx) then + + ! Get stretching parameters + call param_read('Stretching ratio in x pre',rx1) + call param_read('Stretching ratio in x post',rx2) + call param_read('Stretching bdy in x pre',box_xl) + call param_read('Stretching bdy in x post',box_xr) + ! Calculate variables for mesh generation + ! Number of points in each region + n_mid = ceiling((box_xr-box_xl)/rdx) + n_prev = nint(log(-(box_xl+rdx)*(1.0_WP-rx1)/rdx+1.0_WP)/(log(rx1)+epsilon(1.0_WP)))-1 + n_post = nint(log(-(Lx-box_xr+rdx)*(1.0_WP-rx2)/rdx+1.0_WP)/(log(rx2)+epsilon(1.0_WP)))-1 + if (n_prev.lt.0) n_prev = 0 + if (n_post.lt.0) n_post = 0 + nx = n_prev+n_mid+n_post + + if (amRoot) print*, 'nx',nx,'n_prev', n_prev,'n_mid',n_mid,'n_post',n_post,'in x direction' + !print*, 'Lx should become ', rdx*(1.0_WP-rx2**(n_post+1))/(1.0_WP-rx2+epsilon(1.0_WP))+rdx*(1.0_WP-rx1**(n_prev+1))/(1.0_WP-rx1+epsilon(1.0_WP))-box_xl+box_xr-2*rdx + + allocate(x(nx+1)) + + ! First section (from stretched to refined region) + do i=1,n_prev+1 + x(i) = box_xl - rdx*(rx1-rx1**(-i+n_prev+2))/(1.0_WP-rx1+epsilon(1.0_WP)) + end do + resx_1 = x(i-1) ! store for print output, used for next section as well + ! Second section (refined region) + do i=n_prev+2,n_mid+n_prev+1 + x(i) = resx_1+real(i-1-n_prev,WP)*rdx + end do + resx_2 = x(i-1) ! store for print output, used for next section as well + ! Third section (from refined region to stretched) + do i=n_prev+n_mid+2,nx+1 + x(i) = resx_2 + rdx*(rx2-rx2**(i-n_mid-n_prev))/(1.0_WP-rx2+epsilon(1.0_WP)) + end do + + ! Store new Lx + Lx = x(nx+1)-x(1) + !print*, 'Lx, x(1), x(nx+1)', Lx, x(1), x(nx+1) + if (amRoot) print*, 'dx as resolved as cpd from', resx_1, 'to', resx_2, ', for', (resx_2-resx_1)/Lx*100.0_WP, '% of Lx' + else + ! Uniform mesh + call param_read('nx',nx); + allocate(x(nx+1)) + do i=1,nx+1 + x(i) = real(i-1,WP)*Lx/real(nx,WP) + end do + end if + + ! Grid in Y + if (is_sy) then + call param_read('Cell height at wall',dymin) + call param_read('Stretching ratio in y pre',ry1) + call param_read('Stretching ratio in y post',ry2) + call param_read('Stretching bdy in y post',box_yr) + + !! - Calculate number of points needed in mesh in order to allocate - !! + + ! ZEROTH REGION : wall cells + + ! FIRST REGION : from specified resolution at wall to uniform "refined box" resolution + ! Nearest number of cells to accomplish the stretching + ! -- this is set so that the n_prev+1 cell has dy=rdx + n_prev = nint(log(rdx/dymin)/log(ry1)) + ! New stretching rate to correspond with number of cells + ry1 = (rdx/dymin)**(1.0_WP/real(n_prev+1,WP)) + ! Length of new region + box_yl = dymin*(1.0_WP-ry1**n_prev)/(1.0_WP-ry1) + + ! SECOND REGION : uniform box of a specified resolution + n_mid = max(0,ceiling((box_yr-box_yl)/rdx)) + ! Recalculate end of refined region + box_yr = box_yl + rdx*n_mid + + ! THIRD REGION : stretching according to a specified rate until domain length is exceeded + n_post = nint(log(-(Ly-(box_yr-rdx))*(1.0_WP-ry2)/rdx+1.0_WP)/(log(ry2)+epsilon(1.0_WP)))-1 + + if (n_post.lt.0) n_post = 0 + ny = n_wall + n_prev + n_mid + n_post + + if (amRoot) print*, 'ny',ny,'n_wall',n_wall,'n_prev',n_prev,'n_mid',n_mid,'n_post',n_post,'in y direction' + !print*, 'Ly should become ', rdx*(1.0_WP-ry2**(n_post+1))/(1.0_WP-ry2+epsilon(1.0_WP))+box_yr-rdx+dymin*n_wall + + allocate(y(ny+1)) + + !! - Calculate actual cell heights and locations - !! + ! ZEROTH REGION + do j=1,n_wall+1 + y(j) = real(j-1-n_wall,WP)*dymin + end do + ! FIRST REGION + do j=n_wall+2,n_wall+n_prev+1 + jj = j-(n_wall+2) + y(j) = y(j-1) + dymin*ry1**jj + end do + ! SECOND REGION + do j=n_wall+n_prev+2,n_wall+n_prev+n_mid+1 + y(j) = y(j-1) + rdx + end do + ! THIRD REGION + do j=n_wall+n_prev+n_mid+2,n_wall+n_prev+n_mid+n_post+1 + jj = j-(n_wall+n_prev+n_mid+1) + y(j) = y(j-1) + rdx*ry2**jj + end do + + !! - Final calculations and variables for printing - !! + Ly = y(ny+1)-y(1) + !print*, 'Ly, y(1), y(ny+1)', Ly, y(1), y(ny+1) + resy_1 = y(n_wall+n_prev+1); resy_2 = y(n_wall+n_prev+n_mid+1) + if (amRoot) print*, 'dy as resolved as cpd from', resy_1, 'to', resy_2, ', for', (resy_2-resy_1)/Ly*100.0_WP, '% of Ly' + else + call param_read('ny',ny); + allocate(y(ny+1)) + do j=1,ny+1 + y(j) = real(j-1-n_wall,WP)*Ly/real(ny,WP) + end do + end if + + ! Grid in Z + if (is_sz.and.nz.ne.1) then + call param_read('Lz',Lz) + + ! Get stretching parameters + call param_read('Stretching ratio in z',rz) + call param_read('Stretching bdy in z',box_z) + ! Number of points in each region + n_mid = ceiling(2.0_WP*box_z/rdx)/2*2 + box_z = n_mid*rdx + n_prev = nint(log(-(Lz/2.0_WP-box_z/2.0_WP+rdx)*(1.0_WP-rz)/rdx+1.0_WP)/(log(rz)+epsilon(1.0_WP)))-1 + if (n_prev.lt.0) n_prev = 0 + n_post = n_prev + nz = n_prev+n_mid+n_post + + if (amRoot) print*, 'nz',nz,'n_prev', n_prev,'n_mid',n_mid,'n_post',n_post,'in z direction' + !print*, 'Lz should become ', box_z - 2.0_WP*rdx + 2.0_WP*rdx*(1.0_WP-rz**(n_post+1))/(1.0_WP-rz+epsilon(1.0_WP)) + + allocate(z(nz+1)) + + ! First section (from stretched to refined region) + do k=1,n_prev+1 + z(k) = -box_z/2.0_WP - rdx*(rz-rz**(-k+n_prev+2))/(1.0_WP-rz+epsilon(1.0_WP)) + end do + ! Second section (refined region) + do k=n_prev+2,n_mid+n_prev+1 + z(k) = -box_z/2.0_WP + real(k-1-n_prev,WP)*rdx + end do + ! Third section (from refined region to stretched) + do k=n_prev+n_mid+2,nz+1 + z(k) = box_z/2.0_WP + rdx*(rz-rz**(k-n_mid-n_prev))/(1.0_WP-rz+epsilon(1.0_WP)) + end do + + ! Store new Lz + Lz = z(nz+1)-z(1) + !print*, 'Lz, z(1), z(nz+1)', Lz, z(1), z(nz+1) + if (amRoot) print*, 'dz as resolved as cpd from', -box_z, 'to', box_z, ', for', ( box_z )/Lz*100.0_WP, '% of Lz' + else + ! Uniform mesh + call param_read('nz',nz); + if (nz.eq.1) then + Lz = minval(x(2:nx+1)-x(1:nx)) + else + call param_read('Lz',Lz) + end if + allocate(z(nz+1)) + do k=1,nz+1 + z(k) = real(k-1,WP)*Lz/real(nz,WP)-0.5_WP*Lz + end do + end if + + if (is_sx.or.is_sy.or.is_sz) then + if (amRoot) print*, 'total number of cells = ', nx*ny*nz, 'domain cell dimensions', nx,'x',ny,'x',nz + end if + + ! General serial grid object + zper = .false.; if (nz.eq.1) zper=.true.; + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=zper,name='LJSC') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/ljsc/src/simulation.f90 b/examples/ljsc/src/simulation.f90 new file mode 100644 index 000000000..70ac5b39a --- /dev/null +++ b/examples/ljsc/src/simulation.f90 @@ -0,0 +1,576 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use mast_class, only: mast + use vfs_class, only: vfs + use matm_class, only: matm,air,water + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver, volume fraction solver, and material model set + !> With corresponding time tracker + type(mast), public :: fs + type(vfs), public :: vf + type(matm), public :: matmod + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,cvgfile + + public :: simulation_init,simulation_run,simulation_final + + !> Problem definition + real(WP) :: djet + real(WP), dimension(:), allocatable :: xjet + integer :: relax_model, nwall + +contains + + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin-1) isIn=.true. + end function left_of_domain + + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + + !> Function that localizes the top (y+) of the domain + function top_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.eq.pg%jmax+1) isIn=.true. + end function top_of_domain + + !> Function that localizes the back (z-) of the domain + function back_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (k.eq.pg%kmin-1) isIn=.true. + end function back_of_domain + + !> Function that localizes the front (z+) of the domain + function front_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (k.eq.pg%kmax+1) isIn=.true. + end function front_of_domain + + !> Function that localizes the jet(s) initial location + function jet(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP), dimension(3) :: xyz + logical :: isIn + isIn=.false. + xyz(1)=pg%xm(i); xyz(2)=0.0_WP; xyz(3)=pg%zm(k) + if (j.le.pg%jmin-1+nwall.and.levelset_halfdrop(xyz,0.0_WP).gt.0.0_WP) isIn=.true. + end function jet + + !> Function that localizes the walls surrounding the jets + function wall(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.le.pg%jmin-1+nwall.and.(.not.jet(pg,i,j,k))) isIn=.true. + end function wall + + !> Function that localizes the jet(s) BCs at edge of domain + function jet_bdy(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP), dimension(3) :: xyz + logical :: isIn + isIn=.false. + xyz(1)=pg%xm(i); xyz(2)=0.0_WP; xyz(3)=pg%zm(k) + if (j.eq.pg%jmin-1.and.(jet(pg,i,j,k))) isIn=.true. + end function jet_bdy + + !> Function that defines a level set function for the start of a jet at wall + function levelset_halfdrop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + integer :: n + ! Loop jets + G = -huge(1.0_WP) + do n = 1,size(xjet) + G=max(G,0.5_WP*djet-sqrt((xyz(1)-xjet(n))**2+max(0.0_WP,xyz(2))**2+xyz(3)**2)) + end do + end function levelset_halfdrop + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read,param_getsize + implicit none + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + call param_read('Max steps',time%nmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + ! Set up walls before solvers are initialized + create_walls: block + integer :: i,j,k,njet + ! Initialize liquid jet(s) + call param_read('Jet diameter',djet) + njet = param_getsize('Jet location') + allocate(xjet(njet)) + call param_read('Jet location',xjet) + ! Number of wall cells + call param_read('Wall cells in domain', nwall, default=1) + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + if (wall(cfg%pgrid,i,j,k)) then + cfg%VF(i,j,k)=0.0_WP + end if + end do + end do + end do + + end block create_walls + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: elvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver with lvira reconstruction + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_halfdrop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + ! Round up to fully liquid within wall (accuracy of mdot improves with resolution) + if (vf%VF(i,j,k).gt.0.0_WP.and.vf%cfg%ym(j).lt.0.0_WP) vf%VF(i,j,k)=1.0_WP + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Boundary conditions on VF are built into the mast solver + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Set initial interface at the boundaries + call vf%set_full_bcond() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a compressible two-phase flow solver + create_and_initialize_flow_solver: block + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,thermmech_egy_mech_hhz + use ils_class, only: pcg_bbox,gmres_smg + use mathtools, only: Pi + use parallel, only: amRoot + integer :: i,j,k,n + real(WP), dimension(3) :: xyz + real(WP) :: gamm_l,Pref_l,q_l,b_l,gamm_g + real(WP) :: ST, Ma, Ptot, Ttot, mdot, BL, vcross + real(WP) :: T_cf, P_cf, U_cf, RHO_cf + real(WP) :: T_j , P_j , V_j , RHO_j + type(bcond), pointer :: mybc + real(WP), parameter :: R = 287.0_WP ! Gas constant for air + + ! Create material model class + matmod=matm(cfg=cfg,name='Liquid-gas models') + ! Get EOS parameters from input + ! Paramters from Kuhn and Desjardins (2021): gamm_l = 1.19, + ! Pref_l = 7.028e8, q_l = -1.178e6, b_l = 6.61e-4, gamm_g = 1.4 + call param_read('Liquid gamma',gamm_l) + call param_read('Liquid Pref', Pref_l) + call param_read('Liquid q', q_l) + call param_read('Liquid b', b_l) + call param_read('Gas gamma',gamm_g) + ! Register equations of state + call matmod%register_NobleAbelstiffenedgas('liquid',gamm_l,Pref_l,q_l,b_l) + call matmod%register_idealgas('gas',gamm_g) + ! Create flow solver + fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) + ! Register flow solver variables with material models + call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) + call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) + ! Use built-in temperature-dependent models for diffusion and specific heat + call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscmodel_liquid=water, & + hdffmodel_gas=air, hdffmodel_liquid=water, & + sphtmodel_gas=air, sphtmodel_liquid=water) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit momentum solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) + + + ! Read crossflow parameters + call param_read('Mach number',Ma) + call param_read('Stagnation pressure',Ptot) + call param_read('Stagnation temperature',Ttot) + call param_read('Crossflow BL thickness',BL) + ! Get crossflow quantities + T_cf = Ttot / (1+(gamm_g-1.0_WP)/2.0_WP*Ma**2) + P_cf = Ptot * (1.0_WP+(gamm_g-1.0_WP)/2.0_WP*Ma**2)**(gamm_g/(1.0_WP-gamm_g)) + U_cf = Ma * sqrt(gamm_g*R*T_cf) + RHO_cf = P_cf/R/Ttot * (1+(gamm_g-1.0_WP)/2.0_WP*Ma**2) + + ! Read jet parameters + call param_read('Mass flowrate',mdot) + call param_read('Liquid temperature',T_j) + call param_read('Liquid density',RHO_j) + ! Get jet quantities + V_j = mdot / RHO_j / (pi * 0.25_WP * djet**2) + P_j = matmod%EOS_pressure(T_j,RHO_j,matmod%spec_heat_liquid(T_j),'liquid') + + ! Print useful information + if (amRoot) then + print*,"===== Problem Setup Description =====" + print*,'Mach number', Ma, 'Number of jets', size(xjet), 'Mass flowrate', mdot + print*,'Stagnation: Pressure', Ptot, 'Temperature', Ttot + print*,'Crossflow: Pressure', P_cf,'Density',RHO_cf,'Velocity',U_cf + print*,'Jet: Pressure', P_j,'Density', RHO_j,'Velocity', V_j + print*,'Re_BL',RHO_cf*U_cf*BL/matmod%viscosity_air(T_cf), & + 'Re_D',RHO_cf*U_cf*djet/matmod%viscosity_air(T_cf), & + 'Re_jet',RHO_j*V_j*djet/matmod%viscosity_water(T_j) + if (fs%sigma.gt.0.0_WP) then + print*,'We',RHO_cf*U_cf**2*djet/fs%sigma, & + 'We_eff', (2.0_WP + (gamm_g-1.0_WP)*Ma**2) / & + ((gamm_g-1.0_WP)*Ma**2) * (RHO_cf*U_cf**2*djet/fs%sigma) + else + print*,'We Infinity' + end if + end if + + !! -- Populate crossflow data -- !! + ! Initially 0 velocity in y and z + fs%Vi = 0.0_WP; fs%Wi = 0.0_WP + ! Zero face velocities as well for the sake of dirichlet boundaries + fs%V = 0.0_WP; fs%W = 0.0_WP + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + if (j.le.nwall) then + vcross = 0.0_WP + RHO_cf = P_cf/R/Ttot + else + vcross = U_cf * min(1.0_WP, (fs%cfg%ym(j)/BL)**(1.0_WP/7.0_WP)) + RHO_cf = P_cf/R/Ttot/(1+(gamm_g-1.0_WP)/2.0_WP*Ma**2*(1.0_WP-(vcross/U_cf)**2))*(1+(gamm_g-1.0_WP)/2.0_WP*Ma**2) + end if + ! pressure, velocity, use matmod for energy + fs%Grho(:,j,:) = RHO_cf + fs%Ui(:,j,:) = vcross + fs%GrhoE(:,j,:) = matmod%EOS_energy(P_cf,RHO_cf,vcross,0.0_WP,0.0_WP,'gas') + end do + + !! -- Populate jet data -- !! + fs%Lrho = RHO_j + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! Populate liquid velocity (use uniform for now) + if (vf%VF(i,j,k).gt.0.0_WP) then + fs%Ui(i,j,k) = 0.0_WP + fs%Vi(i,j,k) = V_j + fs%LrhoE(i,j,k) = matmod%EOS_energy(P_j,RHO_j,0.0_WP,V_j,0.0_WP,'liquid') + end if + end do + end do + end do + + ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers + call fs%add_bcond(name='crossflow',type=dirichlet ,locator=left_of_domain ,celldir='xm') + call fs%add_bcond(name='jet' ,type=dirichlet ,locator=jet_bdy ,celldir='ym') + call fs%add_bcond(name='outflow' ,type=clipped_neumann,locator=right_of_domain,celldir='xp') + call fs%add_bcond(name='out_yp' ,type=clipped_neumann,locator=top_of_domain ,celldir='yp') + if (fs%cfg%nz.gt.1) then + call fs%add_bcond(name='out_zm' ,type=clipped_neumann,locator=back_of_domain ,celldir='zm') + call fs%add_bcond(name='out_zp' ,type=clipped_neumann,locator=front_of_domain,celldir='zp') + end if + + ! Calculate face velocities + call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) + ! Apply face BC - air inflow + call fs%get_bcond('crossflow',mybc) + do n=1,mybc%itr%n_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i:i+1,j,k)=fs%Ui(i,j,k) + end do + ! Apply face BC - water inflow + call fs%get_bcond('jet',mybc) + do n=1,mybc%itr%n_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%V(i,j:j+1,k)=fs%Vi(i,j,k) + end do + ! Apply face BC - outflows + bc_scope = 'velocity' + call fs%apply_bcond(time%dt,bc_scope) + + ! Calculate mixture density and momenta + fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho + fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi + ! Perform initial pressure relax + relax_model = thermmech_egy_mech_hhz + call fs%pressure_relax(vf,matmod,relax_model) + ! Calculate initial phase and bulk moduli + call fs%init_phase_bulkmod(vf,matmod) + call fs%reinit_phase_pressure(vf,matmod) + call fs%harmonize_advpressure_bulkmod(vf,matmod) + ! Set initial pressure to harmonized field based on internal energy + fs%P = fs%PA + + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='LiqJetinSSCrossflow') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) + call ens_out%add_scalar('P',fs%P) + call ens_out%add_scalar('PA',fs%PA) + call ens_out%add_scalar('Grho',fs%Grho) + call ens_out%add_scalar('Lrho',fs%Lrho) + call ens_out%add_scalar('Density',fs%RHO) + call ens_out%add_scalar('Bulkmod',fs%RHOSS2) + call ens_out%add_scalar('Temperature',fs%Tmptr) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%RHOmin,'RHOmin') + call mfile%add_column(fs%RHOmax,'RHOmax') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%Tmax,'Tmax') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + use messager, only: die + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Reinitialize phase pressure by syncing it with conserved phase energy + call fs%reinit_phase_pressure(vf,matmod) + fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi + fs%RHOold = fs%RHO + ! Remember old flow variables (phase) + fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho + fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE + fs%GPold = fs%GP; fs%LPold = fs%LP + + ! Remember old interface, including VF and barycenters + call vf%copy_interface_to_old() + + ! Create in-cell reconstruction + call fs%flow_reconstruct(vf) + + ! Zero variables that will change during subiterations + fs%P = 0.0_WP + fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP + fs%Hpjump = 0.0_WP + + ! Determine semi-Lagrangian advection flag + call fs%flag_sl(time%dt,vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Predictor step, involving advection and pressure terms + call fs%advection_step(time%dt,vf,matmod) + + ! Viscous step + call fs%diffusion_src_explicit_step(time%dt,vf,matmod) + + ! Prepare pressure projection + call fs%pressureproj_prepare(time%dt,vf,matmod) + ! Initialize and solve Helmholtz equation + call fs%psolv%setup() + fs%psolv%sol=fs%PA-fs%P + call fs%psolv%solve() + call fs%cfg%sync(fs%psolv%sol) + ! Perform corrector step using solution + fs%P=fs%P+fs%psolv%sol + call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + + ! Record convergence monitor + call cvgfile%write() + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Pressure relaxation + call fs%pressure_relax(vf,matmod,relax_model) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays - none + + end subroutine simulation_final + +end module simulation diff --git a/examples/multiphaseKH/GNUmakefile b/examples/multiphaseKH/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseKH/GNUmakefile +++ b/examples/multiphaseKH/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphaseRT/GNUmakefile b/examples/multiphaseRT/GNUmakefile index 6027db469..c4825c881 100644 --- a/examples/multiphaseRT/GNUmakefile +++ b/examples/multiphaseRT/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/multiphase_pipe/GNUmakefile b/examples/multiphase_pipe/GNUmakefile new file mode 100644 index 000000000..b92867b7c --- /dev/null +++ b/examples/multiphase_pipe/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := subgrid constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/multiphase_pipe/README b/examples/multiphase_pipe/README new file mode 100644 index 000000000..ba28b9a69 --- /dev/null +++ b/examples/multiphase_pipe/README @@ -0,0 +1,2 @@ +Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: +Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. diff --git a/examples/multiphase_pipe/input b/examples/multiphase_pipe/input new file mode 100644 index 000000000..3a98424db --- /dev/null +++ b/examples/multiphase_pipe/input @@ -0,0 +1,33 @@ +# Parallelization +Partition : 8 1 1 + +# Mesh definition +Pipe diameter : 1 +Pipe length : 4 +nx : 256 +ny : 64 +nz : 64 + +# Pipe properties +Bulk velocity : 1 +Fluctuation amp : 0.2 + +# Time integration +Max timestep size : 0.01 +Max cfl number : 0.9 +Max time : 1000 + +# Fluid properties +Dynamic viscosity : 2e-4 +Density : 1 + +# Pressure solver +Pressure tolerance : 1e-4 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-4 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1 diff --git a/examples/multiphase_pipe/src/Make.package b/examples/multiphase_pipe/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/multiphase_pipe/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/multiphase_pipe/src/geometry.f90 b/examples/multiphase_pipe/src/geometry.f90 new file mode 100644 index 000000000..9f2df8dae --- /dev/null +++ b/examples/multiphase_pipe/src/geometry.f90 @@ -0,0 +1,136 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init,get_VF + + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + use pgrid_class, only: p3dfft_decomp + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U','u') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V','v') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W','w') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry \ No newline at end of file diff --git a/examples/multiphase_pipe/src/simulation.f90 b/examples/multiphase_pipe/src/simulation.f90 new file mode 100644 index 000000000..052f8051d --- /dev/null +++ b/examples/multiphase_pipe/src/simulation.f90 @@ -0,0 +1,380 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an an incompressible solver, pressure solver, and corresponding time tracker + type(incomp), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays + real(WP), dimension(:,:,:,:,:), allocatable :: gradU + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: G + real(WP) :: visc,mfr_target,mfr,bforce + + +contains + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) + myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho + myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Create an incompressible flow solver without bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=incomp(cfg=cfg,name='Incompressible NS') + ! Set the flow properties + call param_read('Density',fs%rho) + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + ps%maxlevel=14 + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our velocity field + initialize_velocity: block + use mathtools, only: twoPi + use random, only: random_uniform + integer :: i,j,k + real(WP) :: Ubulk,amp + ! Initial fields + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + ! For faster transition + call param_read('Fluctuation amp',amp,default=0.0_WP) + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) + fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + ! Get target MFR and zero bodyforce + mfr=get_bodyforce_mfr() + mfr_target=mfr + bforce=0.0_WP + end block initialize_velocity + + + ! Initialize IBM fields + initialize_ibm: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + end do + end do + end do + end block initialize_ibm + + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='pipe') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Turbulence modeling + sgs_modeling: block + use sgsmodel_class, only: vreman + resU=fs%rho + call fs%get_gradu(gradU) + call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + fs%visc=visc+sgs%visc + end block sgs_modeling + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU + resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV + resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW + + ! Add body forcing + bodyforcing: block + real(WP) :: mfr + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dt*bforce + end block bodyforcing + + ! Apply IB forcing to enforce BC at the pipe walls + !ibforcing: block + ! integer :: i,j,k + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! resU(i,j,k)=resU(i,j,k)-(1.0_WP-get_VF(i,j,k,'U'))*fs%rho*fs%U(i,j,k) + ! resV(i,j,k)=resV(i,j,k)-(1.0_WP-get_VF(i,j,k,'V'))*fs%rho*fs%V(i,j,k) + ! resW(i,j,k)=resW(i,j,k)-(1.0_WP-get_VF(i,j,k,'W'))*fs%rho*fs%W(i,j,k) + ! end do + ! end do + ! end do + !end block ibforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply IB forcing to enforce BC at the pipe walls + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) + fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) + fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions on the resulting fields + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%correct_mfr() + call fs%get_div() + fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho + fs%V=fs%V-time%dt*resV/fs%rho + fs%W=fs%W-time%dt*resW/fs%rho + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) + + end subroutine simulation_final + +end module simulation diff --git a/examples/nozzle_2grids/GNUmakefile b/examples/nozzle_2grids/GNUmakefile index 86fde1a2e..f77956a50 100644 --- a/examples/nozzle_2grids/GNUmakefile +++ b/examples/nozzle_2grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/GNUmakefile b/examples/nozzle_2phase/GNUmakefile index 7b5261a4f..dc888af81 100644 --- a/examples/nozzle_2phase/GNUmakefile +++ b/examples/nozzle_2phase/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_2phase/src/simulation.f90 b/examples/nozzle_2phase/src/simulation.f90 index 8c3c96138..1333c4b95 100644 --- a/examples/nozzle_2phase/src/simulation.f90 +++ b/examples/nozzle_2phase/src/simulation.f90 @@ -852,7 +852,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp%p(np)%col =0.0_WP !< Give zero collision force + lp%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp%p(np)%d =(6.0_WP*Vd/pi)**(1.0_WP/3.0_WP) !< Assign diameter from model above lp%p(np)%pos =vf%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp%p(np)%vel =fs%cfg%get_velocity(pos=lp%p(np)%pos,i0=i,j0=j,k0=k,U=fs%U,V=fs%V,W=fs%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_3grids/GNUmakefile b/examples/nozzle_3grids/GNUmakefile index 7eb9f094c..ce3cd7055 100644 --- a/examples/nozzle_3grids/GNUmakefile +++ b/examples/nozzle_3grids/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/nozzle_3grids/src/simulation.f90 b/examples/nozzle_3grids/src/simulation.f90 index 80fa99650..c3c3027fa 100644 --- a/examples/nozzle_3grids/src/simulation.f90 +++ b/examples/nozzle_3grids/src/simulation.f90 @@ -1627,7 +1627,8 @@ subroutine transfer_vf_to_drops() ! Add the drop lp3%p(np)%id =int(0,8) !< Give id (maybe based on break-up model?) lp3%p(np)%dt =0.0_WP !< Let the drop find it own integration time - lp3%p(np)%col =0.0_WP !< Give zero collision force + lp3%p(np)%Acol=0.0_WP !< Give zero collision force (axial) + lp3%p(np)%Tcol=0.0_WP !< Give zero collision force (tangential) lp3%p(np)%d =(6.0_WP*Vl/pi)**(1.0_WP/3.0_WP) !< Assign diameter based on remaining liquid volume lp3%p(np)%pos =vf2%Lbary(:,i,j,k) !< Place the drop at the liquid barycenter lp3%p(np)%vel =fs2%cfg%get_velocity(pos=lp3%p(np)%pos,i0=i,j0=j,k0=k,U=fs2%U,V=fs2%V,W=fs2%W) !< Interpolate local cell velocity as drop velocity diff --git a/examples/nozzle_internal/GNUmakefile b/examples/nozzle_internal/GNUmakefile index 4649d1344..9bec65f40 100644 --- a/examples/nozzle_internal/GNUmakefile +++ b/examples/nozzle_internal/GNUmakefile @@ -21,9 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/GNUmakefile b/examples/part_bed/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_bed/GNUmakefile +++ b/examples/part_bed/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_bed/src/simulation.f90 b/examples/part_bed/src/simulation.f90 index ab3c8a29a..60d4343ed 100644 --- a/examples/part_bed/src/simulation.f90 +++ b/examples/part_bed/src/simulation.f90 @@ -83,7 +83,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/part_inject/GNUmakefile b/examples/part_inject/GNUmakefile index c66736380..08f94d1c9 100644 --- a/examples/part_inject/GNUmakefile +++ b/examples/part_inject/GNUmakefile @@ -22,9 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -LAPACK_DIR= /Users/jcaps/Research/Codes/Builds/hypre -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_inject/input b/examples/part_inject/input index ce0325099..529ea015f 100644 --- a/examples/part_inject/input +++ b/examples/part_inject/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 2 2 +Partition : 2 2 2 # Mesh definition Lx : 0.007 diff --git a/examples/part_inject/src/simulation.f90 b/examples/part_inject/src/simulation.f90 index 09d75af36..be9287951 100644 --- a/examples/part_inject/src/simulation.f90 +++ b/examples/part_inject/src/simulation.f90 @@ -145,7 +145,7 @@ subroutine simulation_init ! Create a monitor file create_monitor: block ! Prepare some info about fields - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call lp%get_max() ! Create simulation monitor mfile=monitor(amroot=lp%cfg%amRoot,name='simulation') @@ -188,12 +188,12 @@ subroutine simulation_run do while (.not.time%done()) ! Increment time - call lp%get_cfl(time%dt,time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) call time%adjust_dt() call time%increment() ! Inject particles - call lp%inject(dt=time%dt) + call lp%inject(dt=time%dt,avoid_overlap=.true.) ! Collide particles call lp%collide(dt=time%dt) diff --git a/examples/part_tester/GNUmakefile b/examples/part_tester/GNUmakefile index 200ae5c00..ca97911e5 100644 --- a/examples/part_tester/GNUmakefile +++ b/examples/part_tester/GNUmakefile @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/part_tester/src/simulation.f90 b/examples/part_tester/src/simulation.f90 index b0fad014e..269a24285 100644 --- a/examples/part_tester/src/simulation.f90 +++ b/examples/part_tester/src/simulation.f90 @@ -76,7 +76,8 @@ subroutine simulation_init ! Give zero velocity lp%p(i)%vel=0.0_WP ! Give zero collision force - lp%p(i)%col=0.0_WP + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP ! Give zero dt lp%p(i)%dt=0.0_WP ! Locate the particle on the mesh diff --git a/examples/pvessel/GNUmakefile b/examples/pvessel/GNUmakefile index 53ecb4714..7d199c73f 100644 --- a/examples/pvessel/GNUmakefile +++ b/examples/pvessel/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -COOLPROP_DIR= /Users/desjardi/Builds/coolprop +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/rayleigh-taylor/GNUmakefile b/examples/rayleigh-taylor/GNUmakefile index 46ed15431..f928f86a6 100644 --- a/examples/rayleigh-taylor/GNUmakefile +++ b/examples/rayleigh-taylor/GNUmakefile @@ -21,10 +21,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile new file mode 100644 index 000000000..44ad3a454 --- /dev/null +++ b/examples/riser/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK = TRUE +USE_FFTW = TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := variable_density particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/riser/README b/examples/riser/README new file mode 100644 index 000000000..772f09724 --- /dev/null +++ b/examples/riser/README @@ -0,0 +1 @@ +Periodic pipe with particles. diff --git a/examples/riser/input b/examples/riser/input new file mode 100644 index 000000000..1f1fe64e4 --- /dev/null +++ b/examples/riser/input @@ -0,0 +1,46 @@ +# Parallelization +Partition : 1 4 1 + +# Mesh definition +Pipe length : 0.08 +Pipe diameter : .01 +nx : 570 +ny : 70 +nz : 1 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 +Max time : 10 + +# Fluid properties +Bulk velocity : 0.272 +Dynamic viscosity : 1.8e-5 +Density : 1.2 +Gravity : -9.81 0 0 + +# Particle properties +Particle volume fraction : 0.012 +Particle mean diameter : 58e-6 +Particle standard deviation : 25-6 +Particle min diameter : 21e-6 +Particle max diameter : 140e-6 +Particle diameter shift : 8e-6 +Particle density : 2250 +Collision timescale : 15e-5 +Coefficient of restitution : 0.8 +Friction coefficient : 0.1 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 200e-5 + +# Postprocessing output +Postproc output period : 200e-5 + +# Restart files +Restart output period : 200e-5 +!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/Make.package b/examples/riser/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/riser/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/riser/src/geometry.f90 b/examples/riser/src/geometry.f90 new file mode 100644 index 000000000..57e685a7d --- /dev/null +++ b/examples/riser/src/geometry.f90 @@ -0,0 +1,134 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + !> Pipe diameter + real(WP), public :: D + + public :: geometry_init, get_VF + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz,no + real(WP) :: Lx,Ly,Lz,dx + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Pipe length',Lx) + call param_read('Pipe diameter',D) + call param_read('ny',ny); allocate(y(ny+1)) + call param_read('nx',nx); allocate(x(nx+1)) + call param_read('nz',nz); allocate(z(nz+1)) + + dx=Lx/real(nx,WP) + no=6 + if (ny.gt.1) then + Ly=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Ly=dx + end if + if (nz.gt.1) then + Lz=D+real(2*no,WP)*D/real(ny-2*no,WP) + else + Lz=dx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + do k=cfg%kmin_,cfg%kmax_ + do j=cfg%jmin_,cfg%jmax_ + do i=cfg%imin_,cfg%imax_ + cfg%VF(i,j,k)=max(get_VF(i,j,k,'SC'),epsilon(1.0_WP)) + end do + end do + end do + call cfg%sync(cfg%VF) + call cfg%calc_fluid_vol() + end block create_walls + + + end subroutine geometry_init + + + !> Get volume fraction for direct forcing + function get_VF(i,j,k,dir) result(VF) + implicit none + integer, intent(in) :: i,j,k + character(len=*) :: dir + real(WP) :: VF + real(WP) :: r,eta,lam,delta,VFx,VFy,VFz + real(WP), dimension(3) :: norm + select case(trim(dir)) + case('U') + delta=(cfg%dxm(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + case('V') + delta=(cfg%dx(i)*cfg%dym(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%y(j)/r; norm(3)=cfg%zm(k)/r + case('W') + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dzm(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2)+epsilon(1.0_WP) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%z(k)/r + case default + delta=(cfg%dx(i)*cfg%dy(j)*cfg%dz(k))**(1.0_WP/3.0_WP) + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) + norm(1)=0.0_WP; norm(2)=cfg%ym(j)/r; norm(3)=cfg%zm(k)/r + end select + lam=sum(abs(norm)); eta=0.065_WP*(1.0_WP-lam**2)+0.39_WP + VF=0.5_WP*(1.0_WP-tanh((r-0.5_WP*D)/(sqrt(2.0_WP)*lam*eta*delta+epsilon(1.0_WP)))) + end function get_VF + + +end module geometry diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 new file mode 100644 index 000000000..eff547c6e --- /dev/null +++ b/examples/riser/src/simulation.f90 @@ -0,0 +1,825 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg,D,get_VF + use lowmach_class, only: lowmach + use fourier3d_class, only: fourier3d + use hypre_str_class, only: hypre_str + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker + type(lowmach), public :: fs + type(fourier3d), public :: ps + type(hypre_str), public :: vs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Provide a datafile and an event tracker for saving restarts + type(event) :: save_evt + type(datafile) :: df + logical :: restarted + + !> Ensight postprocessing + type(ensight) :: ens_out + type(partmesh) :: pmesh + type(event) :: ens_evt + + !> Event for post-processing + type(event) :: ppevt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,lptfile,tfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: G + real(WP), dimension(:,:,:,:), allocatable :: Gnorm + real(WP) :: visc,rho,mfr,mfr_target,bforce + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + +contains + + + !> Specialized subroutine that outputs mean statistics + subroutine postproc() + use string, only: str_medium + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + integer :: iunit,ierr,i,j,k + real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ + character(len=str_medium) :: filename,timestamp +!!$ ! Allocate radial line storage +!!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP +!!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP +!!$ allocate(vol_ (fs%cfg%jmin:fs%cfg%jmax)); vol_ =0.0_WP +!!$ allocate(vol (fs%cfg%jmin:fs%cfg%jmax)); vol =0.0_WP +!!$ ! Integrate all data over x and z +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ vol_(j) = vol_(j)+fs%cfg%vol(i,j,k) +!!$ Uavg_(j)=Uavg_(j)+fs%cfg%vol(i,j,k)*fs%U(i,j,k) +!!$ end do +!!$ end do +!!$ end do +!!$ ! All-reduce the data +!!$ call MPI_ALLREDUCE( vol_, vol,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ call MPI_ALLREDUCE(Uavg_,Uavg,fs%cfg%ny,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ if (vol(j).gt.0.0_WP) then +!!$ Uavg(j)=Uavg(j)/vol(j) +!!$ else +!!$ Uavg(j)=0.0_WP +!!$ end if +!!$ end do +!!$ ! If root, print it out +!!$ if (fs%cfg%amRoot) then +!!$ filename='Uavg_' +!!$ write(timestamp,'(es12.5)') time%t +!!$ open(newunit=iunit,file=trim(adjustl(filename))//trim(adjustl(timestamp)),form='formatted',status='replace',access='stream',iostat=ierr) +!!$ write(iunit,'(a12,3x,a12)') 'Height','Uavg' +!!$ do j=fs%cfg%jmin,fs%cfg%jmax +!!$ write(iunit,'(es12.5,3x,es12.5)') fs%cfg%ym(j),Uavg(j) +!!$ end do +!!$ close(iunit) +!!$ end if +!!$ ! Deallocate work arrays +!!$ deallocate(Uavg,Uavg_,vol,vol_) + end subroutine postproc + + + !> Compute massflow rate + function get_bodyforce_mfr(srcU) result(mfr) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: vol,myRhoU,myUvol,Uvol,mfr + myRhoU=0.0_WP; myUvol=0.0_WP + if (present(srcU)) then + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*(fs%rhoU(i,j,k)+srcU(i,j,k)) + end do + end do + end do + else + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') + myUvol=myUvol+vol + myRhoU=myRhoU+vol*fs%rhoU(i,j,k) + end do + end do + end do + end if + call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) + call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol + end function get_bodyforce_mfr + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Handle restart/saves here + restart_and_save: block + character(len=str_medium) :: timestamp + ! Create event for saving restart files + save_evt=event(time,'Restart output') + call param_read('Restart output period',save_evt%tper) + ! Check if we are restarting + call param_read(tag='Restart from',val=timestamp,short='r',default='') + restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. + if (restarted) then + ! If we are, read the name of the directory + call param_read('Restart from',timestamp,'r') + ! Read the datafile + df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) + else + ! If we are not restarting, we will still need a datafile for saving restart files + df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) + df%valname(1)='t' + df%valname(2)='dt' + df%valname(3)='mfr' + df%valname(4)='bforce' + df%varname(1)='U' + df%varname(2)='V' + df%varname(3)='W' + df%varname(4)='P' + end if + end block restart_and_save + + + ! Revisit timetracker to adjust time and time step values if this is a restart + update_timetracker: block + if (restarted) then + call df%pullval(name='t' ,val=time%t ) + call df%pullval(name='dt',val=time%dt) + time%told=time%t-time%dt + end if + end block update_timetracker + + + ! Initialize wallclock timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_lognormal,random_uniform + use mathtools, only: Pi,twoPi + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER + use parallel, only: MPI_REAL_WP + real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf + real(WP) :: dmean,dsd,dmin,dmax,dshift + real(WP), dimension(:), allocatable :: dp + integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + character(len=str_medium) :: timestamp + logical :: overlap + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get pipe diameter from input + ! Get mean volume fraction from input + call param_read('Particle volume fraction',VFavg) + ! Get drag model from input + call param_read('Drag model',lp%drag_model,default='Tenneti') + ! Get particle density from input + call param_read('Particle density',lp%rho) + ! Get particle diameter from input + call param_read('Particle mean diameter',dmean) + call param_read('Particle standard deviation',dsd,default=0.0_WP) + call param_read('Particle min diameter',dmin,default=tiny(1.0_WP)) + call param_read('Particle max diameter',dmax,default=huge(1.0_WP)) + call param_read('Particle diameter shift',dshift,default=0.0_WP) + if (dsd.le.epsilon(1.0_WP)) then + dmin=dmean + dmax=dmean + end if + ! Get particle temperature from input + call param_read('Particle temperature',Tp,default=298.15_WP) + ! Set collision timescale + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) + ! Set gravity + call param_read('Gravity',lp%gravity) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + ! Initialize particles + if (restarted) then + call param_read('Restart from',timestamp,'r') + ! Read the part file + call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) + else + ! Get volume of domain belonging to this proc + Vol_=0.0_WP + do k=lp%cfg%kmin_,lp%cfg%kmax_ + do j=lp%cfg%jmin_,lp%cfg%jmax_ + do i=lp%cfg%imin_,fs%cfg%imax_ + Vol_=Vol_+lp%cfg%dx(i)*lp%cfg%dy(j)*lp%cfg%dz(k) + end do + end do + end do + ! Get particle diameters + np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) + allocate(dp(np)) + sumVolp=0.0_WP; np=0 + do while(sumVolp.lt.VFavg*Vol_) + np=np+1 + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + do while (dp(np).gt.dmax+epsilon(1.0_WP).or.dp(np).lt.dmin-epsilon(1.0_WP)) + dp(np)=random_lognormal(m=dmean-dshift,sd=dsd)+dshift + end do + sumVolp=sumVolp+Pi/6.0_WP*dp(np)**3 + end do + call lp%resize(np) + ! Allocate particle in cell arrays + allocate(npic( lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); npic=0 + allocate(ipic(1:40,lp%cfg%imino_:lp%cfg%imaxo_,lp%cfg%jmino_:lp%cfg%jmaxo_,lp%cfg%kmino_:lp%cfg%kmaxo_)); ipic=0 + ! Distribute particles + sumVolp=0.0_WP; meand=0.0_WP + do i=1,np + ! Set the diameter + lp%p(i)%d=dp(i) + ! Give position (avoid overlap) + overlap=.true. + do while (overlap) + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin_),lp%cfg%x(lp%cfg%imax_+1)-dmax),& + & random_uniform(lp%cfg%y(lp%cfg%jmin_),lp%cfg%y(lp%cfg%jmax_+1)-dmax),& + & random_uniform(lp%cfg%z(lp%cfg%kmin_),lp%cfg%z(lp%cfg%kmax_+1)-dmax)] + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + overlap=.false. + do kk=lp%p(i)%ind(3)-1,lp%p(i)%ind(3)+1 + do jj=lp%p(i)%ind(2)-1,lp%p(i)%ind(2)+1 + do ii=lp%p(i)%ind(1)-1,lp%p(i)%ind(1)+1 + do nn=1,npic(ii,jj,kk) + j=ipic(nn,ii,jj,kk) + if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) overlap=.true. + end do + end do + end do + end do + end do + ! Check if particle is within the pipe + r=sqrt(lp%p(i)%pos(2)**2+lp%p(i)%pos(3)**2) + if (r.le.0.5_WP*(D-lp%p(i)%d)) then + ! Activate the particle + lp%p(i)%flag=0 + ip=lp%p(i)%ind(1); jp=lp%p(i)%ind(2); kp=lp%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + ! Set the temperature + lp%p(i)%T=Tp + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Sum up volume + sumVolp=sumVolp+Pi/6.0_WP*lp%p(i)%d**3 + meand=meand+lp%p(i)%d + else + lp%p(i)%flag=1 + end if + end do + deallocate(dp,npic,ipic) + call lp%sync() + ! Set ID + offset=0 + do i=1,lp%cfg%rank + offset=offset+lp%np_proc(i) + end do + do i=1,lp%np_ + lp%p(i)%id=int(i+offset,8) + end do + ! Get mean diameter and volume fraction + call MPI_ALLREDUCE(meand,buf,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meand=buf/real(lp%np,WP) + call MPI_ALLREDUCE(sumVolp,VFavg,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); VFavg=VFavg/(Pi*D**2/4.0_WP*lp%cfg%xL) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', lp%np + print*,'Mean diameter', meand + print*,'Mean volume fraction',VFavg + end if + end if + ! Get initial particle volume fraction + call lp%update_VF() + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + real(WP) :: Ubulk + if (restarted) then + call df%pullvar(name='U',var=fs%U) + call df%pullvar(name='V',var=fs%V) + call df%pullvar(name='W',var=fs%W) + call df%pullvar(name='P',var=fs%P) + else + ! Initial velocity + call param_read('Bulk velocity',Ubulk) + fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + end if + ! Set density from particle volume fraction and store initial density + fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho + ! Form momentum + call fs%rho_multiply + fs%rhoUold=fs%rhoU + ! Apply all other boundary conditions + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Set initial MFR and body force + if (restarted) then + call df%pullval(name='mfr',val=mfr) + call df%pullval(name='bforce',val=bforce) + else + mfr=get_bodyforce_mfr() + bforce=0.0_WP + end if + mfr_target=mfr + end block initialize_velocity + + + ! Initialize levelset and its normal + initialize_G: block + integer :: i,j,k + real(WP) :: buf + real(WP), dimension(3) :: n12 + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + G(i,j,k)=0.5_WP*D-sqrt(fs%cfg%ym(j)**2+fs%cfg%zm(k)**2) + n12(1)=0.0_WP + n12(2)=-fs%cfg%ym(j) + n12(3)=-fs%cfg%zm(k) + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + Gnorm(:,i,j,k)=n12/buf + end do + end do + end do + call fs%cfg%sync(G) + call fs%cfg%sync(Gnorm) + end block initialize_G + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='riser') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('levelset',G) + call ens_out%add_scalar('ibm_vf',fs%cfg%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('epsp',lp%VF) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + ! Create monitor filea + create_monitor: block + real(WP) :: cfl + ! Prepare some info about fields + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(mfr,'MFR') + call mfile%add_column(bforce,'Body force') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%ncol,'Collision number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() + end block create_monitor + + + ! Create a specialized post-processing file + create_postproc: block + ! Create event for data postprocessing + ppevt=event(time=time,name='Postproc output') + call param_read('Postproc output period',ppevt%tper) + ! Perform the output + if (ppevt%occurs()) call postproc() + end block create_postproc + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use parallel, only: parallel_time + implicit none + real(WP) :: cfl + + ! Perform time integration + do while (.not.time%done()) + + ! Initial wallclock time + wt_total%time_in=parallel_time() + + ! Increment time + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Get fluid stress (include mean body force from mfr forcing) + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + resU=resU+bforce + + ! Collide and advance particles + call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) + end do + end do + end do + call fs%cfg%sync(resU) + call fs%cfg%sync(resV) + call fs%cfg%sync(resW) + end block add_lpt_src + + ! Apply direct forcing to enforce BC at the pipe walls + ibm_correction: block + integer :: i,j,k + real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + VFx=get_VF(i,j,k,'U') + VFy=get_VF(i,j,k,'V') + VFz=get_VF(i,j,k,'W') + RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) + RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) + RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + end do + end do + end do + end block ibm_correction + + ! Add body forcing + bodyforcing: block + mfr=get_bodyforce_mfr(resU) + bforce=(mfr_target-mfr)/time%dtmid + resU=resU+time%dtmid*bforce + end block bodyforcing + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + +!!$ ! Apply direct forcing to enforce BC at the pipe walls +!!$ ibm_correction: block +!!$ integer :: i,j,k +!!$ real(WP) :: VFx,VFy,VFz +!!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ +!!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ +!!$ do i=fs%cfg%imin_,fs%cfg%imax_ +!!$ VFx=get_VF(i,j,k,'U') +!!$ VFy=get_VF(i,j,k,'V') +!!$ VFz=get_VF(i,j,k,'W') +!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx +!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy +!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz +!!$ end do +!!$ end do +!!$ end do +!!$ call fs%cfg%sync(fs%U) +!!$ call fs%cfg%sync(fs%V) +!!$ call fs%cfg%sync(fs%W) +!!$ end block ibm_correction + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Solve Poisson equation + wt_pres%time_in=parallel_time() + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Recompute massflow rate + mfr=get_bodyforce_mfr() + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Specialized post-processing + if (ppevt%occurs()) call postproc() + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + ! Finally, see if it's time to save restart files + if (save_evt%occurs()) then + save_restart: block + character(len=str_medium) :: timestamp + ! Prefix for files + write(timestamp,'(es12.5)') time%t + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Populate df and write it + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt ) + call df%pushval(name='mfr',val=mfr_target) + call df%pushval(name='bforce',val=bforce ) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) + call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) + ! Write particle file + call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) + end block save_restart + end if + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) + + end subroutine simulation_final + +end module simulation diff --git a/examples/shock_particle/README b/examples/shock_particle/README deleted file mode 100644 index 098c2471d..000000000 --- a/examples/shock_particle/README +++ /dev/null @@ -1 +0,0 @@ -This is a test case for a shock wave interacting with Lagrangian particles. Uses multiphase solver and hard-codes VF to 0 or 1 based on chosen phase. diff --git a/examples/shock_particle/input b/examples/shock_particle/input deleted file mode 100644 index b359f094b..000000000 --- a/examples/shock_particle/input +++ /dev/null @@ -1,44 +0,0 @@ -# Parallelization -Partition : 3 1 1 - -# Mesh definition -Lx : 0.2048 -nx : 512 -Ly : 0.0256 -ny : 64 - -# Flow setup -Shock location : 0.08 -Mach number of shock : 1.47 -Pre-shock density : 1.204 -Pre-shock pressure : 1.01325e5 -Particle volume fraction : 0.2 -Particle curtain width : 0.0034 - -# Fluid properties -Phase : gas -Dynamic viscosity : 1.8e-5 -Thermal conductivity : 0 -Gamma : 1.4 - -# Particle parameters -Particle density : 1000 -Particle diameter : 200e-6 -Drag model : Tenneti - -# Time integration -Max timestep size : 8e-7 -Max cfl number : 0.9 -Max time : 100000 -Max steps : 100000 - -# Pressure solver -Pressure tolerance : 1e-6 -Pressure iteration : 100 - -# Implicit velocity solver -Implicit tolerance : 1e-6 -Implicit iteration : 100 - -# Ensight output -Ensight output period : 10e-6 diff --git a/examples/shock_particle/src/simulation.f90 b/examples/shock_particle/src/simulation.f90 deleted file mode 100644 index 53a91f348..000000000 --- a/examples/shock_particle/src/simulation.f90 +++ /dev/null @@ -1,593 +0,0 @@ -!> Various definitions and tools for running an NGA2 simulation -module simulation - use precision, only: WP - use geometry, only: cfg - use mast_class, only: mast - use vfs_class, only: vfs - use matm_class, only: matm - use lpt_class, only: lpt - use partmesh_class, only: partmesh - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - use string, only: str_medium - implicit none - private - - !> Single two-phase flow solver, volume fraction solver, material model, and LPT solver set - !> With corresponding time tracker - type(mast), public :: fs - type(vfs), public :: vf - type(matm), public :: matmod - type(lpt), public :: lp - type(timetracker), public :: time - - !> Ensight postprocessing - type(partmesh) :: pmesh - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile,cvgfile - type(monitor) :: lptfile - - public :: simulation_init,simulation_run,simulation_final - - !> Problem definition - character(len=str_medium) :: phase - integer :: relax_model - - !> Work arrays and fluid properties - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resE - real(WP), dimension(:,:,:), allocatable :: dRHOdt - - contains - - !> Function that localizes the left (x-) of the domain - function left_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imin) isIn=.true. - end function left_of_domain - - !> Function that localizes the right (x+) of the domain - function right_of_domain(pg,i,j,k) result(isIn) - use pgrid_class, only: pgrid - implicit none - class(pgrid), intent(in) :: pg - integer, intent(in) :: i,j,k - logical :: isIn - isIn=.false. - if (i.eq.pg%imax+1) isIn=.true. - end function right_of_domain - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - call param_read('Max steps',time%nmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(dRHOdt(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resE (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize our LPT - initialize_lpt: block - use random, only: random_uniform - use mathtools, only: Pi - use parallel, only: amRoot - use lpt_class, only: drag_model - real(WP) :: dp,VFp,L,x0,vol,volp - integer :: i,np - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get drag model from the inpit - call param_read('Drag model',drag_model,default='Tenneti') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle diameter',dp) - ! Get particle volume fraction from the input - call param_read('Particle volume fraction',VFp) - ! Get curtain width from the input - call param_read('Particle curtain width',L) - ! Get starting position - x0=0.5_WP*(lp%cfg%x(lp%cfg%imax+1)-lp%cfg%x(lp%cfg%imin)-L) - ! Get number of particles - vol=L*lp%cfg%yL*lp%cfg%zL - volp=Pi*dp**3/6.0_WP - np=int(VFp * vol / volp) - ! Set filter scale to 3.5*dx - lp%filter_width=3.5_WP*cfg%min_meshsize - ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(x0,x0+L),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin) - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero collision force - lp%p(i)%col=0.0_WP - ! Give it temperature - lp%p(i)%T=293.15_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do - end if - ! Distribute particles - call lp%sync() - ! Get initial particle volume fraction - call lp%update_VF() - ! Set collision timescale - lp%Tcol=5.0_WP*time%dt - if (amRoot) then - print*,"===== Particle Setup Description =====" - print*,'Number of particles', np - print*,'Mean volume fraction',vfp - end if - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - pmesh=partmesh(nvar=0,name='lpt') - call lp%update_partmesh(pmesh) - end block create_pmesh - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver with lvira reconstruction - vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') - call param_read('Phase',phase) - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - select case(trim(phase)) - case('gas') - vf%VF(i,j,k)=0.0_WP - case('liquid') - vf%VF(i,j,k)=1.0_WP - case default - end select - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end do - end do - end do - ! Boundary conditions on VF are built into the mast solver - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Set initial interface at the boundaries - call vf%set_full_bcond() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a compressible two-phase flow solver - create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz - use matm_class, only : air - use ils_class, only: pcg_bbox,gmres_smg - use mathtools, only: Pi - use parallel, only: amRoot - integer :: i,j,k,n - real(WP), dimension(3) :: xyz - real(WP) :: gamm,Pref,visc,hdff - real(WP) :: xshock,vshock,relshockvel - real(WP) :: rho0, P0, rho1, P1, Ma1, Ma, rho, P, U - type(bcond), pointer :: mybc - ! Create material model class - matmod=matm(cfg=cfg,name='Liquid-gas models') - ! Get EOS parameters from input - call param_read('Gamma',gamm) - ! Register equations of state - select case(trim(phase)) - case('gas') - call matmod%register_idealgas('gas',gamm) - case('liquid') - call param_read('Pref', Pref) - call matmod%register_stiffenedgas('liquid',gamm,Pref) - end select - ! Create flow solver - fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) - ! Register flow solver variables with material models - call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) - call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity, also heat diffusion - call param_read('Dynamic viscosity',visc) - call param_read('Thermal conductivity',hdff) - select case(trim(phase)) - case('gas') - call matmod%register_diffusion_thermo_models(viscmodel_gas=air, viscconst_gas=visc, & - viscconst_liquid=0.0_WP, hdffconst_gas=hdff, hdffconst_liquid=0.0_WP) - fs%Lrho = 0.0_WP - fs%LrhoE= 0.0_WP - case('liquid') - call matmod%register_diffusion_thermo_models(viscconst_gas=0.0_WP, viscconst_liquid=visc, & - hdffconst_gas=0.0_WP, hdffconst_liquid=hdff) - fs%Grho = 0.0_WP - end select - ! Read in surface tension coefficient - fs%sigma=0.0_WP - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit momentum solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) - ! Initially 0 velocity in y and z - fs%Vi = 0.0_WP; fs%Wi = 0.0_WP - ! Zero face velocities as well for the sake of dirichlet boundaries - fs%V = 0.0_WP; fs%W = 0.0_WP - ! Set up initial thermo properties (0) - ! Default is from Meng & Colonius (2015), - ! which is basically the same as Igra & Takayama and Terashima & Tryggvason - call param_read('Pre-shock density',rho0,default=1.204_WP) - call param_read('Pre-shock pressure',P0,default=1.01325e5_WP) - call param_read('Mach number of shock',Ma,default=1.47_WP) - call param_read('Shock location',xshock) - ! Use shock relations to get post-shock numbers (1) - P1 = P0 * (2.0_WP*gamm*Ma**2 - (gamm-1.0_WP)) / (gamm+1.0_WP) - rho1 = rho0 * (Ma**2 * (gamm+1.0_WP) / ((gamm-1.0_WP)*Ma**2 + 2.0_WP)) - ! Calculate post-shock Mach number - Ma1 = sqrt(((gamm-1.0_WP)*(Ma**2)+2.0_WP)/(2.0_WP*gamm*(Ma**2)-(gamm-1.0_WP))) - ! Calculate post-shock velocity - vshock = -Ma1 * sqrt(gamm*P1/rho1) + Ma*sqrt(gamm*P0/rho0) - ! Velocity at which shock moves - relshockvel = -rho1*vshock/(rho0-rho1) - - if (amRoot) then - print*,"===== Fluid Setup Description =====" - print*,'Mach number', Ma - print*,'Pre-shock: Density',rho0,'Pressure',P0 - print*,'Post-shock: Density',rho1,'Pressure',P1,'Velocity',vshock - print*,'Shock velocity', relshockvel - end if - - ! Initialize gas phase quantities - do i=fs%cfg%imino_,fs%cfg%imaxo_ - ! pressure, velocity, use matmod for energy - if (fs%cfg%x(i).lt.xshock) then - rho = rho1 - U = vshock - P = P1 - else - rho = rho0 - U = 0.0_WP - P = P0 - end if - select case(trim(phase)) - case('gas') - fs%Grho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%GrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'gas') - case('liquid') - fs%Lrho(i,:,:) = rho - fs%Ui(i,:,:) = U - fs%LrhoE(i,:,:) = matmod%EOS_energy(P,rho,U,0.0_WP,0.0_WP,'liquid') - end select - end do - - ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers - call fs%add_bcond(name= 'inflow',type=dirichlet ,locator=left_of_domain ,face='x',dir=-1) - call fs%add_bcond(name='outflow',type=clipped_neumann,locator=right_of_domain,face='x',dir=+1) - - ! Calculate face velocities - call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) - ! Apply face BC - inflow - call fs%get_bcond('inflow',mybc) - do n=1,mybc%itr%n_ - i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=vshock - end do - ! Apply face BC - outflow - bc_scope = 'velocity' - call fs%apply_bcond(time%dt,bc_scope) - - ! Calculate mixture density and momenta - fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho - fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi - ! Perform initial pressure relax - relax_model = mech_egy_mech_hhz - call fs%pressure_relax(vf,matmod,relax_model) - ! Calculate initial phase and bulk moduli - call fs%init_phase_bulkmod(vf,matmod) - call fs%reinit_phase_pressure(vf,matmod) - call fs%harmonize_advpressure_bulkmod(vf,matmod) - ! Set initial pressure to harmonized field based on internal energy - fs%P = fs%PA - - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='ShockTube') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) - call ens_out%add_scalar('T',fs%Tmptr) - call ens_out%add_scalar('P',fs%P) - call ens_out%add_scalar('PA',fs%PA) - call ens_out%add_scalar('Density',fs%RHO) - call ens_out%add_scalar('Bulkmod',fs%RHOSS2) - call ens_out%add_scalar('divU',fs%divU) - call ens_out%add_scalar('Viscosity',fs%visc) - call ens_out%add_scalar('Mach',fs%Mach) - call ens_out%add_particle('particles',pmesh) - call ens_out%add_scalar('epsp',lp%VF) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call lp%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%RHOmin,'RHOmin') - call mfile%add_column(fs%RHOmax,'RHOmax') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(fs%Tmax,'Tmax') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLa_x,'Acoustic xCFL') - call cflfile%add_column(fs%CFLa_y,'Acoustic yCFL') - call cflfile%add_column(fs%CFLa_z,'Acoustic zCFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - ! Create convergence monitor - cvgfile=monitor(fs%cfg%amRoot,'cvg') - call cvgfile%add_column(time%n,'Timestep number') - call cvgfile%add_column(time%it,'Iteration') - call cvgfile%add_column(time%t,'Time') - call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') - call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') - call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') - call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') - call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') - call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') - call cvgfile%add_column(fs%psolv%it,'Pressure iteration') - call cvgfile%add_column(fs%psolv%rerr,'Pressure error') - ! Create LPT monitor - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%VFmean,'VFp_mean') - call lptfile%add_column(lp%VFmax,'VFp_max') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - use messager, only: die - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Reinitialize phase pressure by syncing it with conserved phase energy - call fs%reinit_phase_pressure(vf,matmod) - fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi - fs%RHOold = fs%RHO - ! Remember old flow variables (phase) - fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho - fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE - fs%GPold = fs%GP; fs%LPold = fs%LP - - ! Remember old interface, including VF and barycenters - call vf%copy_interface_to_old() - - ! Create in-cell reconstruction - call fs%flow_reconstruct(vf) - - ! Zero variables that will change during subiterations - fs%P = 0.0_WP - fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP - fs%Hpjump = 0.0_WP - - ! Determine semi-Lagrangian advection flag - call fs%flag_sl(time%dt,vf) - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - resU=fs%rho - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=fs%visc) - - ! Update density based on particle volume fraction - fs%rho=resU*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Add momentum source term from lpt (cell-centered) - add_lpt_src: block - integer :: i,j,k - resU=0.0_WP; resV=0.0_WP; resW=0.0_WP; resE=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - resU(i,j,k)=resU(i,j,k)+lp%srcU(i,j,k) - resV(i,j,k)=resV(i,j,k)+lp%srcV(i,j,k) - resW(i,j,k)=resW(i,j,k)+lp%srcW(i,j,k) - resE(i,j,k)=resE(i,j,k)+lp%srcE(i,j,k) - end do - end do - end do - end block add_lpt_src - - ! Predictor step, involving advection and pressure terms - call fs%advection_step(time%dt,vf,matmod) - - ! Viscous step - call fs%diffusion_src_explicit_step(time%dt,vf,matmod,srcU=resU,srcV=resV,srcW=resW,srcE=resE) - - ! Prepare pressure projection - call fs%pressureproj_prepare(time%dt,vf,matmod) - ! Initialize and solve Helmholtz equation - call fs%psolv%setup() - fs%psolv%sol=fs%PA-fs%P - call fs%psolv%solve() - call fs%cfg%sync(fs%psolv%sol) - ! Perform corrector step using solution - fs%P=fs%P+fs%psolv%sol - call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) - - ! Record convergence monitor - call cvgfile%write() - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Pressure relaxation - call fs%pressure_relax(vf,matmod,relax_model) - - ! Output to ensight - if (ens_evt%occurs()) then - update_pmesh: block - integer :: i - call lp%update_partmesh(pmesh) - do i=1,lp%np_ - pmesh%var(1,i)=0.5_WP*lp%p(i)%d - end do - end block update_pmesh - call fs%get_viz() - call ens_out%write_data(time%t) - end if - - ! Perform and output monitoring - call fs%get_max() - call lp%get_max() - call mfile%write() - call cflfile%write() - call lptfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,resE,dRHOdt) - - end subroutine simulation_final - -end module simulation diff --git a/examples/shock_water_cylinder/GNUmakefile b/examples/shock_water_cylinder/GNUmakefile index 5680ec1e3..466227c85 100644 --- a/examples/shock_water_cylinder/GNUmakefile +++ b/examples/shock_water_cylinder/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/shock_water_cylinder/input b/examples/shock_water_cylinder/input index 9ee712117..ed26f15cb 100644 --- a/examples/shock_water_cylinder/input +++ b/examples/shock_water_cylinder/input @@ -24,6 +24,8 @@ Pre-shock pressure : 1.01325e5 # Fluid properties Liquid dynamic viscosity : 0 Gas dynamic viscosity : 0 +Liquid thermal conductivity : 0 +Gas thermal conductivity : 0 Liquid gamma : 4.4 Liquid Pref : 6e8 Gas gamma : 1.4 diff --git a/examples/shock_water_cylinder/src/geometry.f90 b/examples/shock_water_cylinder/src/geometry.f90 index aa01d943f..1ee21f16f 100644 --- a/examples/shock_water_cylinder/src/geometry.f90 +++ b/examples/shock_water_cylinder/src/geometry.f90 @@ -228,7 +228,7 @@ subroutine geometry_init print*,' first dy',y(ny/2+nyr+2)-y(ny/2+nyr+1),'last dy',y(ny+1)-y(ny) print*,' first pt',y(ny/2+nyr+1),'last pt',y(ny+1) print*,'Bottom region' - print*,' first pt',y(1),'last pt',y(ny/2) + print*,' first pt',y(1),'last pt',y(ny/2-nyr+1) print*,' ' end if diff --git a/examples/shock_water_cylinder/src/simulation.f90 b/examples/shock_water_cylinder/src/simulation.f90 index ea4607301..089786029 100644 --- a/examples/shock_water_cylinder/src/simulation.f90 +++ b/examples/shock_water_cylinder/src/simulation.f90 @@ -24,12 +24,13 @@ module simulation type(event) :: ens_evt !> Simulation monitor file - type(monitor) :: mfile,cflfile + type(monitor) :: mfile,cflfile,cvgfile public :: simulation_init,simulation_run,simulation_final !> Problem definition real(WP) :: dcyl,xcyl + integer :: relax_model contains @@ -85,14 +86,14 @@ subroutine simulation_init ! Initialize our VOF solver and field create_and_initialize_vof: block use mms_geom, only: cube_refine_vol - use vfs_class, only: r2p,lvira,VFhi,VFlo + use vfs_class, only: r2p,lvira,elvira,VFhi,VFlo integer :: i,j,k,n,si,sj,sk real(WP), dimension(3,8) :: cube_vertex real(WP), dimension(3) :: v_cent,a_cent real(WP) :: vol,area integer, parameter :: amr_ref_lvl=4 ! Create a VOF solver with lvira reconstruction - vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') ! Initialize liquid at left call param_read('Cylinder diameter',dcyl) call param_read('Cylinder location',xcyl) @@ -115,6 +116,7 @@ subroutine simulation_init if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then vf%Lbary(:,i,j,k)=v_cent vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + vf%Gbary(3,i,j,k)=v_cent(3); else vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] @@ -122,11 +124,12 @@ subroutine simulation_init end do end do end do + ! Boundary conditions on VF are built into the mast solver ! Update the band call vf%update_band() ! Perform interface reconstruction from VOF field call vf%build_interface() - ! Set interface at the boundaries + ! Set initial interface at the boundaries call vf%set_full_bcond() ! Create discontinuous polygon mesh from IRL interface call vf%polygonalize_interface() @@ -143,14 +146,14 @@ subroutine simulation_init ! Create a compressible two-phase flow solver create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond - use ils_class, only: pcg_bbox,pcg_amg + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz + use ils_class, only: pcg_bbox,gmres_smg use mathtools, only: Pi use parallel, only: amRoot integer :: i,j,k,n real(WP), dimension(3) :: xyz - real(WP) :: gamm_l,Pref_l,gamm_g - real(WP) :: xshock,vshock,relshockvel,dcyl + real(WP) :: gamm_l,Pref_l,gamm_g,visc_l,visc_g,hdff_g,hdff_l + real(WP) :: xshock,vshock,relshockvel real(WP) :: Grho0, GP0, Grho1, GP1, ST, Ma1, Ma, Lrho0 type(bcond), pointer :: mybc ! Create material model class @@ -167,9 +170,13 @@ subroutine simulation_init ! Register flow solver variables with material models call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l0) - call param_read('Gas dynamic viscosity',fs%visc_g0) + ! Assign constant viscosity to each phase, also heat diffusion + call param_read('Liquid dynamic viscosity',visc_l) + call param_read('Gas dynamic viscosity',visc_g) + call param_read('Liquid thermal conductivity',hdff_l) + call param_read('Gas thermal conductivity',hdff_g) + call matmod%register_diffusion_thermo_models(viscconst_gas=visc_g, viscconst_liquid=visc_l, & + hdffconst_gas=hdff_g, hdffconst_liquid=hdff_l) ! Read in surface tension coefficient call param_read('Surface tension coefficient',fs%sigma) ! Configure pressure solver @@ -179,13 +186,15 @@ subroutine simulation_init call param_read('Implicit iteration',fs%implicit%maxit) call param_read('Implicit tolerance',fs%implicit%rcvg) ! Setup the solver - call fs%setup(pressure_ils=pcg_bbox,implicit_ils=pcg_amg) + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=gmres_smg) ! Liquid density call param_read('Liquid density',Lrho0) fs%Lrho = Lrho0 ! Initially 0 velocity in y and z fs%Vi = 0.0_WP; fs%Wi = 0.0_WP + ! Zero face velocities as well for the sake of dirichlet boundaries + fs%V = 0.0_WP; fs%W = 0.0_WP ! Set up initial thermo properties (0) ! Default is from Meng & Colonius (2015), ! which is basically the same as Igra & Takayama and Terashima & Tryggvason @@ -226,7 +235,6 @@ subroutine simulation_init end do ! Initialize liquid energy, with surface tension - call param_read('Cylinder diameter',dcyl) fs%LrhoE = matmod%EOS_energy(GP0+fs%sigma*2.0_WP/dcyl,Lrho0,0.0_WP,0.0_WP,0.0_WP,'liquid') ! Define boundary conditions - initialized values are intended dirichlet values too, for the cell centers @@ -249,7 +257,8 @@ subroutine simulation_init fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi ! Perform initial pressure relax - call fs%pressure_relax(vf,matmod) + relax_model = mech_egy_mech_hhz + call fs%pressure_relax(vf,matmod,relax_model) ! Calculate initial phase and bulk moduli call fs%init_phase_bulkmod(vf,matmod) call fs%reinit_phase_pressure(vf,matmod) @@ -294,16 +303,13 @@ subroutine simulation_init call mfile%add_column(time%t,'Time') call mfile%add_column(time%dt,'Timestep size') call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%RHOmin,'RHOmin') + call mfile%add_column(fs%RHOmax,'RHOmax') call mfile%add_column(fs%Umax,'Umax') call mfile%add_column(fs%Vmax,'Vmax') call mfile%add_column(fs%Wmax,'Wmax') call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - !call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%add_column(fs%Tmax,'Tmax') call mfile%write() ! Create CFL monitor cflfile=monitor(fs%cfg%amRoot,'cfl') @@ -317,6 +323,19 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') call cflfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') end block create_monitor @@ -325,6 +344,7 @@ end subroutine simulation_init !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase subroutine simulation_run + use messager, only: die implicit none ! Perform time integration @@ -350,10 +370,6 @@ subroutine simulation_run ! Create in-cell reconstruction call fs%flow_reconstruct(vf) - ! Get boundary conditions at current time - - ! Other routines to add later: sgs, lpt, prescribe - ! Zero variables that will change during subiterations fs%P = 0.0_WP fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP @@ -367,10 +383,9 @@ subroutine simulation_run ! Predictor step, involving advection and pressure terms call fs%advection_step(time%dt,vf,matmod) - - ! Insert viscous step here, or possibly incorporate into predictor above - - ! Insert sponge step here + + ! Viscous step + call fs%diffusion_src_explicit_step(time%dt,vf,matmod) ! Prepare pressure projection call fs%pressureproj_prepare(time%dt,vf,matmod) @@ -383,13 +398,15 @@ subroutine simulation_run fs%P=fs%P+fs%psolv%sol call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + ! Record convergence monitor + call cvgfile%write() ! Increment sub-iteration counter time%it=time%it+1 end do ! Pressure relaxation - call fs%pressure_relax(vf,matmod) + call fs%pressure_relax(vf,matmod,relax_model) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/examples/spreading/GNUmakefile b/examples/spreading/GNUmakefile index d2be840a9..01b390664 100644 --- a/examples/spreading/GNUmakefile +++ b/examples/spreading/GNUmakefile @@ -23,11 +23,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL -LAPACK_DIR= /Users/desjardi/Builds/lapack -#ODRPACK_DIR=/Users/desjardi/Builds/odrpack +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/swirl_atomizer/GNUmakefile b/examples/swirl_atomizer/GNUmakefile new file mode 100644 index 000000000..d3c3c1851 --- /dev/null +++ b/examples/swirl_atomizer/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +USE_ODRPACK=FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/swirl_atomizer/README b/examples/swirl_atomizer/README new file mode 100644 index 000000000..e13540dfa --- /dev/null +++ b/examples/swirl_atomizer/README @@ -0,0 +1 @@ +This is an implementation of a two-phase pressure swirl atomizer. diff --git a/examples/swirl_atomizer/input b/examples/swirl_atomizer/input new file mode 100644 index 000000000..3d2151b27 --- /dev/null +++ b/examples/swirl_atomizer/input @@ -0,0 +1,39 @@ +# Parallelization +Partition : 8 1 1 + +# Domain definition +Lx : 5 +Ly : 5 +Lz : 5 +nx : 100 +ny : 100 +nz : 100 + +# Problem definition +Inner radius : 0.4 +Outer radius : 0.6 +Liquid velocity : 1 +Swirl ratio : 1 + +# Fluid properties - Dimensional case +Liquid dynamic viscosity : 1e-3 +Gas dynamic viscosity : 1e-5 +Liquid density : 1 +Gas density : 1e-3 +Surface tension coefficient : 1e-3 + +# Time integration +Max timestep size : 4e-3 +Max cfl number : 0.9 +Max time : 100 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-5 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 diff --git a/examples/swirl_atomizer/src/Make.package b/examples/swirl_atomizer/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/swirl_atomizer/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/shock_particle/src/geometry.f90 b/examples/swirl_atomizer/src/geometry.f90 similarity index 62% rename from examples/shock_particle/src/geometry.f90 rename to examples/swirl_atomizer/src/geometry.f90 index 736845194..b247f2af5 100644 --- a/examples/shock_particle/src/geometry.f90 +++ b/examples/swirl_atomizer/src/geometry.f90 @@ -4,78 +4,70 @@ module geometry use precision, only: WP implicit none private - + !> Single config type(config), public :: cfg - + public :: geometry_init contains - - + + !> Initialization of problem geometry subroutine geometry_init use sgrid_class, only: sgrid - use param, only: param_read, param_exists - use parallel, only: amRoot - use messager, only: die + use param, only: param_read implicit none type(sgrid) :: grid - - + + ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian integer :: i,j,k,nx,ny,nz - real(WP) :: Lx,Ly,Lz,dx + real(WP) :: Lx,Ly,Lz real(WP), dimension(:), allocatable :: x,y,z - - ! Read in grid definition + + ! Read in grid and geometry definition call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) - dx = Lx/nx call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) - call param_read('nz',nz,default=1); allocate(z(nz+1)) - - if (nz.eq.1) then - Lz = dx - else - call param_read('Lz',Lz) - end if - - ! Uniform grid + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid do i=1,nx+1 - x(i) = real(i-1,WP)*dx + x(i)=real(i-1,WP)/real(nx,WP)*Lx end do do j=1,ny+1 - y(j) = real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly end do - - ! z is always uniform do k=1,nz+1 - z(k) = real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz end do - + ! General serial grid object - grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='ShockTube') - - end block create_grid - - - ! Create a config from that grid on our entire group - create_cfg: block + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='swirl_atomizer') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block use parallel, only: group integer, dimension(3) :: partition - ! Read in partition call param_read('Partition',partition,short='p') - ! Create partitioned grid cfg=config(grp=group,decomp=partition,grid=grid) - end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + end subroutine geometry_init - - + + end module geometry diff --git a/examples/swirl_atomizer/src/simulation.f90 b/examples/swirl_atomizer/src/simulation.f90 new file mode 100644 index 000000000..73e0ea519 --- /dev/null +++ b/examples/swirl_atomizer/src/simulation.f90 @@ -0,0 +1,515 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use surfmesh_class, only: surfmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver and volume fraction solver and corresponding time tracker + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + type(surfmesh), public :: smesh + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: SRmag + real(WP), dimension(:,:,:,:), allocatable :: SR + + !> Problem definition + real(WP) :: R1,R2 !< Inner and outer radii of annulus + real(WP) :: Ul,SW !< Liquid axial velocity and swirl ratio + +contains + + + !> Function that defines a level set function for an annular liquid region + function levelset_annulus(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G,r + r=sqrt(xyz(2)**2+xyz(3)**2) + G=min(r-R1,R2-r) + end function levelset_annulus + + + !> Function that localizes the top (x+) of the domain + function xp_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function xp_locator + + + !> Function that localizes the bottom (x-) of the domain boundary + function xm_locator(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.le.pg%imin) isIn=.true. + end function xm_locator + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SRmag(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR (6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot,name='pressure_swirl') + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,r2p,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Set full domain to gas + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + vf%VF(i,j,k)=0.0_WP + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end do + end do + end do + ! Initialize an annular interface at the inlet only + call param_read('Inner radius',R1) + call param_read('Outer radius',R2) + if (vf%cfg%iproc.eq.1) then + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino,vf%cfg%imin-1 + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_annulus,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + end if + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use tpns_class, only: dirichlet,clipped_neumann + use ils_class, only: pcg_pfmg + integer :: i,j,k + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity' ,fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density' ,fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Inflow on the left of domain + call fs%add_bcond(name='inflow',type=dirichlet, face='x',dir=-1,canCorrect=.false.,locator=xm_locator) + ! Clipped Neumann outflow on the right of domain + call fs%add_bcond(name='bc_xp' ,type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=xp_locator) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_pfmg,implicit_ils=pcg_pfmg) + end block create_and_initialize_flow_solver + + + ! Initialize our velocity field + initialize_velocity: block + use tpns_class, only: bcond + type(bcond), pointer :: mybc + real(WP) :: r,theta + integer :: n,i,j,k + ! Zero initial field in the domain + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Read in inflow parameters + call param_read('Liquid velocity',Ul) + call param_read('Swirl ratio',SW) + ! Apply axial and swirl component Dirichlet at inlet + call fs%get_bcond('inflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + ! Set U velocity + r=sqrt(cfg%ym(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%U(i,j,k)=Ul + ! Set V velocity + r=sqrt(cfg%y(j)**2+cfg%zm(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%y(j),cfg%zm(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%V(i,j,k)=+4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*cos(theta) + ! Set W velocity + r=sqrt(cfg%ym(j)**2+cfg%z(k)**2) !< Radius in cylindrical coordinates + theta=atan2(cfg%ym(j),cfg%z(k)) !< Angle in cylindrical coordinates + if (r.ge.R1.and.r.le.R2) fs%W(i,j,k)=-4.0_WP*SW*Ul*(-r**2+(R2+R1)*r-R2*R1)/((R2-R1)**2)*sin(theta) + end do + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + ! Adjust MFR for global mass balance + call fs%correct_mfr() + ! Compute cell-centered velocity + call fs%interp_vel(Ui,Vi,Wi) + ! Compute divergence + call fs%get_div() + end block initialize_velocity + + + ! Create surfmesh object for interface polygon output + create_smesh: block + use irl_fortran_interface + integer :: i,j,k,nplane,np + ! Include an extra variable for number of planes + smesh=surfmesh(nvar=1,name='plic') + smesh%varname(1)='nplane' + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block create_smesh + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='swirl_atomizer') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('Pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_surface('vofplic',smesh) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(vf%SDint,'SD integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Calculate SR + ! call fs%get_strainrate(Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) + + ! ! Model shear thinning fluid + ! nonewt: block + ! integer :: i,j,k + ! real(WP), parameter :: C=1.137e-3_WP + ! real(WP), parameter :: n=0.3_WP + ! ! Update viscosity + ! do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + ! do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + ! do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! ! Power law model + ! SRmag(i,j,k)=sqrt(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! SRmag(i,j,k)=max(SRmag(i,j,k),1000.0_WP**(1.0_WP/(n-1.0_WP))) + ! fs%visc_l(i,j,k)=C*SRmag(i,j,k)**(n-1.0_WP) + ! ! Carreau Model + ! ! SRmag(i,j,k)=sqrt(2.00_WP*SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2)) + ! ! fs%visc_l(i,j,k)=visc_inf+(visc_0-visc_inf)*(1.00_WP+(lambda*SRmag(i,j,k))**2.00_WP)**((n-1.00_WP)/2.00_WP) + ! end do + ! end do + ! end do + ! ! call fs%cfg%sync(fs%visc_l) + ! end block nonewt + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) then + ! Update surfmesh object + update_smesh: block + use irl_fortran_interface + integer :: nplane,np,i,j,k + ! Transfer polygons to smesh + call vf%update_surfmesh(smesh) + ! Also populate nplane variable + smesh%var(1,:)=1.0_WP + np=0 + do k=vf%cfg%kmin_,vf%cfg%kmax_ + do j=vf%cfg%jmin_,vf%cfg%jmax_ + do i=vf%cfg%imin_,vf%cfg%imax_ + do nplane=1,getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)) + if (getNumberOfVertices(vf%interface_polygon(nplane,i,j,k)).gt.0) then + np=np+1; smesh%var(1,np)=real(getNumberOfPlanes(vf%liquid_gas_interface(i,j,k)),WP) + end if + end do + end do + end do + end do + end block update_smesh + ! Perform ensight output + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + ! After we're done clip all VOF at the exit area and along the sides - hopefully nothing's left + clip_vof: block + integer :: i,j,k + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + if (i.ge.vf%cfg%imax-5) vf%VF(i,j,k)=0.0_WP + if (j.ge.vf%cfg%jmax-5) vf%VF(i,j,k)=0.0_WP + if (j.le.vf%cfg%jmin+5) vf%VF(i,j,k)=0.0_WP + if (k.ge.vf%cfg%kmax-5) vf%VF(i,j,k)=0.0_WP + if (k.le.vf%cfg%kmin+5) vf%VF(i,j,k)=0.0_WP + end do + end do + end do + end block clip_vof + + end do + + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi,SR,SRmag) + + end subroutine simulation_final + + +end module simulation diff --git a/examples/vdjet/GNUmakefile b/examples/vdjet/GNUmakefile new file mode 100644 index 000000000..7f4563ac0 --- /dev/null +++ b/examples/vdjet/GNUmakefile @@ -0,0 +1,45 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core variable_density data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/vdjet/README b/examples/vdjet/README new file mode 100644 index 000000000..49711c7e4 --- /dev/null +++ b/examples/vdjet/README @@ -0,0 +1,2 @@ +This is an implementation of a Rayleigh-Taylor instability. This is currently intended as a test of +the variable density velocity and scalar solvers. diff --git a/examples/vdjet/input b/examples/vdjet/input new file mode 100644 index 000000000..e00fa4cf8 --- /dev/null +++ b/examples/vdjet/input @@ -0,0 +1,34 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 10 +Ly : 5 +Lz : 0.05 +nx : 200 +ny : 100 +nz : 1 + +# Fluid properties +Dynamic viscosity : 0.001 +Dynamic diffusivity : 0.001 +Jet density : 1.0 +Coflow density : 1.0 +Jet diameter : 1.0 +Jet velocity : 1.0 +Coflow velocity : 0.1 + +# Time integration +Max timestep size : 5e-2 +Max cfl number : 1 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-1 diff --git a/examples/vdjet/src/Make.package b/examples/vdjet/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/vdjet/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/vdjet/src/geometry.f90 b/examples/vdjet/src/geometry.f90 new file mode 100644 index 000000000..2ea1158a7 --- /dev/null +++ b/examples/vdjet/src/geometry.f90 @@ -0,0 +1,76 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.true.,zper=.true.,name='vdjet') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + cfg%VF=0.0_WP + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/vdjet/src/simulation.f90 b/examples/vdjet/src/simulation.f90 new file mode 100644 index 000000000..1e13ad3b9 --- /dev/null +++ b/examples/vdjet/src/simulation.f90 @@ -0,0 +1,484 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use lowmach_class, only: lowmach + use vdscalar_class, only: vdscalar + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single low Mach flow solver and scalar solver and corresponding time tracker + type(lowmach), public :: fs + type(vdscalar), public :: sc + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,consfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resSC + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Equation of state + real(WP) :: rho_jet,rho_cof + real(WP) :: D_jet + real(WP) :: U_jet,U_cof + +contains + + + !> Function that localizes the right domain boundary + function right_boundary(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_boundary + + + !> Function that localizes jet at -x + function jet(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP) :: radius + logical :: isIn + isIn=.false. + ! Jet in yz plane + radius=norm2([pg%ym(j),pg%zm(k)]-[0.0_WP,0.0_WP]) + if (radius.le.0.5_WP*D_jet.and.i.eq.pg%imin) isIn=.true. + end function jet + + + !> Function that localizes coflow at -x + function coflow(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP) :: radius + logical :: isIn + isIn=.false. + ! Coflow in yz plane + radius=norm2([pg%ym(j),pg%zm(k)]-[0.0_WP,0.0_WP]) + if (radius.gt.0.5_WP*D_jet.and.i.eq.pg%imin) isIn=.true. + end function coflow + + + !> Function that localizes jet at -x + function jetsc(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP) :: radius + logical :: isIn + isIn=.false. + ! Jet in yz plane + radius=norm2([pg%ym(j),pg%zm(k)]-[0.0_WP,0.0_WP]) + if (radius.le.0.5_WP*D_jet.and.i.eq.pg%imin-1) isIn=.true. + end function jetsc + + + !> Function that localizes coflow at -x + function coflowsc(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + real(WP) :: radius + logical :: isIn + isIn=.false. + ! Coflow in yz plane + radius=norm2([pg%ym(j),pg%zm(k)]-[0.0_WP,0.0_WP]) + if (radius.gt.0.5_WP*D_jet.and.i.eq.pg%imin-1) isIn=.true. + end function coflowsc + + + !> Define here our equation of state + subroutine get_rho() + implicit none + integer :: i,j,k + ! Calculate density + do k=sc%cfg%kmino_,sc%cfg%kmaxo_ + do j=sc%cfg%jmino_,sc%cfg%jmaxo_ + do i=sc%cfg%imino_,sc%cfg%imaxo_ + sc%rho(i,j,k)=1.0_WP!rho_jet*rho_cof/((1.0_WP-sc%SC(i,j,k))*rho_jet+sc%SC(i,j,k)*rho_cof) + end do + end do + end do + end subroutine get_rho + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Read in the EOS info and jet diameter + call param_read('Jet density',rho_jet) + call param_read('Coflow density',rho_cof) + call param_read('Jet diameter',D_jet) + call param_read('Jet velocity',U_jet) + call param_read('Coflow velocity',U_cof) + + + ! Create an incompressible flow solver with bconds + create_solver: block + use ils_class, only: pcg_amg + use lowmach_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define jet and coflow boundary conditions + call fs%add_bcond(name='jet' ,type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=jet ) + call fs%add_bcond(name='coflow',type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=coflow) + ! Outflow on the right + call fs%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true.,locator=right_boundary) + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit velocity solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_amg) + end block create_solver + + + ! Create a scalar solver + create_scalar: block + use ils_class, only: pcg_amg + use vdscalar_class, only: dirichlet,neumann,quick + real(WP) :: diffusivity + ! Create scalar solver + sc=vdscalar(cfg=cfg,scheme=quick,name='MixFrac') + ! Define jet and coflow boundary conditions + call sc%add_bcond(name='jet' ,type=dirichlet,locator=jetsc ) + call sc%add_bcond(name='coflow',type=dirichlet,locator=coflowsc) + ! Outflow on the right + call sc%add_bcond(name='outflow',type=neumann,locator=right_boundary,dir='+x') + ! Assign constant diffusivity + call param_read('Dynamic diffusivity',diffusivity) + sc%diff=diffusivity + ! Configure implicit scalar solver + sc%implicit%maxit=fs%implicit%maxit; sc%implicit%rcvg=fs%implicit%rcvg + ! Setup the solver + call sc%setup(implicit_ils=pcg_amg) + end block create_scalar + + + ! Allocate work arrays + allocate_work_arrays: block + ! Flow solver + allocate(resU(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(resV(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(resW(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Ui (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Vi (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Wi (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + ! Scalar solver + allocate(resSC(sc%cfg%imino_:sc%cfg%imaxo_,sc%cfg%jmino_:sc%cfg%jmaxo_,sc%cfg%kmino_:sc%cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=fs%cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our mixture fraction field + initialize_scalar: block + use vdscalar_class, only: bcond + integer :: n,i,j,k + type(bcond), pointer :: mybc + ! Zero initial field + sc%SC=0.0_WP + ! Apply BCs + call sc%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=1.0_WP + end do + call sc%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=0.0_WP + end do + ! Compute density + call get_rho() + end block initialize_scalar + + + ! Initialize our velocity field + initialize_velocity: block + use lowmach_class, only: bcond + integer :: n,i,j,k + type(bcond), pointer :: mybc + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Apply BCs + call fs%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_jet + end do + call fs%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_cof + end do + ! Set density from scalar + fs%rho=sc%rho + ! Form momentum + call fs%rho_multiply + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + call fs%interp_vel(Ui,Vi,Wi) + resSC=0.0_WP + call fs%get_div(drhodt=resSC) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + end block initialize_velocity + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='vdjet') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('divergence',fs%div) + call ens_out%add_scalar('density',sc%rho) + call ens_out%add_scalar('mixfrac',sc%SC) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call sc%get_max() + call sc%get_int() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(sc%SCmax,'Zmax') + call mfile%add_column(sc%SCmin,'Zmin') + call mfile%add_column(sc%rhomax,'RHOmax') + call mfile%add_column(sc%rhomin,'RHOmin') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create conservation monitor + consfile=monitor(fs%cfg%amRoot,'conservation') + call consfile%add_column(time%n,'Timestep number') + call consfile%add_column(time%t,'Time') + call consfile%add_column(sc%SCint,'SC integral') + call consfile%add_column(sc%rhoint,'RHO integral') + call consfile%add_column(sc%rhoSCint,'rhoSC integral') + call consfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old scalar + sc%rhoold=sc%rho + sc%SCold =sc%SC + + ! Remember old velocity and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! ============= SCALAR SOLVER ======================= + ! Build mid-time scalar + !sc%SC=0.5_WP*(sc%SC+sc%SCold) + + ! Explicit calculation of drhoSC/dt from scalar equation + !call sc%get_drhoSCdt(resSC,fs%rhoU,fs%rhoV,fs%rhoW) + + ! Assemble explicit residual + !resSC=time%dt*resSC-(2.0_WP*sc%rho*sc%SC-(sc%rho+sc%rhoold)*sc%SCold) + + ! Form implicit residual + !call sc%solve_implicit(time%dt,resSC,fs%rhoU,fs%rhoV,fs%rhoW) + + ! Apply this residual + !sc%SC=2.0_WP*sc%SC-sc%SCold+resSC + + ! Apply other boundary conditions on the resulting field + !call sc%apply_bcond(time%t,time%dt) + ! =================================================== + + ! ============ UPDATE PROPERTIES ==================== + ! Backup rhoSC + !resSC=sc%rho*sc%SC + ! Update density + !call get_rho() + ! Rescale scalar for conservation + !sc%SC=resSC/sc%rho + ! UPDATE THE VISCOSITY + ! UPDATE THE DIFFUSIVITY + ! =================================================== + + ! ============ VELOCITY SOLVER ====================== + + ! Build n+1 density + fs%rho=0.5_WP*(sc%rho+sc%rhoold) + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + ! Solve Poisson equation + !call sc%get_drhodt(dt=time%dt,drhodt=resSC) + resSC=0.0_WP + call fs%correct_mfr(drhodt=resSC) + call fs%get_div(drhodt=resSC) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + ! =================================================== + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call sc%get_drhodt(dt=time%dt,drhodt=resSC) + call fs%get_div(drhodt=resSC) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call sc%get_max() + call sc%get_int() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resSC,resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + + + + +end module simulation diff --git a/examples/vortexTG/GNUmakefile b/examples/vortexTG/GNUmakefile new file mode 100644 index 000000000..466227c85 --- /dev/null +++ b/examples/vortexTG/GNUmakefile @@ -0,0 +1,46 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/vortexTG/README b/examples/vortexTG/README new file mode 100644 index 000000000..9ff38ef5d --- /dev/null +++ b/examples/vortexTG/README @@ -0,0 +1 @@ +This is part of the MAST V & V suite of cases. 2D Taylor-Green vortex. diff --git a/examples/vortexTG/input b/examples/vortexTG/input new file mode 100644 index 000000000..097119adf --- /dev/null +++ b/examples/vortexTG/input @@ -0,0 +1,33 @@ +# Parallelization +Partition : 1 1 1 + +# Mesh definition +nx : 32 + +# Flow setup +Background pressure : 59.76143 + +# Fluid properties +Liquid gamma : 4.4 +Liquid Pref : 6e3 +Gas gamma : 1.4 +Gas dynamic viscosity : 0 + +# Initial conditions +Gas density : 1 + +# Time integration +Max timestep size : 0.01 +Max cfl number : 1 +Max time : 3.9999999 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 5e-4 diff --git a/examples/vortexTG/src/Make.package b/examples/vortexTG/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/vortexTG/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/vortexTG/src/geometry.f90 b/examples/vortexTG/src/geometry.f90 new file mode 100644 index 000000000..74b914dff --- /dev/null +++ b/examples/vortexTG/src/geometry.f90 @@ -0,0 +1,94 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read,param_exists + use mathtools, only: pi + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! All dimensions are 2*pi unless there is only one cell + Lx = 2.0_WP*pi; Ly = 2.0_WP*pi; Lz = 2.0_WP*pi; + ! Read in grid definition: 2D problem with different orientations + call param_read('nx',nx); allocate(x(nx+1)) + if (param_exists('ny')) then + call param_read('ny',ny); allocate(y(ny+1)) + else + if (.not.param_exists('nz')) then + ny = nx + else + ny = 1 + end if + allocate(y(ny+1)) + end if + if (param_exists('nz')) then + call param_read('nz',nz); allocate(z(nz+1)) + else + nz = 1; allocate(z(nz+1)) + end if + ! Reduce length of unused dimension + if (nx.eq.1) then + Lx = Ly/ny + elseif (ny.eq.1) then + Ly = Lx/nx + elseif (nz.eq.1) then + Lz = Lx/nx + end if + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly-0.5_WP*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='TaylorGreenVortex') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/vortexTG/src/simulation.f90 b/examples/vortexTG/src/simulation.f90 new file mode 100644 index 000000000..a8f348ff5 --- /dev/null +++ b/examples/vortexTG/src/simulation.f90 @@ -0,0 +1,364 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use mast_class, only: mast + use vfs_class, only: vfs + use matm_class, only: matm + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single two-phase flow solver, volume fraction solver, and material model set + !> With corresponding time tracker + type(mast), public :: fs + type(vfs), public :: vf + type(matm), public :: matmod + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,kefile + + public :: simulation_init,simulation_run,simulation_final + + ! Ad-hoc monitor variable and function + real(WP) :: KE + public :: current_KE + +contains + + function current_KE(this) result(buf) + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + type(mast), intent(in) :: this + real(WP) :: buf, KE + integer :: ierr,i,j,k + + KE = 0.0_WP + + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + KE = KE + 0.5_WP*this%RHO(i,j,k)* & + (this%Ui(i,j,k)**2+this%Vi(i,j,k)**2+this%Wi(i,j,k)**2) + end do + end do + end do + call MPI_ALLREDUCE(KE,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + + end function + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read,param_exists + implicit none + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + !call param_read('Max steps',time%nmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Single-phase simulation, but MAST requires vfs solver + create_and_initialize_vof: block + use vfs_class, only: lvira + integer :: i,j,k + real(WP) :: vol,area + ! Create a VOF solver with lvira reconstruction + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Single phase + vf%VF = 0.0_WP + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Set interface at the boundaries + call vf%set_full_bcond() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a compressible two-phase flow solver + create_and_initialize_flow_solver: block + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond + use matm_class, only: none + use ils_class, only: pcg_bbox,pcg_amg + use mathtools, only: Pi + character(len=1) :: orientation + integer :: i,j,k,n + real(WP), dimension(3) :: xyz + real(WP) :: gamm_l,Pref_l,gamm_g,rho_g0,visc_g,psol,p0 + type(bcond), pointer :: mybc + ! Create material model class + matmod=matm(cfg=cfg,name='Liquid-gas models') + ! Get EOS parameters from input + call param_read('Liquid gamma',gamm_l) + call param_read('Liquid Pref', Pref_l) + call param_read('Gas gamma',gamm_g) + ! Register equations of state + call matmod%register_stiffenedgas('liquid',gamm_l,Pref_l) + call matmod%register_idealgas('gas',gamm_g) + ! Create flow solver + fs=mast(cfg=cfg,name='Two-phase All-Mach',vf=vf) + ! Register flow solver variables with material models + call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) + call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) + + ! Assign constant viscosity to each phase and turn off heat diffusion + call param_read('Gas dynamic viscosity',visc_g) + call matmod%register_diffusion_thermo_models(viscconst_gas=visc_g,hdffmodel_gas=none) + ! Surface tension should be set to 0, it is a single-phase case + fs%sigma = 0.0_WP + ! Configure pressure solver + call param_read('Pressure iteration',fs%psolv%maxit) + call param_read('Pressure tolerance',fs%psolv%rcvg) + ! Configure implicit momentum solver + call param_read('Implicit iteration',fs%implicit%maxit) + call param_read('Implicit tolerance',fs%implicit%rcvg) + ! Setup the solver + call fs%setup(pressure_ils=pcg_bbox,implicit_ils=pcg_amg) + + ! Initial conditions + call param_read('Gas density',rho_g0) + fs%Grho = rho_g0 + ! Liquid quantities are irrelevant, set to unity + fs%Lrho = 1.0_WP; fs%LrhoE = 1.0_WP + call param_read('Background pressure',p0) + ! Orientation of flow field + if (fs%cfg%nz.eq.1) then + orientation = 'z' + elseif (fs%cfg%ny.eq.1) then + orientation = 'y' + elseif (fs%cfg%nx.eq.1) then + orientation = 'x' + else + call param_read('Orientation',orientation) + end if + do k=fs%cfg%kmino_,fs%cfg%kmaxo_ + do j=fs%cfg%jmino_,fs%cfg%jmaxo_ + do i=fs%cfg%imino_,fs%cfg%imaxo_ + ! Set up flow field according to designated orientation + select case(orientation) + case('x') + fs%Ui(i,j,k) = 0.0_WP + fs%Vi(i,j,k) = cos(fs%cfg%ym(j))*sin(fs%cfg%zm(k)) + fs%Wi(i,j,k) = -sin(fs%cfg%ym(j))*cos(fs%cfg%zm(k)) + psol = p0 - 0.25_WP*(cos(2.0_WP*fs%cfg%ym(j))+cos(2.0_WP*fs%cfg%zm(k))) + case('y') + fs%Ui(i,j,k) = -sin(fs%cfg%zm(k))*cos(fs%cfg%xm(i)) + fs%Vi(i,j,k) = 0.0_WP + fs%Wi(i,j,k) = cos(fs%cfg%zm(k))*sin(fs%cfg%xm(i)) + psol = p0 - 0.25_WP*(cos(2.0_WP*fs%cfg%zm(k))+cos(2.0_WP*fs%cfg%xm(i))) + case('z') ! This is the default + fs%Ui(i,j,k) = -cos(fs%cfg%xm(i))*sin(fs%cfg%ym(j)) + fs%Vi(i,j,k) = sin(fs%cfg%xm(i))*cos(fs%cfg%ym(j)) + fs%Wi(i,j,k) = 0.0_WP + psol = p0 - 0.25_WP*(cos(2.0_WP*fs%cfg%xm(i))+cos(2.0_WP*fs%cfg%ym(j))) + end select + ! Calculate total energy + fs%GrhoE(i,j,k) = matmod%EOS_energy(psol,rho_g0,fs%Ui(i,j,k),fs%Vi(i,j,k),fs%Wi(i,j,k),'gas') + end do + end do + end do + + ! Calculate face velocities + call fs%interp_vel_basic(vf,fs%Ui,fs%Vi,fs%Wi,fs%U,fs%V,fs%W) + ! Apply face BC - this is for the sync operations within + bc_scope = 'velocity' + call fs%apply_bcond(time%dt,bc_scope) + ! Calculate mixture density and momenta + fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho + fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi + ! Perform initial pressure relax + call fs%pressure_relax(vf,matmod) + ! Calculate initial phase and bulk moduli + call fs%init_phase_bulkmod(vf,matmod) + call fs%reinit_phase_pressure(vf,matmod) + call fs%harmonize_advpressure_bulkmod(vf,matmod) + ! Set initial pressure to harmonized field based on internal energy + fs%P = fs%PA + + ! Update KE + KE = current_KE(fs) + + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='TaylorGreenVortex') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',fs%Ui,fs%Vi,fs%Wi) + call ens_out%add_scalar('P',fs%P) + call ens_out%add_scalar('Density',fs%RHO) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl,matmod=matmod) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create kinetic energy monitor + kefile=monitor(fs%cfg%amRoot,'kinetic_energy') + call kefile%add_column(time%n,'Timestep number') + call kefile%add_column(time%t,'Time') + call kefile%add_column(KE,'Kinetic energy') + call kefile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl,matmod=matmod) + call time%adjust_dt() + call time%increment() + + ! Reinitialize phase pressure by syncing it with conserved phase energy + call fs%reinit_phase_pressure(vf,matmod) + fs%Uiold=fs%Ui; fs%Viold=fs%Vi; fs%Wiold=fs%Wi + fs%RHOold = fs%RHO + ! Remember old flow variables (phase) + fs%Grhoold = fs%Grho; fs%Lrhoold = fs%Lrho + fs%GrhoEold=fs%GrhoE; fs%LrhoEold=fs%LrhoE + fs%GPold = fs%GP; fs%LPold = fs%LP + + ! Remember old interface, including VF and barycenters + call vf%copy_interface_to_old() + + ! Create in-cell reconstruction + call fs%flow_reconstruct(vf) + + ! Zero variables that will change during subiterations + fs%P = 0.0_WP + fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP + fs%Hpjump = 0.0_WP + + ! Determine semi-Lagrangian advection flag + call fs%flag_sl(time%dt,vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Predictor step, involving advection and pressure terms + call fs%advection_step(time%dt,vf,matmod) + + ! Insert viscous step here, or possibly incorporate into predictor above + call fs%diffusion_src_explicit_step(time%dt,vf,matmod) + + ! Prepare pressure projection + call fs%pressureproj_prepare(time%dt,vf,matmod) + ! Initialize and solve Helmholtz equation + call fs%psolv%setup() + fs%psolv%sol=fs%PA-fs%P + call fs%psolv%solve() + call fs%cfg%sync(fs%psolv%sol) + ! Perform corrector step using solution + fs%P=fs%P+fs%psolv%sol + call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Single-phase, no need for relaxation + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Update KE + KE = current_KE(fs) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call kefile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays - none + + end subroutine simulation_final + +end module simulation diff --git a/examples/water_air_rarefaction/GNUmakefile b/examples/water_air_rarefaction/GNUmakefile index bef49b8f7..466227c85 100644 --- a/examples/water_air_rarefaction/GNUmakefile +++ b/examples/water_air_rarefaction/GNUmakefile @@ -22,10 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -HYPRE_DIR = /Users/desjardi/Builds/hypre -LAPACK_DIR= /Users/desjardi/Builds/lapack -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/water_air_rarefaction/input b/examples/water_air_rarefaction/input index 9b00d926c..31044c06c 100644 --- a/examples/water_air_rarefaction/input +++ b/examples/water_air_rarefaction/input @@ -15,8 +15,6 @@ Post-discontinuity velocity : 11.20375 Post-discontinuity pressure : 0.7 # Fluid properties -Liquid dynamic viscosity : 0 -Gas dynamic viscosity : 0 Liquid gamma : 4.4 Liquid Pref : 6e3 Gas gamma : 1.4 @@ -24,7 +22,6 @@ Gas gamma : 1.4 # Initial conditions Liquid density : 1 Gas density : 1e-3 -Surface tension coefficient : 0 # Time integration Max timestep size : 1e-4 diff --git a/examples/water_air_rarefaction/src/simulation.f90 b/examples/water_air_rarefaction/src/simulation.f90 index 5aa2b1216..e58672841 100644 --- a/examples/water_air_rarefaction/src/simulation.f90 +++ b/examples/water_air_rarefaction/src/simulation.f90 @@ -24,13 +24,14 @@ module simulation type(event) :: ens_evt !> Simulation monitor file - type(monitor) :: mfile,cflfile + type(monitor) :: mfile,cflfile,cvgfile public :: simulation_init,simulation_run,simulation_final !> Problem definition real(WP) :: l0,l1 real(WP) :: discloc,v0,v1,p0,p1 + integer :: relax_model contains @@ -123,7 +124,8 @@ subroutine simulation_init ! Create a compressible two-phase flow solver create_and_initialize_flow_solver: block - use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond + use mast_class, only: clipped_neumann,dirichlet,bc_scope,bcond,mech_egy_mech_hhz + use matm_class, only: none use ils_class, only: gmres_amg,pcg_bbox use mathtools, only: Pi integer :: i,j,k,n @@ -144,11 +146,10 @@ subroutine simulation_init ! Register flow solver variables with material models call matmod%register_thermoflow_variables('liquid',fs%Lrho,fs%Ui,fs%Vi,fs%Wi,fs%LrhoE,fs%LP) call matmod%register_thermoflow_variables('gas' ,fs%Grho,fs%Ui,fs%Vi,fs%Wi,fs%GrhoE,fs%GP) - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l0) - call param_read('Gas dynamic viscosity',fs%visc_g0) - ! Read in surface tension coefficient - call param_read('Surface tension coefficient',fs%sigma) + ! As a shocktube case, it is intended to be inviscid, no diffusion + call matmod%register_diffusion_thermo_models(viscmodel_liquid=none,viscmodel_gas=none,hdffmodel_liquid=none,hdffmodel_gas=none) + ! Surface tension should be set to 0, it is a 1D case + fs%sigma = 0.0_WP ! Configure pressure solver call param_read('Pressure iteration',fs%psolv%maxit) call param_read('Pressure tolerance',fs%psolv%rcvg) @@ -201,7 +202,8 @@ subroutine simulation_init fs%RHO = (1.0_WP-vf%VF)*fs%Grho + vf%VF*fs%Lrho fs%rhoUi = fs%RHO*fs%Ui; fs%rhoVi = fs%RHO*fs%Vi; fs%rhoWi = fs%RHO*fs%Wi ! Perform initial pressure relax - call fs%pressure_relax(vf,matmod) + relax_model = mech_egy_mech_hhz + call fs%pressure_relax(vf,matmod,relax_model) ! Calculate initial phase and bulk moduli call fs%init_phase_bulkmod(vf,matmod) call fs%reinit_phase_pressure(vf,matmod) @@ -259,13 +261,20 @@ subroutine simulation_init call mfile%add_column(fs%Vmax,'Vmax') call mfile%add_column(fs%Wmax,'Wmax') call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - !call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') call mfile%write() + ! Create convergence monitor + cvgfile=monitor(fs%cfg%amRoot,'cvg') + call cvgfile%add_column(time%n,'Timestep number') + call cvgfile%add_column(time%it,'Iteration') + call cvgfile%add_column(time%t,'Time') + call cvgfile%add_column(fs%impl_it_x,'Impl_x iteration') + call cvgfile%add_column(fs%impl_rerr_x,'Impl_x error') + call cvgfile%add_column(fs%impl_it_y,'Impl_y iteration') + call cvgfile%add_column(fs%impl_rerr_y,'Impl_y error') + call cvgfile%add_column(fs%implicit%it,'Impl_z iteration') + call cvgfile%add_column(fs%implicit%rerr,'Impl_z error') + call cvgfile%add_column(fs%psolv%it,'Pressure iteration') + call cvgfile%add_column(fs%psolv%rerr,'Pressure error') ! Create CFL monitor cflfile=monitor(fs%cfg%amRoot,'cfl') call cflfile%add_column(time%n,'Timestep number') @@ -311,10 +320,6 @@ subroutine simulation_run ! Create in-cell reconstruction call fs%flow_reconstruct(vf) - ! Get boundary conditions at current time - - ! Other routines to add later: sgs, lpt, prescribe - ! Zero variables that will change during subiterations fs%P = 0.0_WP fs%Pjx = 0.0_WP; fs%Pjy = 0.0_WP; fs%Pjz = 0.0_WP @@ -329,9 +334,7 @@ subroutine simulation_run ! Predictor step, involving advection and pressure terms call fs%advection_step(time%dt,vf,matmod) - ! Insert viscous step here, or possibly incorporate into predictor above - - ! Insert sponge step here + ! No diffusion in this test ! Prepare pressure projection call fs%pressureproj_prepare(time%dt,vf,matmod) @@ -344,13 +347,15 @@ subroutine simulation_run fs%P=fs%P+fs%psolv%sol call fs%pressureproj_correct(time%dt,vf,fs%psolv%sol) + ! Record convergence monitor + call cvgfile%write() ! Increment sub-iteration counter time%it=time%it+1 end do ! Pressure relaxation - call fs%pressure_relax(vf,matmod) + call fs%pressure_relax(vf,matmod,relax_model) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/examples/zalesak/GNUmakefile b/examples/zalesak/GNUmakefile index 5bd0a2dc2..26c33af3b 100644 --- a/examples/zalesak/GNUmakefile +++ b/examples/zalesak/GNUmakefile @@ -4,8 +4,8 @@ NGA_HOME ?= ../.. # Compilation parameters PRECISION = DOUBLE USE_MPI = TRUE -USE_HYPRE = TRUE USE_LAPACK= TRUE +USE_HYPRE = TRUE USE_IRL = TRUE PROFILE = FALSE DEBUG = FALSE @@ -22,11 +22,7 @@ include $(Upack) INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) -# Define external libraries - this can also be in .profile -#HDF5_DIR = /Users/desjardi/Builds/hdf5 -LAPACK_DIR= /Users/desjardi/Builds/lapack -HYPRE_DIR = /Users/desjardi/Builds/hypre -IRL_DIR = /Users/desjardi/Builds/IRL +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/src/config/config_class.f90 b/src/config/config_class.f90 index c78562450..91917045b 100644 --- a/src/config/config_class.f90 +++ b/src/config/config_class.f90 @@ -19,11 +19,13 @@ module config_class ! Geometry real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction info (VF=1 is fluid, VF=0 is wall) + real(WP) :: fluid_vol !< Total fluid volume in the config contains procedure :: print=>config_print !< Output configuration information to the screen procedure :: write=>config_write !< Write out config files: grid and geometry procedure, private :: prep=>config_prep !< Finish preparing config after the partitioned grid is loaded + procedure :: calc_fluid_vol !< Compute fluid_vol after VF has been set procedure :: VF_extend !< Extend VF array into the non-periodic domain overlaps procedure :: integrate !< Integrate a variable on config while accounting for VF procedure :: set_scalar !< Subroutine that extrapolates a provided scalar value at a point to a pgrid field @@ -83,6 +85,8 @@ function construct_from_file(grp,decomp,no,fgrid,fgeom) result(self) call geomfile%pullvar('VF',self%VF) ! Perform an extension in the overlap call self%VF_extend() + ! Update fluid_vol + call self%calc_fluid_vol() end block read_VF end function construct_from_file @@ -122,6 +126,7 @@ subroutine config_prep(this) ! Allocate wall geometry - assume all fluid until told otherwise allocate(this%VF(this%imino_:this%imaxo_,this%jmino_:this%jmaxo_,this%kmino_:this%kmaxo_)); this%VF=1.0_WP + this%fluid_vol=this%vol_total end subroutine config_prep @@ -166,6 +171,26 @@ subroutine VF_extend(this) end if end subroutine VF_extend + + !> Calculate the total fluid volume by integrating VF + subroutine calc_fluid_vol(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(config), intent(inout) :: this + integer :: i,j,k,ierr + real(WP) :: buf + buf=0.0_WP + do k=this%kmin_,this%kmax_ + do j=this%jmin_,this%jmax_ + do i=this%imin_,this%imax_ + buf=buf+this%vol(i,j,k)*this%VF(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(buf,this%fluid_vol,1,MPI_REAL_WP,MPI_SUM,this%comm,ierr) + end subroutine calc_fluid_vol + !> Calculate the integral of a field on the config while accounting for VF subroutine integrate(this,A,integral) diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index b2bee2b43..8831ca27a 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -75,7 +75,7 @@ module incomp_class ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity - real(WP), dimension(:,:,:,:), allocatable :: itpi_x,itpi_y,itpi_z !< Interpolation for Ui/Vi/Wi + real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Interpolation for U real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Interpolation for V real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Interpolation for W @@ -114,7 +114,9 @@ module incomp_class procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values procedure :: interp_vel !< Calculate interpolated velocity - procedure :: get_strainrate !< Calculate strain rate tensor + procedure :: get_strainrate !< Calculate deviatoric part of strain rate tensor + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_vorticity !< Calculate vorticity tensor procedure :: get_mfr !< Calculate outgoing MFR through each bcond procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation procedure :: shift_p !< Shift pressure to have zero average @@ -249,21 +251,21 @@ subroutine init_metrics(this) integer :: i,j,k,st1,st2 real(WP), dimension(-1:0) :: itpx,itpy,itpz - ! Allocate finite difference Ui/Vi/Wi interpolation coefficients - allocate(this%itpi_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%itpi_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%itpi_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered - ! Create interpolation coefficients to cell face + ! Allocate finite difference density (or other things) interpolation coefficients + allocate(this%itpr_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered + allocate(this%itpr_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered + allocate(this%itpr_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered + ! Create density (or other things) interpolation coefficients to cell face do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpi_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] - this%itpi_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] - this%itpi_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do end do end do - + ! Allocate finite difference viscosity interpolation coefficients allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) @@ -459,16 +461,26 @@ subroutine adjust_metrics(this) if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) - ! Adjust Ui/Vi/Wi interpolation coefficients back to cell faces in the presence of walls (only walls!) - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (this%umask(i,j,k).eq.1) this%itpi_x(:,i,j,k)=0.0_WP - if (this%vmask(i,j,k).eq.1) this%itpi_y(:,i,j,k)=0.0_WP - if (this%wmask(i,j,k).eq.1) this%itpi_z(:,i,j,k)=0.0_WP - end do - end do - end do + ! I am assuming here that we do not really need to zero out wall cells + ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) + ! or outflow condition (then the density needs to be available but it should be directly calculated) + ! or used for a real no-slip wall (then density is always multiplied by zero) + ! Adjust density interpolation coefficients to cell faces in the presence of walls (only walls!) + !do k=this%cfg%kmin_,this%cfg%kmax_+1 + ! do j=this%cfg%jmin_,this%cfg%jmax_+1 + ! do i=this%cfg%imin_,this%cfg%imax_+1 + ! ! Linear interpolation in x + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i-1,j,k).gt.0.0_WP) this%itpr_x(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i-1,j,k).eq.0.0_WP) this%itpr_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in y + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j-1,k).gt.0.0_WP) this%itpr_y(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j-1,k).eq.0.0_WP) this%itpr_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in z + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j,k-1).gt.0.0_WP) this%itpr_z(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j,k-1).eq.0.0_WP) this%itpr_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! end do + ! end do + !end do ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ @@ -1219,50 +1231,75 @@ subroutine interp_vel(this,Ui,Vi,Wi) end subroutine interp_vel - !> Calculate the strain rate tensor, including approximations for domain overlap - !> This only uses interpolated velocities passed to this function (we could imagine a more local one that uses U/V/W too) - subroutine get_strainrate(this,Ui,Vi,Wi,SR) + !> Calculate the deviatoric part of the strain rate tensor from U/V/W + !> 1: du/dx-div/3 + !> 2: dv/dy-div/3 + !> 3: dw/dz-div/3 + !> 4: (du/dy+dv/dx)/2 + !> 5: (dv/dz+dw/dy)/2 + !> 6: (dw/dx+du/dz)/2 + subroutine get_strainrate(this,SR) use messager, only: die implicit none class(incomp), intent(inout) :: this - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + real(WP) :: div integer :: i,j,k - real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp - real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp - real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp - real(WP), dimension(3,3) :: dUdx ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - ! Calculate inside - do k=this%cfg%kmin_,this%cfg%kmax_ + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + SR(2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + SR(3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + div=sum(SR(1:3,i,j,k))/3.0_WP + SR(1,i,j,k)=SR(1,i,j,k)-div + SR(2,i,j,k)=SR(2,i,j,k)-div + SR(3,i,j,k)=SR(3,i,j,k)-div + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - ! Rebuild face velocities from interpolated velocities - Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) - Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) - Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) - ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uxp-Uxm); dUdx(1,3)=this%cfg%dzi(k)*(Uxp-Uxm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vxp-Vxm); dUdx(2,3)=this%cfg%dzi(k)*(Vxp-Vxm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wxp-Wxm); dUdx(3,3)=this%cfg%dzi(k)*(Wxp-Wxm) - ! Assemble the strain rate - SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) - SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) - SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) + SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) + SR(5,i,j,k)=0.125_WP*(sum(dvdz(i ,j:j+1,k:k+1))+sum(dwdy(i ,j:j+1,k:k+1))) + SR(6,i,j,k)=0.125_WP*(sum(dwdx(i:i+1,j ,k:k+1))+sum(dudz(i:i+1,j ,k:k+1))) end do end do end do ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then + if (.not.this%cfg%xper) then if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) end if @@ -1276,7 +1313,7 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end if ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ + do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ do i=this%cfg%imino_,this%cfg%imaxo_ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP @@ -1285,9 +1322,181 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end do ! Sync it - call this%cfg%sync(SR) + call this%cfg%sync(SR) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) end subroutine get_strainrate + + + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(incomp), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + + !> Calculate vorticity vector + subroutine get_vorticity(this,vort) + use messager, only: die + implicit none + class(incomp), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check vort's first two dimensions + if (size(vort,dim=1).ne.3) call die('[incomp get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + vort(1,i,j,k)=0.25_WP*(sum(dwdy(i,j:j+1,k:k+1))-sum(dvdz(i,j:j+1,k:k+1))) + vort(2,i,j,k)=0.25_WP*(sum(dudz(i:i+1,j,k:k+1))-sum(dwdx(i:i+1,j,k:k+1))) + vort(3,i,j,k)=0.25_WP*(sum(dvdx(i:i+1,j:j+1,k))-sum(dudy(i:i+1,j:j+1,k))) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) vort(:,this%cfg%imin-1,:,:)=vort(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) vort(:,this%cfg%imax+1,:,:)=vort(:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) vort(:,:,this%cfg%jmin-1,:)=vort(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) vort(:,:,this%cfg%jmax+1,:)=vort(:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) vort(:,:,:,this%cfg%kmin-1)=vort(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) vort(:,:,:,this%cfg%kmax+1)=vort(:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(vort) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_vorticity !> Calculate the CFL @@ -1332,7 +1541,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl @@ -1515,28 +1724,14 @@ end subroutine correct_mfr !> Shift pressure to ensure zero average subroutine shift_p(this,pressure) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP implicit none class(incomp), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index 484f033e7..a7a877d17 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -5,7 +5,7 @@ module scalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -59,7 +59,7 @@ module scalar_class real(WP), dimension(:,:,:), allocatable :: SCold !< SCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -74,7 +74,7 @@ module scalar_class real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity ! Bquick requires additional storage - real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup + real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup real(WP), dimension(:,:,:,:), allocatable :: bitp_xm,bitp_ym,bitp_zm !< Minus interpolation for SC - backup ! Masking info for metric modification @@ -91,8 +91,8 @@ module scalar_class procedure :: apply_bcond !< Apply all boundary conditions procedure :: init_metrics !< Initialize metrics procedure :: adjust_metrics !< Adjust metrics - procedure :: metric_reset !< Reset adaptive metrics like bquick - procedure :: metric_adjust !< Adjust adaptive metrics like bquick + procedure :: metric_reset !< Reset adaptive metrics like bquick + procedure :: metric_adjust !< Adjust adaptive metrics like bquick procedure :: get_drhoSCdt !< Calculate drhoSC/dt procedure :: get_max !< Calculate maximum field values procedure :: get_int !< Calculate integral field values @@ -136,13 +136,13 @@ function constructor(cfg,scheme,name) result(self) ! Prepare advection scheme self%scheme=scheme select case (self%scheme) - case (upwind) - ! Check current overlap - if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=1 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (upwind) + ! Check current overlap + if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=1 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (quick) ! Check current overlap if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') @@ -150,20 +150,17 @@ function constructor(cfg,scheme,name) result(self) self%nst=3 self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 - case (bquick) - ! Check current overlap - if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=3 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + case (bquick) + ! Check current overlap + if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=3 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case default call die('[scalar constructor] Unknown scalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -224,10 +221,10 @@ subroutine init_metrics(this) allocate(this%itp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered ! Create scalar interpolation coefficients to cell faces select case (this%scheme) - case (upwind) - this%itp_xp=1.0_WP; this%itp_xm=1.0_WP - this%itp_yp=1.0_WP; this%itp_ym=1.0_WP - this%itp_zp=1.0_WP; this%itp_zm=1.0_WP + case (upwind) + this%itp_xp=1.0_WP; this%itp_xm=1.0_WP + this%itp_yp=1.0_WP; this%itp_ym=1.0_WP + this%itp_zp=1.0_WP; this%itp_zm=1.0_WP case (quick,bquick) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -382,42 +379,50 @@ end subroutine adjust_metrics !> Finish setting up the scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) + subroutine setup(this,implicit_solver) implicit none class(scalar), intent(inout) :: this - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st ! Adjust metrics based on mask array call this%adjust_metrics() ! Bquick needs to remember the quick coefficients - select case (this%scheme) + select case (this%scheme) case (bquick) - allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp - allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm - allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp - allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym - allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp - allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm + allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp + allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm + allocate(this%bitp_yp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_yp=this%itp_yp + allocate(this%bitp_ym(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_ym=this%itp_ym + allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp + allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm end select - - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -705,53 +710,53 @@ subroutine metric_reset(this) this%itp_zm=this%bitp_zm end select end subroutine metric_reset - - + + !> Adjust adaptive metrics like bquick subroutine metric_adjust(this,SC,SCmin,SCmax) - implicit none - class(scalar), intent(inout) :: this + implicit none + class(scalar), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: SC !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), optional :: SCmin - real(WP), optional :: SCmax - integer :: i,j,k - select case (this%scheme) - case (bquick) - if (present(SCmin)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).lt.SCmin) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + real(WP), optional :: SCmin + real(WP), optional :: SCmax + integer :: i,j,k + select case (this%scheme) + case (bquick) + if (present(SCmin)) then + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).lt.SCmin) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if + end if + end do + end do + end do + end if if (present(SCmax)) then - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (SC(i,j,k).gt.SCmax) then - !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if - end do - end do - end do - end if - end select + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + if (SC(i,j,k).gt.SCmax) then + !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if + end do + end do + end do + end if + end select end subroutine metric_adjust - + !> Print out info for scalar solver subroutine scalar_print(this) diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index f0ba13b90..936b38002 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -8,10 +8,6 @@ module pgrid_class implicit none private - !> Default parallelization strategy - character(len=str_medium), parameter :: defstrat='fewest_dir' - integer, parameter :: defmincell=4 - ! Expose type/constructor/methods public :: pgrid @@ -248,7 +244,7 @@ subroutine pgrid_domain_decomp(self) use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none class(pgrid), intent(inout) :: self - integer :: ierr,q,r + integer :: strat_,ierr,q,r type(MPI_Comm) :: tmp_comm integer, parameter :: ndims=3 logical, parameter :: reorder=.true. diff --git a/src/immersed/df_class.f90 b/src/immersed/df_class.f90 index 36d6b4ae1..8d8e492dc 100644 --- a/src/immersed/df_class.f90 +++ b/src/immersed/df_class.f90 @@ -1,849 +1,847 @@ !> Basic direct forcing IBM class: !> Provides support for Lagrangian marker particles module df_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION - implicit none - private - - - ! Expose type/constructor/methods - public :: dfibm - - - !> Memory adaptation parameter - real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor - real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor - - !> I/O chunk size to read at a time - integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - !> Basic marker particle definition - type :: part - !> MPI_DOUBLE_PRECISION data - real(WP) :: dA !< Element area - real(WP), dimension(3) :: norm !< Outward normal vector - real(WP), dimension(3) :: pos !< Particle center coordinates - real(WP), dimension(3) :: vel !< Velocity of particle - !> MPI_INTEGER data - integer :: id !< ID the object is associated with - integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) - end type part - !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=2 - integer , dimension(part_nblock) :: part_lblock=[10,5] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] - !> MPI_PART derived datatype and size - type(MPI_Datatype) :: MPI_PART - integer :: MPI_PART_SIZE - - !> Basic ibm object definition - type :: obj - !> MPI_DOUBLE_PRECISION data - real(WP) :: vol !< Object volume - real(WP), dimension(3) :: pos !< Center of mass - real(WP), dimension(3) :: vel !< Translational velocity of the object - real(WP), dimension(3) :: angVel !< Angular velocity of the object - real(WP), dimension(3) :: F !< Hydrodynamic force - end type obj - - !> Direct forcing IBM solver object definition - type :: dfibm - - ! This is our underlying config - class(config), pointer :: cfg !< This is the config the solver is build for - - ! This is the name of the solver - character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM - - ! Marker particle data - integer :: np !< Global number of particles - integer :: np_ !< Local number of particles - integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor - type(part), dimension(:), allocatable :: p !< Array of particles of type part - - ! Object data - integer :: nobj !< Global number of objects - type(obj), dimension(:), allocatable :: o !< Array of objects of type obj - - ! CFL numbers - real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers - - ! Solver parameters - real(WP) :: nstep=1 !< Number of substeps (default=1) - logical :: can_move !< Flag to allow moving IBM objects - - ! Monitoring info - real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info - real(WP) :: Umin,Umax,Umean !< U velocity info - real(WP) :: Vmin,Vmax,Vmean !< V velocity info - real(WP) :: Wmin,Wmax,Wmean !< W velocity info - real(WP) :: Fx,Fy,Fz !< Total force - - ! Volume fraction associated with IBM projection - real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered - - ! Momentum source - real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered - real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered - - ! Distance levelset for visualization and collision detection - real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered - + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: dfibm + + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic marker particle definition + type :: part + !> MPI_DOUBLE_PRECISION data + real(WP) :: dA !< Element area + real(WP), dimension(3) :: norm !< Outward normal vector + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + !> MPI_INTEGER data + integer :: id !< ID the object is associated with + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=2 + integer , dimension(part_nblock) :: part_lblock=[10,5] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Basic ibm object definition + type :: obj + !> MPI_DOUBLE_PRECISION data + real(WP) :: vol !< Object volume + real(WP), dimension(3) :: pos !< Center of mass + real(WP), dimension(3) :: vel !< Translational velocity of the object + real(WP), dimension(3) :: angVel !< Angular velocity of the object + real(WP), dimension(3) :: F !< Hydrodynamic force + end type obj + + !> Direct forcing IBM solver object definition + type :: dfibm + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_DFIBM' !< Solver name (default=UNNAMED_DFIBM + + ! Marker particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Object data + integer :: nobj !< Global number of objects + type(obj), dimension(:), allocatable :: o !< Array of objects of type obj + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z !< CFL numbers + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + logical :: can_move !< Flag to allow moving IBM objects + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean !< Volume fraction info + real(WP) :: Umin,Umax,Umean !< U velocity info + real(WP) :: Vmin,Vmax,Vmean !< V velocity info + real(WP) :: Wmin,Wmax,Wmean !< W velocity info + real(WP) :: Fx,Fy,Fz !< Total force + + ! Volume fraction associated with IBM projection + real(WP), dimension(:,:,:), allocatable :: VF !< Volume fraction, cell-centered + + ! Momentum source + real(WP), dimension(:,:,:), allocatable :: srcU !< U momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcV !< V momentum source on mesh, cell-centered + real(WP), dimension(:,:,:), allocatable :: srcW !< W momentum source on mesh, cell-centered + + ! Distance levelset for visualization and collision detection + real(WP), dimension(:,:,:), allocatable :: G !< Levelset, cell-centered + contains - procedure :: update_partmesh !< Update a partmesh object using current particles - procedure :: setup_obj !< Setup IBM object - procedure :: get_source !< Compute direct forcing source - procedure :: resize !< Resize particle array to given size - procedure :: recycle !< Recycle particle array by removing flagged particles - procedure :: sync !< Synchronize particles across interprocessor boundaries - procedure :: read !< Parallel read particles from file - procedure :: write !< Parallel write particles to file - procedure :: get_max !< Extract various monitoring data - procedure :: get_cfl !< Calculate maximum CFL - procedure :: update_VF !< Compute volume fraction - procedure :: get_delta !< Compute regularized delta function - procedure :: interpolate !< Interpolation routine from mesh=>marker - procedure :: extrapolate !< Extrapolation routine from marker=>mesh - end type dfibm - - - !> Declare df solver constructor - interface dfibm - procedure constructor - end interface dfibm - + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: setup_obj !< Setup IBM object + procedure :: get_source !< Compute direct forcing source + procedure :: resize !< Resize particle array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute volume fraction + procedure :: get_delta !< Compute regularized delta function + procedure :: interpolate !< Interpolation routine from mesh=>marker + procedure :: extrapolate !< Extrapolation routine from marker=>mesh + end type dfibm + + + !> Declare df solver constructor + interface dfibm + procedure constructor + end interface dfibm + contains - !> Default constructor for direct forcing solver - function constructor(cfg,name) result(self) - implicit none - type(dfibm) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - integer :: i,j,k - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Allocate variables - allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 - self%np_=0; self%np=0 - call self%resize(0) - - ! Initialize MPI derived datatype for a particle - call prepare_mpi_part() - - ! Allocate levelset, VF and src arrays on cfg mesh - allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP - allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP - allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP - - ! Initialize object - self%can_move=.false. - self%nobj=0 - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (self%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + !> Default constructor for direct forcing solver + function constructor(cfg,name) result(self) + implicit none + type(dfibm) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate levelset, VF and src arrays on cfg mesh + allocate(self%G(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%G=huge(1.0_WP) + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + allocate(self%srcU (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcU=0.0_WP + allocate(self%srcV (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcV=0.0_WP + allocate(self%srcW (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%srcW=0.0_WP + + ! Initialize object + self%can_move=.false. + self%nobj=0 + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Setup IBM objects, each processors own all objects + subroutine setup_obj(this) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i,j,n,ibuf,ierr + real(WP) :: myVol,dV,fac + real(WP), dimension(3) :: pos0,dist + ! Determine number of objects based on marker ID + n=1 + do i=1,this%np_ + n=max(n,this%p(i)%id) + end do + call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + ! Allocate and zero out the object array + allocate(this%o(1:this%nobj)) + if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then + fac=1.0_WP/3.0_WP + else + fac=1.0_WP/2.0_WP end if - end block logging - - end function constructor - - - !> Setup IBM objects, each processors own all objects - subroutine setup_obj(this) - use mpi_f08 - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i,j,n,ibuf,ierr - real(WP) :: myVol,dV,fac - real(WP), dimension(3) :: pos0,dist - ! Determine number of objects based on marker ID - n=1 - do i=1,this%np_ - n=max(n,this%p(i)%id) - end do - call MPI_ALLREDUCE(n,this%nobj,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - ! Allocate and zero out the object array - allocate(this%o(1:this%nobj)) - if (this%cfg%nx.gt.1.and.this%cfg%ny.gt.1.and.this%cfg%nz.gt.1) then - fac=1.0_WP/3.0_WP - else - fac=1.0_WP/2.0_WP - end if - do i=1,this%nobj - ! Zero-out object properties - this%o(i)%pos=0.0_WP - this%o(i)%vel=0.0_WP - this%o(i)%angVel=0.0_WP - this%o(i)%F=0.0_WP - ! Compute center of mass - myVol=0.0_WP - do j=1,this%np_ - ! Determine particle associated with object - if (this%p(j)%id.eq.i) then - myVol=myVol+this%p(j)%dA - this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV - ! Determine object volume - myVol=0.0_WP - do j=1,this%np_ - if (this%p(j)%id.eq.i) then - dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) - if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) - if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) - if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) - myVol=myVol+fac*sum(dist)*this%p(j)%dA - end if - end do - call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV - end do - end subroutine setup_obj - - - !> Compute direct forcing source by a specified time step dt - subroutine get_source(this,dt,U,V,W,rho) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: dti,rho_,dV - real(WP), dimension(3) :: vel,src - - ! Zero out source term arrays - this%srcU=0.0_WP - this%srcV=0.0_WP - this%srcW=0.0_WP - - ! Zero-out forces on objects - do i=1,this%nobj - this%o(i)%F=0.0_WP - end do - - ! Advance the equations - dti=1.0_WP/dt - do i=1,this%np_ - ! Interpolate the velocity to the particle location - vel=0.0_WP - if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') - if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') - if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') - rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') - ! Compute the source term - src=(this%p(i)%vel-vel) - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Send source term back to the mesh - if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') - if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') - if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') - ! Sum up force on object (Newton's 3rd law) - j=max(this%p(i)%id,1) - this%o(j)%F=this%o(j)%F-rho_*src*dV*dti - end do - - ! Sum at boundaries - call this%cfg%syncsum(this%srcU) - call this%cfg%syncsum(this%srcV) - call this%cfg%syncsum(this%srcW) - - ! Sum over each object - do j=1,this%nobj - call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src - end do - - ! Recompute volume fraction - call this%update_VF() - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) + do i=1,this%nobj + ! Zero-out object properties + this%o(i)%pos=0.0_WP + this%o(i)%vel=0.0_WP + this%o(i)%angVel=0.0_WP + this%o(i)%F=0.0_WP + ! Compute center of mass + myVol=0.0_WP + do j=1,this%np_ + ! Determine particle associated with object + if (this%p(j)%id.eq.i) then + myVol=myVol+this%p(j)%dA + this%o(i)%pos=this%o(i)%pos+this%p(j)%pos*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) + call MPI_ALLREDUCE(this%o(i)%pos,pos0,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%pos=pos0/dV + ! Determine object volume + myVol=0.0_WP + do j=1,this%np_ + if (this%p(j)%id.eq.i) then + dist=abs((this%p(j)%pos-this%o(i)%pos)*this%p(j)%norm) + if (this%cfg%xper) dist(1)=min(dist(1),this%cfg%xL-abs((this%p(j)%pos(1)-this%o(i)%pos(1))*this%p(j)%norm(1))) + if (this%cfg%yper) dist(2)=min(dist(2),this%cfg%yL-abs((this%p(j)%pos(2)-this%o(i)%pos(2))*this%p(j)%norm(2))) + if (this%cfg%zper) dist(3)=min(dist(3),this%cfg%zL-abs((this%p(j)%pos(3)-this%o(i)%pos(3))*this%p(j)%norm(3))) + myVol=myVol+fac*sum(dist)*this%p(j)%dA + end if + end do + call MPI_ALLREDUCE(myVol,dV,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(i)%vol=dV + end do + end subroutine setup_obj + + + !> Compute direct forcing source by a specified time step dt + subroutine get_source(this,dt,U,V,W,rho) + use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr + real(WP) :: dti,rho_,dV + real(WP), dimension(3) :: vel,src + + ! Zero out source term arrays + this%srcU=0.0_WP + this%srcV=0.0_WP + this%srcW=0.0_WP + + ! Zero-out forces on objects + do i=1,this%nobj + this%o(i)%F=0.0_WP + end do + + ! Advance the equations + dti=1.0_WP/dt + do i=1,this%np_ + ! Interpolate the velocity to the particle location + vel=0.0_WP + if (this%cfg%nx.gt.1) vel(1)=this%interpolate(A=U,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='U') + if (this%cfg%ny.gt.1) vel(2)=this%interpolate(A=V,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='V') + if (this%cfg%nz.gt.1) vel(3)=this%interpolate(A=W,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='W') + rho_=this%interpolate(A=rho,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),dir='SC') + ! Compute the source term + src=(this%p(i)%vel-vel) + ! Get element volume + dV=this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Send source term back to the mesh + if (this%cfg%nx.gt.1) call this%extrapolate(Ap=src(1)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcU,dir='U') + if (this%cfg%ny.gt.1) call this%extrapolate(Ap=src(2)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcV,dir='V') + if (this%cfg%nz.gt.1) call this%extrapolate(Ap=src(3)*dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%srcW,dir='W') + ! Sum up force on object (Newton's 3rd law) + j=max(this%p(i)%id,1) + this%o(j)%F=this%o(j)%F-rho_*src*dV*dti + end do + + ! Sum at boundaries + call this%cfg%syncsum(this%srcU) + call this%cfg%syncsum(this%srcV) + call this%cfg%syncsum(this%srcW) + + ! Sum over each object + do j=1,this%nobj + call MPI_ALLREDUCE(this%o(j)%F,src,3,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%o(j)%F=src + end do + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("IBM solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end subroutine get_source + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(dfibm), intent(inout) :: this + integer :: i + real(WP) :: dV + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1) cycle + ! Get element volume + dV = this%p(i)%dA*sqrt((this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2+& + & (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2+& + & (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2) + ! Transfer volume to mesh + call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& + & ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') + end do + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + end subroutine update_VF + + + !> Compute regularized delta function + subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(out) :: delta !< Return delta function + integer, intent(in) :: ic,jc,kc !< Cell index + real(WP), intent(in) :: xp,yp,zp !< Position of marker + character(len=*) :: dir + real(WP) :: deltax,deltay,deltaz,r + + ! Compute in X + if (trim(adjustl(dir)).eq.'U') then + r=(xp-this%cfg%x(ic))*this%cfg%dxmi(ic) + deltax=roma_kernel(r)*this%cfg%dxmi(ic) + else + r=(xp-this%cfg%xm(ic))*this%cfg%dxi(ic) + deltax=roma_kernel(r)*this%cfg%dxi(ic) end if - end block logging - - end subroutine get_source - - - !> Update particle volume fraction using our current particles - subroutine update_VF(this) - use mathtools, only: Pi - implicit none - class(dfibm), intent(inout) :: this - integer :: i - real(WP) :: dV - ! Reset volume fraction - this%VF=0.0_WP - ! Transfer particle volume - do i=1,this%np_ - ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle - ! Get element volume - dV = this%p(i)%dA * sqrt( & - (this%cfg%dx(this%p(i)%ind(1))*this%p(i)%norm(1))**2 + & - (this%cfg%dy(this%p(i)%ind(2))*this%p(i)%norm(2))**2 + & - (this%cfg%dz(this%p(i)%ind(3))*this%p(i)%norm(3))**2 ) - ! Transfer volume to mesh - call this%extrapolate(Ap=dV,xp=this%p(i)%pos(1),yp=this%p(i)%pos(2),zp=this%p(i)%pos(3),& - ip=this%p(i)%ind(1),jp=this%p(i)%ind(2),kp=this%p(i)%ind(3),A=this%VF,dir='SC') - end do - ! Sum at boundaries - call this%cfg%syncsum(this%VF) - end subroutine update_VF - - - !> Compute regularized delta function - subroutine get_delta(this,delta,ic,jc,kc,xp,yp,zp,dir) - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(out) :: delta !< Return delta function - integer, intent(in) :: ic,jc,kc !< Cell index - real(WP), intent(in) :: xp,yp,zp !< Position of marker - character(len=*) :: dir - real(WP) :: deltax,deltay,deltaz,r - - ! Compute in X - if (trim(adjustl(dir)).eq.'U') then - r = (xp-this%cfg%x(ic))*this%cfg%dxmi(ic) - deltax = roma_kernel(r)*this%cfg%dxmi(ic) - else - r = (xp-this%cfg%xm(ic))*this%cfg%dxi(ic) - deltax = roma_kernel(r)*this%cfg%dxi(ic) - end if - - ! Compute in Y - if (trim(adjustl(dir)).eq.'V') then - r = (yp-this%cfg%y(jc))*this%cfg%dymi(jc) - deltay = roma_kernel(r)*this%cfg%dymi(jc) - else - r = (yp-this%cfg%ym(jc))*this%cfg%dyi(jc) - deltay = roma_kernel(r)*this%cfg%dyi(jc) - end if - - ! Compute in Z - if (trim(adjustl(dir)).eq.'W') then - r = (zp-this%cfg%z(kc))*this%cfg%dzmi(kc) - deltaz = roma_kernel(r)*this%cfg%dzmi(kc) - else - r = (zp-this%cfg%zm(kc))*this%cfg%dzi(kc) - deltaz = roma_kernel(r)*this%cfg%dzi(kc) - end if - - ! Put it all together - delta=deltax*deltay*deltaz - - contains - ! Mollification kernel - ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 - function roma_kernel(r) result(phi) + + ! Compute in Y + if (trim(adjustl(dir)).eq.'V') then + r=(yp-this%cfg%y(jc))*this%cfg%dymi(jc) + deltay=roma_kernel(r)*this%cfg%dymi(jc) + else + r=(yp-this%cfg%ym(jc))*this%cfg%dyi(jc) + deltay=roma_kernel(r)*this%cfg%dyi(jc) + end if + + ! Compute in Z + if (trim(adjustl(dir)).eq.'W') then + r=(zp-this%cfg%z(kc))*this%cfg%dzmi(kc) + deltaz=roma_kernel(r)*this%cfg%dzmi(kc) + else + r=(zp-this%cfg%zm(kc))*this%cfg%dzi(kc) + deltaz=roma_kernel(r)*this%cfg%dzi(kc) + end if + + ! Put it all together + delta=deltax*deltay*deltaz + + contains + ! Mollification kernel + ! Roma A, Peskin C and Berger M 1999 J. Comput. Phys. 153 509–534 + function roma_kernel(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + if (abs(r).le.0.5_WP) then + phi=1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) + else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then + phi=1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + else + phi=0.0_WP + end if + end function roma_kernel + + end subroutine get_delta + + + !> Interpolation routine + function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) implicit none - real(WP), intent(in) :: r - real(WP) :: phi - if (abs(r).le.0.5_WP) then - phi = 1.0_WP/3.0_WP*(1.0_WP+sqrt(-3.0_WP*r**2+1.0_WP)) - else if (abs(r).gt.0.5_WP .and. abs(r).le.1.5_WP) then - phi = 1.0_WP/6.0_WP*(5.0_WP-3.0_WP*abs(r)-sqrt(-3.0_WP*(1.0_WP-abs(r))**2+1.0_WP)) + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + character(len=*) :: dir + real(WP) :: Ap + integer :: di,dj,dk + integer :: i1,i2,j1,j2,k1,k2 + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + ! Get the interpolation points + i1=ip-2; i2=ip+2 + j1=jp-2; j2=jp+2 + k1=kp-2; k2=kp+2 + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual interpolation on Ap + Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) + end function interpolate + + + !> Extrapolation routine + subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) + use messager, only: die + implicit none + class(dfibm), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(in) :: xp,yp,zp + integer, intent(in) :: ip,jp,kp + real(WP), intent(in) :: Ap + character(len=*) :: dir + real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta + integer :: di,dj,dk + ! If particle has left processor domain or reached last ghost cell, kill job + if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& + & jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& + & kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then + write(*,*) ip,jp,kp,xp,yp,zp + call die('[df extrapolate] Particle has left the domain') + end if + ! Loop over neighboring cells and compute regularized delta function + do dk=-2,+2 + do dj=-2,+2 + do di=-2,+2 + call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) + end do + end do + end do + ! Perform the actual extrapolation on A + A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap + end subroutine extrapolate + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z + + ! Return if not used + if (.not.this%can_move) then + cfl=0.0_WP + return + end if + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(dfibm), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Get mean, max, and min volume fraction and total force + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) + this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) + this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(dfibm), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(dfibm), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(dfibm), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 else - phi = 0.0_WP + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if end if - end function roma_kernel - - end subroutine get_delta - - - !> Interpolation routine - function interpolate(this,A,xp,yp,zp,ip,jp,kp,dir) result(Ap) - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - character(len=*) :: dir - real(WP) :: Ap - integer :: di,dj,dk - integer :: i1,i2,j1,j2,k1,k2 - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - ! Get the interpolation points - i1=ip-2; i2=ip+2 - j1=jp-2; j2=jp+2 - k1=kp-2; k2=kp+2 - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual interpolation on Ap - Ap = sum(delta*A(i1:i2,j1:j2,k1:k2))*this%cfg%vol(ip,jp,kp) - end function interpolate - - - !> Extrapolation routine - subroutine extrapolate(this,Ap,xp,yp,zp,ip,jp,kp,A,dir) - use messager, only: die - implicit none - class(dfibm), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), intent(in) :: xp,yp,zp - integer, intent(in) :: ip,jp,kp - real(WP), intent(in) :: Ap - character(len=*) :: dir - real(WP), dimension(-2:+2,-2:+2,-2:+2) :: delta - integer :: di,dj,dk - ! If particle has left processor domain or reached last ghost cell, kill job - if ( ip.lt.this%cfg%imin_-1.or.ip.gt.this%cfg%imax_+1.or.& - jp.lt.this%cfg%jmin_-1.or.jp.gt.this%cfg%jmax_+1.or.& - kp.lt.this%cfg%kmin_-1.or.kp.gt.this%cfg%kmax_+1) then - write(*,*) ip,jp,kp,xp,yp,zp - call die('[df extrapolate] Particle has left the domain') - end if - ! Loop over neighboring cells and compute regularized delta function - do dk=-2,+2 - do dj=-2,+2 - do di=-2,+2 - call this%get_delta(delta=delta(di,dj,dk),ic=ip+di,jc=jp+dj,kc=kp+dk,xp=xp,yp=yp,zp=zp,dir=trim(dir)) - end do - end do - end do - ! Perform the actual extrapolation on A - A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)=A(ip-2:ip+2,jp-2:jp+2,kp-2:kp+2)+delta*Ap - end subroutine extrapolate - - - !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl - integer :: i,ierr - real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z - - ! Return if not used - if (.not.this%can_move) then - cfl=0.0_WP - return - end if - - ! Set the CFLs to zero - my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP - do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) - end do - my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt - - ! Get the parallel max - call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Return the maximum CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - - end subroutine get_cfl - - - !> Extract various monitoring data from particle field - subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(dfibm), intent(inout) :: this - real(WP) :: buf,safe_np - integer :: i,j,k,ierr - - ! Create safe np - safe_np=real(max(this%np,1),WP) - - ! Diameter and velocity min/max/mean - this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP - this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP - this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP - do i=1,this%np_ - this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) - this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) - this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) - end do - call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf - call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf - call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np - call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf - call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf - call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np - call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf - call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf - call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - - ! Get mean, max, and min volume fraction and total force - this%VFmean=0.0_WP - this%VFmax =-huge(1.0_WP) - this%VFmin =+huge(1.0_WP) - this%Fx=0.0_WP; this%Fy=0.0_WP; this%Fz=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) - this%VFmax =max(this%VFmax,this%VF(i,j,k)) - this%VFmin =min(this%VFmin,this%VF(i,j,k)) - this%Fx=this%Fx+sum(this%o(:)%F(1))*this%cfg%vol(i,j,k) - this%Fy=this%Fy+sum(this%o(:)%F(2))*this%cfg%vol(i,j,k) - this%Fz=this%Fz+sum(this%o(:)%F(3))*this%cfg%vol(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf - call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf - call MPI_ALLREDUCE(this%Fx ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fx=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fy ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fy=buf/this%cfg%vol_total - call MPI_ALLREDUCE(this%Fz ,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Fz=buf/this%cfg%vol_total - - end subroutine get_max - - - !> Update particle mesh using our current particles - subroutine update_partmesh(this,pmesh) - use partmesh_class, only: partmesh - implicit none - class(dfibm), intent(inout) :: this - class(partmesh), intent(inout) :: pmesh - integer :: i - ! Reset particle mesh storage - call pmesh%reset() - ! Nothing else to do if no particle is present - if (this%np_.eq.0) return - ! Copy particle info - call pmesh%set_size(this%np_) - do i=1,this%np_ - pmesh%pos(:,i)=this%p(i)%pos - end do - end subroutine update_partmesh - - - !> Creation of the MPI datatype for particle - subroutine prepare_mpi_part() - use mpi_f08 - use messager, only: die - implicit none - integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp - integer(MPI_ADDRESS_KIND) :: lb,extent - type(MPI_Datatype) :: MPI_PART_TMP - integer :: i,mysize,ierr - ! Prepare the displacement array - disp(1)=0 - do i=2,part_nblock - call MPI_Type_size(part_tblock(i-1),mysize,ierr) - disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) - end do - ! Create and commit the new type - call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) - call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) - call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) - call MPI_Type_commit(MPI_PART,ierr) - ! If a problem was encountered, say it - if (ierr.ne.0) call die('[dfibm prepare_mpi_part] MPI Particle type creation failed') - ! Get the size of this type - call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) - end subroutine prepare_mpi_part - - - !> Synchronize particle arrays across processors - subroutine sync(this) - use mpi_f08 - implicit none - class(dfibm), intent(inout) :: this - integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc - integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp - integer :: n,prank,ierr - type(part), dimension(:), allocatable :: buf_send - ! Recycle first to minimize communication load - call this%recycle() - ! Prepare information about what to send - nsend_proc=0 - do n=1,this%np_ - prank=this%cfg%get_rank(this%p(n)%ind) - nsend_proc(prank)=nsend_proc(prank)+1 - end do - nsend_proc(this%cfg%rank)=0 - ! Inform processors of what they will receive - call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - ! Prepare displacements for all-to-all - nsend_disp(0)=0 - nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array - do n=1,this%cfg%nproc-1 - nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) - nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) - end do - ! Allocate buffer to send particles - allocate(buf_send(sum(nsend_proc))) - ! Pack the particles in the send buffer - nsend_proc=0 - do n=1,this%np_ - ! Get the rank - prank=this%cfg%get_rank(this%p(n)%ind) - ! Skip particles still inside - if (prank.eq.this%cfg%rank) cycle - ! Pack up for sending - nsend_proc(prank)=nsend_proc(prank)+1 - buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) - ! Flag particle for removal - this%p(n)%flag=1 - end do - ! Allocate buffer for receiving particles - call this%resize(this%np_+sum(nrecv_proc)) - ! Perform communication - call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) - ! Deallocate buffer - deallocate(buf_send) - ! Recycle to remove duplicate particles - call this%recycle() - end subroutine sync - - - !> Adaptation of particle array size - subroutine resize(this,n) - implicit none - class(dfibm), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize particle array to size n - if (.not.allocated(this%p)) then - ! Allocate directly to size n - allocate(this%p(n)) - this%p(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%p,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%p - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%p) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%p(1:n) - call move_alloc(tmp,this%p) - end if - end if - end subroutine resize - - - !> Clean-up of particle array by removing flag=1 particles - subroutine recycle(this) - implicit none - class(dfibm), intent(inout) :: this - integer :: new_size,i,ierr - ! Compact all active particles at the beginning of the array - new_size=0 - if (allocated(this%p)) then - do i=1,size(this%p,dim=1) - if (this%p(i)%flag.ne.1) then - new_size=new_size+1 - if (i.ne.new_size) then - this%p(new_size)=this%p(i) - this%p(i)%flag=1 - end if - end if - end do - end if - ! Resize to new size - call this%resize(new_size) - ! Update number of particles - this%np_=new_size - call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - this%np=sum(this%np_proc) - end subroutine recycle - - - !> Parallel write particles to file - subroutine write(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset - integer :: i,ierr,iunit - - ! Root serial-writes the file header - if (this%cfg%amRoot) then - ! Open the file - open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) - ! Number of particles and particle object size - write(iunit) this%np,MPI_PART_SIZE - ! Done with the header - close(iunit) - end if - - ! The rest is done in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) - - ! Get current position - call MPI_FILE_GET_POSITION(ifile,offset,ierr) - - ! Compute the offset and write - do i=1,this%cfg%rank - offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) - end do - if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + end subroutine resize + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(dfibm), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do end if - end block logging - - end subroutine write - - - !> Parallel read particles to file - subroutine read(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(dfibm), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset,header_offset - integer :: i,j,ierr,npadd,psize,nchunk,cnt - integer, dimension(:,:), allocatable :: ppp - - ! First open the file in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) - - ! Read file header first - call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) - call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) - - ! Remember current position - call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) - - ! Check compatibility of particle type - if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') - - ! Naively share reading task among all processors - nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 - allocate(ppp(this%cfg%nproc,nchunk)) - ppp=int(npadd/(this%cfg%nproc*nchunk)) - cnt=0 - out:do j=1,nchunk - do i=1,this%cfg%nproc - cnt=cnt+1 - if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out - ppp(i,j)=ppp(i,j)+1 - end do - end do out - - ! Read by chunk - do j=1,nchunk - ! Find offset - offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) - ! Resize particle array - call this%resize(this%np_+ppp(this%cfg%rank+1,j)) - ! Read this file - call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) - ! Most general case: relocate every droplet - do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - ! Exchange all that - call this%sync() - end do - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header if (this%cfg%amRoot) then - write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) end if - end block logging - - end subroutine read - - + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(dfibm), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[dfibm read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[dfibm read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + end module df_class diff --git a/src/libraries/precision.mod b/src/libraries/precision.mod new file mode 100644 index 0000000000000000000000000000000000000000..575582711d32a4fc04a849d2e7c82e516daa9199 GIT binary patch literal 364 zcmV-y0h9h8iwFP!000006V;VjZ-PJ&fZz95%-g_&W`X5;D>2lN>SB<#kH*N-ka!jC z@$K1BakwJ0h%@ml3*OBVFLI3j>nI@7x6UY z=~0~|@!+74XgnE3gDCAygNG0((B{9@mZ5aPs!#Gh=rW*MuWSY}pQeFytdXD1(ZgEO z^mb<}Qk__U1?vh1Q(`cQ;dKQ=oedjsHGiKK>%Djq{;urYtGAq|Pgqm5$Aluagfz K?-op62LJ$(^sEU0 literal 0 HcmV?d00001 diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 4765b6fd3..e7782d88b 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -79,10 +79,8 @@ module lpt_class ! Solver parameters real(WP) :: nstep=1 !< Number of substeps (default=1) character(len=str_medium), public :: drag_model !< Drag model - logical :: use_lift=.false. !< Compute lift force on particles - + ! Collisional parameters - logical :: use_col=.true. !< Flag for collisions real(WP) :: tau_col !< Characteristic collision time scale real(WP) :: e_n !< Normal restitution coefficient real(WP) :: e_w !< Wall restitution coefficient @@ -350,233 +348,279 @@ function constructor(cfg,name) result(self) end function constructor - !> Resolve collisional interaction between particles + !> Resolve collisional interaction between particles, walls, and an optional IB level set !> Requires tau_col, e_n, e_w and mu_f to be set beforehand - subroutine collide(this,dt) - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - - ! Start by zeroing out the collision force - zero_force: block - integer :: i - do i=1,this%np_ - this%p(i)%Acol=0.0_WP - this%p(i)%Tcol=0.0_WP - end do - end block zero_force - - ! Return if not used - if (.not.this%use_col) return - - ! Then share particles across overlap - call this%share() - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - - ! Finally, calculate collision force - collision_force: block - use mpi_f08 - use mathtools, only: Pi,normalize,cross_product - integer :: i1,i2,ii,jj,kk,nn,ierr - real(WP) :: d1,m1,d2,m2,d12,m12 - real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t - real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv - real(WP), parameter :: aclipnorm=1.0e-6_WP - real(WP), parameter :: acliptan=1.0e-9_WP - real(WP), parameter :: rcliptan=0.05_WP - - ! Reset collision counter - this%ncol=0 - - ! Precompute coefficients for k and eta - k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 - eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col - k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 - eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col - - ! Loop over all local particles - collision: do i1=1,this%np_ - - ! Cycle if id<=0 - if (this%p(i1)%id.le.0) cycle collision - - ! Store particle data - r1=this%p(i1)%pos - v1=this%p(i1)%vel - w1=this%p(i1)%angVel - d1=this%p(i1)%d - m1=this%rho*Pi/6.0_WP*d1**3 - - ! First collide with walls - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') - n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) - n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1*k_coeff_w - eta_n=m1*eta_coeff_w - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt/d1.gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - end if - - ! Loop over nearest cells - do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 - do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 - do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - v2=this%p(i2)%vel - w2=this%p(i2)%angVel - d2=this%p(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - v2=this%g(i2)%vel - w2=this%g(i2)%angVel - d2=this%g(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - end if - - ! Compute relative information - d12=norm2(r1-r2) - if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision - n12=(r2-r1)/d12 - v12=v1-v2 - rnv=dot_product(v12,n12) - r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) - delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - m12=m1*m2/(m1+m2) - k_n=m12*k_coeff - eta_n=m12*eta_coeff - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - ! Add up the collisions - this%ncol=this%ncol+1 - end if - - end do - - end do - end do - end do - - ! Deal with dimensionality - if (this%cfg%nx.eq.1) then - this%p(i1)%Acol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%ny.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Acol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%nz.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Acol(3)=0.0_WP - end if - - end do collision - - ! Determine total number of collisions - call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 - - end block collision_force - - end subroutine collide - + subroutine collide(this,dt,Gib,Nxib,Nyib,Nzib) + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Gib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nxib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nyib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: Nzib !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + + ! Check if all IB parameters are present + check_G: block + use messager, only: die + if (present(Gib).and.(.not.present(Nxib).or..not.present(Nyib).or..not.present(Nzib))) & + call die('[lpt collide] IB collisions need Gib, Nxib, Nyib, AND Nzib') + end block check_G + + ! Start by zeroing out the collision force + zero_force: block + integer :: i + do i=1,this%np_ + this%p(i)%Acol=0.0_WP + this%p(i)%Tcol=0.0_WP + end do + end block zero_force + + ! Then share particles across overlap + call this%share() + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i + end do + + end block pic_prep + + ! Finally, calculate collision force + collision_force: block + use mpi_f08 + use mathtools, only: Pi,normalize,cross_product + integer :: i1,i2,ii,jj,kk,nn,ierr + real(WP) :: d1,m1,d2,m2,d12,m12,buf + real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t + real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv + real(WP), parameter :: aclipnorm=1.0e-6_WP + real(WP), parameter :: acliptan=1.0e-9_WP + real(WP), parameter :: rcliptan=0.05_WP + + ! Reset collision counter + this%ncol=0 + + ! Precompute coefficients for k and eta + k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 + eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col + k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 + eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col + + ! Loop over all local particles + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision + + ! Store particle data + r1=this%p(i1)%pos + v1=this%p(i1)%vel + w1=this%p(i1)%angVel + d1=this%p(i1)%d + m1=this%rho*Pi/6.0_WP*d1**3 + + ! First collide with walls + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') + n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) + n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + + ! Collide with IB + if (present(Gib)) then + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Gib,bc='n') + n12(1)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nxib,bc='n') + n12(2)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nyib,bc='n') + n12(3)=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=Nzib,bc='n') + buf = sqrt(sum(n12*n12))+epsilon(1.0_WP) + n12 = -n12/buf + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + end if + + ! Loop over nearest cells + do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 + do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 + do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + v2=this%p(i2)%vel + w2=this%p(i2)%angVel + d2=this%p(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + v2=this%g(i2)%vel + w2=this%g(i2)%angVel + d2=this%g(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + end if + + ! Compute relative information + d12=norm2(r1-r2) + if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision + n12=(r2-r1)/d12 + v12=v1-v2 + rnv=dot_product(v12,n12) + r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) + delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + m12=m1*m2/(m1+m2) + k_n=m12*k_coeff + eta_n=m12*eta_coeff + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + ! Add up the collisions + this%ncol=this%ncol+1 + end if + + end do + + end do + end do + end do + + ! Deal with dimensionality + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if + + end do collision + + ! Determine total number of collisions + call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 + + end block collision_force + + end subroutine collide + !> Advance the particle equations by a specified time step dt !> p%id=0 => no coll, no solve @@ -592,9 +636,9 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) @@ -606,6 +650,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty integer :: i,j,k,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz type(part) :: myp,pold ! Zero out source term arrays @@ -613,6 +658,23 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty if (present(srcV)) srcV=0.0_WP if (present(srcW)) srcW=0.0_WP if (present(srcE)) srcE=0.0_WP + + ! Get fluid stress + if (present(stress_x)) then + sx=stress_x + else + sx=0.0_WP + end if + if (present(stress_y)) then + sy=stress_y + else + sy=0.0_WP + end if + if (present(stress_z)) then + sz=stress_z + else + sz=0.0_WP + end if ! Zero out number of particles removed this%np_out=0 @@ -633,13 +695,12 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty ! Particle moment of inertia per unit mass Ip = 0.1_WP*myp%d**2 ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) - !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) myp%pos=pold%pos+0.5_WP*mydt*myp%vel myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=stress_x,stress_y=stress_y,stress_z=stress_z,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt) myp%pos=pold%pos+mydt*myp%vel myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip @@ -746,8 +807,6 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque fVF=1.0_WP-pVF ! Interpolate the fluid temperature to the particle location if present if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Interpolate the fluid vorticity to the particle location if needed - !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) end block interpolate ! Compute acceleration due to drag @@ -781,18 +840,18 @@ subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque end block compute_drag ! Compute acceleration due to Saffman lift - compute_lift: block - use mathtools, only: Pi,cross_product - real(WP) :: omegag,Cl,Reg - if (this%use_lift) then - omegag=sqrt(sum(fvort**2)) - if (omegag.gt.0.0_WP) then - Reg = p%d**2*omegag*frho/fvisc - Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) - acc=acc+Cl*cross_product(fvel-p%vel,fvort) - end if - end if - end block compute_lift + !compute_lift: block + ! use mathtools, only: Pi,cross_product + ! real(WP) :: omegag,Cl,Reg + ! if (this%use_lift) then + ! omegag=sqrt(sum(fvort**2)) + ! if (omegag.gt.0.0_WP) then + ! Reg = p%d**2*omegag*frho/fvisc + ! Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) + ! acc=acc+Cl*cross_product(fvel-p%vel,fvort) + ! end if + ! end if + !end block compute_lift ! Compute fluid torque (assumed Stokes drag) compute_torque: block @@ -819,7 +878,7 @@ subroutine update_VF(this) ! Transfer particle volume do i=1,this%np_ ! Skip inactive particle - if (this%p(i)%flag.eq.1) cycle + if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle ! Transfer particle volume Vp=Pi/6.0_WP*this%p(i)%d**3 call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') @@ -934,22 +993,23 @@ end subroutine filter !> Inject particles from a prescribed location with given mass flowrate !> Requires injection parameters to be set beforehand - subroutine inject(this,dt) + subroutine inject(this,dt,avoid_overlap) use mpi_f08 use parallel, only: MPI_REAL_WP use mathtools, only: Pi implicit none class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection - real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters - real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep - integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id + real(WP), intent(inout) :: dt !< Timestep size over which to advance + logical, intent(in), optional :: avoid_overlap !< Option to avoid overlap during injection + real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection + real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters + real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep + integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id integer :: i,j,np0_,np2,np_tmp,count,ierr integer, dimension(:), allocatable :: nrecv type(part), dimension(:), allocatable :: p2 type(MPI_Status) :: status - logical :: overlap + logical :: avoid_overlap_,overlap ! Initial number of particles np0_=this%np_ @@ -967,7 +1027,9 @@ subroutine inject(this,dt) call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) ! Communicate nearby particles to check for overlap - if (this%use_col) then + avoid_overlap_=.false. + if (present(avoid_overlap)) avoid_overlap_=avoid_overlap + if (avoid_overlap_) then allocate(nrecv(this%cfg%nproc)) count=0 inj_min(1)=this%cfg%x(this%cfg%imino) @@ -1036,7 +1098,7 @@ subroutine inject(this,dt) this%p(count)%pos=get_position() overlap=.false. ! Check overlap with particles recently injected - if (this%use_col) then + if (avoid_overlap_) then do j=1,np_tmp-1 if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. end do @@ -1139,13 +1201,14 @@ end subroutine inject !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) + subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX use parallel, only: MPI_REAL_WP implicit none class(lpt), intent(inout) :: this real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl + real(WP), intent(out) :: cflc + real(WP), optional :: cfl integer :: i,ierr real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col @@ -1165,15 +1228,15 @@ subroutine get_cfl(this,dt,cfl) call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) ! Return the maximum convective CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - if (this%use_col) then - my_CFL_col=10.0_WP*my_CFL_col*dt - call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - cfl = max(cfl,this%CFL_col) - else - this%CFL_col=0.0_WP - end if + cflc=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + ! Compute collision CFL + my_CFL_col=10.0_WP*my_CFL_col*dt + call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! If asked for, also return the maximum overall CFL + if (present(CFL)) cfl=max(cflc,this%CFL_col) + end subroutine get_cfl @@ -1242,7 +1305,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf @@ -1255,7 +1318,7 @@ subroutine get_max(this) end do end do end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%vol_total + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol end subroutine get_max diff --git a/src/solver/Make.package b/src/solver/Make.package index 6fc6cc525..0e5511f99 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -3,7 +3,7 @@ ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif ifeq ($(USE_FFTW),TRUE) - f90EXE_sources += pfft3d_class.f90 + f90EXE_sources += fourier3d_class.f90 endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/diag_class.f90 b/src/solver/diag_class.f90 index b671d7f84..7f3a8b58d 100644 --- a/src/solver/diag_class.f90 +++ b/src/solver/diag_class.f90 @@ -1,1189 +1,1190 @@ !> Direct diagonal solvers defined here module diag_class - use precision, only: WP - use config_class, only: config - use string, only: str_medium - implicit none - private - - ! Expose type/constructor/methods - public :: diag - - !> diag object definition - type :: diag - ! Diagonalr solver works for a config - type(config), pointer :: cfg !< Config for the diag solver - character(len=str_medium) :: name !< Name of solver - integer :: ndiags !< Number of diagonals - real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays - real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays - real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays - + use precision, only: WP + use config_class, only: config + use string, only: str_medium + implicit none + private + + ! Expose type/constructor/methods + public :: diag + + !> diag object definition + type :: diag + ! Diagonal solver works for a config + type(config), pointer :: cfg !< Config for the diag solver + character(len=str_medium) :: name !< Name of solver + integer :: ndiags !< Number of diagonals + real(WP), dimension(:,:,:,:), allocatable :: Ax,Ay,Az !< Working arrays + real(WP), dimension(:,:,:), allocatable :: Rx,Ry,Rz !< Solution arrays + real(WP), dimension(:,:), allocatable :: stackmem !< Work arrays contains - procedure :: linsol_x !< Linear solver in x - procedure :: linsol_y !< Linear solver in y - procedure :: linsol_z !< Linear solver in z - procedure :: tridiagonal - procedure :: pentadiagonal - procedure :: polydiagonal - final :: destructor !< Destructor for diag - end type diag - - !> Declare diag constructor - interface diag - procedure diag_from_args - end interface diag - + procedure :: linsol_x !< Linear solver in x + procedure :: linsol_y !< Linear solver in y + procedure :: linsol_z !< Linear solver in z + procedure :: tridiagonal + procedure :: pentadiagonal + procedure :: polydiagonal + final :: destructor !< Destructor for diag + end type diag + + !> Declare diag constructor + interface diag + procedure diag_from_args + end interface diag + contains - - !> Destructor for diag object - subroutine destructor(this) - implicit none - type(diag) :: this - if (allocated(this%Ax)) deallocate(this%Ax) - if (allocated(this%Ay)) deallocate(this%Ay) - if (allocated(this%Az)) deallocate(this%Az) - if (allocated(this%Rx)) deallocate(this%Rx) - if (allocated(this%Ry)) deallocate(this%Ry) - if (allocated(this%Rz)) deallocate(this%Rz) - if (allocated(this%stackmem)) deallocate(this%stackmem) - end subroutine destructor - - - !> Constructor for a diag object - function diag_from_args(cfg,name,n) result(self) - use messager, only: die - implicit none - type(diag) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - integer, intent(in) :: n - integer :: nst - - ! Link the config and store the name - self%cfg=>cfg - self%name=trim(adjustl(name)) - - ! Number of diagonals and stencil size - self%ndiags=n - nst=(n-1)/2 - - ! Allocate arrays - allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) - allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) - allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) - allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) - allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) - allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) - - end function diag_from_args - - - ! Real solver in x - subroutine linsol_x(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& - this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& - this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,& - -(this%ndiags-1)/2),this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) - end select - - return - end subroutine linsol_x - - - ! Real solver in y - subroutine linsol_y(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& - this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& - this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,& - -(this%ndiags-1)/2),this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) - end select - - return - end subroutine linsol_y - - - ! Real solver in z - subroutine linsol_z(this) - implicit none - class(diag), intent(inout) :: this - - ! Choose based on number of diagonals - select case(this%ndiags) - case(3) - call this%tridiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) - case(5) - call this%pentadiagonal(& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& - this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& - this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) - case default - call this%polydiagonal((this%ndiags-1)/2,this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,& - -(this%ndiags-1)/2),this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) - end select - - return - end subroutine linsol_z - - - subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER - real(WP), dimension(lot,n) :: B ! DIAGONAL - real(WP), dimension(lot,n) :: C ! UPPER - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot) :: r1 - real(WP), dimension(lot) :: r2 - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:), allocatable :: sendbuf - real(WP), dimension(:,:,:), allocatable :: recvbuf1 - real(WP), dimension(:,:), allocatable :: recvbuf2 - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 - ! Stuff - integer :: i,igroup - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call tridiagonal_serial(A,B,C,R,n,lot) - else - call tridiagonal_periodic_serial(A,B,C,R,n,lot) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot*12*proc)) - allocate(recvbuf1(nlot,6,2*proc)) - allocate(recvbuf2(nlot,2*proc)) - - ! Initialize boundary values - s1(:,1) = a(:,1) - s2(:,n) = c(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(i) - do i=2,n - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - s1(:,i) = -s1(:,i-1)*const(:) - end do - - ! Backward elimination - ! Lower boundary in s2(i) - do i=n-1,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) - s2(:,i) = -s2(:,i+1)*const(:) - end do - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced pentadiagonal system - ! Use of pentadiagonal system is more robust than the - ! reordered (removes zeros) tridiagonal system - - ! Send rows of pentadiagonal system - ! (0, s1, b, 0, s2; r) - ! (s1, 0, b, s2, 0; r) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = ngroup(igroup) - - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot - sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot - sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot - sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) - - ! Clear unused values - nk = ngroup(nrank+1) - recvbuf1(nk+1:nlot, :, :) = 0.0_WP - recvbuf1(nk+1:nlot, 3, :) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - ! Store in buf to avoid creating a temporary array (there must be a better way to do this) - allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) - buf1=recvbuf1(:,1,2:2*proc-1) - buf2=recvbuf1(:,2,2:2*proc-1) - buf3=recvbuf1(:,3,2:2*proc-1) - buf4=recvbuf1(:,4,2:2*proc-1) - buf5=recvbuf1(:,5,2:2*proc-1) - buf6=recvbuf1(:,6,2:2*proc-1) - call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) - recvbuf1(:,1,2:2*proc-1)=buf1 - recvbuf1(:,2,2:2*proc-1)=buf2 - recvbuf1(:,3,2:2*proc-1)=buf3 - recvbuf1(:,4,2:2*proc-1)=buf4 - recvbuf1(:,5,2:2*proc-1)=buf5 - recvbuf1(:,6,2:2*proc-1)=buf6 - deallocate(buf1,buf2,buf3,buf4,buf5,buf6) - else - call pentadiagonal_periodic_serial(& - recvbuf1(:,1,:),recvbuf1(:,2,:),recvbuf1(:,3,:),& - recvbuf1(:,4,:),recvbuf1(:,5,:),recvbuf1(:,6,:),& - 2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) - end if - - ! Move solution to first slot - do i=1,2*proc - recvbuf2(:,i) = recvbuf1(:,6,i) - end do - - ! Permute the order - do i=1,proc-1 - const(1:nlot) = recvbuf2(:,2*i) - recvbuf2(:,2*i) = recvbuf2(:,2*i+1) - recvbuf2(:,2*i+1) = const(1:nlot) - end do - - ! If periodic, don't forget the end points - if (nper) then - const(1:nlot) = recvbuf2(:,1) - recvbuf2(:,1) = recvbuf2(:,2*proc) - recvbuf2(:,2*proc) = const(1:nlot) - end if - - ! Scatter back the solution - call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - do i=1,n - r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) - end do - - deallocate(sendbuf) - deallocate(recvbuf2) - deallocate(recvbuf1) - deallocate(ngroup) - - return - end subroutine tridiagonal - - - !> TriDiagonal Solver - Serial Case - Periodic - subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - r = r/(a + b + c) - return - else if (n .eq. 2) then - ! Solve 2x2 system - c(:,1) = c(:,1) + a(:,1) - a(:,2) = a(:,2) + c(:,2) - const(:) = a(:,2)/b(:,1) - b(:,2) = b(:,2) - c(:,1)*const(:) - r(:,2) = r(:,2) - r(:,1)*const(:) - r(:,2) = r(:,2)/b(:,2) - r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) - return - end if - - ! Forward elimination - do i=2,n-2 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - ! Boundary is stored in a(i) - a(:,i) = -a(:,i-1)*const(:) - end do - i=n-1 - const(:) = a(:,i)/b(:,i-1) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = c(:,i) - a(:,i-1)*const(:) - i=n - const(:) = a(:,i)/b(:,i-1) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - a(:,i) = b(:,i) - a(:,i-1)*const(:) - - ! Backward elimination - do i=n-2,1,-1 - const(:) = c(:,i)/b(:,i+1) - r(:,i) = r(:,i) - r(:,i+1)*const(:) - a(:,i) = a(:,i) - a(:,i+1)*const(:) - end do - - ! Eliminate oddball - const(:) = c(:,n)/b(:,1) - r(:,n) = r(:,n) - r(:,1)*const(:) - a(:,n) = a(:,n) - a(:,1)*const(:) - - ! Backward substitution - r(:,n) = r(:,n)/a(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) - end do - - return - end subroutine tridiagonal_periodic_serial - - - !> TriDiagonal Solver - Serial Case - Not Periodic - subroutine tridiagonal_serial(a,b,c,r,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), intent(inout), dimension(lot,n) :: a,b,c,r - real(WP), dimension(lot) :: const - integer :: i - - ! Forward elimination - do i=2,n - const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) - b(:,i) = b(:,i) - c(:,i-1)*const(:) - r(:,i) = r(:,i) - r(:,i-1)*const(:) - end do - - ! Back-substitution - r(:,n) = r(:,n)/b(:,n) - do i=n-1,1,-1 - r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine tridiagonal_serial - - subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) - use parallel - use mpi_f08, only : mpi_comm - implicit none - class(diag), intent(inout) :: this - ! Direction - character(len=*), intent(in) :: dir - ! Size of the problems - integer, intent(in) :: n - ! Number of problems - integer, intent(in) :: lot - ! Matrix - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - ! Local - real(WP), dimension(lot) :: const - real(WP), dimension(lot,2) :: r1 - real(WP), dimension(lot,2) :: r2 - real(WP), dimension(lot,n,2) :: s1 - real(WP), dimension(lot,n,2) :: s2 - ! Communication - logical :: nper - type(MPI_Comm) :: ncom - integer :: proc,nrank - integer :: nremain,nlot - real(WP), dimension(:,:), allocatable :: sendbuf - real(WP), dimension(:,:), allocatable :: recvbuf - integer, dimension(:), allocatable :: ngroup - real(WP), dimension(:,:,:), allocatable :: AA - real(WP), dimension(:,:), allocatable :: swap - - ! Stuff - integer :: i,igroup,j,k,m - integer :: k1,L,k2,nk - integer :: ierr - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nrank = this%cfg%xrank - ncom = this%cfg%xcomm - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nrank = this%cfg%yrank - ncom = this%cfg%ycomm - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nrank = this%cfg%zrank - ncom = this%cfg%zcomm - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc .eq. 1) then - if (.not.nper) then - call pentadiagonal_serial(A,B,C,D,E,R,n,lot) - else - call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - end if - return - end if - - ! Partition the lot - if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' - allocate(ngroup(proc)) - ngroup(:) = lot/proc - nremain = mod(lot,proc) - ngroup(1:nremain) = ngroup(1:nremain) + 1 - nlot = ngroup(1) - allocate(sendbuf(nlot,24*proc)) - allocate(recvbuf(nlot,24*proc)) - - if (n > 1) then ! do normal stuff - - ! Initialize boundary values - s1(:,1,1) = a(:,1) - s1(:,1,2) = b(:,1) - s1(:,2,1) = 0.0_WP - s1(:,2,2) = a(:,2) - s2(:,n-1,1) = e(:,n-1) - s2(:,n-1,2) = 0.0_WP - s2(:,n,1) = d(:,n) - s2(:,n,2) = e(:,n) - if (.not.nper) then - if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP - if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP - end if - - ! Forward elimination - ! Upper boundary in s1(:,i,1:2) - do i=1,n-2 - ! Eliminate a(i+2) - const(:) = a(:,i+2)/c(:,i) - b(:,i+2) = b(:,i+2) - d(:,i)*const(:) - c(:,i+2) = c(:,i+2) - e(:,i)*const(:) - r(:,i+2) = r(:,i+2) - r(:,i)*const(:) - s1(:,i+2,1) = -s1(:,i,1)*const(:) - s1(:,i+2,2) = -s1(:,i,2)*const(:) - - ! Eliminate b(i+1) - const(:) = b(:,i+1)/c(:,i) - c(:,i+1) = c(:,i+1) - d(:,i)*const(:) - d(:,i+1) = d(:,i+1) - e(:,i)*const(:) - r(:,i+1) = r(:,i+1) - r(:,i)*const(:) - s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) - s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) - end do - ! Eliminate b(n) - const(:) = b(:,n)/c(:,n-1) - c(:,n) = c(:,n) - d(:,n-1)*const(:) - r(:,n) = r(:,n) - r(:,n-1)*const(:) - s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) - s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) - s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) - - ! Backward elimination - ! Lower boundary in s2(:,i,1:2) - do i=n,3,-1 - ! Eliminate e(i-2) - const(:) = e(:,i-2)/c(:,i) - r(:,i-2) = r(:,i-2) - r(:,i)*const(:) - s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) - s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) - s2(:,i-2,1) = -s2(:,i,1)*const(:) - s2(:,i-2,2) = -s2(:,i,2)*const(:) - - ! Eliminate d(i-1) - const(:) = d(:,i-1)/c(:,i) - r(:,i-1) = r(:,i-1) - r(:,i)*const(:) - s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) - s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) - s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) - s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) - end do - ! Eliminate d(1) - const(:) = d(:,1)/c(:,2) - r(:,1) = r(:,1) - r(:,2)*const(:) - s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) - s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) - s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) - s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) - - end if ! n > 1 - - ! All dependence has been shifted to the boundary elements - ! Communicate boundary values to root process - ! and solve reduced 11-diagonal system - ! Use of 11-diagonal system is more robust than the - ! reordered (removes zeros) 7-diagonal system - - ! Send rows of 11-diagonal system - ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) - ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) - ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) - ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) - ! For efficiency, only send non-zero elements - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - if (n > 1) then ! do normal stuff - - do i=1,2 - sendbuf(1:nk, L+0) = c(k1:k2, i) - sendbuf(1:nk, L+1) = r(k1:k2, i) - sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) - sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - sendbuf(1:nk, L+0) = s1(k1:k2, i,j) - sendbuf(1:nk, L+1) = s2(k1:k2, i,j) - sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) - sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) - L = L + 4 - end do - end do - - else ! n == 1 special case - - sendbuf(1:nk, L+0) = c(k1:k2, 1) - sendbuf(1:nk, L+1) = r(k1:k2, 1) - sendbuf(1:nk, L+2) = 1.0_WP - sendbuf(1:nk, L+3) = 0.0_WP - sendbuf(1:nk, L+4) = 1.0_WP - sendbuf(1:nk, L+5) = 0.0_WP - sendbuf(1:nk, L+6) = c(k1:k2, 1) - sendbuf(1:nk, L+7) = r(k1:k2, 1) - sendbuf(1:nk, L+8) = a(k1:k2, 1) - sendbuf(1:nk, L+9) = d(k1:k2, 1) - sendbuf(1:nk, L+10) = 0.0_WP - sendbuf(1:nk, L+11) = 0.0_WP - sendbuf(1:nk, L+12) = b(k1:k2, 1) - sendbuf(1:nk, L+13) = e(k1:k2, 1) - sendbuf(1:nk, L+14) = -1.0_WP - sendbuf(1:nk, L+15) = 0.0_WP - sendbuf(1:nk, L+16) = 0.0_WP - sendbuf(1:nk, L+17) = -1.0_WP - sendbuf(1:nk, L+18) = a(k1:k2, 1) - sendbuf(1:nk, L+19) = d(k1:k2, 1) - sendbuf(1:nk, L+20) = 0.0_WP - sendbuf(1:nk, L+21) = 0.0_WP - sendbuf(1:nk, L+22) = b(k1:k2, 1) - sendbuf(1:nk, L+23) = e(k1:k2, 1) - L = L + 24 - - end if - - k1 = k2 + 1 - end do - - ! Gather the boundary data - call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) - - ! Build reduced matrix - allocate(AA(nlot, 4*proc, -5:5 + 1)) - AA = 0.0_WP - L = 1 - do k=1,proc - m = 4*(k-1) - - do i=1,2 - AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) - AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) - AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) - AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) - L = L + 4 - end do - do i=1,2 - do j=1,2 - AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) - AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) - AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) - AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) - L = L + 4 - end do - end do - - end do - - ! Clear unused values - nk = ngroup(nrank+1) - AA(nk+1:nlot, :, :) = 0.0_WP - AA(nk+1:nlot, :, 0) = 1.0_WP - - ! Solve reduced systems - if (.not.nper) then - call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) - else - if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' - call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) - end if - - ! Move solution to beginning of recvbuf - recvbuf(:, 1:4*proc) = AA(:, :, 6) - deallocate(AA) - - ! Permute the order - allocate (swap(nlot,2)) - do i=1,proc-1 - swap(:,:) = recvbuf(:, 4*i-1:4*i) - recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) - recvbuf(:, 4*i+1:4*i+2) = swap(:,:) - end do - ! If periodic, don't forget the end points - if (nper) then - swap(:,:) = recvbuf(:, 4*proc-1:4*proc) - recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) - recvbuf(:, 1:2) = swap(:,:) - end if - deallocate (swap) - - ! Scatter back the solution - deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) - call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) - - L = 1 - k1 = 1 - do igroup=1,proc - k2 = k1+ngroup(igroup)-1 - nk = k2-k1+1 - - r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) - r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) - L = L + 4 - - k1 = k2 + 1 - end do - - ! Only if not periodic - if (.not.nper) then - if (nrank .eq. 0) r1 = 0.0_WP - if (nrank .eq. proc-1) r2 = 0.0_WP - end if - - if (n > 1) then ! do normal stuff - - do j=1,2 - do i=1,n - r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) - end do - end do - r = r / c - - else ! n == 1 special case - - r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & - -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) - - end if - - deallocate(sendbuf) - deallocate(recvbuf) - deallocate(ngroup) - - return - end subroutine pentadiagonal - - - ! ================================================= ! - ! PentaDiagonal Solver - Serial Case - Not periodic ! - ! ================================================= ! - subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,1) = R(:,1)/C(:,1) - return - else if (n .eq. 2) then - ! Solve 2x2 system - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - end if - - ! Forward elimination - do i=1,n-2 - ! Eliminate A(2,i+1) - const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - - ! Eliminate A(1,i+2) - const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - end do - ! Eliminate A(2,n) - const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) - C(:,n) = C(:,n) - D(:,n-1)*const(:) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - - ! Back-substitution - R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) - R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) - end do - - return - end subroutine pentadiagonal_serial - - - - ! ============================================= ! - ! PentaDiagonal Solver - Serial Case - Periodic ! - ! ============================================= ! - subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) - implicit none - - integer, intent(in) :: n,lot - real(WP), dimension(lot,n) :: A ! LOWER-2 - real(WP), dimension(lot,n) :: B ! LOWER-1 - real(WP), dimension(lot,n) :: C ! DIAGONAL - real(WP), dimension(lot,n) :: D ! UPPER+1 - real(WP), dimension(lot,n) :: E ! UPPER+2 - real(WP), dimension(lot,n) :: R ! RHS - RESULT - real(WP), dimension(lot,n) :: s1 - real(WP), dimension(lot,n) :: s2 - real(WP), dimension(lot) :: const - integer :: i - - if (n .eq. 1) then - ! Solve 1x1 system - R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) - return - else if (n .eq. 2) then - ! Solve 2x2 system - C(:,:) = C(:,:) + A(:,:) + E(:,:) - D(:,1) = D(:,1) + B(:,1) - B(:,2) = B(:,2) + D(:,2) - const(:) = B(:,2)/C(:,1) - C(:,2) = C(:,2) - D(:,1)*const(:) - R(:,2) = R(:,2) - R(:,1)*const(:) - R(:,2) = R(:,2)/C(:,2) - R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) - return - else if (n .eq. 3) then - B(:,:) = B(:,:) + E(:,:) - D(:,:) = D(:,:) + A(:,:) - call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) - return - else if (n .eq. 4) then - A(:,:) = A(:,:) + E(:,:) - E(:,:) = 0.0_WP - end if - - ! Initialize boundary data - s1 = 0.0_WP - s1(:,1) = A(:,1) - s1(:,n-3) = s1(:,n-3) + E(:,n-3) - s1(:,n-2) = D(:,n-2) - s1(:,n-1) = C(:,n-1) - s1(:,n) = B(:,n) - s2 = 0.0_WP - s2(:,1) = B(:,1) - s2(:,2) = A(:,2) - s2(:,n-2) = s2(:,n-2) + E(:,n-2) - s2(:,n-1) = D(:,n-1) - s2(:,n) = C(:,n) - - ! Forward elimination - do i=1,n-2 - ! Eliminate b(i+1) - const(:) = B(:,i+1)/C(:,i) - C(:,i+1) = C(:,i+1) - D(:,i)*const(:) - D(:,i+1) = D(:,i+1) - E(:,i)*const(:) - R(:,i+1) = R(:,i+1) - R(:,i)*const(:) - s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) - s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) - - ! Eliminate a(i+2) - const(:) = A(:,i+2)/C(:,i) - B(:,i+2) = B(:,i+2) - D(:,i)*const(:) - C(:,i+2) = C(:,i+2) - E(:,i)*const(:) - R(:,i+2) = R(:,i+2) - R(:,i)*const(:) - s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) - s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) - end do - - ! Backward elimination - do i=n-2,3,-1 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate e(i-2) - const(:) = E(:,i-2)/C(:,i) - R(:,i-2) = R(:,i-2) - R(:,i)*const(:) - s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) - s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) - end do - i=2 - ! Eliminate d(i-1) - const(:) = D(:,i-1)/C(:,i) - R(:,i-1) = R(:,i-1) - R(:,i)*const(:) - s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) - s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) - - ! Eliminate oddball region - const(:) = E(:,n-1)/C(:,1) - R(:,n-1) = R(:,n-1) - R(:,1)*const(:) - s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) - s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) - - const(:) = D(:,n)/C(:,1) - R(:,n) = R(:,n) - R(:,1)*const(:) - s1(:,n) = s1(:,n) - s1(:,1)*const(:) - s2(:,n) = s2(:,n) - s2(:,1)*const(:) - - const(:) = E(:,n)/C(:,2) - R(:,n) = R(:,n) - R(:,2)*const(:) - s1(:,n) = s1(:,n) - s1(:,2)*const(:) - s2(:,n) = s2(:,n) - s2(:,2)*const(:) - - ! Eliminate corner region - const(:) = s1(:,n)/s1(:,n-1) - R(:,n) = R(:,n) - R(:,n-1)*const(:) - s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) - - R(:,n) = R(:,n)/s2(:,n) - R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) - do i=n-2,1,-1 - R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) - end do - - return - end subroutine pentadiagonal_periodic_serial - - - subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) - implicit none - class(diag), intent(inout) :: this - character(len=*), intent(in) :: dir - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - integer :: proc - logical :: nper - - ! Get parallel info - select case (trim(adjustl(dir))) - case ('x') - proc = this%cfg%npx - nper = this%cfg%xper - case ('y') - proc = this%cfg%npy - nper = this%cfg%yper - case ('z') - proc = this%cfg%npz - nper = this%cfg%zper - case default - stop 'Unknown direction' - end select - - ! If serial - if (proc.eq.1) then - if (.not.nper) then - call polydiagonal_serial(nd,A,R,n,lot) - else - call polydiagonal_periodic_serial(nd,A,R,n,lot,b) - end if - return - else - stop 'polydiagonal: Implemented only in serial.' - end if - - return - end subroutine polydiagonal - - - subroutine polydiagonal_serial(nd,A,R,n,lot) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k - - ! Forward elimination - do i=1,n-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,n-i) - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,min(nd,n-i) - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Back-substitution - do i=n,1,-1 - do j=1,min(nd,n-i) - R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_serial - - - subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) - implicit none - - integer, intent(in) :: n,lot,nd - real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A - real(WP), intent(inout), dimension(lot,n) :: R - real(WP), intent(inout), dimension(lot,n,nd) :: b - real(WP), dimension(lot) :: const,pivot - integer :: i,j,k,i0 - - if (n.eq.1) then - const(:) = 0.0_WP - do j=-nd,nd - const(:) = const(:) + A(:,j,1) - end do - R(:,1) = R(:,1) / const(:) - return - end if - - ! Setup bridge array - do j=1,nd - do i=1,n - b(:,i,j) = 0.0_WP - end do - end do - do i=1,nd - do j=i,nd - b(:,i,j) = A(:,i,-nd+j-i) - b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) - end do - end do - do i=n-nd+1,n - do j=1,nd - b(:,i,j) = A(:,i,-nd+j-(i-n)) - end do - end do - - ! Forward elimination - do i=1,n-nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,nd - const(:) = A(:,i+j,-j)*pivot(:) - do k=1,nd - A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) - b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) - end do - R(:,i+j) = R(:,i+j) - R(:,i)*const(:) - end do - end do - - ! Backward elimination - do i=n-nd,1,-1 - pivot(:) = 1.0_WP/A(:,i,0) - do j=1,min(nd,i-1) - const(:) = A(:,i-j,j)*pivot(:) - do k=1,nd - b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) - end do - R(:,i-j) = R(:,i-j) - R(:,i)*const(:) - end do - end do - - ! Eliminate oddball region - do i=1,nd - pivot(:) = 1.0_WP/A(:,i,0) - do j=i,nd - const(:) = A(:,n-j+i,j)*pivot(:) - do k=1,nd - b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) - end do - R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) - end do - end do - - ! Elimination for corner matrix - i0 = n-nd - do i=1,nd-1 - pivot(:) = 1.0_WP/b(:,i+i0,i) - do j=i+1,nd - const(:) = b(:,j+i0,i)*pivot(:) - do k=i+1,nd - b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) - end do - R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) - end do - end do - - ! Back-substitution for corner matrix - i0 = n-nd - do i=nd,1,-1 - do j=i+1,nd - R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) - end do - R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) - end do - - ! Back-substitution for bridge - do i=n-nd,1,-1 - do j=1,nd - R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) - end do - R(:,i) = R(:,i)/A(:,i,0) - end do - - return - end subroutine polydiagonal_periodic_serial - - + + !> Destructor for diag object + subroutine destructor(this) + implicit none + type(diag) :: this + if (allocated(this%Ax)) deallocate(this%Ax) + if (allocated(this%Ay)) deallocate(this%Ay) + if (allocated(this%Az)) deallocate(this%Az) + if (allocated(this%Rx)) deallocate(this%Rx) + if (allocated(this%Ry)) deallocate(this%Ry) + if (allocated(this%Rz)) deallocate(this%Rz) + if (allocated(this%stackmem)) deallocate(this%stackmem) + end subroutine destructor + + + !> Constructor for a diag object + function diag_from_args(cfg,name,n) result(self) + use messager, only: die + implicit none + type(diag) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: n + integer :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Number of diagonals and stencil size + self%ndiags=n + nst=(n-1)/2 + + ! Allocate arrays + allocate(self%Ax(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_,-nst:+nst)) + allocate(self%Ay(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_,-nst:+nst)) + allocate(self%Az(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,-nst:+nst)) + allocate(self%Rx(self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%imin_:self%cfg%imax_)) + allocate(self%Ry(self%cfg%imin_:self%cfg%imax_,self%cfg%kmin_:self%cfg%kmax_,self%cfg%jmin_:self%cfg%jmax_)) + allocate(self%Rz(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%stackmem((self%cfg%imaxo_-self%cfg%imino_)*(self%cfg%jmaxo_-self%cfg%jmino_)*(self%cfg%kmaxo_-self%cfg%kmino_),nst+1)) + + end function diag_from_args + + + ! Real solver in x + subroutine linsol_x(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-2),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_, 0),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+1),& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,+2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ax(this%cfg%jmin_,this%cfg%kmin_,this%cfg%imin_,-(this%ndiags-1)/2),& + this%Rx,this%cfg%nx_,this%cfg%ny_*this%cfg%nz_,'x',this%stackmem) + end select + + end subroutine linsol_x + + + ! Real solver in y + subroutine linsol_y(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-2),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_, 0),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+1),& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,+2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Ay(this%cfg%imin_,this%cfg%kmin_,this%cfg%jmin_,-(this%ndiags-1)/2),& + this%Ry,this%cfg%ny_,this%cfg%nx_*this%cfg%nz_,'y',this%stackmem) + end select + + end subroutine linsol_y + + + ! Real solver in z + subroutine linsol_z(this) + implicit none + class(diag), intent(inout) :: this + + ! Choose based on number of diagonals + select case(this%ndiags) + case(3) + call this%tridiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,2)) + case(5) + call this%pentadiagonal(& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-2),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_, 0),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+1),& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,+2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem(1,1),this%stackmem(1,3)) + case default + call this%polydiagonal((this%ndiags-1)/2,& + this%Az(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_,-(this%ndiags-1)/2),& + this%Rz,this%cfg%nz_,this%cfg%ny_*this%cfg%nx_,'z',this%stackmem) + end select + + end subroutine linsol_z + + + subroutine tridiagonal(this,A,B,C,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER + real(WP), dimension(lot,n) :: B ! DIAGONAL + real(WP), dimension(lot,n) :: C ! UPPER + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot) :: r1 + real(WP), dimension(lot) :: r2 + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:), allocatable :: sendbuf + real(WP), dimension(:,:,:), allocatable :: recvbuf1 + real(WP), dimension(:,:), allocatable :: recvbuf2 + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:), allocatable :: buf1,buf2,buf3,buf4,buf5,buf6 + ! Stuff + integer :: i,igroup + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call tridiagonal_serial(A,B,C,R,n,lot) + else + call tridiagonal_periodic_serial(A,B,C,R,n,lot) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Tridiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot*12*proc)) + allocate(recvbuf1(nlot,6,2*proc)) + allocate(recvbuf2(nlot,2*proc)) + + ! Initialize boundary values + s1(:,1) = a(:,1) + s2(:,n) = c(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(i) + do i=2,n + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + s1(:,i) = -s1(:,i-1)*const(:) + end do + + ! Backward elimination + ! Lower boundary in s2(i) + do i=n-1,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + s1(:,i) = s1(:,i) - s1(:,i+1)*const(:) + s2(:,i) = -s2(:,i+1)*const(:) + end do + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced pentadiagonal system + ! Use of pentadiagonal system is more robust than the + ! reordered (removes zeros) tridiagonal system + + ! Send rows of pentadiagonal system + ! (0, s1, b, 0, s2; r) + ! (s1, 0, b, s2, 0; r) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = ngroup(igroup) + + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,1) ; L = L + nlot + sendbuf(L:L+nk-1) = s1(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = b(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = s2(k1:k2,n) ; L = L + nlot + sendbuf(L:L+nk-1) = 0.0_WP ; L = L + nlot + sendbuf(L:L+nk-1) = r(k1:k2,n) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_ALLTOALL(sendbuf,nlot*12,MPI_REAL_WP,recvbuf1,nlot*12,MPI_REAL_WP,ncom,ierr) + + ! Clear unused values + nk = ngroup(nrank+1) + recvbuf1(nk+1:nlot, :, :) = 0.0_WP + recvbuf1(nk+1:nlot, 3, :) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + ! Store in buf to avoid creating a temporary array (there must be a better way to do this) + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,2:2*proc-1) + buf2=recvbuf1(:,2,2:2*proc-1) + buf3=recvbuf1(:,3,2:2*proc-1) + buf4=recvbuf1(:,4,2:2*proc-1) + buf5=recvbuf1(:,5,2:2*proc-1) + buf6=recvbuf1(:,6,2:2*proc-1) + call pentadiagonal_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc-2,nlot) + recvbuf1(:,1,2:2*proc-1)=buf1 + recvbuf1(:,2,2:2*proc-1)=buf2 + recvbuf1(:,3,2:2*proc-1)=buf3 + recvbuf1(:,4,2:2*proc-1)=buf4 + recvbuf1(:,5,2:2*proc-1)=buf5 + recvbuf1(:,6,2:2*proc-1)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + else + allocate(buf1(nlot,2*proc),buf2(nlot,2*proc),buf3(nlot,2*proc),buf4(nlot,2*proc),buf5(nlot,2*proc),buf6(nlot,2*proc)) + buf1=recvbuf1(:,1,:) + buf2=recvbuf1(:,2,:) + buf3=recvbuf1(:,3,:) + buf4=recvbuf1(:,4,:) + buf5=recvbuf1(:,5,:) + buf6=recvbuf1(:,6,:) + call pentadiagonal_periodic_serial(buf1,buf2,buf3,buf4,buf5,buf6,2*proc,nlot,sendbuf(1),sendbuf(2*proc*nlot+1)) + recvbuf1(:,1,:)=buf1 + recvbuf1(:,2,:)=buf2 + recvbuf1(:,3,:)=buf3 + recvbuf1(:,4,:)=buf4 + recvbuf1(:,5,:)=buf5 + recvbuf1(:,6,:)=buf6 + deallocate(buf1,buf2,buf3,buf4,buf5,buf6) + end if + + ! Move solution to first slot + do i=1,2*proc + recvbuf2(:,i) = recvbuf1(:,6,i) + end do + + ! Permute the order + do i=1,proc-1 + const(1:nlot) = recvbuf2(:,2*i) + recvbuf2(:,2*i) = recvbuf2(:,2*i+1) + recvbuf2(:,2*i+1) = const(1:nlot) + end do + + ! If periodic, don't forget the end points + if (nper) then + const(1:nlot) = recvbuf2(:,1) + recvbuf2(:,1) = recvbuf2(:,2*proc) + recvbuf2(:,2*proc) = const(1:nlot) + end if + + ! Scatter back the solution + call MPI_ALLTOALL(recvbuf2,nlot*2,MPI_REAL_WP,sendbuf,nlot*2,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + r2(k1:k2) = sendbuf(L:L+nk-1) ; L = L + nlot + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + do i=1,n + r(:,i) = (r(:,i) - s1(:,i)*r1(:) - s2(:,i)*r2(:))/b(:,i) + end do + + deallocate(sendbuf) + deallocate(recvbuf2) + deallocate(recvbuf1) + deallocate(ngroup) + + end subroutine tridiagonal + + + !> TriDiagonal Solver - Serial Case - Periodic + subroutine tridiagonal_periodic_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + r = r/(a + b + c) + return + else if (n .eq. 2) then + ! Solve 2x2 system + c(:,1) = c(:,1) + a(:,1) + a(:,2) = a(:,2) + c(:,2) + const(:) = a(:,2)/b(:,1) + b(:,2) = b(:,2) - c(:,1)*const(:) + r(:,2) = r(:,2) - r(:,1)*const(:) + r(:,2) = r(:,2)/b(:,2) + r(:,1) = (r(:,1) - c(:,1)*r(:,2))/b(:,1) + return + end if + + ! Forward elimination + do i=2,n-2 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + ! Boundary is stored in a(i) + a(:,i) = -a(:,i-1)*const(:) + end do + i=n-1 + const(:) = a(:,i)/b(:,i-1) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = c(:,i) - a(:,i-1)*const(:) + i=n + const(:) = a(:,i)/b(:,i-1) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + a(:,i) = b(:,i) - a(:,i-1)*const(:) + + ! Backward elimination + do i=n-2,1,-1 + const(:) = c(:,i)/b(:,i+1) + r(:,i) = r(:,i) - r(:,i+1)*const(:) + a(:,i) = a(:,i) - a(:,i+1)*const(:) + end do + + ! Eliminate oddball + const(:) = c(:,n)/b(:,1) + r(:,n) = r(:,n) - r(:,1)*const(:) + a(:,n) = a(:,n) - a(:,1)*const(:) + + ! Backward substitution + r(:,n) = r(:,n)/a(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - a(:,i)*r(:,n))/b(:,i) + end do + + end subroutine tridiagonal_periodic_serial + + + !> TriDiagonal Solver - Serial Case - Not Periodic + subroutine tridiagonal_serial(a,b,c,r,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), intent(inout), dimension(lot,n) :: a,b,c,r + real(WP), dimension(lot) :: const + integer :: i + + ! Forward elimination + do i=2,n + const(:) = a(:,i)/(b(:,i-1)+tiny(1.0_WP)) + b(:,i) = b(:,i) - c(:,i-1)*const(:) + r(:,i) = r(:,i) - r(:,i-1)*const(:) + end do + + ! Back-substitution + r(:,n) = r(:,n)/b(:,n) + do i=n-1,1,-1 + r(:,i) = (r(:,i) - c(:,i)*r(:,i+1))/(b(:,i)+tiny(1.0_WP)) + end do + + end subroutine tridiagonal_serial + + + subroutine pentadiagonal(this,A,B,C,D,E,R,n,lot,dir,s1,s2) + use parallel + use mpi_f08, only : mpi_comm + implicit none + class(diag), intent(inout) :: this + ! Direction + character(len=*), intent(in) :: dir + ! Size of the problems + integer, intent(in) :: n + ! Number of problems + integer, intent(in) :: lot + ! Matrix + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + ! Local + real(WP), dimension(lot) :: const + real(WP), dimension(lot,2) :: r1 + real(WP), dimension(lot,2) :: r2 + real(WP), dimension(lot,n,2) :: s1 + real(WP), dimension(lot,n,2) :: s2 + ! Communication + logical :: nper + type(MPI_Comm) :: ncom + integer :: proc,nrank + integer :: nremain,nlot + real(WP), dimension(:,:), allocatable :: sendbuf + real(WP), dimension(:,:), allocatable :: recvbuf + integer, dimension(:), allocatable :: ngroup + real(WP), dimension(:,:,:), allocatable :: AA + real(WP), dimension(:,:), allocatable :: swap + + ! Stuff + integer :: i,igroup,j,k,m + integer :: k1,L,k2,nk + integer :: ierr + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nrank = this%cfg%xrank + ncom = this%cfg%xcomm + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nrank = this%cfg%yrank + ncom = this%cfg%ycomm + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nrank = this%cfg%zrank + ncom = this%cfg%zcomm + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc .eq. 1) then + if (.not.nper) then + call pentadiagonal_serial(A,B,C,D,E,R,n,lot) + else + call pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + end if + return + end if + + ! Partition the lot + if (lot .lt. proc) stop 'Pentadiagonal solver cannot handle so many proc for such a small problem.' + allocate(ngroup(proc)) + ngroup(:) = lot/proc + nremain = mod(lot,proc) + ngroup(1:nremain) = ngroup(1:nremain) + 1 + nlot = ngroup(1) + allocate(sendbuf(nlot,24*proc)) + allocate(recvbuf(nlot,24*proc)) + + if (n > 1) then ! do normal stuff + + ! Initialize boundary values + s1(:,1,1) = a(:,1) + s1(:,1,2) = b(:,1) + s1(:,2,1) = 0.0_WP + s1(:,2,2) = a(:,2) + s2(:,n-1,1) = e(:,n-1) + s2(:,n-1,2) = 0.0_WP + s2(:,n,1) = d(:,n) + s2(:,n,2) = e(:,n) + if (.not.nper) then + if (nrank .eq. 0) s1(:,1:2,1:2) = 0.0_WP + if (nrank .eq. proc-1) s2(:,n-1:n,1:2) = 0.0_WP + end if + + ! Forward elimination + ! Upper boundary in s1(:,i,1:2) + do i=1,n-2 + ! Eliminate a(i+2) + const(:) = a(:,i+2)/c(:,i) + b(:,i+2) = b(:,i+2) - d(:,i)*const(:) + c(:,i+2) = c(:,i+2) - e(:,i)*const(:) + r(:,i+2) = r(:,i+2) - r(:,i)*const(:) + s1(:,i+2,1) = -s1(:,i,1)*const(:) + s1(:,i+2,2) = -s1(:,i,2)*const(:) + + ! Eliminate b(i+1) + const(:) = b(:,i+1)/c(:,i) + c(:,i+1) = c(:,i+1) - d(:,i)*const(:) + d(:,i+1) = d(:,i+1) - e(:,i)*const(:) + r(:,i+1) = r(:,i+1) - r(:,i)*const(:) + s1(:,i+1,1) = s1(:,i+1,1) - s1(:,i,1)*const(:) + s1(:,i+1,2) = s1(:,i+1,2) - s1(:,i,2)*const(:) + end do + ! Eliminate b(n) + const(:) = b(:,n)/c(:,n-1) + c(:,n) = c(:,n) - d(:,n-1)*const(:) + r(:,n) = r(:,n) - r(:,n-1)*const(:) + s1(:,n,1) = s1(:,n,1) - s1(:,n-1,1)*const(:) + s1(:,n,2) = s1(:,n,2) - s1(:,n-1,2)*const(:) + s2(:,n,1) = s2(:,n,1) - s2(:,n-1,1)*const(:) + + ! Backward elimination + ! Lower boundary in s2(:,i,1:2) + do i=n,3,-1 + ! Eliminate e(i-2) + const(:) = e(:,i-2)/c(:,i) + r(:,i-2) = r(:,i-2) - r(:,i)*const(:) + s1(:,i-2,1) = s1(:,i-2,1) - s1(:,i,1)*const(:) + s1(:,i-2,2) = s1(:,i-2,2) - s1(:,i,2)*const(:) + s2(:,i-2,1) = -s2(:,i,1)*const(:) + s2(:,i-2,2) = -s2(:,i,2)*const(:) + + ! Eliminate d(i-1) + const(:) = d(:,i-1)/c(:,i) + r(:,i-1) = r(:,i-1) - r(:,i)*const(:) + s1(:,i-1,1) = s1(:,i-1,1) - s1(:,i,1)*const(:) + s1(:,i-1,2) = s1(:,i-1,2) - s1(:,i,2)*const(:) + s2(:,i-1,1) = s2(:,i-1,1) - s2(:,i,1)*const(:) + s2(:,i-1,2) = s2(:,i-1,2) - s2(:,i,2)*const(:) + end do + ! Eliminate d(1) + const(:) = d(:,1)/c(:,2) + r(:,1) = r(:,1) - r(:,2)*const(:) + s1(:,1,1) = s1(:,1,1) - s1(:,2,1)*const(:) + s1(:,1,2) = s1(:,1,2) - s1(:,2,2)*const(:) + s2(:,1,1) = s2(:,1,1) - s2(:,2,1)*const(:) + s2(:,1,2) = s2(:,1,2) - s2(:,2,2)*const(:) + + end if ! n > 1 + + ! All dependence has been shifted to the boundary elements + ! Communicate boundary values to root process + ! and solve reduced 11-diagonal system + ! Use of 11-diagonal system is more robust than the + ! reordered (removes zeros) 7-diagonal system + + ! Send rows of 11-diagonal system + ! (0, 0, 0, a, b, c, 0, 0, 0, d, e; r) + ! (0, 0, a, b, 0, c, 0, 0, d, e, 0; r) + ! (0, a, b, 0, 0, c, 0, d, e, 0, 0; r) + ! (a, b, 0, 0, 0, c, d, e, 0, 0, 0; r) + ! For efficiency, only send non-zero elements + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + if (n > 1) then ! do normal stuff + + do i=1,2 + sendbuf(1:nk, L+0) = c(k1:k2, i) + sendbuf(1:nk, L+1) = r(k1:k2, i) + sendbuf(1:nk, L+2) = c(k1:k2, n-2+i) + sendbuf(1:nk, L+3) = r(k1:k2, n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + sendbuf(1:nk, L+0) = s1(k1:k2, i,j) + sendbuf(1:nk, L+1) = s2(k1:k2, i,j) + sendbuf(1:nk, L+2) = s1(k1:k2, n-2+i,j) + sendbuf(1:nk, L+3) = s2(k1:k2, n-2+i,j) + L = L + 4 + end do + end do + + else ! n == 1 special case + + sendbuf(1:nk, L+0) = c(k1:k2, 1) + sendbuf(1:nk, L+1) = r(k1:k2, 1) + sendbuf(1:nk, L+2) = 1.0_WP + sendbuf(1:nk, L+3) = 0.0_WP + sendbuf(1:nk, L+4) = 1.0_WP + sendbuf(1:nk, L+5) = 0.0_WP + sendbuf(1:nk, L+6) = c(k1:k2, 1) + sendbuf(1:nk, L+7) = r(k1:k2, 1) + sendbuf(1:nk, L+8) = a(k1:k2, 1) + sendbuf(1:nk, L+9) = d(k1:k2, 1) + sendbuf(1:nk, L+10) = 0.0_WP + sendbuf(1:nk, L+11) = 0.0_WP + sendbuf(1:nk, L+12) = b(k1:k2, 1) + sendbuf(1:nk, L+13) = e(k1:k2, 1) + sendbuf(1:nk, L+14) = -1.0_WP + sendbuf(1:nk, L+15) = 0.0_WP + sendbuf(1:nk, L+16) = 0.0_WP + sendbuf(1:nk, L+17) = -1.0_WP + sendbuf(1:nk, L+18) = a(k1:k2, 1) + sendbuf(1:nk, L+19) = d(k1:k2, 1) + sendbuf(1:nk, L+20) = 0.0_WP + sendbuf(1:nk, L+21) = 0.0_WP + sendbuf(1:nk, L+22) = b(k1:k2, 1) + sendbuf(1:nk, L+23) = e(k1:k2, 1) + L = L + 24 + + end if + + k1 = k2 + 1 + end do + + ! Gather the boundary data + call MPI_AllToAll (sendbuf,nlot*24,MPI_REAL_WP,recvbuf,nlot*24,MPI_REAL_WP,ncom,ierr) + + ! Build reduced matrix + allocate(AA(nlot, 4*proc, -5:5 + 1)) + AA = 0.0_WP + L = 1 + do k=1,proc + m = 4*(k-1) + + do i=1,2 + AA(:, m+i , 0) = recvbuf(:, L+0) ! c(i) + AA(:, m+i , 6) = recvbuf(:, L+1) ! r(i) + AA(:, m+i+2, 0) = recvbuf(:, L+2) ! c(n-2+i) + AA(:, m+i+2, 6) = recvbuf(:, L+3) ! r(n-2+i) + L = L + 4 + end do + do i=1,2 + do j=1,2 + AA(:, m+i, -2+j-i) = recvbuf(:, L+0) ! s1(i,j) + AA(:, m+i, 4+j-i) = recvbuf(:, L+1) ! s2(i,j) + AA(:, m+i+2, -4+j-i) = recvbuf(:, L+2) ! s1(n-2+i,j) + AA(:, m+i+2, 2+j-i) = recvbuf(:, L+3) ! s2(n-2+i,j) + L = L + 4 + end do + end do + + end do + + ! Clear unused values + nk = ngroup(nrank+1) + AA(nk+1:nlot, :, :) = 0.0_WP + AA(nk+1:nlot, :, 0) = 1.0_WP + + ! Solve reduced systems + if (.not.nper) then + call polydiagonal_serial(5, AA(:,3:4*proc-2,-5:+5), AA(:,3:4*proc-2,6), (2*proc-2)*2, nlot) + else + if (proc.lt.3) stop 'Pentadiagonal solver needs more proc for this problem' + call polydiagonal_periodic_serial(5, AA(:,:,-5:+5), AA(:,:,6), (2*proc)*2, nlot, sendbuf) + end if + + ! Move solution to beginning of recvbuf + recvbuf(:, 1:4*proc) = AA(:, :, 6) + deallocate(AA) + + ! Permute the order + allocate (swap(nlot,2)) + do i=1,proc-1 + swap(:,:) = recvbuf(:, 4*i-1:4*i) + recvbuf(:, 4*i-1:4*i) = recvbuf(:, 4*i+1:4*i+2) + recvbuf(:, 4*i+1:4*i+2) = swap(:,:) + end do + ! If periodic, don't forget the end points + if (nper) then + swap(:,:) = recvbuf(:, 4*proc-1:4*proc) + recvbuf(:, 4*proc-1:4*proc) = recvbuf(:, 1:2) + recvbuf(:, 1:2) = swap(:,:) + end if + deallocate (swap) + + ! Scatter back the solution + deallocate(sendbuf); allocate(sendbuf(nlot,4*proc)) + call MPI_AllToAll(recvbuf,nlot*4,MPI_REAL_WP,sendbuf,nlot*4,MPI_REAL_WP,ncom,ierr) + + L = 1 + k1 = 1 + do igroup=1,proc + k2 = k1+ngroup(igroup)-1 + nk = k2-k1+1 + + r1(k1:k2, :) = sendbuf(1:nk, L+0:L+1) + r2(k1:k2, :) = sendbuf(1:nk, L+2:L+3) + L = L + 4 + + k1 = k2 + 1 + end do + + ! Only if not periodic + if (.not.nper) then + if (nrank .eq. 0) r1 = 0.0_WP + if (nrank .eq. proc-1) r2 = 0.0_WP + end if + + if (n > 1) then ! do normal stuff + + do j=1,2 + do i=1,n + r(:,i) = r(:,i) - s1(:,i,j)*r1(:,j) - s2(:,i,j)*r2(:,j) + end do + end do + r = r / c + + else ! n == 1 special case + + r(:,1) = ( r(:,1) - a(:,1)*r1(:,1) - b(:,1)*r1(:,2) & + & -d(:,1)*r2(:,1) - e(:,1)*r2(:,2) )/c(:,1) + + end if + + deallocate(sendbuf) + deallocate(recvbuf) + deallocate(ngroup) + + end subroutine pentadiagonal + + + ! ================================================= ! + ! PentaDiagonal Solver - Serial Case - Not periodic ! + ! ================================================= ! + subroutine pentadiagonal_serial(A,B,C,D,E,R,n,lot) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,1) = R(:,1)/C(:,1) + return + else if (n .eq. 2) then + ! Solve 2x2 system + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + end if + + ! Forward elimination + do i=1,n-2 + ! Eliminate A(2,i+1) + const(:) = B(:,i+1)/(C(:,i)+tiny(1.0_WP)) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + + ! Eliminate A(1,i+2) + const(:) = A(:,i+2)/(C(:,i)+tiny(1.0_WP)) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + end do + ! Eliminate A(2,n) + const(:) = B(:,n)/(C(:,n-1)+tiny(1.0_WP)) + C(:,n) = C(:,n) - D(:,n-1)*const(:) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + + ! Back-substitution + R(:,n) = R(:,n)/(C(:,n)+tiny(1.0_WP)) + R(:,n-1) = (R(:,n-1) - D(:,n-1)*R(:,n))/(C(:,n-1)+tiny(1.0_WP)) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - D(:,i)*R(:,i+1) - E(:,i)*R(:,i+2))/(C(:,i)+tiny(1.0_WP)) + end do + + end subroutine pentadiagonal_serial + + + ! ============================================= ! + ! PentaDiagonal Solver - Serial Case - Periodic ! + ! ============================================= ! + subroutine pentadiagonal_periodic_serial(A,B,C,D,E,R,n,lot,s1,s2) + implicit none + + integer, intent(in) :: n,lot + real(WP), dimension(lot,n) :: A ! LOWER-2 + real(WP), dimension(lot,n) :: B ! LOWER-1 + real(WP), dimension(lot,n) :: C ! DIAGONAL + real(WP), dimension(lot,n) :: D ! UPPER+1 + real(WP), dimension(lot,n) :: E ! UPPER+2 + real(WP), dimension(lot,n) :: R ! RHS - RESULT + real(WP), dimension(lot,n) :: s1 + real(WP), dimension(lot,n) :: s2 + real(WP), dimension(lot) :: const + integer :: i + + if (n .eq. 1) then + ! Solve 1x1 system + R(:,:) = R(:,:)/(A(:,:)+B(:,:)+C(:,:)+D(:,:)+E(:,:)) + return + else if (n .eq. 2) then + ! Solve 2x2 system + C(:,:) = C(:,:) + A(:,:) + E(:,:) + D(:,1) = D(:,1) + B(:,1) + B(:,2) = B(:,2) + D(:,2) + const(:) = B(:,2)/C(:,1) + C(:,2) = C(:,2) - D(:,1)*const(:) + R(:,2) = R(:,2) - R(:,1)*const(:) + R(:,2) = R(:,2)/C(:,2) + R(:,1) = (R(:,1) - D(:,1)*R(:,2))/C(:,1) + return + else if (n .eq. 3) then + B(:,:) = B(:,:) + E(:,:) + D(:,:) = D(:,:) + A(:,:) + call tridiagonal_periodic_serial(B(:,:), C(:,:), D(:,:), R(:,:), n, lot) + return + else if (n .eq. 4) then + A(:,:) = A(:,:) + E(:,:) + E(:,:) = 0.0_WP + end if + + ! Initialize boundary data + s1 = 0.0_WP + s1(:,1) = A(:,1) + s1(:,n-3) = s1(:,n-3) + E(:,n-3) + s1(:,n-2) = D(:,n-2) + s1(:,n-1) = C(:,n-1) + s1(:,n) = B(:,n) + s2 = 0.0_WP + s2(:,1) = B(:,1) + s2(:,2) = A(:,2) + s2(:,n-2) = s2(:,n-2) + E(:,n-2) + s2(:,n-1) = D(:,n-1) + s2(:,n) = C(:,n) + + ! Forward elimination + do i=1,n-2 + ! Eliminate b(i+1) + const(:) = B(:,i+1)/C(:,i) + C(:,i+1) = C(:,i+1) - D(:,i)*const(:) + D(:,i+1) = D(:,i+1) - E(:,i)*const(:) + R(:,i+1) = R(:,i+1) - R(:,i)*const(:) + s1(:,i+1) = s1(:,i+1) - s1(:,i)*const(:) + s2(:,i+1) = s2(:,i+1) - s2(:,i)*const(:) + + ! Eliminate a(i+2) + const(:) = A(:,i+2)/C(:,i) + B(:,i+2) = B(:,i+2) - D(:,i)*const(:) + C(:,i+2) = C(:,i+2) - E(:,i)*const(:) + R(:,i+2) = R(:,i+2) - R(:,i)*const(:) + s1(:,i+2) = s1(:,i+2) - s1(:,i)*const(:) + s2(:,i+2) = s2(:,i+2) - s2(:,i)*const(:) + end do + + ! Backward elimination + do i=n-2,3,-1 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate e(i-2) + const(:) = E(:,i-2)/C(:,i) + R(:,i-2) = R(:,i-2) - R(:,i)*const(:) + s1(:,i-2) = s1(:,i-2) - s1(:,i)*const(:) + s2(:,i-2) = s2(:,i-2) - s2(:,i)*const(:) + end do + i=2 + ! Eliminate d(i-1) + const(:) = D(:,i-1)/C(:,i) + R(:,i-1) = R(:,i-1) - R(:,i)*const(:) + s1(:,i-1) = s1(:,i-1) - s1(:,i)*const(:) + s2(:,i-1) = s2(:,i-1) - s2(:,i)*const(:) + + ! Eliminate oddball region + const(:) = E(:,n-1)/C(:,1) + R(:,n-1) = R(:,n-1) - R(:,1)*const(:) + s1(:,n-1) = s1(:,n-1) - s1(:,1)*const(:) + s2(:,n-1) = s2(:,n-1) - s2(:,1)*const(:) + + const(:) = D(:,n)/C(:,1) + R(:,n) = R(:,n) - R(:,1)*const(:) + s1(:,n) = s1(:,n) - s1(:,1)*const(:) + s2(:,n) = s2(:,n) - s2(:,1)*const(:) + + const(:) = E(:,n)/C(:,2) + R(:,n) = R(:,n) - R(:,2)*const(:) + s1(:,n) = s1(:,n) - s1(:,2)*const(:) + s2(:,n) = s2(:,n) - s2(:,2)*const(:) + + ! Eliminate corner region + const(:) = s1(:,n)/s1(:,n-1) + R(:,n) = R(:,n) - R(:,n-1)*const(:) + s2(:,n) = s2(:,n) - s2(:,n-1)*const(:) + + R(:,n) = R(:,n)/s2(:,n) + R(:,n-1) = (R(:,n-1) - s2(:,n-1)*R(:,n))/s1(:,n-1) + do i=n-2,1,-1 + R(:,i) = (R(:,i) - s1(:,i)*R(:,n-1) - s2(:,i)*R(:,n))/C(:,i) + end do + + end subroutine pentadiagonal_periodic_serial + + + subroutine polydiagonal(this,nd,A,R,n,lot,dir,b) + implicit none + class(diag), intent(inout) :: this + character(len=*), intent(in) :: dir + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + integer :: proc + logical :: nper + + ! Get parallel info + select case (trim(adjustl(dir))) + case ('x') + proc = this%cfg%npx + nper = this%cfg%xper + case ('y') + proc = this%cfg%npy + nper = this%cfg%yper + case ('z') + proc = this%cfg%npz + nper = this%cfg%zper + case default + stop 'Unknown direction' + end select + + ! If serial + if (proc.eq.1) then + if (.not.nper) then + call polydiagonal_serial(nd,A,R,n,lot) + else + call polydiagonal_periodic_serial(nd,A,R,n,lot,b) + end if + return + else + stop 'polydiagonal: Implemented only in serial.' + end if + + end subroutine polydiagonal + + + subroutine polydiagonal_serial(nd,A,R,n,lot) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k + + ! Forward elimination + do i=1,n-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,n-i) + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,min(nd,n-i) + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Back-substitution + do i=n,1,-1 + do j=1,min(nd,n-i) + R(:,i) = R(:,i) - A(:,i,j)*R(:,i+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_serial + + + subroutine polydiagonal_periodic_serial(nd,A,R,n,lot,b) + implicit none + + integer, intent(in) :: n,lot,nd + real(WP), intent(inout), dimension(lot,n,-nd:nd) :: A + real(WP), intent(inout), dimension(lot,n) :: R + real(WP), intent(inout), dimension(lot,n,nd) :: b + real(WP), dimension(lot) :: const,pivot + integer :: i,j,k,i0 + + if (n.eq.1) then + const(:) = 0.0_WP + do j=-nd,nd + const(:) = const(:) + A(:,j,1) + end do + R(:,1) = R(:,1) / const(:) + return + end if + + ! Setup bridge array + do j=1,nd + do i=1,n + b(:,i,j) = 0.0_WP + end do + end do + do i=1,nd + do j=i,nd + b(:,i,j) = A(:,i,-nd+j-i) + b(:,n-nd-i+1,j-i+1) = A(:,n-nd-i+1,j) + end do + end do + do i=n-nd+1,n + do j=1,nd + b(:,i,j) = A(:,i,-nd+j-(i-n)) + end do + end do + + ! Forward elimination + do i=1,n-nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,nd + const(:) = A(:,i+j,-j)*pivot(:) + do k=1,nd + A(:,i+j,-j+k) = A(:,i+j,-j+k) - A(:,i,k)*const(:) + b(:,i+j,k) = b(:,i+j,k) - b(:,i,k)*const(:) + end do + R(:,i+j) = R(:,i+j) - R(:,i)*const(:) + end do + end do + + ! Backward elimination + do i=n-nd,1,-1 + pivot(:) = 1.0_WP/A(:,i,0) + do j=1,min(nd,i-1) + const(:) = A(:,i-j,j)*pivot(:) + do k=1,nd + b(:,i-j,k) = b(:,i-j,k) - b(:,i,k)*const(:) + end do + R(:,i-j) = R(:,i-j) - R(:,i)*const(:) + end do + end do + + ! Eliminate oddball region + do i=1,nd + pivot(:) = 1.0_WP/A(:,i,0) + do j=i,nd + const(:) = A(:,n-j+i,j)*pivot(:) + do k=1,nd + b(:,n-j+i,k) = b(:,n-j+i,k) - b(:,i,k)*const(:) + end do + R(:,n-j+i) = R(:,n-j+i) - R(:,i)*const(:) + end do + end do + + ! Elimination for corner matrix + i0 = n-nd + do i=1,nd-1 + pivot(:) = 1.0_WP/b(:,i+i0,i) + do j=i+1,nd + const(:) = b(:,j+i0,i)*pivot(:) + do k=i+1,nd + b(:,j+i0,k) = b(:,j+i0,k) - b(:,i+i0,k)*const(:) + end do + R(:,j+i0) = R(:,j+i0) - R(:,i+i0)*const(:) + end do + end do + + ! Back-substitution for corner matrix + i0 = n-nd + do i=nd,1,-1 + do j=i+1,nd + R(:,i+i0) = R(:,i+i0) - b(:,i+i0,j)*R(:,j+i0) + end do + R(:,i+i0) = R(:,i+i0)/b(:,i+i0,i) + end do + + ! Back-substitution for bridge + do i=n-nd,1,-1 + do j=1,nd + R(:,i) = R(:,i) - b(:,i,j)*R(:,n-nd+j) + end do + R(:,i) = R(:,i)/A(:,i,0) + end do + + end subroutine polydiagonal_periodic_serial + + end module diag_class diff --git a/src/solver/pfft3d_class.f90 b/src/solver/fourier3d_class.f90 similarity index 64% rename from src/solver/pfft3d_class.f90 rename to src/solver/fourier3d_class.f90 index 85605ba08..b8bc1d930 100644 --- a/src/solver/pfft3d_class.f90 +++ b/src/solver/fourier3d_class.f90 @@ -1,8 +1,8 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -! Based on serial FFTW here, and manual transpose. It'd be nice to switch to a library -module pfft3d_class +!> Makes use of FFTW and in-house parallel transpose operations +module fourier3d_class use precision, only: WP use config_class, only: config use string, only: str_short @@ -13,98 +13,106 @@ module pfft3d_class ! Expose type/constructor/methods - public :: pfft3d + public :: fourier3d - !> pfft3d object definition - type, extends(linsol) :: pfft3d + !> fourier3d object definition + type, extends(linsol) :: fourier3d ! FFT's oddball logical :: oddball ! Data storage for FFTW plans - real(C_DOUBLE), dimension(:), allocatable :: in_x,out_x - real(C_DOUBLE), dimension(:), allocatable :: in_y,out_y - real(C_DOUBLE), dimension(:), allocatable :: in_z,out_z + complex(WP), dimension(:), allocatable :: in_x,out_x + complex(WP), dimension(:), allocatable :: in_y,out_y + complex(WP), dimension(:), allocatable :: in_z,out_z ! FFTW plans type(C_PTR) :: fplan_x,bplan_x type(C_PTR) :: fplan_y,bplan_y type(C_PTR) :: fplan_z,bplan_z + !> Unstrided arrays + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs + ! Storage for transposed data - real(WP), dimension(:,:,:), allocatable :: xtrans - real(WP), dimension(:,:,:), allocatable :: ytrans - real(WP), dimension(:,:,:), allocatable :: ztrans + complex(WP), dimension(:,:,:), allocatable :: xtrans + complex(WP), dimension(:,:,:), allocatable :: ytrans + complex(WP), dimension(:,:,:), allocatable :: ztrans ! Transpose partition - X integer, dimension(:), allocatable :: imin_x,imax_x integer, dimension(:), allocatable :: jmin_x,jmax_x integer, dimension(:), allocatable :: kmin_x,kmax_x integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x integer :: sendcount_x,recvcount_x character(len=str_short) :: xdir - + ! Transpose partition - Y integer, dimension(:), allocatable :: imin_y,imax_y integer, dimension(:), allocatable :: jmin_y,jmax_y integer, dimension(:), allocatable :: kmin_y,kmax_y integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y integer :: sendcount_y,recvcount_y character(len=str_short) :: ydir - + ! Transpose partition - Z integer, dimension(:), allocatable :: imin_z,imax_z integer, dimension(:), allocatable :: jmin_z,jmax_z integer, dimension(:), allocatable :: kmin_z,kmax_z integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - real(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z integer :: sendcount_z,recvcount_z character(len=str_short) :: zdir contains - procedure :: print_short=>pfft3d_print_short !< One-line printing of solver status - procedure :: print=>pfft3d_print !< Long-form printing of solver status - procedure :: log=>pfft3d_log !< Long-form logging of solver status - procedure :: init=>pfft3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup=>pfft3d_setup !< Solver setup (every time the operator changes) - procedure :: solve=>pfft3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy=>pfft3d_destroy !< Solver destruction (every time the operator changes) + procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status + procedure :: print=>fourier3d_print !< Long-form printing of solver status + procedure :: log=>fourier3d_log !< Long-form logging of solver status + procedure :: init=>fourier3d_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>fourier3d_setup !< Solver setup (every time the operator changes) + procedure :: solve=>fourier3d_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>fourier3d_destroy !< Solver destruction (every time the operator changes) - procedure, private :: pfft3d_xtranspose_init - procedure, private :: pfft3d_ytranspose_init - procedure, private :: pfft3d_ztranspose_init + procedure, private :: fourier3d_fourier_transform + procedure, private :: fourier3d_inverse_transform + + procedure, private :: fourier3d_xtranspose_init + procedure, private :: fourier3d_ytranspose_init + procedure, private :: fourier3d_ztranspose_init - procedure, private :: pfft3d_xtranspose_forward - procedure, private :: pfft3d_ytranspose_forward - procedure, private :: pfft3d_ztranspose_forward + procedure, private :: fourier3d_xtranspose_forward + procedure, private :: fourier3d_ytranspose_forward + procedure, private :: fourier3d_ztranspose_forward - procedure, private :: pfft3d_xtranspose_backward - procedure, private :: pfft3d_ytranspose_backward - procedure, private :: pfft3d_ztranspose_backward + procedure, private :: fourier3d_xtranspose_backward + procedure, private :: fourier3d_ytranspose_backward + procedure, private :: fourier3d_ztranspose_backward - end type pfft3d + end type fourier3d - !> Declare pfft3d constructor - interface pfft3d - procedure pfft3d_from_args - end interface pfft3d + !> Declare fourier3d constructor + interface fourier3d + procedure fourier3d_from_args + end interface fourier3d contains - !> Constructor for an pfft3d object - function pfft3d_from_args(cfg,name) result(self) + !> Constructor for a fourier3d object + function fourier3d_from_args(cfg,name,nst) result(self) use messager, only: die implicit none - type(pfft3d) :: self + type(fourier3d) :: self class(config), target, intent(in) :: cfg character(len=*), intent(in) :: name + integer, intent(in) :: nst ! Link the config and store the name self%cfg=>cfg @@ -114,7 +122,7 @@ function pfft3d_from_args(cfg,name) result(self) self%method=0 ! Set up stencil size and map - self%nst=7 + self%nst=nst allocate(self%stc(1:self%nst,1:3)) self%stc=0 @@ -124,10 +132,14 @@ function pfft3d_from_args(cfg,name) result(self) allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP ! Zero out some info - self%it=0 + self%it=1 self%aerr=0.0_WP self%rerr=0.0_WP + ! Allocate unstrided arrays + allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%transformed_rhs (self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + ! Setup is not done self%setup_done=.false. @@ -135,9 +147,9 @@ function pfft3d_from_args(cfg,name) result(self) check_solver_is_useable: block integer :: ndim,ndcp ! Periodicity and uniformity of mesh - if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[pfft3d constructor] Need x-direction needs to be periodic and uniform') - if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[pfft3d constructor] Need y-direction needs to be periodic and uniform') - if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[pfft3d constructor] Need z-direction needs to be periodic and uniform') + if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[fourier3d constructor] Need x-direction needs to be periodic and uniform') + if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[fourier3d constructor] Need y-direction needs to be periodic and uniform') + if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[fourier3d constructor] Need z-direction needs to be periodic and uniform') ! Ensure that we have at least one non-decomposed direction ndim=0 if (self%cfg%nx.gt.1) ndim=ndim+1 @@ -147,19 +159,19 @@ function pfft3d_from_args(cfg,name) result(self) if (self%cfg%npx.gt.1) ndcp=ndcp+1 if (self%cfg%npy.gt.1) ndcp=ndcp+1 if (self%cfg%npz.gt.1) ndcp=ndcp+1 - if (ndcp.ge.ndim) call die('[pfft3d constructor] Need at least one NON-decomposed direction') + if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one NON-decomposed direction') end block check_solver_is_useable - end function pfft3d_from_args + end function fourier3d_from_args !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver !> Only the stencil needs to be defined at this point - subroutine pfft3d_init(this) + subroutine fourier3d_init(this) use messager, only: die implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 integer, dimension(3) :: periodicity,offset include 'fftw3.f03' @@ -175,40 +187,40 @@ subroutine pfft3d_init(this) ! Initialize transpose and FFTW plans in x if (this%cfg%nx.gt.1) then - call this%pfft3d_xtranspose_init() + call this%fourier3d_xtranspose_init() allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) - this%fplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_R2HC,FFTW_MEASURE) - this%bplan_x=fftw_plan_r2r_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_HC2R,FFTW_MEASURE) + this%fplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) end if ! Initialize transpose and FFTW plans in y if (this%cfg%ny.gt.1) then - call this%pfft3d_ytranspose_init() + call this%fourier3d_ytranspose_init() allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) - this%fplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_R2HC,FFTW_MEASURE) - this%bplan_y=fftw_plan_r2r_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_HC2R,FFTW_MEASURE) + this%fplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) end if ! Initialize transpose and FFTW plans in z if (this%cfg%nz.gt.1) then - call this%pfft3d_ztranspose_init() + call this%fourier3d_ztranspose_init() allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) - this%fplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_R2HC,FFTW_MEASURE) - this%bplan_z=fftw_plan_r2r_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_HC2R,FFTW_MEASURE) + this%fplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) + this%bplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) end if ! Find who owns the oddball this%oddball=.false. if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. - end subroutine pfft3d_init + end subroutine fourier3d_init !> Initialize transpose tool in x - subroutine pfft3d_xtranspose_init(this) + subroutine fourier3d_xtranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,ip,q,r ! Determine non-decomposed direction to use for transpose @@ -319,14 +331,14 @@ subroutine pfft3d_xtranspose_init(this) ! Allocate storage allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - end subroutine pfft3d_xtranspose_init + end subroutine fourier3d_xtranspose_init !> Initialize transpose tool in y - subroutine pfft3d_ytranspose_init(this) + subroutine fourier3d_ytranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,jp,q,r ! Determine non-decomposed direction to use for transpose @@ -437,14 +449,14 @@ subroutine pfft3d_ytranspose_init(this) ! Allocate storage allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - end subroutine pfft3d_ytranspose_init + end subroutine fourier3d_ytranspose_init !> Initialize transpose tool in z - subroutine pfft3d_ztranspose_init(this) + subroutine fourier3d_ztranspose_init(this) use mpi_f08 implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr,kp,q,r ! Determine non-decomposed direction to use for transpose @@ -555,17 +567,17 @@ subroutine pfft3d_ztranspose_init(this) ! Allocate storage allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - end subroutine pfft3d_ztranspose_init + end subroutine fourier3d_ztranspose_init !> Perform forward transpose in x - subroutine pfft3d_xtranspose_forward(this,A,At) + subroutine fourier3d_xtranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -585,7 +597,7 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) @@ -610,7 +622,7 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -624,17 +636,17 @@ subroutine pfft3d_xtranspose_forward(this,A,At) end do end select - end subroutine pfft3d_xtranspose_forward + end subroutine fourier3d_xtranspose_forward !> Perform forward transpose in y - subroutine pfft3d_ytranspose_forward(this,A,At) + subroutine fourier3d_ytranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -651,7 +663,7 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_y(jp),this%jmax_y(jp) @@ -679,7 +691,7 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) do j=this%jmin_y(jp),this%jmax_y(jp) @@ -693,17 +705,17 @@ subroutine pfft3d_ytranspose_forward(this,A,At) end do end select - end subroutine pfft3d_ytranspose_forward + end subroutine fourier3d_ytranspose_forward !> Perform forward transpose in z - subroutine pfft3d_ztranspose_forward(this,A,At) + subroutine fourier3d_ztranspose_forward(this,A,At) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -720,7 +732,7 @@ subroutine pfft3d_ztranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(kp),this%kmax_z(kp) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -745,7 +757,7 @@ subroutine pfft3d_ztranspose_forward(this,A,At) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(kp),this%kmax_z(kp) do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) @@ -762,17 +774,17 @@ subroutine pfft3d_ztranspose_forward(this,A,At) At=A end select - end subroutine pfft3d_ztranspose_forward + end subroutine fourier3d_ztranspose_forward !> Perform backward transpose in x - subroutine pfft3d_xtranspose_backward(this,At,A) + subroutine fourier3d_xtranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,ip,ii,jj,kk,ierr select case (trim(this%xdir)) @@ -792,7 +804,7 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_x(ip),this%jmax_x(ip) @@ -817,7 +829,7 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_REAL_WP,this%recvbuf_x,this%recvcount_x,MPI_REAL_WP,this%cfg%xcomm,ierr) + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) do ip=1,this%cfg%npx do k=this%kmin_x(ip),this%kmax_x(ip) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -831,17 +843,17 @@ subroutine pfft3d_xtranspose_backward(this,At,A) end do end select - end subroutine pfft3d_xtranspose_backward - + end subroutine fourier3d_xtranspose_backward + !> Perform backward transpose in y - subroutine pfft3d_ytranspose_backward(this,At,A) + subroutine fourier3d_ytranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,jp,ii,jj,kk,ierr select case (trim(this%ydir)) @@ -858,7 +870,7 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) @@ -886,7 +898,7 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_REAL_WP,this%recvbuf_y,this%recvcount_y,MPI_REAL_WP,this%cfg%ycomm,ierr) + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) do jp=1,this%cfg%npy do k=this%kmin_y(jp),this%kmax_y(jp) do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) @@ -900,17 +912,17 @@ subroutine pfft3d_ytranspose_backward(this,At,A) end do end select - end subroutine pfft3d_ytranspose_backward + end subroutine fourier3d_ytranspose_backward !> Perform backward transpose in z - subroutine pfft3d_ztranspose_backward(this,At,A) + subroutine fourier3d_ztranspose_backward(this,At,A) use mpi_f08 use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - real(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - real(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A integer :: i,j,k,kp,ii,jj,kk,ierr select case (trim(this%zdir)) @@ -927,7 +939,7 @@ subroutine pfft3d_ztranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) do j=this%cfg%jmin_,this%cfg%jmax_ @@ -952,7 +964,7 @@ subroutine pfft3d_ztranspose_backward(this,At,A) end do end do end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_REAL_WP,this%recvbuf_z,this%recvcount_z,MPI_REAL_WP,this%cfg%zcomm,ierr) + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) do kp=1,this%cfg%npz do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) do j=this%jmin_z(kp),this%jmax_z(kp) @@ -969,44 +981,216 @@ subroutine pfft3d_ztranspose_backward(this,At,A) A=At end select - end subroutine pfft3d_ztranspose_backward + end subroutine fourier3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine fourier3d_fourier_transform(this,A) + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Forward transform - X + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x + end do + end do + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Forward transform - Y + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y + end do + end do + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Forward transform - Z + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + + ! Oddball + if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP + + end subroutine fourier3d_fourier_transform - !> Setup solver - done everytime the operator changes - subroutine pfft3d_setup(this) + !> FFT -> real and transpose back + subroutine fourier3d_inverse_transform(this,A) + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Inverse transform + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x/this%cfg%nx + end do + end do + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Inverse transform + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y/this%cfg%ny + end do + end do + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Inverse transform + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z/this%cfg%nz + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + +end subroutine fourier3d_inverse_transform + + +!> Setup solver - done everytime the operator changes + subroutine fourier3d_setup(this) use messager, only: die + use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM + use parallel, only: MPI_REAL_WP implicit none - class(pfft3d), intent(inout) :: this - integer :: i,j,k,st,ierr - integer, dimension(:), allocatable :: row - real(WP), dimension(:), allocatable :: val + class(fourier3d), intent(inout) :: this + real(WP), dimension(1:this%nst) :: ref_opr + logical :: circulant + integer :: i,j,k,n,ierr ! If the solver has already been setup, destroy it first if (this%setup_done) call this%destroy() + ! Check circulent operator + if (this%cfg%amRoot) ref_opr=this%opr(:,this%cfg%imin,this%cfg%jmin,this%cfg%kmin) + call MPI_BCAST(ref_opr,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) + circulant=.true. + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (any(abs(this%opr(:,i,j,k)-ref_opr).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulant=.false. + end do + end do + end do + if (.not.circulant) call die('[fourier3d setup] operator must be uniform in space') + + ! Build the operator + this%factored_operator=0.0_WP + do n=1,this%nst + i=modulo(this%stc(n,1)-this%cfg%imin+1,this%cfg%nx)+this%cfg%imin + j=modulo(this%stc(n,2)-this%cfg%jmin+1,this%cfg%ny)+this%cfg%jmin + k=modulo(this%stc(n,3)-this%cfg%kmin+1,this%cfg%nz)+this%cfg%kmin + if (this%cfg%imin_.le.i.and.i.le.this%cfg%imax_.and.& + & this%cfg%jmin_.le.j.and.j.le.this%cfg%jmax_.and.& + & this%cfg%kmin_.le.k.and.k.le.this%cfg%kmax_) this%factored_operator(i,j,k)=this%factored_operator(i,j,k)+real(ref_opr(n),WP) + end do + + ! Take transform of operator + call this%fourier3d_fourier_transform(this%factored_operator) + ! Make zero wavenumber not zero + ! Setting this to one has the nice side effect of returning a solution with the same integral + if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=1.0_C_DOUBLE + + ! Make sure other wavenumbers are not close to zero + i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_WP)) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) then + print*,j + call die('[fourier3d setup] elements of transformed operator near zero') + end if + + ! Divide now instead of later + this%factored_operator=1.0_WP/this%factored_operator + + ! Check for division issues + i=count(isnan(abs(this%factored_operator))) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) call die('[fourier3d setup] elements of transformed operator are NaN') ! Set setup-flag to true this%setup_done=.true. - end subroutine pfft3d_setup + end subroutine fourier3d_setup !> Solve the linear system iteratively - subroutine pfft3d_solve(this) + subroutine fourier3d_solve(this) use messager, only: die use param, only: verbose implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: i,j,k,ierr ! Check that setup was done - if (.not.this%setup_done) call die('[pfft3d solve] Solver has not been setup.') + if (.not.this%setup_done) call die('[fourier3d solve] Solver has not been setup.') - ! Set solver it and err to standard values - this%it=-1; this%aerr=huge(1.0_WP); this%rerr=huge(1.0_WP) + ! Copy to unstrided array + this%transformed_rhs=this%rhs(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) + ! Forward transform + call this%fourier3d_fourier_transform(this%transformed_rhs) + ! Divide + this%transformed_rhs=this%transformed_rhs*this%factored_operator + + ! Backward transform + call this%fourier3d_inverse_transform(this%transformed_rhs) + + ! Copy to strided output + this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs ! Sync the solution vector call this%cfg%sync(this%sol) @@ -1015,56 +1199,59 @@ subroutine pfft3d_solve(this) if (verbose.gt.0) call this%log if (verbose.gt.1) call this%print_short - end subroutine pfft3d_solve + end subroutine fourier3d_solve !> Destroy solver - done everytime the operator changes - subroutine pfft3d_destroy(this) + subroutine fourier3d_destroy(this) use messager, only: die implicit none - class(pfft3d), intent(inout) :: this + class(fourier3d), intent(inout) :: this integer :: ierr + include 'fftw3.f03' - ! Destroy solver, operator, and rhs/sol vectors - + ! Destroy our plans + call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x) + call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y) + call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z) ! Set setup-flag to false this%setup_done=.false. - end subroutine pfft3d_destroy + end subroutine fourier3d_destroy - !> Log pfft3d info - subroutine pfft3d_log(this) + !> Log fourier3d info + subroutine fourier3d_log(this) use string, only: str_long use messager, only: log implicit none - class(pfft3d), intent(in) :: this + class(fourier3d), intent(in) :: this character(len=str_long) :: message if (this%cfg%amRoot) then - write(message,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) + write(message,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) end if - end subroutine pfft3d_log + end subroutine fourier3d_log - !> Print pfft3d info to the screen - subroutine pfft3d_print(this) + !> Print fourier3d info to the screen + subroutine fourier3d_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(pfft3d), intent(in) :: this + class(fourier3d), intent(in) :: this if (this%cfg%amRoot) then - write(output_unit,'("PFFT3D solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) + write(output_unit,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) end if - end subroutine pfft3d_print + end subroutine fourier3d_print - !> Short print of pfft3d info to the screen - subroutine pfft3d_print_short(this) + !> Short print of fourier3d info to the screen + subroutine fourier3d_print_short(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(pfft3d), intent(in) :: this - if (this%cfg%amRoot) write(output_unit,'("PFFT3D solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - end subroutine pfft3d_print_short + class(fourier3d), intent(in) :: this + if (this%cfg%amRoot) write(output_unit,'("fourier3d solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + end subroutine fourier3d_print_short -end module pfft3d_class +end module fourier3d_class diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index d74b623ae..e5aeb2264 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -26,7 +26,7 @@ module sgsmodel_class integer :: imax_in,jmax_in,kmax_in !< Safe max in each direction ! Some clipping parameters - real(WP) :: Cs_ref=0.1_WP + real(WP) :: Cs_ref=0.17_WP ! LM and MM tensor norms and eddy viscosity real(WP), dimension(:,:,:), allocatable :: LM,MM !< LM and MM tensor norms @@ -256,6 +256,7 @@ function constructor(cfg,umask,vmask,wmask) result(self) end function constructor + !> Calls appropriate eddy viscosity subroutine according to SGSmodel%type subroutine get_visc(this,type,dt,rho,Ui,Vi,Wi,SR,gradu) use messager, only: die @@ -298,7 +299,8 @@ subroutine get_visc(this,type,dt,rho,Ui,Vi,Wi,SR,gradu) if (verbose.gt.1) call this%print() end subroutine get_visc - + + !> Get subgrid scale dynamic viscosity - Dynamic subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) implicit none @@ -423,7 +425,7 @@ subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) deallocate(LMold,MMold,S_) end subroutine visc_dynamic - + !> Get subgrid scale dynamic viscosity - Constant subroutine visc_cst(this,rho,SR) @@ -449,60 +451,63 @@ subroutine visc_cst(this,rho,SR) ! Synchronize visc call this%cfg%sync(this%visc) - + ! Deallocate work arrays deallocate(S_) - end subroutine visc_cst - + end subroutine visc_cst + !> Get subgrid scale dynamic viscosity - Vreman subroutine visc_vreman(this,rho,gradu) implicit none class(sgsmodel), intent(inout) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rho !< Density including all ghosts - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient - real(WP), dimension(:,:,:), allocatable :: alph2 !< velocity gradient tensor squared - real(WP) :: C,B,beta11,beta22,beta33,beta12,beta13,beta23 - integer :: i,j,k - - allocate(alph2(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - alph2 = gradu(1,1,:,:,:)**2 + gradu(1,2,:,:,:)**2 + gradu(1,3,:,:,:)**2 + & - gradu(2,1,:,:,:)**2 + gradu(2,2,:,:,:)**2 + gradu(2,3,:,:,:)**2 + & - gradu(3,1,:,:,:)**2 + gradu(3,2,:,:,:)**2 + gradu(3,3,:,:,:)**2 - - ! Model constant - FOR HIT c \approx 0.07 - ! For complex flows c = 2.5*Cs**2 - C = 2.5*this%Cs_ref**2 + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: gradu !< Velocity gradient + real(WP) :: A,B,C + real(WP), dimension(1:3,1:3) :: beta + integer :: i,j,k,ii,jj + + ! Model constant is c=2.5*Cs_ref**2 + ! Vreman uses c=0.07 which corresponds to Cs_ref=0.17 + C=2.5_WP*this%Cs_ref**2 ! Compute the eddy viscosity do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - beta11 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)**2 + gradu(2,1,i,j,k)**2 + gradu(3,1,i,j,k)**2) - beta22 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)**2 + gradu(2,2,i,j,k)**2 + gradu(3,2,i,j,k)**2) - beta33 = this%delta(i,j,k)**2*(gradu(1,3,i,j,k)**2 + gradu(2,3,i,j,k)**2 + gradu(3,3,i,j,k)**2) - beta12 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,2,i,j,k) + gradu(2,1,i,j,k)*gradu(2,2,i,j,k) + & - gradu(3,1,i,j,k)*gradu(3,2,i,j,k)) - beta13 = this%delta(i,j,k)**2*(gradu(1,1,i,j,k)*gradu(1,3,i,j,k) + gradu(2,1,i,j,k)*gradu(2,3,i,j,k) + & - gradu(3,1,i,j,k)*gradu(3,3,i,j,k)) - beta23 = this%delta(i,j,k)**2*(gradu(1,2,i,j,k)*gradu(1,3,i,j,k) + gradu(2,2,i,j,k)*gradu(2,3,i,j,k) + & - gradu(3,2,i,j,k)*gradu(3,3,i,j,k)) - - B = beta11*beta22 - beta12**2 + beta11*beta33 - beta13**2 + beta22*beta33 - beta23**2 - this%visc(i,j,k) = C*sqrt(B/alph2(i,j,k)) + ! Compute A=gradu_ij*gradu_ij invariant + A=gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2+& + & gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2+& + & gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2 + ! Compute beta_ij=dx_m*dx_m*gradu_mi*gradu_mj + do jj=1,3 + do ii=1,3 + beta(ii,jj)=this%cfg%dx(i)**2*gradu(1,ii,i,j,k)*gradu(1,jj,i,j,k)& + & +this%cfg%dy(j)**2*gradu(2,ii,i,j,k)*gradu(2,jj,i,j,k)& + & +this%cfg%dz(k)**2*gradu(3,ii,i,j,k)*gradu(3,jj,i,j,k) + end do + end do + ! Compute B invariant + B=beta(1,1)*beta(2,2)-beta(1,2)**2& + &+beta(1,1)*beta(3,3)-beta(1,3)**2& + &+beta(2,2)*beta(3,3)-beta(2,3)**2 + ! Assemble algebraic eddy viscosity model + if (B.lt.1.0e-8_WP) then + this%visc(i,j,k)=0.0_WP + else + this%visc(i,j,k)=rho(i,j,k)*C*sqrt(B/A) + end if end do end do end do ! Synchronize visc call this%cfg%sync(this%visc) - - ! Deallocate work arrays - deallocate(alph2) end subroutine visc_vreman + !> Private function that performs an trilinear interpolation of a cell-centered !> field A to the provided position pos in the vicinity of cell i0,j0,k0 function interpolate(this,pos,i0,j0,k0,A) result(Ap) diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 97ec1e81f..4d106e6f7 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -115,7 +115,7 @@ module mast_class real(WP), dimension(:,:,:), allocatable :: dPjy !< dPressure jump to add to -ddP/dy real(WP), dimension(:,:,:), allocatable :: dPjz !< dPressure jump to add to -ddP/dz real(WP), dimension(:,:,:), allocatable :: Tmptr !< Temperature of mixture - + ! Flow variables - individual phases real(WP), dimension(:,:,:), allocatable :: Grho, Lrho !< phase density arrays real(WP), dimension(:,:,:), allocatable :: GrhoE, LrhoE !< phase energy arrays @@ -2527,100 +2527,100 @@ end subroutine calculate_ustar end subroutine advection_step subroutine diffusion_src_explicit_step(this,dt,vf,matmod,sgs_visc,srcU,srcV,srcW,srcE) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - use vfs_class, only: vfs - use matm_class, only: matm - implicit none - class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver - class(vfs), intent(inout) :: vf !< The volume fraction solver - class(matm), intent(inout) :: matmod !< The material models for this solver - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT - real(WP), intent(in) :: dt !< Timestep size over which to advance - real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep - real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces - real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces - integer :: i,j,k,n,nCFL,ierr - real(WP) :: buf,myCFL,mydt,spec_heat - - ! Set up intermediate divergence - div =>this%tmp1 - ! Set up temporary face velocity - Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 - Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 - ! Set up face viscosities - visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 - - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Viscosity and thermal conductivity updated using new temperature and VOF - call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - - ! Estimate CFL from explicit diffusive and source terms - buf=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - ! Viscous CFL - buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) - spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & - +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) - buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) - ! Gravity CFL (check this) - buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & - dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & - dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) - end do - end do - end do - call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Calculate sub-step for viscous solver - nCFL=ceiling(myCFL) - mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon - - ! Sub-step for stability - do n=1,nCFL - ! Perform viscous step - call diffusion_src_explicit_substep() - ! Update temperature - call matmod%update_temperature(vf,this%Tmptr) - ! Calculate viscosity - if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) - end do - - ! Nullify... - - contains - - subroutine diffusion_src_explicit_substep() + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + use vfs_class, only: vfs + use matm_class, only: matm implicit none - - real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX - real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy - real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz - real(WP) :: dMUdx,dMUdy,dMUdz - real(WP) :: div2U,div2V,div2W - real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz - - integer :: i,j,k,n - - ! Viscous routine operates on face velocities, need to be updated each time - ! Update traditional face velocity (just interpolated) - call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) - ! Apply boundary condtions - bc_scope = 'velocity' - call this%apply_bcond(dt,bc_scope) - ! Calculate other interpolated face velocities (ignore masks) - call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) - call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) - ! BCs not needed, masks are already addressed, nothing used from within boundary + class(mast), intent(inout) :: this !< The two-phase all-Mach flow solver + class(vfs), intent(inout) :: vf !< The volume fraction solver + class(matm), intent(inout) :: matmod !< The material models for this solver + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: sgs_visc !< The subgrid-scale modeling, passed in + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcU !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcV !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcW !< Source term from LPT + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in), optional :: srcE !< Source term from LPT + real(WP), intent(in) :: dt !< Timestep size over which to advance + real(WP), dimension(:,:,:), pointer :: div !< divergence calculated each substep + real(WP), dimension(:,:,:), pointer :: Uf_y,Uf_z !< X velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Vf_x,Vf_z !< Y velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: Wf_x,Wf_y !< Z velocity interpolated to other faces + real(WP), dimension(:,:,:), pointer :: visc_x,visc_y,visc_z !< viscosity interpolated to faces + integer :: i,j,k,n,nCFL,ierr + real(WP) :: buf,myCFL,mydt,spec_heat + + ! Set up intermediate divergence + div =>this%tmp1 + ! Set up temporary face velocity + Uf_y=>this%tmp2; Vf_z=>this%tmp4; Wf_x=>this%tmp6 + Uf_z=>this%tmp3; Vf_x=>this%tmp5; Wf_y=>this%tmp7 + ! Set up face viscosities + visc_x=>this%tmp8; visc_y=>this%tmp9; visc_z=>this%tmp10 + + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Viscosity and thermal conductivity updated using new temperature and VOF + call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + + ! Estimate CFL from explicit diffusive and source terms + buf=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + ! Viscous CFL + buf=max(buf,4.0_WP*dt*this%visc(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/this%RHO(i,j,k)) + spec_heat = ((1.0_WP-vf%VF(i,j,k))*matmod%spec_heat_gas (this%Tmptr(i,j,k))*this%Grho(i,j,k) & + & +( vf%VF(i,j,k))*matmod%spec_heat_liquid(this%Tmptr(i,j,k))*this%Lrho(i,j,k) ) + buf=max(buf,4.0_WP*dt*this%therm_cond(i,j,k)*max(this%cfg%dxi(i),this%cfg%dyi(j),this%cfg%dzi(k))**2/spec_heat) + ! Gravity CFL (check this) + buf=max(buf,dt**2*abs(this%gravity(1))*this%cfg%dxi(i), & + & dt**2*abs(this%gravity(2))*this%cfg%dyi(j), & + & dt**2*abs(this%gravity(3))*this%cfg%dzi(k)) + end do + end do + end do + call MPI_ALLREDUCE(buf,myCFL,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Calculate sub-step for viscous solver + nCFL=ceiling(myCFL) + mydt=dt/(real(nCFL,WP)+epsilon(1.0_WP)) ! This would divide by zero if there is no viscosity, so I added the epsilon + + ! Sub-step for stability + do n=1,nCFL + ! Perform viscous step + call diffusion_src_explicit_substep() + ! Update temperature + call matmod%update_temperature(vf,this%Tmptr) + ! Calculate viscosity + if (n.lt.nCFL) call this%get_viscosity(vf,matmod,sgs_visc,visc_x,visc_y,visc_z) + end do + + ! Nullify... + + contains + + subroutine diffusion_src_explicit_substep() + implicit none + + real(WP) :: VISCforceX,VISCforceY,VISCforceZ,spongeX + real(WP) :: VISCIntEnergy,VISCKinEnergy,HEATIntEnergy + real(WP) :: dUdx,dUdy,dUdz,dVdx,dVdy,dVdz,dWdx,dWdy,dWdz + real(WP) :: dMUdx,dMUdy,dMUdz + real(WP) :: div2U,div2V,div2W + real(WP) :: ddilatationdx,ddilatationdy,ddilatationdz + + integer :: i,j,k,n + + ! Viscous routine operates on face velocities, need to be updated each time + ! Update traditional face velocity (just interpolated) + call this%interp_vel_basic(vf,this%Ui,this%Vi,this%Wi,this%U,this%V,this%W) + ! Apply boundary condtions + bc_scope = 'velocity' + call this%apply_bcond(dt,bc_scope) + ! Calculate other interpolated face velocities (ignore masks) + call this%interp_vel_basic(vf,this%Vi,this%Wi,this%Ui,Vf_x,Wf_y,Uf_z,use_masks=.false.) + call this%interp_vel_basic(vf,this%Wi,this%Ui,this%Vi,Wf_x,Uf_y,Vf_z,use_masks=.false.) + ! BCs not needed, masks are already addressed, nothing used from within boundary ! Compute divergence and SGS isotropic tensor in each cell do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 92f53a5f8..9eaf88f1a 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -7,7 +7,7 @@ module tpns_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -107,15 +107,15 @@ module tpns_class real(WP), dimension(:,:,:), allocatable :: FWX,FWY,FWZ !< W-momentum fluxes ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP) :: RHOeps !< Parameter for when to switch between centered and modified interpolation scheme - real(WP), dimension(:,:,:,:), allocatable :: itpi_x,itpi_y,itpi_z !< Interpolation for Ui/Vi/Wi real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity + real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Second order interpolation for U real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Second order interpolation for V real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Second order interpolation for W @@ -161,7 +161,9 @@ module tpns_class procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values procedure :: interp_vel !< Calculate interpolated velocity - procedure :: get_strainrate !< Calculate strain rate tensor + procedure :: get_strainrate !< Calculate deviatoric part of strain rate tensor + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_vorticity !< Calculate vorticity tensor procedure :: get_mfr !< Calculate outgoing MFR through each bcond procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation procedure :: shift_p !< Shift pressure to have zero average @@ -243,12 +245,6 @@ function constructor(cfg,name) result(self) allocate(self%FWY(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWY=0.0_WP allocate(self%FWZ(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%FWZ=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -344,21 +340,35 @@ subroutine init_metrics(this) allocate(this%hybu_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)); this%hybu_z=0.0_WP allocate(this%hybv_z(-1: 0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)); this%hybv_z=0.0_WP - ! Allocate finite difference Ui/Vi/Wi interpolation coefficients - allocate(this%itpi_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%itpi_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%itpi_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered - ! Create interpolation coefficients to cell face - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpi_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] - this%itpi_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] - this%itpi_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + ! Allocate finite difference density interpolation coefficients to cell faces + allocate(this%itpr_x(-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< X-face-centered + allocate(this%itpr_y(-1:0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Y-face-centered + allocate(this%itpr_z(-1:0,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Z-face-centered + ! Create density interpolation coefficients to cell face in x + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_+1,this%cfg%imaxo_ + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] end do end do end do - + ! Create density interpolation coefficients to cell face in y + do k=this%cfg%kmino_ ,this%cfg%kmaxo_ + do j=this%cfg%jmino_+1,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + end do + end do + end do + ! Create density interpolation coefficients to cell face in z + do k=this%cfg%kmino_+1,this%cfg%kmaxo_ + do j=this%cfg%jmino_ ,this%cfg%jmaxo_ + do i=this%cfg%imino_ ,this%cfg%imaxo_ + this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + ! Allocate finite difference viscosity interpolation coefficients allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) @@ -554,17 +564,27 @@ subroutine adjust_metrics(this) if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) - ! Adjust Ui/Vi/Wi interpolation coefficients back to cell faces in the presence of walls (only walls!) - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (this%umask(i,j,k).eq.1) this%itpi_x(:,i,j,k)=0.0_WP - if (this%vmask(i,j,k).eq.1) this%itpi_y(:,i,j,k)=0.0_WP - if (this%wmask(i,j,k).eq.1) this%itpi_z(:,i,j,k)=0.0_WP - end do - end do - end do - + ! I am assuming here that we do not really need to zero out wall cells + ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) + ! or outflow condition (then the density needs to be available but it should be directly calculated) + ! or used for a real no-slip wall (then density is always multiplied by zero) + ! Adjust density interpolation coefficients to cell faces in the presence of walls (only walls!) + !do k=this%cfg%kmin_,this%cfg%kmax_+1 ! SIZES NEED TO BE ADJUSTED + ! do j=this%cfg%jmin_,this%cfg%jmax_+1 ! SIZES NEED TO BE ADJUSTED + ! do i=this%cfg%imin_,this%cfg%imax_+1 ! SIZES NEED TO BE ADJUSTED + ! ! Linear interpolation in x + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i-1,j,k).gt.0.0_WP) this%itpr_x(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i-1,j,k).eq.0.0_WP) this%itpr_x(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in y + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j-1,k).gt.0.0_WP) this%itpr_y(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j-1,k).eq.0.0_WP) this%itpr_y(:,i,j,k)=[0.0_WP,1.0_WP] + ! ! Linear interpolation in z + ! if (this%cfg%VF(i,j,k).eq.0.0_WP.and.this%cfg%VF(i,j,k-1).gt.0.0_WP) this%itpr_z(:,i,j,k)=[1.0_WP,0.0_WP] + ! if (this%cfg%VF(i,j,k).gt.0.0_WP.and.this%cfg%VF(i,j,k-1).eq.0.0_WP) this%itpr_z(:,i,j,k)=[0.0_WP,1.0_WP] + ! end do + ! end do + !end do + ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -813,14 +833,17 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(tpns), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided ! Adjust metrics based on bcflag array call this%adjust_metrics() + + ! Point to pressure solver linsol object + this%psolv=>pressure_solver ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] @@ -835,22 +858,30 @@ subroutine setup(this,pressure_ils,implicit_ils) this%psolv%opr(1,:,:,:)=this%cfg%VF ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) - - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP + call this%psolv%init() - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -1732,50 +1763,75 @@ subroutine interp_vel(this,Ui,Vi,Wi) end subroutine interp_vel - !> Calculate the strain rate tensor, including approximations for domain overlap - !> This only uses interpolated velocities passed to this function (we could imagine a more local one that uses U/V/W too) - subroutine get_strainrate(this,Ui,Vi,Wi,SR) + !> Calculate the deviatoric part of the strain rate tensor from U/V/W + !> 1: du/dx-div/3 + !> 2: dv/dy-div/3 + !> 3: dw/dz-div/3 + !> 4: (du/dy+dv/dx)/2 + !> 5: (dv/dz+dw/dy)/2 + !> 6: (dw/dx+du/dz)/2 + subroutine get_strainrate(this,SR) use messager, only: die implicit none class(tpns), intent(inout) :: this - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + real(WP) :: div integer :: i,j,k - real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp - real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp - real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp - real(WP), dimension(3,3) :: dUdx ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + if (size(SR,dim=1).ne.6) call die('[tpns get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - ! Calculate inside - do k=this%cfg%kmin_,this%cfg%kmax_ + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - ! Rebuild face velocities from interpolated velocities - Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) - Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) - Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) - ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) - ! Assemble the strain rate - SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) - SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) - SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) + SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + SR(2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + SR(3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + div=sum(SR(1:3,i,j,k))/3.0_WP + SR(1,i,j,k)=SR(1,i,j,k)-div + SR(2,i,j,k)=SR(2,i,j,k)-div + SR(3,i,j,k)=SR(3,i,j,k)-div + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) + SR(5,i,j,k)=0.125_WP*(sum(dvdz(i ,j:j+1,k:k+1))+sum(dwdy(i ,j:j+1,k:k+1))) + SR(6,i,j,k)=0.125_WP*(sum(dwdx(i:i+1,j ,k:k+1))+sum(dudz(i:i+1,j ,k:k+1))) end do end do end do ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then + if (.not.this%cfg%xper) then if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) end if @@ -1789,7 +1845,7 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end if ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ + do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ do i=this%cfg%imino_,this%cfg%imaxo_ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP @@ -1798,10 +1854,182 @@ subroutine get_strainrate(this,Ui,Vi,Wi,SR) end do ! Sync it - call this%cfg%sync(SR) + call this%cfg%sync(SR) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) end subroutine get_strainrate + + + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[tpns get_strainrate] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + !> Calculate vorticity vector + subroutine get_vorticity(this,vort) + use messager, only: die + implicit none + class(tpns), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check vort's first two dimensions + if (size(vort,dim=1).ne.3) call die('[tpns get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + vort(1,i,j,k)=0.25_WP*(sum(dwdy(i,j:j+1,k:k+1))-sum(dvdz(i,j:j+1,k:k+1))) + vort(2,i,j,k)=0.25_WP*(sum(dudz(i:i+1,j,k:k+1))-sum(dwdx(i:i+1,j,k:k+1))) + vort(3,i,j,k)=0.25_WP*(sum(dvdx(i:i+1,j:j+1,k))-sum(dudy(i:i+1,j:j+1,k))) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) vort(:,this%cfg%imin-1,:,:)=vort(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) vort(:,this%cfg%imax+1,:,:)=vort(:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) vort(:,:,this%cfg%jmin-1,:)=vort(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) vort(:,:,this%cfg%jmax+1,:)=vort(:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) vort(:,:,:,this%cfg%kmin-1)=vort(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) vort(:,:,:,this%cfg%kmax+1)=vort(:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(vort) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_vorticity + !> Calculate the CFL subroutine get_cfl(this,dt,cflc,cfl) @@ -1864,7 +2092,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLst) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z,this%CFLst) end subroutine get_cfl @@ -2052,23 +2280,11 @@ subroutine shift_p(this,pressure) implicit none class(tpns), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/two_phase/vfs_class.f90 b/src/two_phase/vfs_class.f90 index ac2fee604..34a4354bc 100644 --- a/src/two_phase/vfs_class.f90 +++ b/src/two_phase/vfs_class.f90 @@ -131,7 +131,7 @@ module vfs_class integer, dimension(:,:,:), allocatable :: vmask !< Integer array used for enforcing bconds - for vertices ! Monitoring quantities - real(WP) :: VFmax,VFmin,VFint !< Maximum, minimum, and integral volume fraction + real(WP) :: VFmax,VFmin,VFint,SDint !< Maximum, minimum, and integral volume fraction and surface density ! Old arrays that are needed for the compressible MAST solver real(WP), dimension(:,:,:,:), allocatable :: Lbaryold !< Liquid barycenter @@ -2949,6 +2949,7 @@ subroutine get_max(this) my_VFmax=maxval(this%VF); call MPI_ALLREDUCE(my_VFmax,this%VFmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) my_VFmin=minval(this%VF); call MPI_ALLREDUCE(my_VFmin,this%VFmin,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) call this%cfg%integrate(this%VF,integral=this%VFint) + call this%cfg%integrate(this%SD,integral=this%SDint) end subroutine get_max diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index 0325bc59e..d194ff686 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -6,7 +6,7 @@ module lowmach_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -78,15 +78,14 @@ module lowmach_class real(WP), dimension(:,:,:), allocatable :: div !< Divergence array ! Pressure solver - type(ils) :: psolv !< Iterative linear solver object for the pressure Poisson equation + class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation ! Implicit velocity solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density - real(WP), dimension(:,:,:,:), allocatable :: itpi_x,itpi_y,itpi_z !< Interpolation for Ui/Vi/Wi real(WP), dimension(:,:,:,:), allocatable :: itpu_x,itpu_y,itpu_z !< Interpolation for U real(WP), dimension(:,:,:,:), allocatable :: itpv_x,itpv_y,itpv_z !< Interpolation for V real(WP), dimension(:,:,:,:), allocatable :: itpw_x,itpw_y,itpw_z !< Interpolation for W @@ -122,15 +121,15 @@ module lowmach_class procedure :: get_dmomdt !< Calculate dmom/dt procedure :: get_div !< Calculate velocity divergence procedure :: get_pgrad !< Calculate pressure gradient - procedure :: get_div_stress !< Calculate divergence of stress - procedure :: get_gradu !< Calculate velocity gradient tensor - procedure :: get_vorticity !< Calculate vorticity tensor procedure :: rho_divide !< Form U from rhoU procedure :: rho_multiply !< Form rhoU from U procedure :: get_cfl !< Calculate maximum CFL procedure :: get_max !< Calculate maximum field values procedure :: interp_vel !< Calculate interpolated velocity - procedure :: get_strainrate !< Calculate strain rate tensor + procedure :: get_strainrate !< Calculate deviatoric part of strain rate tensor + procedure :: get_gradu !< Calculate velocity gradient tensor + procedure :: get_div_stress !< Calculate divergence of stress + procedure :: get_vorticity !< Calculate vorticity tensor procedure :: get_mfr !< Calculate outgoing MFR through each bcond procedure :: correct_mfr !< Correct for mfr mismatch to ensure global conservation procedure :: shift_p !< Shift pressure to have zero average @@ -192,12 +191,6 @@ function constructor(cfg,name) result(self) ! Allocate fluid viscosity allocate(self%visc(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc=0.0_WP - ! Create pressure solver object - self%psolv =ils(cfg=self%cfg,name='Pressure') - - ! Create implicit velocity solver object - self%implicit=ils(cfg=self%cfg,name='Momentum') - ! Prepare default metrics call self%init_metrics() @@ -290,28 +283,13 @@ subroutine init_metrics(this) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + this%itpr_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] this%itpr_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] this%itpr_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] end do end do end do - ! Allocate finite difference Ui/Vi/Wi interpolation coefficients - allocate(this%itpi_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered - allocate(this%itpi_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered - allocate(this%itpi_z(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Z-face-centered - ! Create interpolation coefficients to cell face - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - this%itpi_x(:,i,j,k)=this%cfg%dxmi(i)*[this%cfg%xm(i)-this%cfg%x(i),this%cfg%x(i)-this%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] - this%itpi_y(:,i,j,k)=this%cfg%dymi(j)*[this%cfg%ym(j)-this%cfg%y(j),this%cfg%y(j)-this%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] - this%itpi_z(:,i,j,k)=this%cfg%dzmi(k)*[this%cfg%zm(k)-this%cfg%z(k),this%cfg%z(k)-this%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] - end do - end do - end do - ! Allocate finite difference viscosity interpolation coefficients allocate(this%itp_xy(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (xy) allocate(this%itp_yz(-1:0,-1:0,this%cfg%imino_+1:this%cfg%imaxo_,this%cfg%jmino_+1:this%cfg%jmaxo_,this%cfg%kmino_+1:this%cfg%kmaxo_)) !< Edge-centered (yz) @@ -528,17 +506,6 @@ subroutine adjust_metrics(this) ! end do !end do - ! Adjust Ui/Vi/Wi interpolation coefficients back to cell faces in the presence of walls (only walls!) - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - if (this%umask(i,j,k).eq.1) this%itpi_x(:,i,j,k)=0.0_WP - if (this%vmask(i,j,k).eq.1) this%itpi_y(:,i,j,k)=0.0_WP - if (this%wmask(i,j,k).eq.1) this%itpi_z(:,i,j,k)=0.0_WP - end do - end do - end do - ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -787,16 +754,19 @@ end subroutine adjust_metrics !> Finish setting up the flow solver now that bconds have been defined - subroutine setup(this,pressure_ils,implicit_ils) + subroutine setup(this,pressure_solver,implicit_solver) implicit none class(lowmach), intent(inout) :: this - integer, intent(in) :: pressure_ils - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required + class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided integer :: i,j,k ! Adjust metrics based on bcflag array call this%adjust_metrics() + ! Point to pressure solver linsol object + this%psolv=>pressure_solver + ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] this%psolv%stc(2,:)=[+1, 0, 0] @@ -830,23 +800,31 @@ subroutine setup(this,pressure_ils,implicit_ils) end do ! Initialize the pressure Poisson solver - call this%psolv%init(pressure_ils) + call this%psolv%init() call this%psolv%setup() - ! Set 7-pt stencil map for the velocity solver - this%implicit%stc(1,:)=[ 0, 0, 0] - this%implicit%stc(2,:)=[+1, 0, 0] - this%implicit%stc(3,:)=[-1, 0, 0] - this%implicit%stc(4,:)=[ 0,+1, 0] - this%implicit%stc(5,:)=[ 0,-1, 0] - this%implicit%stc(6,:)=[ 0, 0,+1] - this%implicit%stc(7,:)=[ 0, 0,-1] - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit velocity solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set 7-pt stencil map for the velocity solver + this%implicit%stc(1,:)=[ 0, 0, 0] + this%implicit%stc(2,:)=[+1, 0, 0] + this%implicit%stc(3,:)=[-1, 0, 0] + this%implicit%stc(4,:)=[ 0,+1, 0] + this%implicit%stc(5,:)=[ 0,-1, 0] + this%implicit%stc(6,:)=[ 0, 0,+1] + this%implicit%stc(7,:)=[ 0, 0,-1] + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup @@ -1245,8 +1223,282 @@ subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) call this%cfg%sync(Pgrady) call this%cfg%sync(Pgradz) end subroutine get_pgrad + + + !> Divide momentum by rho to form velocity + subroutine rho_divide(this) + implicit none + class(lowmach), intent(inout) :: this + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%U(i,j,k)=this%rhoU(i,j,k)/sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)) + this%V(i,j,k)=this%rhoV(i,j,k)/sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)) + this%W(i,j,k)=this%rhoW(i,j,k)/sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)) + end do + end do + end do + ! Sync it + call this%cfg%sync(this%U) + call this%cfg%sync(this%V) + call this%cfg%sync(this%W) + end subroutine rho_divide + + + !> Multiply velocity by rho to form momentum + subroutine rho_multiply(this) + implicit none + class(lowmach), intent(inout) :: this + integer :: i,j,k + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%rhoU(i,j,k)=this%U(i,j,k)*sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)) + this%rhoV(i,j,k)=this%V(i,j,k)*sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)) + this%rhoW(i,j,k)=this%W(i,j,k)*sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)) + end do + end do + end do + ! Sync it + call this%cfg%sync(this%rhoU) + call this%cfg%sync(this%rhoV) + call this%cfg%sync(this%rhoW) + end subroutine rho_multiply + + + !> Calculate the interpolated velocity, including overlap and ghosts + subroutine interp_vel(this,Ui,Vi,Wi) + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + ! Calculate as far as possible each component + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_-1 + Ui(i,j,k)=sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_-1 + do i=this%cfg%imino_,this%cfg%imaxo_ + Vi(i,j,k)=sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) + end do + end do + end do + do k=this%cfg%kmino_,this%cfg%kmaxo_-1 + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + Wi(i,j,k)=sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + ! Add last layer in each direction + if (.not.this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) Ui(this%cfg%imaxo,:,:)=this%U(this%cfg%imaxo,:,:) + if (.not.this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) Vi(:,this%cfg%jmaxo,:)=this%V(:,this%cfg%jmaxo,:) + if (.not.this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) Wi(:,:,this%cfg%kmaxo)=this%W(:,:,this%cfg%kmaxo) + ! Sync it + call this%cfg%sync(Ui) + call this%cfg%sync(Vi) + call this%cfg%sync(Wi) + end subroutine interp_vel + + + !> Calculate the deviatoric part of the strain rate tensor from U/V/W + !> 1: du/dx-div/3 + !> 2: dv/dy-div/3 + !> 3: dw/dz-div/3 + !> 4: (du/dy+dv/dx)/2 + !> 5: (dv/dz+dw/dy)/2 + !> 6: (dw/dx+du/dz)/2 + subroutine get_strainrate(this,SR) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + real(WP) :: div + integer :: i,j,k + + ! Check SR's first dimension + if (size(SR,dim=1).ne.6) call die('[lowmach get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + SR(2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + SR(3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + div=sum(SR(1:3,i,j,k))/3.0_WP + SR(1,i,j,k)=SR(1,i,j,k)-div + SR(2,i,j,k)=SR(2,i,j,k)-div + SR(3,i,j,k)=SR(3,i,j,k)-div + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) + SR(5,i,j,k)=0.125_WP*(sum(dvdz(i ,j:j+1,k:k+1))+sum(dwdy(i ,j:j+1,k:k+1))) + SR(6,i,j,k)=0.125_WP*(sum(dwdx(i:i+1,j ,k:k+1))+sum(dudz(i:i+1,j ,k:k+1))) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(SR) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_strainrate - + + !> Calculate the velocity gradient tensor from U/V/W + !> Note that gradu(i,j)=duj/dxi + subroutine get_gradu(this,gradu) + use messager, only: die + implicit none + class(lowmach), intent(inout) :: this + real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k + real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy + + ! Check gradu's first two dimensions + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[lowmach get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + ! Compute dudx, dvdy, and dwdz first + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) + gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) + gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) + end do + end do + end do + + ! Allocate velocity gradient components + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) + dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) + dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) + dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) + dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) + dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) + end do + end do + end do + + ! Interpolate off-diagonal components of the velocity gradient to the cell center + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) + gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) + gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) + gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) + gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) + gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) + end do + end do + end do + + ! Apply a Neumann condition in non-periodic directions + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) + end if + if (.not.this%cfg%yper) then + if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) + end if + if (.not.this%cfg%zper) then + if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) + end if + + ! Ensure zero in walls + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP + end do + end do + end do + + ! Sync it + call this%cfg%sync(gradu) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_gradu + + !> Calculate divergence of stress based on U/V/W/P (needed by LPT class) subroutine get_div_stress(this,divx,divy,divz) implicit none @@ -1358,109 +1610,18 @@ subroutine get_div_stress(this,divx,divy,divz) ! Deallocate flux arrays deallocate(FX,FY,FZ) - end subroutine get_div_stress - - - !> Calculate velocity gradient tensor - subroutine get_gradu(this,gradu) - use messager, only: die - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - - ! Check gradu's first two dimensions - if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[lowmach get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - - ! Compute dudx, dvdy, and dwdz first - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) - gradu(2,2,i,j,k)=sum(this%grdv_y(:,i,j,k)*this%V(i,j:j+1,k)) - gradu(3,3,i,j,k)=sum(this%grdw_z(:,i,j,k)*this%W(i,j,k:k+1)) - end do - end do - end do - - ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - - ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) - dudz(i,j,k)=sum(this%grdu_z(:,i,j,k)*this%U(i,j,k-1:k)) - dvdx(i,j,k)=sum(this%grdv_x(:,i,j,k)*this%V(i-1:i,j,k)) - dvdz(i,j,k)=sum(this%grdv_z(:,i,j,k)*this%V(i,j,k-1:k)) - dwdx(i,j,k)=sum(this%grdw_x(:,i,j,k)*this%W(i-1:i,j,k)) - dwdy(i,j,k)=sum(this%grdw_y(:,i,j,k)*this%W(i,j-1:j,k)) - end do - end do - end do - - ! Interpolate off-diagonal components of the velocity gradient to the cell center - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) - gradu(3,1,i,j,k)=0.25_WP*sum(dudz(i:i+1,j,k:k+1)) - gradu(1,2,i,j,k)=0.25_WP*sum(dvdx(i:i+1,j:j+1,k)) - gradu(3,2,i,j,k)=0.25_WP*sum(dvdz(i,j:j+1,k:k+1)) - gradu(1,3,i,j,k)=0.25_WP*sum(dwdx(i:i+1,j,k:k+1)) - gradu(2,3,i,j,k)=0.25_WP*sum(dwdy(i,j:j+1,k:k+1)) - end do - end do - end do - - ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then - if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) - if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) - end if - if (.not.this%cfg%yper) then - if (this%cfg%jproc.eq.1) gradu(:,:,:,this%cfg%jmin-1,:)=gradu(:,:,:,this%cfg%jmin,:) - if (this%cfg%jproc.eq.this%cfg%npy) gradu(:,:,:,this%cfg%jmax+1,:)=gradu(:,:,:,this%cfg%jmax,:) - end if - if (.not.this%cfg%zper) then - if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) - if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) - end if - - ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP - end do - end do - end do - - ! Sync it - call this%cfg%sync(gradu) - - ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - - end subroutine get_gradu - - - !> Calculate vorticity vector - subroutine get_vorticity(this,vort) + end subroutine get_div_stress + + + !> Calculate vorticity vector + subroutine get_vorticity(this,vort) use messager, only: die implicit none class(lowmach), intent(inout) :: this real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - + ! Check vort's first two dimensions if (size(vort,dim=1).ne.3) call die('[lowmach get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') @@ -1496,178 +1657,38 @@ subroutine get_vorticity(this,vort) end do end do end do - - ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP - end do - end do - end do - - ! Sync it - call this%cfg%sync(vort) - - ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - - end subroutine get_vorticity - - - !> Divide momentum by rho to form velocity - subroutine rho_divide(this) - implicit none - class(lowmach), intent(inout) :: this - integer :: i,j,k - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%U(i,j,k)=this%rhoU(i,j,k)/sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)) - this%V(i,j,k)=this%rhoV(i,j,k)/sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)) - this%W(i,j,k)=this%rhoW(i,j,k)/sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)) - end do - end do - end do - ! Sync it - call this%cfg%sync(this%U) - call this%cfg%sync(this%V) - call this%cfg%sync(this%W) - end subroutine rho_divide - - - !> Multiply velocity by rho to form momentum - subroutine rho_multiply(this) - implicit none - class(lowmach), intent(inout) :: this - integer :: i,j,k - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%rhoU(i,j,k)=this%U(i,j,k)*sum(this%itpr_x(:,i,j,k)*this%rho(i-1:i,j,k)) - this%rhoV(i,j,k)=this%V(i,j,k)*sum(this%itpr_y(:,i,j,k)*this%rho(i,j-1:j,k)) - this%rhoW(i,j,k)=this%W(i,j,k)*sum(this%itpr_z(:,i,j,k)*this%rho(i,j,k-1:k)) - end do - end do - end do - ! Sync it - call this%cfg%sync(this%rhoU) - call this%cfg%sync(this%rhoV) - call this%cfg%sync(this%rhoW) - end subroutine rho_multiply - - - !> Calculate the interpolated velocity, including overlap and ghosts - subroutine interp_vel(this,Ui,Vi,Wi) - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - ! Calculate as far as possible each component - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_-1 - Ui(i,j,k)=sum(this%itpu_x(:,i,j,k)*this%U(i:i+1,j,k)) - end do - end do - end do - do k=this%cfg%kmino_,this%cfg%kmaxo_ - do j=this%cfg%jmino_,this%cfg%jmaxo_-1 - do i=this%cfg%imino_,this%cfg%imaxo_ - Vi(i,j,k)=sum(this%itpv_y(:,i,j,k)*this%V(i,j:j+1,k)) - end do - end do - end do - do k=this%cfg%kmino_,this%cfg%kmaxo_-1 - do j=this%cfg%jmino_,this%cfg%jmaxo_ - do i=this%cfg%imino_,this%cfg%imaxo_ - Wi(i,j,k)=sum(this%itpw_z(:,i,j,k)*this%W(i,j,k:k+1)) - end do - end do - end do - ! Add last layer in each direction - if (.not.this%cfg%xper.and.this%cfg%iproc.eq.this%cfg%npx) Ui(this%cfg%imaxo,:,:)=this%U(this%cfg%imaxo,:,:) - if (.not.this%cfg%yper.and.this%cfg%jproc.eq.this%cfg%npy) Vi(:,this%cfg%jmaxo,:)=this%V(:,this%cfg%jmaxo,:) - if (.not.this%cfg%zper.and.this%cfg%kproc.eq.this%cfg%npz) Wi(:,:,this%cfg%kmaxo)=this%W(:,:,this%cfg%kmaxo) - ! Sync it - call this%cfg%sync(Ui) - call this%cfg%sync(Vi) - call this%cfg%sync(Wi) - end subroutine interp_vel - - - !> Calculate the strain rate tensor, including approximations for domain overlap - !> This only uses interpolated velocities passed to this function (we could imagine a more local one that uses U/V/W too) - subroutine get_strainrate(this,Ui,Vi,Wi,SR) - use messager, only: die - implicit none - class(lowmach), intent(inout) :: this - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension (this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in ) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: SR !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k - real(WP) :: Uxm,Uxp,Uym,Uyp,Uzm,Uzp - real(WP) :: Vxm,Vxp,Vym,Vyp,Vzm,Vzp - real(WP) :: Wxm,Wxp,Wym,Wyp,Wzm,Wzp - real(WP), dimension(3,3) :: dUdx - - ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[lowmach get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - - ! Calculate inside - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - ! Rebuild face velocities from interpolated velocities - Uxm=sum(this%itpi_x(:,i,j,k)*Ui(i-1:i,j,k)); Uxp=sum(this%itpi_x(:,i+1,j,k)*Ui(i:i+1,j,k)); Uym=sum(this%itpi_y(:,i,j,k)*Ui(i,j-1:j,k)); Uyp=sum(this%itpi_y(:,i,j+1,k)*Ui(i,j:j+1,k)); Uzm=sum(this%itpi_z(:,i,j,k)*Ui(i,j,k-1:k)); Uzp=sum(this%itpi_z(:,i,j,k+1)*Ui(i,j,k:k+1)) - Vxm=sum(this%itpi_x(:,i,j,k)*Vi(i-1:i,j,k)); Vxp=sum(this%itpi_x(:,i+1,j,k)*Vi(i:i+1,j,k)); Vym=sum(this%itpi_y(:,i,j,k)*Vi(i,j-1:j,k)); Vyp=sum(this%itpi_y(:,i,j+1,k)*Vi(i,j:j+1,k)); Vzm=sum(this%itpi_z(:,i,j,k)*Vi(i,j,k-1:k)); Vzp=sum(this%itpi_z(:,i,j,k+1)*Vi(i,j,k:k+1)) - Wxm=sum(this%itpi_x(:,i,j,k)*Wi(i-1:i,j,k)); Wxp=sum(this%itpi_x(:,i+1,j,k)*Wi(i:i+1,j,k)); Wym=sum(this%itpi_y(:,i,j,k)*Wi(i,j-1:j,k)); Wyp=sum(this%itpi_y(:,i,j+1,k)*Wi(i,j:j+1,k)); Wzm=sum(this%itpi_z(:,i,j,k)*Wi(i,j,k-1:k)); Wzp=sum(this%itpi_z(:,i,j,k+1)*Wi(i,j,k:k+1)) - ! Get velocity gradient tensor - dUdx(1,1)=this%cfg%dxi(i)*(Uxp-Uxm); dUdx(1,2)=this%cfg%dyi(j)*(Uyp-Uym); dUdx(1,3)=this%cfg%dzi(k)*(Uzp-Uzm) - dUdx(2,1)=this%cfg%dxi(i)*(Vxp-Vxm); dUdx(2,2)=this%cfg%dyi(j)*(Vyp-Vym); dUdx(2,3)=this%cfg%dzi(k)*(Vzp-Vzm) - dUdx(3,1)=this%cfg%dxi(i)*(Wxp-Wxm); dUdx(3,2)=this%cfg%dyi(j)*(Wyp-Wym); dUdx(3,3)=this%cfg%dzi(k)*(Wzp-Wzm) - ! Assemble the strain rate - SR(1,i,j,k)=dUdx(1,1)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(2,i,j,k)=dUdx(2,2)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(3,i,j,k)=dUdx(3,3)-(dUdx(1,1)+dUdx(2,2)+dUdx(3,3))/3.0_WP - SR(4,i,j,k)=0.5_WP*(dUdx(1,2)+dUdx(2,1)) - SR(5,i,j,k)=0.5_WP*(dUdx(2,3)+dUdx(3,2)) - SR(6,i,j,k)=0.5_WP*(dUdx(3,1)+dUdx(1,3)) - end do - end do - end do ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then - if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) - if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) + if (.not.this%cfg%xper) then + if (this%cfg%iproc.eq.1) vort(:,this%cfg%imin-1,:,:)=vort(:,this%cfg%imin,:,:) + if (this%cfg%iproc.eq.this%cfg%npx) vort(:,this%cfg%imax+1,:,:)=vort(:,this%cfg%imax,:,:) end if if (.not.this%cfg%yper) then - if (this%cfg%jproc.eq.1) SR(:,:,this%cfg%jmin-1,:)=SR(:,:,this%cfg%jmin,:) - if (this%cfg%jproc.eq.this%cfg%npy) SR(:,:,this%cfg%jmax+1,:)=SR(:,:,this%cfg%jmax,:) + if (this%cfg%jproc.eq.1) vort(:,:,this%cfg%jmin-1,:)=vort(:,:,this%cfg%jmin,:) + if (this%cfg%jproc.eq.this%cfg%npy) vort(:,:,this%cfg%jmax+1,:)=vort(:,:,this%cfg%jmax,:) end if if (.not.this%cfg%zper) then - if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) - if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) + if (this%cfg%kproc.eq.1) vort(:,:,:,this%cfg%kmin-1)=vort(:,:,:,this%cfg%kmin) + if (this%cfg%kproc.eq.this%cfg%npz) vort(:,:,:,this%cfg%kmax+1)=vort(:,:,:,this%cfg%kmax) end if ! Ensure zero in walls do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ do i=this%cfg%imino_,this%cfg%imaxo_ - if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP + if (this%mask(i,j,k).eq.1) vort(:,i,j,k)=0.0_WP end do end do end do - + ! Sync it - call this%cfg%sync(SR) - - end subroutine get_strainrate - + call this%cfg%sync(vort) + + ! Deallocate velocity gradient storage + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + + end subroutine get_vorticity + !> Calculate the CFL subroutine get_cfl(this,dt,cflc,cfl) @@ -1711,7 +1732,7 @@ subroutine get_cfl(this,dt,cflc,cfl) cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) ! If asked for, also return the maximum overall CFL - if (present(CFL)) cfl =max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) + if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) end subroutine get_cfl @@ -1901,23 +1922,11 @@ subroutine shift_p(this,pressure) implicit none class(lowmach), intent(in) :: this real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: vol_tot,pressure_tot,my_vol_tot,my_pressure_tot - integer :: i,j,k,ierr + real(WP) :: pressure_tot + integer :: i,j,k - ! Loop over domain and integrate volume and pressure - my_vol_tot=0.0_WP - my_pressure_tot=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - my_vol_tot =my_vol_tot +this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k) - my_pressure_tot=my_pressure_tot+this%cfg%vol(i,j,k)*this%cfg%VF(i,j,k)*pressure(i,j,k) - end do - end do - end do - call MPI_ALLREDUCE(my_vol_tot ,vol_tot ,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_pressure_tot,pressure_tot,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - pressure_tot=pressure_tot/vol_tot + ! Compute volume-averaged pressure + call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 105e30b51..89747e49b 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -5,7 +5,7 @@ module vdscalar_class use precision, only: WP use string, only: str_medium use config_class, only: config - use ils_class, only: ils + use linsol_class, only: linsol use iterator_class, only: iterator implicit none private @@ -60,7 +60,7 @@ module vdscalar_class real(WP), dimension(:,:,:), allocatable :: rhoSCold !< rhoSCold array ! Implicit scalar solver - type(ils) :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual + class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location ! Metrics @@ -151,9 +151,6 @@ function constructor(cfg,scheme,name) result(self) call die('[scalar constructor] Unknown vdscalar transport scheme selected') end select - ! Create implicit scalar solver object - self%implicit=ils(cfg=self%cfg,name='Scalar',nst=1+6*abs(self%stp1)) - ! Prepare default metrics call self%init_metrics() @@ -368,31 +365,39 @@ end subroutine adjust_metrics !> Finish setting up the variable density scalar solver now that bconds have been defined - subroutine setup(this,implicit_ils) + subroutine setup(this,implicit_solver) implicit none class(vdscalar), intent(inout) :: this - integer, intent(in) :: implicit_ils + class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st ! Adjust metrics based on mask array call this%adjust_metrics() - ! Set dynamic stencil map for the scalar solver - count=1; this%implicit%stc(count,:)=[0,0,0] - do st=1,abs(this%stp1) - count=count+1; this%implicit%stc(count,:)=[+st,0,0] - count=count+1; this%implicit%stc(count,:)=[-st,0,0] - count=count+1; this%implicit%stc(count,:)=[0,+st,0] - count=count+1; this%implicit%stc(count,:)=[0,-st,0] - count=count+1; this%implicit%stc(count,:)=[0,0,+st] - count=count+1; this%implicit%stc(count,:)=[0,0,-st] - end do - - ! Set the diagonal to 1 to make sure all cells participate in solver - this%implicit%opr(1,:,:,:)=1.0_WP - - ! Initialize the implicit scalar solver - call this%implicit%init(implicit_ils) + ! Prepare implicit solver if it had been provided + if (present(implicit_solver)) then + + ! Point to implicit solver linsol object + this%implicit=>implicit_solver + + ! Set dynamic stencil map for the scalar solver + count=1; this%implicit%stc(count,:)=[0,0,0] + do st=1,abs(this%stp1) + count=count+1; this%implicit%stc(count,:)=[+st,0,0] + count=count+1; this%implicit%stc(count,:)=[-st,0,0] + count=count+1; this%implicit%stc(count,:)=[0,+st,0] + count=count+1; this%implicit%stc(count,:)=[0,-st,0] + count=count+1; this%implicit%stc(count,:)=[0,0,+st] + count=count+1; this%implicit%stc(count,:)=[0,0,-st] + end do + + ! Set the diagonal to 1 to make sure all cells participate in solver + this%implicit%opr(1,:,:,:)=1.0_WP + + ! Initialize the implicit velocity solver + call this%implicit%init() + + end if end subroutine setup diff --git a/tools/GNUMake/packages/Make.irl b/tools/GNUMake/packages/Make.irl index 0e7a9278d..6586c7787 100644 --- a/tools/GNUMake/packages/Make.irl +++ b/tools/GNUMake/packages/Make.irl @@ -2,7 +2,12 @@ ifdef IRL_DIR INCLUDE_LOCATIONS += $(IRL_DIR)/include/irl_fortran LIBRARY_LOCATIONS += $(IRL_DIR)/lib - LIBRARIES += -lirl_fortran -lirl_c -lirl -labsl_all -lc++ + is_gnu = $(shell expr `mpicc --version | awk '{print substr($$1,1,3); exit}'` = 'gcc') + ifeq ($(is_gnu), 1) + LIBRARIES += -lirl_fortran -lirl_c -lirl -labsl_all -lstdc++ + else + LIBRARIES += -lirl_fortran -lirl_c -lirl -labsl_all -lc++ + endif ifeq ($(os_name), Darwin) LIBRARIES += -framework CoreFoundation endif From b52251546df386517436a13de23df9efa1eb0dae Mon Sep 17 00:00:00 2001 From: johnpwakefield Date: Thu, 9 Feb 2023 13:13:39 -0500 Subject: [PATCH 115/152] MUSCL (#5) * fixed bad tab character * added error message for bad write; exposed additional method * exposed additional method until issue can be debugged * first draft of muscl solver * make localization interface public in iterator_class.f90 * fixed boundary conditions * advection and detonation test cases with and without periodic boundaries * fixed periodic bcs * updated test cases * added sod case * fixed bad comment * moved several definitions to a hyperbolic_general.f90 module in preparation for future solvers that depend on them * added reflection bc test * extensive style cleanup in preparation of merging with upstream * reverted to upstream makefile in HIT case * fixed issues with monitor files --- examples/advection/GNUmakefile | 50 + examples/advection/README | 2 + examples/advection/input | 24 + examples/advection/src/Make.package | 2 + examples/advection/src/geometry.f90 | 80 ++ examples/advection/src/simulation.f90 | 313 ++++++ examples/detonation/GNUmakefile | 50 + examples/detonation/README | 1 + examples/detonation/input_openbcs | 26 + examples/detonation/input_reflect | 26 + examples/detonation/src/Make.package | 2 + examples/detonation/src/geometry.f90 | 80 ++ examples/detonation/src/simulation.f90 | 368 +++++++ examples/hit/input | 1 + examples/muscl_reflect_test/GNUmakefile | 50 + examples/muscl_reflect_test/README | 2 + examples/muscl_reflect_test/input | 22 + examples/muscl_reflect_test/src/Make.package | 2 + examples/muscl_reflect_test/src/geometry.f90 | 82 ++ .../muscl_reflect_test/src/simulation.f90 | 350 +++++++ examples/sod/GNUmakefile | 50 + examples/sod/README | 6 + examples/sod/input_aligned | 21 + examples/sod/input_skew | 21 + examples/sod/src/Make.package | 2 + examples/sod/src/geometry.f90 | 80 ++ examples/sod/src/simulation.f90 | 335 +++++++ src/data/ensight_class.f90 | 54 +- src/grid/iterator_class.f90 | 21 +- src/grid/pgrid_class.f90 | 2 +- src/hyperbolic/Make.package | 5 + src/hyperbolic/advection.f90 | 145 +++ src/hyperbolic/euler.f90 | 418 ++++++++ src/hyperbolic/hyperbolic_general.f90 | 147 +++ src/hyperbolic/muscl_class.f90 | 932 ++++++++++++++++++ tools/GNUMake/Make.local | 3 +- 36 files changed, 3737 insertions(+), 38 deletions(-) create mode 100644 examples/advection/GNUmakefile create mode 100644 examples/advection/README create mode 100644 examples/advection/input create mode 100644 examples/advection/src/Make.package create mode 100644 examples/advection/src/geometry.f90 create mode 100644 examples/advection/src/simulation.f90 create mode 100644 examples/detonation/GNUmakefile create mode 100644 examples/detonation/README create mode 100644 examples/detonation/input_openbcs create mode 100644 examples/detonation/input_reflect create mode 100644 examples/detonation/src/Make.package create mode 100644 examples/detonation/src/geometry.f90 create mode 100644 examples/detonation/src/simulation.f90 create mode 100644 examples/muscl_reflect_test/GNUmakefile create mode 100644 examples/muscl_reflect_test/README create mode 100644 examples/muscl_reflect_test/input create mode 100644 examples/muscl_reflect_test/src/Make.package create mode 100644 examples/muscl_reflect_test/src/geometry.f90 create mode 100644 examples/muscl_reflect_test/src/simulation.f90 create mode 100644 examples/sod/GNUmakefile create mode 100644 examples/sod/README create mode 100644 examples/sod/input_aligned create mode 100644 examples/sod/input_skew create mode 100644 examples/sod/src/Make.package create mode 100644 examples/sod/src/geometry.f90 create mode 100644 examples/sod/src/simulation.f90 create mode 100644 src/hyperbolic/Make.package create mode 100644 src/hyperbolic/advection.f90 create mode 100644 src/hyperbolic/euler.f90 create mode 100644 src/hyperbolic/hyperbolic_general.f90 create mode 100644 src/hyperbolic/muscl_class.f90 diff --git a/examples/advection/GNUmakefile b/examples/advection/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/advection/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/advection/README b/examples/advection/README new file mode 100644 index 000000000..fb7412417 --- /dev/null +++ b/examples/advection/README @@ -0,0 +1,2 @@ +standard advection test case advecting different shapes over a periodic domain +to evaluate accuracy and diffusion diff --git a/examples/advection/input b/examples/advection/input new file mode 100644 index 000000000..267b7e036 --- /dev/null +++ b/examples/advection/input @@ -0,0 +1,24 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 128 +Ly : 1.0 +ny : 128 +Lz : 1.0 +nz : 1 +Periodic : true + +# Initialization +Shapes : c + +# Direction +Advection direction : 1 1 0 + +# Time integration +Max cfl number : 0.5 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/advection/src/Make.package b/examples/advection/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/advection/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/advection/src/geometry.f90 b/examples/advection/src/geometry.f90 new file mode 100644 index 000000000..2520b1f66 --- /dev/null +++ b/examples/advection/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + logical :: periodic + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + call param_read('Periodic', periodic) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=periodic, & + & yper=periodic, zper=periodic) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 new file mode 100644 index 000000000..8354723c7 --- /dev/null +++ b/examples/advection/src/simulation.f90 @@ -0,0 +1,313 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hyperbolic, only: SUPERBEE + use muscl_class, only: muscl + use hyperbolic_advection, only: make_advec_muscl + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> simulation monitor file + type(monitor) :: mfile, cflfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> circles and donuts shape + ! TODO fill between zero and one on boundaries + subroutine init_donut(iR, oR, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: iR, oR + real(WP), dimension(3) :: c, x + real(WP) :: r2 + integer :: i, j, k + + U(:,:,:) = 0.0_WP + + c = 0.5 * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmin_, cfg%kmax_ + x(3) = cfg%zm(k) + do j = cfg%jmin_, cfg%jmax_ + x(2) = cfg%ym(j) + do i = cfg%imin_, cfg%imax_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (iR**2 .lt. r2 .and. r2 .lt. oR**2) U(i,j,k) = 1.0_WP + end do + end do + end do + + end subroutine init_donut + + !> bar so we can test 1d behavior + subroutine init_bar(xmin, xmax, U) + implicit none + real(WP), dimension(cfg%imino_:,cfg%jmino_:,cfg%kmino_:), intent(out) :: U + real(WP), intent(in) :: xmin, xmax + integer :: i + + U(:,:,:) = 0.0_WP + + do i = cfg%imin_, cfg%imax_ + if (xmin .lt. cfg%xm(i) .and. cfg%xm(i) .lt. xmax) then + U(i,:,:) = 1.0_WP + end if + end do + + end subroutine + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use string, only: str_medium + use messager, only: die + implicit none + + integer :: numfields + character, dimension(:), allocatable :: fields + + ! read shapes + read_shapes: block + character(len=str_medium) :: fieldbuffer + integer :: i, j + + call param_read('Shapes', fieldbuffer) + fieldbuffer = adjustl(fieldbuffer) + + ! check for duplicates + do i = 1, str_medium + if (fieldbuffer(i:i) .ne. ' ') then + do j = i+1, str_medium + if (fieldbuffer(i:i) .eq. fieldbuffer(j:j)) then + call die("field name '" // fieldbuffer(i:i) // "' appears twice") + end if + end do + end if + end do + + ! count valid fields and warn user + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + case ('d') ! donut + numfields = numfields + 1 + case ('b') ! bar + numfields = numfields + 1 + case (' ') ! skip spaces + case default + write(*, *) "unrecognized shape: '", fieldbuffer(i:i), "'" + end select + end do + if (numfields .eq. 0) call die("must advect at least one shape") + + ! read fields into array + allocate(fields(numfields)) + numfields = 0 + do i = 1, str_medium + select case (fieldbuffer(i:i)) + case ('c') ! circle + numfields = numfields + 1 + fields(numfields) = 'c' + case ('d') ! donut + numfields = numfields + 1 + fields(numfields) = 'd' + case ('b') ! bar + numfields = numfields + 1 + fields(numfields) = 'b' + case default + end select + end do + + end block read_shapes + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + real(WP), dimension(3) :: vel + real(WP) :: traversal_length + + ! read velocity direction, find velocity + call param_read('Advection direction', vel, 'Advec dir') + traversal_length = sqrt(sum(vel**2)) * cfg%xL + vel = vel * traversal_length + + ! call constructor + fs = make_advec_muscl(cfg, numfields, SUPERBEE, vel) + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + integer :: i + real(WP), dimension(:,:,:), pointer :: fieldptr + + do i = 1, numfields + fieldptr => fs%Uc(i,:,:,:) + select case (fields(i)) + case ('c') ! circle + call init_donut(0.0_WP, 0.375_WP * cfg%xL, fieldptr) + case ('d') ! donut + call init_donut(0.250_WP * cfg%xL, 0.375_WP * cfg%xL, fieldptr) + case ('b') ! bar + call init_bar(0.333_WP * cfg%xL, 0.666_WP * cfg%xL, fieldptr) + end select + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + integer :: i + character(len=4) :: istr + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg, name='AdvectionTest') + + ! Create event for Ensight output + ens_evt=event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + do i = 1, numfields + ptr1 => fs%Uc(i,:,:,:) + write(istr,'(I2.2)') i + call ens_out%add_scalar('U'//istr, ptr1) + end do + + ptr1 => fs%params(1,:,:,:) + ptr2 => fs%params(2,:,:,:) + ptr3 => fs%params(3,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + character(len=str_short) :: fieldname + integer :: i + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + do i = 1, numfields + write(fieldname,'("[",a,"]min")') fields(i) + real_ptr => fs%Umin(i) + call mfile%add_column(real_ptr, fieldname) + write(fieldname,'("[",a,"]max")') fields(i) + real_ptr => fs%Umax(i) + call mfile%add_column(real_ptr, fieldname) + end do + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/detonation/GNUmakefile b/examples/detonation/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/detonation/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/detonation/README b/examples/detonation/README new file mode 100644 index 000000000..8718d3d32 --- /dev/null +++ b/examples/detonation/README @@ -0,0 +1 @@ +a spherical detonation based off the Sod problem diff --git a/examples/detonation/input_openbcs b/examples/detonation/input_openbcs new file mode 100644 index 000000000..9a7ce3168 --- /dev/null +++ b/examples/detonation/input_openbcs @@ -0,0 +1,26 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 + +# Reflect? +Reflect : false + +# Initialization +Initial diameter : 0.2 +Initial x velocity : 0.4 +Initial x position : 0.5 +Initial pressure multiplier : 12.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/detonation/input_reflect b/examples/detonation/input_reflect new file mode 100644 index 000000000..3c266f879 --- /dev/null +++ b/examples/detonation/input_reflect @@ -0,0 +1,26 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 + +# Reflect? +Reflect : true + +# Initialization +Initial diameter : 0.16 +Initial x velocity : 0.0 +Initial x position : 0.8 +Initial pressure multiplier : 12.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/detonation/src/Make.package b/examples/detonation/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/detonation/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/detonation/src/geometry.f90 b/examples/detonation/src/geometry.f90 new file mode 100644 index 000000000..637b9e1c0 --- /dev/null +++ b/examples/detonation/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 new file mode 100644 index 000000000..e00dab230 --- /dev/null +++ b/examples/detonation/src/simulation.f90 @@ -0,0 +1,368 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES, WALL_REFLECT + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Flow solver and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + character(len=str_medium) :: ens_out_name + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(1:5,i,j,k)) + phys_out(6,i,j,k) = sqrt(sum(phys_out(2:4,i,j,k)**2) / (DIATOMIC_GAMMA * phys_out(5,i,j,k) / phys_out(1,i,j,k))) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + function side_locator_z_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.lt.pg%kmin) loc = .true. + end function side_locator_z_l + function side_locator_z_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.gt.pg%kmax) loc = .true. + end function side_locator_z_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver + create_and_initialize_flow_solver: block + logical :: reflect + + call param_read('Reflect', reflect) + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + if (reflect) then + call fs%add_bcond(name='reflxr' , type=WALL_REFLECT, & + & locator=side_locator_x_r, dir='xr') + ens_out_name = 'SodSphereReflect' + else + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + ens_out_name = 'SodSphereOpen' + end if + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + call fs%add_bcond(name='openzl' , type=NO_WAVES, & + & locator=side_locator_z_l, dir='zl') + call fs%add_bcond(name='openzr' , type=NO_WAVES, & + & locator=side_locator_z_r, dir='zr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP) :: r2, oR, initxpos, initxvel, initpmul + real(WP), dimension(3) :: x, c + real(WP), dimension(5) :: insvalphys, outvalphys, insval, outval + integer :: i, j, k + + call param_read('Initial diameter', oR) + call param_read('Initial x position', initxpos, 'Initial x pos', 0.5_WP * cfg%xL) + call param_read('Initial x velocity', initxvel, 'Initial x vel', 0.0_WP) + call param_read('Initial pressure multiplier', initpmul, 'Initial p mul', 1.0_WP) + + oR = 0.5_WP * oR + + insvalphys = SOD_PHYS_L + outvalphys = SOD_PHYS_R + insvalphys(2) = insvalphys(2) + initxvel + outvalphys(2) = outvalphys(2) + initxvel + insvalphys(5) = insvalphys(5) * initpmul + + call euler_tocons(DIATOMIC_GAMMA, insvalphys, insval) + call euler_tocons(DIATOMIC_GAMMA, outvalphys, outval) + + c = 0.5_WP * (/ 2 * initxpos, cfg%yL, cfg%zL /) + + do k = cfg%kmino_, cfg%kmaxo_ + x(3) = cfg%zm(k) + do j = cfg%jmino_, cfg%jmaxo_ + x(2) = cfg%ym(j) + do i = cfg%imino_, cfg%imaxo_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (r2 .lt. oR**2) then + fs%Uc(:,i,j,k) = insval + else + fs%Uc(:,i,j,k) = outval + end if + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name=ens_out_name) + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:) + ptr2 => phys_out(3,:,:,:) + ptr3 => phys_out(4,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + ptr1 => phys_out(6,:,:,:) + call ens_out%add_scalar('Ma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/hit/input b/examples/hit/input index 563066350..7646043ff 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -22,3 +22,4 @@ Max cfl number : 0.9 # Ensight output Ensight output period : 0.01 + diff --git a/examples/muscl_reflect_test/GNUmakefile b/examples/muscl_reflect_test/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/muscl_reflect_test/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/muscl_reflect_test/README b/examples/muscl_reflect_test/README new file mode 100644 index 000000000..07c52460b --- /dev/null +++ b/examples/muscl_reflect_test/README @@ -0,0 +1,2 @@ +The 'detonation' example, but with an initial velocity toward a reflecting +wall. diff --git a/examples/muscl_reflect_test/input b/examples/muscl_reflect_test/input new file mode 100644 index 000000000..f146e101b --- /dev/null +++ b/examples/muscl_reflect_test/input @@ -0,0 +1,22 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 +Lz : 1.0 +nz : 1 +Periodic : false + +# Initialization +Initial diameter : 0.2 +Initial x velocity : 0.5 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/muscl_reflect_test/src/Make.package b/examples/muscl_reflect_test/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/muscl_reflect_test/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/muscl_reflect_test/src/geometry.f90 b/examples/muscl_reflect_test/src/geometry.f90 new file mode 100644 index 000000000..c27998de1 --- /dev/null +++ b/examples/muscl_reflect_test/src/geometry.f90 @@ -0,0 +1,82 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + logical :: periodic + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + call param_read('Lz', Lz) + call param_read('nz', nz) + call param_read('Periodic', periodic) + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=periodic, & + & yper=periodic, zper=periodic) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF=1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/muscl_reflect_test/src/simulation.f90 b/examples/muscl_reflect_test/src/simulation.f90 new file mode 100644 index 000000000..e1c266b80 --- /dev/null +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -0,0 +1,350 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(:,i,j,k)) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + function side_locator_z_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.lt.pg%kmin) loc = .true. + end function side_locator_z_l + function side_locator_z_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (k.gt.pg%kmax) loc = .true. + end function side_locator_z_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use string, only: str_medium + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver without bconds + create_and_initialize_flow_solver: block + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + call fs%add_bcond(name='openzl' , type=NO_WAVES, & + & locator=side_locator_z_l, dir='zl') + call fs%add_bcond(name='openzr' , type=NO_WAVES, & + & locator=side_locator_z_r, dir='zr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP) :: r2, oR, initxvel + real(WP), dimension(3) :: x, c + real(WP), dimension(5) :: insvalphys, outvalphys, insval, outval + integer :: i, j, k + + call param_read('Initial diameter', oR) + oR = 0.5_WP * oR + + call param_read('Initial x velocity', initxvel, 'Initial x velocity', 0.0_WP) + + insvalphys = SOD_PHYS_L + outvalphys = SOD_PHYS_R + insvalphys(2) = insvalphys(2) + initxvel + outvalphys(2) = outvalphys(2) + initxvel + call euler_tocons(DIATOMIC_GAMMA, insvalphys, insval) + call euler_tocons(DIATOMIC_GAMMA, outvalphys, outval) + + c = 0.5_WP * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmino_, cfg%kmaxo_ + x(3) = cfg%zm(k) + do j = cfg%jmino_, cfg%jmaxo_ + x(2) = cfg%ym(j) + do i = cfg%imino_, cfg%imaxo_ + x(1) = cfg%xm(i) + r2 = sum((c - x)**2) + if (r2 .lt. oR**2) then + fs%Uc(:,i,j,k) = insval + else + fs%Uc(:,i,j,k) = outval + end if + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(5,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name='SodSphereTest') + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:) + ptr2 => phys_out(3,:,:,:) + ptr3 => phys_out(4,:,:,:) + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + !call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/examples/sod/GNUmakefile b/examples/sod/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/sod/GNUmakefile @@ -0,0 +1,50 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_FFTW = FALSE +USE_HYPRE = FALSE +USE_LAPACK = TRUE +PROFILE = FALSE +DEBUG = TRUE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +HDF5_DIR = /opt/hdf5 +HYPRE_DIR = /opt/hypre +LAPACK_DIR = /opt/lapack-3.10.1 +FFTW_DIR = /opt/fftw-3.3.10 + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles core hyperbolic data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/sod/README b/examples/sod/README new file mode 100644 index 000000000..b5ce65a88 --- /dev/null +++ b/examples/sod/README @@ -0,0 +1,6 @@ +The classic Sod problem (Sod, JCP, 1978). + +An incident angle may be specified so that the 1d behavior (see +`input_aligned`) and the behavior at an angle to the mesh (see `input_skew`) +may be examined. + diff --git a/examples/sod/input_aligned b/examples/sod/input_aligned new file mode 100644 index 000000000..4ff2de33b --- /dev/null +++ b/examples/sod/input_aligned @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 0.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod/input_skew b/examples/sod/input_skew new file mode 100644 index 000000000..5974f5f37 --- /dev/null +++ b/examples/sod/input_skew @@ -0,0 +1,21 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 +Ly : 1.0 +ny : 64 + +# Mesh Angle +Mesh angle : 35.0 + +# Initialization +Initial x velocity : 0.0 + +# Time integration +Max cfl number : 0.98 + +# Ensight output +Ensight output period : 0.01 + diff --git a/examples/sod/src/Make.package b/examples/sod/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/sod/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/sod/src/geometry.f90 b/examples/sod/src/geometry.f90 new file mode 100644 index 000000000..dfe9a5b6e --- /dev/null +++ b/examples/sod/src/geometry.f90 @@ -0,0 +1,80 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i, j, k, nx, ny, nz + real(WP) :: Lx, Ly, Lz + real(WP), dimension(:), allocatable :: x, y, z + + ! read in grid definition + call param_read('Lx', Lx) + call param_read('nx', nx) + call param_read('Ly', Ly) + call param_read('ny', ny) + nz = 1 + Lz = 1.0_WP + + ! allocate + allocate(x(nx+1), y(ny+1), z(nz+1)) + + ! create simple rectilinear grid + do i = 1, nx+1 + x(i) = real(i-1-nx/2,WP) / real(nx, WP) * Lx + end do + do j = 1, ny+1 + y(j) = real(j-1-nz/2,WP) / real(ny, WP) * Ly + end do + do k = 1, nz+1 + z(k) = real(k-1,WP) / real(nz, WP) * Lz + end do + + ! generate serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) + + deallocate(x, y, z) + + end block create_grid + + ! create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! read in partition + call param_read('Partition', partition, short='p') + + ! create partitioned grid + cfg = config(grp=group, decomp=partition, grid=grid) + + end block create_cfg + + ! Create masks for this config + create_walls: block + cfg%VF = 1.0_WP + end block create_walls + + end subroutine geometry_init + +end module geometry + diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 new file mode 100644 index 000000000..1778ef3fb --- /dev/null +++ b/examples/sod/src/simulation.f90 @@ -0,0 +1,335 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, NO_WAVES, WALL_REFLECT + use hyperbolic_euler, only: make_euler_muscl, euler_tocons, & + & euler_tophys, SOD_PHYS_L, SOD_PHYS_R, DIATOMIC_GAMMA + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use string, only: str_medium + implicit none + private + + !> Flow solver and a time tracker + type(muscl), public :: fs + type(timetracker), public :: time + + !> Ensight postprocessing + character(len=str_medium) :: ens_out_name + type(ensight) :: ens_out + type(event) :: ens_evt + + !> physical value arrays for ensight output + real(WP), dimension(:,:,:,:), pointer :: phys_out + + !> simulation monitor file + type(monitor) :: mfile, cflfile, consfile + + !> simulation control functions + public :: simulation_init, simulation_run, simulation_final + +contains + + !> update phys + subroutine update_phys_out() + implicit none + integer :: i, j, k + + do k = cfg%kmin_, cfg%kmax_ + do j = cfg%jmin_, cfg%jmax_ + do i = cfg%imin_, cfg%imax_ + call euler_tophys(DIATOMIC_GAMMA, fs%Uc(:,i,j,k), phys_out(1:5,i,j,k)) + phys_out(6,i,j,k) = sqrt(sum(phys_out(2:4,i,j,k)**2) / (DIATOMIC_GAMMA * phys_out(5,i,j,k) / phys_out(1,i,j,k))) + end do + end do + end do + + call cfg%sync(phys_out) + + end subroutine + + !> functions localize the sides of the domain + function side_locator_x_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.lt.pg%imin) loc = .true. + end function side_locator_x_l + function side_locator_x_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (i.gt.pg%imax) loc = .true. + end function side_locator_x_r + function side_locator_y_l(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.lt.pg%jmin) loc = .true. + end function side_locator_y_l + function side_locator_y_r(pg, i, j, k) result(loc) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i, j, k + logical :: loc + loc = .false. + if (j.gt.pg%jmax) loc = .true. + end function side_locator_y_r + + !> initialization of problem solver + subroutine simulation_init() + use param, only: param_read + use messager, only: die + implicit none + + !TODO need to figure out what the right interaction with this is + initialize_timetracker: block + + time = timetracker(amRoot=cfg%amRoot) + call param_read('Max cfl number', time%cflmax) + time%dt = 1e-3_WP + time%itmax = 1 + + end block initialize_timetracker + + ! create a single-phase flow solver + create_and_initialize_flow_solver: block + + ! call constructor + fs = make_euler_muscl(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=NO_WAVES, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=NO_WAVES, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=NO_WAVES, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=NO_WAVES, & + & locator=side_locator_y_r, dir='yr') + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP), dimension(5) :: lval, rval, val + real(WP) :: angle, x0, y0, x1, y1, w + integer :: i, j, k + + call param_read('Mesh angle', angle) + + write(ens_out_name,'(A,F0.1)') 'SodAngle', angle + + angle = angle * 2.0_WP * 4.0_WP * atan(1.0_WP) / 360 + + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_L, lval) + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_R, rval) + + do j = cfg%jmino_, cfg%jmaxo_ + y0 = cfg%y(j); y1 = cfg%y(j+1); + do i = cfg%imino_, cfg%imaxo_ + x0 = cfg%x(i); x1 = cfg%x(i+1); + if (cos(angle) * x1 + sin(angle) * y1 .le. 0.0_WP) then + val = lval + else if (cos(angle) * x0 + sin(angle) * y0 .ge. 0.0_WP) then + val = rval + else + w = 0.5_WP * (cotan(angle) * x0 + y0) * (tan(angle) * y0 + x0) + if (-cotan(angle) * x0 .gt. y1) then + w = w - 0.5_WP * (tan(angle) * y1 + x0) * (cotan(angle) * x0 + y1) + end if + if (-tan(angle) * y0 .gt. x1) then + w = w - 0.5_WP * (tan(angle) * y0 + x1) * (cotan(angle) * x1 + y0) + end if + w = w / (cfg%dx(i) * cfg%dy(j)) + val = lval * w + rval * (1.0_WP - w) + end if + do k = cfg%kmino_, cfg%kmaxo_ + fs%Uc(:,i,j,k) = val + end do + end do + end do + + call fs%recalc_cfl() + + end block initialize_fields + + ! Add Ensight output + create_ensight: block + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 + + ! create array to hold physical coordinates + allocate(phys_out(6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + & cfg%kmino_:cfg%kmaxo_)) + + ! Create Ensight output from cfg + ens_out = ensight(cfg=cfg, name=ens_out_name) + + ! Create event for Ensight output + ens_evt = event(time=time, name='Ensight output') + call param_read('Ensight output period', ens_evt%tper) + + ! Add variables to output + ptr1 => phys_out(1,:,:,:) + call ens_out%add_scalar('density', ptr1) + ptr1 => phys_out(2,:,:,:); + ptr2 => phys_out(3,:,:,:); + ptr3 => phys_out(4,:,:,:); + call ens_out%add_vector('velocity', ptr1, ptr2, ptr3) + ptr1 => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', ptr1) + ptr1 => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', ptr1) + ptr1 => phys_out(6,:,:,:) + call ens_out%add_scalar('Ma', ptr1) + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + end block create_ensight + + ! Create a monitor file + create_monitor: block + use string, only: str_short + real(WP), pointer :: real_ptr + + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_range() + + ! Create simulation monitor + mfile = monitor(fs%cfg%amRoot, 'simulation') + call mfile%add_column(time%n, 'Timestep number') + call mfile%add_column(time%t, 'Time') + call mfile%add_column(time%dt, 'Timestep size') + call mfile%add_column(time%cfl, 'Maximum CFL') + ! not sure why this doesn't work? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + real_ptr => fs%Umin(1) + call mfile%add_column(real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call mfile%add_column(real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call mfile%add_column(real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call mfile%add_column(real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call mfile%add_column(real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call mfile%add_column(real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call mfile%add_column(real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call mfile%add_column(real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call mfile%add_column(real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call mfile%add_column(real_ptr, 'totE_max') + call mfile%write() + + ! Create CFL monitor + cflfile = monitor(fs%cfg%amRoot, 'cfl') + call cflfile%add_column(time%n, 'Timestep number') + call cflfile%add_column(time%t, 'Time') + call cflfile%add_column(fs%CFL_x, 'CFLx') + call cflfile%add_column(fs%CFL_y, 'CFLy') + call cflfile%add_column(fs%CFL_z, 'CFLz') + call cflfile%write() + + ! Create conservation monitor + consfile = monitor(fs%cfg%amRoot, 'conservation') + call consfile%add_column(time%n, 'Timestep number') + call consfile%add_column(time%t, 'Time') + real_ptr => fs%Uint(1) + call consfile%add_column(real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call consfile%add_column(real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call consfile%add_column(real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call consfile%add_column(real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call consfile%add_column(real_ptr, 'totE_int') + call consfile%write() + + end block create_monitor + + end subroutine simulation_init + + !> do the thing + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt, time%cfl) + call time%adjust_dt() + call time%increment() + + ! take step (Strang) + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + call fs%apply_bcond(time%t, time%dt) + fs%dU(:, :, :, :) = 0.0_WP + call fs%calc_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! Output to ensight + if (ens_evt%occurs()) then + call update_phys_out() + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_range() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + !TODO + ! monitor + ! ensight + ! bcond + ! timetracker + + + end subroutine simulation_final + +end module simulation + diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index e033c87f0..9c3a3a305 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -9,10 +9,10 @@ module ensight_class use partmesh_class, only: partmesh implicit none private - + ! Expose type/constructor/methods public :: ensight - + ! List types type :: scl !< Scalar field type(scl), pointer :: next @@ -37,7 +37,7 @@ module ensight_class character(len=str_medium) :: name type(partmesh), pointer :: ptr end type prt - + !> Ensight object definition as list of pointers to arrays type :: ensight ! An ensight object has a name @@ -60,21 +60,19 @@ module ensight_class procedure :: write_part !< Write out particle mesh file generic :: add_scalar=>add_rscalar,add_iscalar !< Add a new scalar field procedure, private :: add_rscalar !< Add a new real(WP) scalar field - procedure, private :: add_iscalar !< Add a new integer scalar field + procedure, private :: add_iscalar !< Add a new integer scalar field procedure :: add_vector !< Add a new vector field procedure :: add_surface !< Add a new surface mesh procedure :: add_particle !< Add a new particle mesh end type ensight - - + !> Declare ensight constructor interface ensight procedure construct_ensight end interface ensight - - + contains - + !> Constructor for an empty ensight object function construct_ensight(cfg,name) result(self) use messager, only: die @@ -87,25 +85,25 @@ function construct_ensight(cfg,name) result(self) character(len=str_medium) :: line integer :: iunit,ierr,stat logical :: file_is_there,found - + ! Link to config self%cfg=>cfg - + ! Store casename self%name=trim(adjustl(name)) - + ! Start with no time stamps self%ntime=0 - + ! Create directory if (self%cfg%amRoot) then call execute_command_line('mkdir -p ensight') call execute_command_line('mkdir -p ensight/'//trim(self%name)) end if - + ! Write out the geometry call self%write_geom(cfg=self%cfg,name='geometry') - + ! Empty pointer to lists for now self%first_scl=>NULL() self%first_vct=>NULL() @@ -144,17 +142,17 @@ function construct_ensight(cfg,name) result(self) close(iunit) end if end if - + ! Communicate to all processors call MPI_BCAST(self%ntime,1,MPI_INTEGER,0,self%cfg%comm,ierr) if (self%ntime.gt.0) then if (.not.self%cfg%amRoot) allocate(self%time(self%ntime)) call MPI_BCAST(self%time,self%ntime,MPI_REAL_WP,0,self%cfg%comm,ierr) end if - + end function construct_ensight - - + + !> Add a real scalar field for output subroutine add_rscalar(this,name,scalar) implicit none @@ -174,8 +172,8 @@ subroutine add_rscalar(this,name,scalar) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_scl%name)) end subroutine add_rscalar - - + + !> Add an integer scalar field for output subroutine add_iscalar(this,name,scalar) implicit none @@ -195,8 +193,8 @@ subroutine add_iscalar(this,name,scalar) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_scl%name)) end subroutine add_iscalar - - + + !> Add a vector field for output subroutine add_vector(this,name,vectx,vecty,vectz) implicit none @@ -219,8 +217,8 @@ subroutine add_vector(this,name,vectx,vecty,vectz) ! Also create the corresponding directory if (this%cfg%amRoot) call execute_command_line('mkdir -p ensight/'//trim(this%name)//'/'//trim(new_vct%name)) end subroutine add_vector - - + + !> Add a surface mesh for output subroutine add_surface(this,name,surface) implicit none @@ -272,6 +270,7 @@ subroutine write_data(this,time) real(WP), intent(in) :: time character(len=str_medium) :: filename integer :: iunit,ierr,n,i + character(len=8) :: ierr_s integer :: ibuff character(len=80) :: cbuff type(MPI_File) :: ifile @@ -317,7 +316,10 @@ subroutine write_data(this,time) if (this%cfg%amRoot) then ! Open the file open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[ensight write data] Could not open file '//trim(filename)) + if (ierr.ne.0) then + write(ierr_s, "(I4)") ierr + call die('[ensight write data] Could not open file '//trim(filename)//'(error '//ierr_s//')') + end if ! Write the header cbuff=trim(my_scl%name); write(iunit) cbuff cbuff='part' ; write(iunit) cbuff diff --git a/src/grid/iterator_class.f90 b/src/grid/iterator_class.f90 index 988c2ddf8..90a319ddb 100644 --- a/src/grid/iterator_class.f90 +++ b/src/grid/iterator_class.f90 @@ -10,7 +10,7 @@ module iterator_class private ! Expose type/constructor/methods - public :: iterator + public :: iterator, locator_gen_ftype !> itr object definition type :: iterator @@ -32,7 +32,15 @@ module iterator_class contains procedure :: print=>iterator_print !< Output iterator to the screen end type iterator - + + !> iterator generating function type + interface + logical function locator_gen_ftype(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator_gen_ftype + end interface !> Declare single-grid iterator constructor interface iterator @@ -50,14 +58,7 @@ function construct_from_function(pg,name,locator,face) result(self) type(iterator) :: self class(pgrid), target, intent(in) :: pg character(len=*), intent(in) :: name - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_gen_ftype) :: locator character(len=1), optional :: face integer :: i,j,k,cnt integer :: color,key,ierr diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 936b38002..964116cee 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -88,7 +88,7 @@ module pgrid_class procedure, private :: pgrid_isync,pgrid_isync_no !< Commmunicate inner and periodic boundaries for integer procedure, private :: pgrid_rsync,pgrid_rsync_no !< Commmunicate inner and periodic boundaries for real(WP) procedure, private :: pgrid_rsync_array !< Commmunicate inner and periodic boundaries for arrays of real(WP) of the form (:,i,j,k) - procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) + procedure, private :: pgrid_rsync_tensor !< Commmunicate inner and periodic boundaries for tensors of real(WP) of the form (:,:,i,j,k) generic :: syncsum=>pgrid_rsyncsum !< Summation across inner and periodic boundaries - generic procedure, private :: pgrid_rsyncsum !< Summation inner and periodic boundaries for real(WP) procedure :: get_rank !< Function that returns rank of processor that contains provided indices diff --git a/src/hyperbolic/Make.package b/src/hyperbolic/Make.package new file mode 100644 index 000000000..73e3d8da8 --- /dev/null +++ b/src/hyperbolic/Make.package @@ -0,0 +1,5 @@ +f90EXE_sources += hyperbolic_general.f90 muscl_class.f90 advection.f90 euler.f90 +# houssem2d.f90 rusanov_class.f90 + +INCLUDE_LOCATIONS += $(NGA_HOME)/src/hyperbolic +VPATH_LOCATIONS += $(NGA_HOME)/src/hyperbolic diff --git a/src/hyperbolic/advection.f90 b/src/hyperbolic/advection.f90 new file mode 100644 index 000000000..0848f1a90 --- /dev/null +++ b/src/hyperbolic/advection.f90 @@ -0,0 +1,145 @@ + +!> contains necessary functions for using the muscl class (or other general hyperbolic +!> solvers) to solve basic advection problems + +!> Originally written by John P Wakefield in December 2022. + +module hyperbolic_advection + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use hyperbolic, only: eigenvals_ftype, rsolver_ftype, limiter_ftype + use muscl_class, only: muscl + implicit none + + real(WP), parameter :: advec_muscl_cflsafety = 0.99_WP + real(WP), parameter :: advec_muscl_divzero_eps = 1e-12_WP + character(len=str_medium), parameter :: advec_muscl_name = 'MUSCL_CONST_ADVEC' + +contains + + !> factory + function make_advec_muscl(cfg, N, limiter, velocity) result(solver) + implicit none + type(muscl) :: solver + class(config), target, intent(in) :: cfg + integer, intent(in) :: N + integer(1), intent(in) :: limiter + real(WP), dimension(3), intent(in) :: velocity + character(len=str_medium) :: name_actual + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(rsolver_ftype), pointer :: rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr + integer :: i + + name_actual = advec_muscl_name + + evals_x_ptr => advec_evals_x; rsolv_x_ptr => advec_rsolv_x; + evals_y_ptr => advec_evals_y; rsolv_y_ptr => advec_rsolv_y; + evals_z_ptr => advec_evals_z; rsolv_z_ptr => advec_rsolv_z; + + ! build solver + solver = muscl(cfg, name_actual, N, 3, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr, limiter, & + & advec_muscl_divzero_eps, advec_muscl_cflsafety) + + ! set velocity + do i = 1, 3 + solver%params(i,:,:,:) = velocity(i) + end do + + ! set velocity mask + solver%vel_mask_x(:) = .false. + solver%vel_mask_y(:) = .false. + solver%vel_mask_z(:) = .false. + + end function make_advec_muscl + + pure subroutine advec_evals_x(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(1) + + end subroutine advec_evals_x + + pure subroutine advec_evals_y(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(2) + + end subroutine advec_evals_y + + pure subroutine advec_evals_z(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: U + real(WP), dimension(N), intent(out) :: evals + + ! silence unused variable warning + evals(1) = U(1) + + evals(:) = params(3) + + end subroutine advec_evals_z + + pure subroutine advec_rsolv_simple(v, Ul, Ur, rs) + real(WP), intent(in) :: v + real(WP), dimension(:), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + integer :: i + + rs(:,:) = 0.0_WP + rs(:,1) = min(v, 0.0_WP) + rs(:,2) = max(v, 0.0_WP) + rs(:,3) = Ur(:) - Ul(:) + + rs(1:size(Ul,1),5:(size(Ul,1)+4)) = 1.0_WP + + end subroutine + + pure subroutine advec_rsolv_x(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(1) + pr(1)), Ul, Ur, rs) + + end subroutine advec_rsolv_x + + pure subroutine advec_rsolv_y(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(2) + pr(2)), Ul, Ur, rs) + + end subroutine advec_rsolv_y + + pure subroutine advec_rsolv_z(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call advec_rsolv_simple(0.5_WP * (pl(3) + pr(3)), Ul, Ur, rs) + + end subroutine advec_rsolv_z + +end module hyperbolic_advection + diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 new file mode 100644 index 000000000..b281eb923 --- /dev/null +++ b/src/hyperbolic/euler.f90 @@ -0,0 +1,418 @@ + +!> contains necessary functions for using the muscl class (or other general +!> hyperbolic solvers) to solve the Euler equations for an ideal (gamma) gas + +!> Originally written by John P Wakefield in December 2022. + +module hyperbolic_euler + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use hyperbolic, only: VANLEER, eigenvals_ftype, rsolver_ftype, limiter_ftype, flux_ftype + use muscl_class, only: muscl + !use rusanov_class, only: rusanov + implicit none + + real(WP), parameter :: euler_muscl_cflsafety = 0.92_WP + real(WP), parameter :: euler_muscl_divzero_eps = 1e-9_WP + character(len=str_medium), parameter :: euler_muscl_name = 'MUSCL_EULER' + + real(WP), parameter :: DIATOMIC_GAMMA = 1.4_WP + real(WP), dimension(5), parameter :: SOD_PHYS_L = (/ 1.0_WP, 0.0_WP, & + & 0.0_WP, 0.0_WP, 1.0_WP /) + real(WP), dimension(5), parameter :: SOD_PHYS_R = (/ 0.125_WP, 0.0_WP, & + & 0.0_WP, 0.0_WP, 0.1_WP /) + +contains + + !> muscl factory + function make_euler_muscl(cfg, limiter, gma) result(solver) + implicit none + type(muscl) :: solver + class(config), target, intent(in) :: cfg + integer(1), optional, intent(in) :: limiter + real(WP), optional, intent(in) :: gma + integer(1) :: limiter_actual + real(WP) :: gma_actual + character(len=str_medium) :: name_actual + procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + procedure(rsolver_ftype), pointer :: rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr + + if (present(limiter)) then + limiter_actual = limiter + else + limiter_actual = VANLEER + end if + + if (present(gma)) then + gma_actual = gma + else + gma_actual = DIATOMIC_GAMMA + end if + + name_actual = euler_muscl_name + + evals_x_ptr => euler_evals_x; rsolv_x_ptr => euler_rsolv_x; + evals_y_ptr => euler_evals_y; rsolv_y_ptr => euler_rsolv_y; + evals_z_ptr => euler_evals_z; rsolv_z_ptr => euler_rsolv_z; + + ! build solver + solver = muscl(cfg, name_actual, 5, 1, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr, limiter_actual, & + & euler_muscl_divzero_eps, euler_muscl_cflsafety) + + ! set param array to hold gamma + solver%params(1,:,:,:) = gma_actual + + ! set velocity mask + solver%vel_mask_x(:) = (/ .false., .true., .false., .false., .false. /) + solver%vel_mask_y(:) = (/ .false., .false., .true., .false., .false. /) + solver%vel_mask_z(:) = (/ .false., .false., .false., .true., .false. /) + + end function make_euler_muscl + + !> rusanov factory + !function make_euler_rusanov(cfg, gma) result(solver) + ! implicit none + ! type(rusanov) :: solver + ! class(config), target, intent(in) :: cfg + ! real(WP), optional, intent(in) :: gma + ! real(WP) :: gma_actual + ! procedure(eigenvals_ftype), pointer :: evals_x_ptr, evals_y_ptr, evals_z_ptr + ! procedure(flux_ftype), pointer :: flux_x_ptr, flux_y_ptr, flux_z_ptr + + ! if (present(gma)) then + ! gma_actual = gma + ! else + ! gma_actual = DIATOMIC_GAMMA + ! end if + + ! evals_x_ptr => euler_evals_x + ! evals_y_ptr => euler_evals_y + ! evals_z_ptr => euler_evals_z + ! flux_x_ptr => euler_flux_x + ! flux_y_ptr => euler_flux_y + ! flux_z_ptr => euler_flux_z + + ! ! build solver + ! solver = rusanov(cfg, 'EULER_RUSANOV', 5, 1, evals_x_ptr, evals_y_ptr, & + ! & evals_z_ptr, flux_x_ptr, flux_y_ptr, flux_z_ptr) + + ! ! set param array to hold gamma + ! solver%params(1,:,:,:) = gma_actual + + ! ! set velocity mask + ! solver%vel_mask_x(:) = (/ .false., .true., .false., .false., .false. /) + ! solver%vel_mask_y(:) = (/ .false., .false., .true., .false., .false. /) + ! solver%vel_mask_z(:) = (/ .false., .false., .false., .true., .false. /) + + !end function make_euler_rusanov + + !> Convert to Physical Coordinates (velocity and pressure to momentum and energy) + pure subroutine euler_tophys(gma, cons, phys) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: cons + real(WP), dimension(5), intent(out) :: phys + real(WP) :: KE + + phys(1) = cons(1) + phys(2) = cons(2) / cons(1) + phys(3) = cons(3) / cons(1) + phys(4) = cons(4) / cons(1) + KE = 0.5_WP * sum(cons(2:4)**2) / cons(1) + phys(5) = (gma - 1.0_WP) * (cons(5) - KE) + + end subroutine + + !> Convert to Conserved Coordinates (velocity and pressure to momentum and energy) + pure subroutine euler_tocons(gma, phys, cons) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: phys + real(WP), dimension(5), intent(out) :: cons + real(WP) :: KE + + cons(1) = phys(1) + cons(2) = phys(1) * phys(2) + cons(3) = phys(1) * phys(3) + cons(4) = phys(1) * phys(4) + KE = 0.5_WP * phys(1) * sum(phys(2:4)**2) + cons(5) = phys(5) / (gma - 1.0_WP) + KE + + end subroutine + + pure subroutine euler_flux_x(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP) :: pressure + + pressure = (params(1) - 1.0_WP) * (U(3) - 0.5_WP * U(2)**2 / U(1)) + + flux(1) = U(2) + flux(2) = U(2)**2 / U(1) + pressure + flux(3) = U(2) * U(3) / U(1) + flux(4) = U(2) * U(4) / U(1) + flux(5) = U(2) / U(1) * (U(5) + pressure) + + end subroutine euler_flux_x + + pure subroutine euler_flux_y(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP), dimension(5) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(3); u_permute(3) = u(2); + + call euler_flux_x(P, N, params, u_permute, flux) + + end subroutine euler_flux_y + + pure subroutine euler_flux_z(P, N, params, U, flux) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: flux + real(WP), dimension(N) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(4); u_permute(4) = u(2); + + call euler_flux_x(P, N, params, u_permute, flux) + + end subroutine euler_flux_z + + pure subroutine euler_evals_x(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + + call euler_evals_1d(params(1), U, evals) + + end subroutine euler_evals_x + + pure subroutine euler_evals_y(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + real(WP), dimension(5) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(3); u_permute(3) = u(2); + + call euler_evals_1d(params(1), u_permute, evals) + + end subroutine euler_evals_y + + pure subroutine euler_evals_z(P, N, params, U, evals) + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + real(WP), dimension(N) :: u_permute + + u_permute(:) = u(:); u_permute(2) = u(4); u_permute(4) = u(2); + + call euler_evals_1d(params(1), u_permute, evals) + + end subroutine euler_evals_z + + !> eigenvalues + pure subroutine euler_evals_1d(gma, U, lambda) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: U + real(WP), dimension(5), intent(out) :: lambda + real(WP) :: v, p, c, KE + + KE = 0.5_WP * sum(U(2:4)**2) / U(1) + v = U(2) / U(1) + p = (gma - 1) * (U(5) - KE) + c = sqrt(gma * p / U(1)) + + lambda = (/ v - c, v, v, v, v + c /) + + end subroutine euler_evals_1d + + pure subroutine euler_rsolv_x(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Ul, Ur, rs) + + end subroutine euler_rsolv_x + + pure subroutine euler_rsolv_y(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + real(WP), dimension(N) :: Uln, Urn + real(WP), dimension(5) :: rs_row + + Uln(:) = Ul(:); Uln(2) = Ul(3); Uln(3) = Ul(2); + Urn(:) = Ur(:); Urn(2) = Ur(3); Urn(3) = Ur(2); + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Uln, Urn, rs) + + rs_row(:) = rs(2,5:9); rs(2,5:9) = rs(3,5:9); rs(3,5:9) = rs_row(:); + + end subroutine euler_rsolv_y + + pure subroutine euler_rsolv_z(P, N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: Ul, Ur + real(WP), dimension(:,:), intent(out) :: rs + real(WP), dimension(N) :: Uln, Urn + real(WP), dimension(5) :: rs_row + + Uln(:) = Ul(:); Uln(2) = Ul(4); Uln(4) = Ul(2); + Urn(:) = Ur(:); Urn(2) = Ur(4); Urn(4) = Ur(2); + + call euler_rsolv_roe_1d(0.5_WP * (pl(1) + pr(1)), Uln, Urn, rs) + + rs_row(:) = rs(2,5:9); rs(2,5:9) = rs(4,5:9); rs(4,5:9) = rs_row(:); + + end subroutine euler_rsolv_z + + !> Roe Solver + ! see page 354-ish of Toro's book + ! here `Ul' and `Ur' are the whole state, (u, v, w) is the velocity vector + pure subroutine euler_rsolv_roe_1d(gma, Ul, Ur, rs) + implicit none + real(WP), intent(in) :: gma + real(WP), dimension(5), intent(in) :: Ul, Ur + real(WP), dimension(5,9), intent(out) :: rs + real(WP) :: rrhol, rrhor, drho, rho, pl, pr, Hl, Hr, u, v, w, H, a, du5b + + ! Roe averages + rrhol = sqrt(Ul(1)); rrhor = sqrt(Ur(1)); + rho = rrhol * rrhor + pl = (gma - 1.0_WP) * (Ul(5) - 0.5_WP * sum(Ul(2:4)**2) / Ul(1)) + pr = (gma - 1.0_WP) * (Ur(5) - 0.5_WP * sum(Ur(2:4)**2) / Ur(1)) + Hl = (Ul(5) + pl) / Ul(1); Hr = (Ur(5) + pr) / Ur(1); + u = (rrhol * Ul(2) / Ul(1) + rrhor * Ur(2) / Ur(1)) / (rrhol + rrhor) + v = (rrhol * Ul(3) / Ul(1) + rrhor * Ur(3) / Ur(1)) / (rrhol + rrhor) + w = (rrhol * Ul(4) / Ul(1) + rrhor * Ur(4) / Ur(1)) / (rrhol + rrhor) + H = (rrhol * Hl + rrhor * Hr) / (rrhol + rrhor) + a = sqrt((gma - 1.0_WP) * (H - 0.5_WP * (u**2 + v**2 + w**2))) + + ! lambdal and lambdar + rs(1,2) = u - a; rs(2:4,2) = u; rs(5,2) = u + a; + rs(:,1) = min(rs(:,2), 0.0_WP) + rs(:,2) = rs(:,2) - rs(:,1) + + ! α2 + drho = Ur(1) - Ul(1) + du5b = Ur(5) - Ul(5) - (Ur(3) - Ul(3) - v * drho) * v - (Ur(4) - Ul(4) - & + & w * drho) * w + rs(2,3) = (gma - 1.0_WP) / a**2 * ( & + & (Ur(1) - Ul(1)) * (H - u**2) + u * (Ur(2) - Ul(2)) - du5b & + & ) + + ! α1 + rs(1,3) = (drho * (u + a) - (Ur(2) - Ul(2)) - a * rs(2,3)) / (2 * a) + + ! α5 + rs(5,3) = drho - rs(1,3) - rs(2,3) + + ! α3 and α4 + rs(3,3) = Ur(3) - Ul(3) - v * drho + rs(4,3) = Ur(4) - Ul(4) - w * drho + + ! βs + rs(:,4) = 0.0_WP + + ! eigenvectors + rs(1,5) = 1.0_WP; rs(2,5) = u - a; rs(3,5) = v; rs(4,5) = w; rs(5,5) = H - u * a; + rs(1,9) = 1.0_WP; rs(2,9) = u + a; rs(3,9) = v; rs(4,9) = w; rs(5,9) = H + u * a; + rs(1,6) = 1.0_WP; rs(2,6) = u; rs(3,6) = v; rs(4,6) = w; rs(5,6) = 0.5_WP * (u**2 + v**2 + w**2); + rs(1,7) = 0.0_WP; rs(2,7) = 0.0_WP; rs(3,7) = 1.0_WP; rs(4,7) = 0.0_WP; rs(5,7) = v; + rs(1,8) = 0.0_WP; rs(2,8) = 0.0_WP; rs(3,8) = 0.0_WP; rs(4,8) = 1.0_WP; rs(5,8) = w; + + end subroutine euler_rsolv_roe_1d + + !! subroutines for Solving Riemann Problems Exactly + + !> From Toro, returns fK and fKprime + pure subroutine euler_fK(gma, rhoK, pK, cK, p, fK, fKprime) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoK, pK, cK, p + real(WP), intent(out) :: fK, fKprime + real(WP) :: AK, BK + + AK = 2 * ((gma + 1) * rhoK)**(-1); BK = (gma - 1) / (gma + 1) * pK; + if (p > pK) then ! shock + fK = (p - pK) * sqrt(AK / (p + BK)) + fKprime = sqrt(AK / (BK + p)) * (1 - (p - pK) / (2 * (BK + p))) + else ! rarefaction + fK = 2 * cK / (gma - 1) * ((p / pK)**((gma - 1) / (2 * gma)) - 1) + fKprime = (rhoK * cK)**(-1) * (p / pK)**(- (gma + 1) / (2 * gma)) + end if + + end subroutine + + !> returns f and fprime + pure subroutine euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, p, f, fprime) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoL, vL, pL, cL, rhoR, vR, pR, cR, p + real(WP), intent(out) :: f, fprime + real(WP) :: fL, fLp, fR, fRp + + call euler_fK(gma, rhoL, pL, cL, p, fL, fLp) + call euler_fK(gma, rhoR, pR, cR, p, fR, fRp) + + f = fL + fR + vR - vL + fprime = fLp + fRp + + end subroutine + + !> returns pressure and velocity (in that order) of the mid state + pure subroutine euler_findmid(gma, rhoL, vL, pL, rhoR, vR, pR, delta, maxiters, pM, vM) + implicit none + real(WP), intent(in) :: gma + real(WP), intent(in) :: rhoL, vL, pL, rhoR, vR, pR, delta + integer, intent(in) :: maxiters + real(WP), intent(out) :: pM, vM + real(WP) :: z, f, fp, cL, cR, fL, fLp, fR, fRp + integer(WP) :: n + + cL = sqrt(gma * pL / rhoL); cR = sqrt(gma * pR / rhoR); + + ! start with two rarefaction solution + z = (gma - 1) / (2 * gma) + pM = ((cL + cR - 0.5_WP * (gma - 1) * (vR - vL)) / (cL / pL**z + cR / & + & pR**z))**(z**(-1)) + + ! do rootfinding + call euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, pM, f, fp) + n = 0 + do while (abs(f) < delta .and. n < maxiters) + pM = pM - f / fp + call euler_f(gma, rhoL, vL, pL, cL, rhoR, vR, pR, cR, pM, f, fp) + n = n + 1 + end do + + call euler_fK(gma, rhoL, pL, cL, pM, fL, fLp) + call euler_fK(gma, rhoR, pR, cR, pM, fR, fRp) + vM = 0.5_WP * (vL + vR + fR - fL) + + end subroutine + +end module hyperbolic_euler + diff --git a/src/hyperbolic/hyperbolic_general.f90 b/src/hyperbolic/hyperbolic_general.f90 new file mode 100644 index 000000000..da784a3de --- /dev/null +++ b/src/hyperbolic/hyperbolic_general.f90 @@ -0,0 +1,147 @@ + +!> module containing definitions relevant to a wide range of hyperbolic +!> solvers, e.g. function type definitions and limiter definitions + +!> Originally written by John P Wakefield in Feb 2023. + +module hyperbolic + use precision, only: WP + implicit none + public + + !> limiter names + integer(1), parameter, public :: UPWIND = 0_1 + integer(1), parameter, public :: LAXWEND = 1_1 + integer(1), parameter, public :: BEAMWARM = 2_1 + integer(1), parameter, public :: FROMM = 3_1 + integer(1), parameter, public :: MINMOD = 4_1 + integer(1), parameter, public :: SUPERBEE = 5_1 + integer(1), parameter, public :: MC = 6_1 + integer(1), parameter, public :: VANLEER = 7_1 + + !> function types + interface + + pure subroutine eigenvals_ftype(P, N, params, u, evals) + use precision, only: WP + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + end subroutine + + pure subroutine rsolver_ftype(P, N, pl, ul, pr, ur, rs) + use precision, only: WP + implicit none + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: ul, ur + real(WP), dimension(:,:), intent(out) :: rs + end subroutine + + pure subroutine flux_ftype(P, N, params, u, f) + use precision, only: WP + integer, intent(in) :: P, N + real(WP), dimension(P), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: f + end subroutine + + pure function limiter_ftype(r) result(phi) + use precision, only: WP + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + end function + + end interface + +contains + + !! limiter lookup function + function get_limiter(i) result(lim) + use messager, only: die + implicit none + integer(1), intent(in) :: i + procedure(limiter_ftype), pointer :: lim + + lim => NULL() + + select case (i) + case (UPWIND) + lim => limiter_upwind + case (LAXWEND) + lim => limiter_laxwend + case (BEAMWARM) + lim => limiter_beamwarm + case (FROMM) + lim => limiter_fromm + case (MINMOD) + lim => limiter_minmod + case (SUPERBEE) + lim => limiter_superbee + case (MC) + lim => limiter_mc + case (VANLEER) + lim => limiter_vanleer + case default + call die("could not find limiter") + end select + + end function get_limiter + + !! limiter definitions + pure function limiter_upwind(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + phi = 0.0 + end function + pure function limiter_laxwend(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + phi = 1.0 + end function + pure function limiter_beamwarm(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = r + end function + pure function limiter_fromm(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = 0.5_WP * (r + 1.0_WP) + end function + pure function limiter_minmod(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min(1.0_WP, r)) + end function + pure function limiter_superbee(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min(1.0_WP, 2.0_WP * r), min(2.0_WP, r)) + end function + pure function limiter_mc(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = max(0.0_WP, min((1.0_WP + r) / 2.0_WP, 2.0_WP, 2.0_WP * r)) + end function + pure function limiter_vanleer(r) result(phi) + implicit none + real(WP), intent(in) :: r + real(WP) :: phi + phi = (r + abs(r)) / (1.0_WP + abs(r)) + end function + +end module hyperbolic + diff --git a/src/hyperbolic/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 new file mode 100644 index 000000000..7797c235a --- /dev/null +++ b/src/hyperbolic/muscl_class.f90 @@ -0,0 +1,932 @@ +!> MUSCL-type solver class +!> Provides support for various BC, generic hyperbolic structures +!> +!> Originally written by John P Wakefield in December 2022. +!> +!> When possible, helper functions immediately follow the class function that +!> calls them. +!> +module muscl_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use iterator_class, only: iterator + use hyperbolic, only: limiter_ftype, eigenvals_ftype, rsolver_ftype, get_limiter + implicit none + private + + ! expose type/constructor/methods + public :: muscl, muscl_bc + + ! List of known available bcond types for this solver + ! here 'right' means bcond direction +1 + ! bits 1 and 2 - 00 nothing, 10 interpolate, 11 reflect + ! bits 3 and 4 - 00 nothing, 01 zero normal velocity + ! bit 5 - right moving waves, 0 leave, 1 zero + ! bit 6 - left moving waves, 0 leave, 1 zero + integer(1), parameter, public :: WALL_REFLECT = 7_1 !< reflecting wall + integer(1), parameter, public :: WALL_ABSORB = 39_1 !< absorbing wall + integer(1), parameter, public :: NO_WAVES = 34_1 !< outflow/free condition condition + + ! riemann solutions for an N dimensional system are stored in N by N+4 + ! dimensional arrays, in which + ! rs(:, 1) left-going eigenvalues + ! rs(:, 2) right-going eigenvalues + ! rs(:, 3) wave strengths + ! rs(:, 4) (projected) source strengths (only a good idea in 1d; commented below) + ! rs(:, 5:(N+4)) (linearized) eigenvectors + + !> boundary conditions for the hyperbolic solver + type :: muscl_bc + type(muscl_bc), pointer :: next !< linked list of bconds + character(len=str_medium) :: name = 'UNNAMED_BC' !< bcond name (default UNNAMED_BCOND) + integer(1) :: type !< bcond type + type(iterator) :: itr !< this is the iterator for the bcond + integer(1) :: dir !< bcond direction 0-6 + end type muscl_bc + + !> solver object definition + type :: muscl + + ! config / pgrid object + class(config), pointer :: cfg !< config / pgrid information + + ! name + character(len=str_medium) :: name = 'MUSCL' !< solver name + + ! system information + integer :: N !< system dimension + integer :: P !< number of parameters + procedure(eigenvals_ftype), pointer, nopass :: evals_x, evals_y, evals_z + procedure(rsolver_ftype), pointer, nopass :: rsolv_x, rsolv_y, rsolv_z + logical, dimension(:), allocatable :: vel_mask_x, vel_mask_y, vel_mask_z + + ! limiting + procedure(limiter_ftype), pointer, nopass :: limiter!< limiter function + real(WP) :: upratio_divzero_eps !< softening epsilon for upwind ratio + + ! boundary condition list + integer :: nbc !< number of bcond for our solver + type(muscl_bc), pointer :: first_bc !< list of bcond for our solver + + ! flow variables, parameter arrays + real(WP), dimension(:,:,:,:), pointer :: Uc, dU !< state variables + real(WP), dimension(:,:,:,:), pointer :: params !< params for evals/rsolver + + !TODO get this working + ! transsonic flags + !integer(1), dimension(:,:,:), allocatable :: trans !< bitwise entropy violation check xyz + !integer :: trans_total + !logical :: have_trans_flags + + ! wave bcs + ! first 6 bits used, same convention as type, xxyyzz + integer(1), dimension(:,:,:), allocatable :: wavebcs + + ! CFL numbers + real(WP) :: CFL_x, CFL_y, CFL_z !< global CFL numbers (over dt) + real(WP) :: CFL_safety !< CFL modifier when using cached value + logical :: have_CFL_x_estim, have_CFL_y_estim, have_CFL_z_estim + logical :: have_CFL_x_exact, have_CFL_y_exact, have_CFL_z_exact + + ! monitoring quantities + real(WP), dimension(:), pointer :: Umin, Umax !< state variable range + real(WP), dimension(:), pointer :: Uint !< integral of state vars over domain + logical :: have_Urange + + contains + + ! standard interface + procedure :: print => muscl_print !< output solver to the screen + procedure :: add_bcond !< add a boundary condition + procedure :: get_bcond !< get a boundary condition + procedure :: apply_bcond !< apply all boundary conditions + procedure :: get_cfl !< get maximum CFL + procedure :: get_range !< calculate min/max field values + procedure :: get_min => get_range !< compatibility + procedure :: get_max => get_range !< compatibility + !procedure :: get_mfr !< mfr at ea bcond in last step + procedure :: calc_dU_x, calc_dU_y, calc_dU_z !< take step + + ! muscl specific + !TODO get this working + !procedure :: check_transonic !< check for transonic waves + procedure :: recalc_cfl !< calculate maximum CFL + + end type muscl + + !> declare constructors + interface muscl; procedure constructor; end interface + +contains + + !! standard interface class functions + + !> default constructor for MUSCL-type flow solver + function constructor(cfg, name, N, P, evals_x, evals_y, evals_z, rsolv_x, & + & rsolv_y, rsolv_z, lim, upratio_divzero_eps, CFL_safety) result(this) + use messager, only: die + implicit none + type(muscl) :: this + class(config), target, intent(in) :: cfg + character(len=*), intent(in), optional :: name + integer, intent(in) :: N, P + procedure(eigenvals_ftype), pointer, intent(in) :: evals_x, evals_y, evals_z + procedure(rsolver_ftype), pointer, intent(in) :: rsolv_x, rsolv_y, rsolv_z + integer(1), intent(in) :: lim + real(WP), intent(in) :: upratio_divzero_eps, CFL_safety + integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo, minmino, maxmaxo + + ! check number of ghost cells + if (cfg%no .lt. 2) call die("must have at least two ghost cells") + + ! point to pgrid object + this%cfg => cfg + + ! set the name for the solver + if (present(name)) this%name = trim(adjustl(name)) + + ! system information + this%N = N; this%P = P; + this%evals_x => evals_x; this%evals_y => evals_y; this%evals_z => evals_z; + this%rsolv_x => rsolv_x; this%rsolv_y => rsolv_y; this%rsolv_z => rsolv_z; + + ! limiting + this%limiter => get_limiter(lim) + this%upratio_divzero_eps = upratio_divzero_eps + + ! initialize boundary condition list + this%nbc = 0; this%first_bc => NULL(); + + ! get array sizes + imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; + jmino = this%cfg%jmino_; jmaxo = this%cfg%jmaxo_; + kmino = this%cfg%kmino_; kmaxo = this%cfg%kmaxo_; + minmino = min(imino, jmino, kmino); maxmaxo = max(imaxo, jmaxo, kmaxo) + + ! allocate flow variables and parameter arrays + allocate(this%params(P,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%Uc(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + allocate(this%dU(N,imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + + ! allocate transsonic flags, initialize values + !allocate(this%trans(imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + !this%have_trans_flags = .false. + + ! allocate velocity masks + allocate(this%vel_mask_x(N), this%vel_mask_y(N), this%vel_mask_z(N)) + + ! wave bcs flags + allocate(this%wavebcs(imino:imaxo,jmino:jmaxo,kmino:kmaxo)) + this%wavebcs(:,:,:) = 0_1 + + ! initialize CFL computations + this%CFL_safety = CFL_safety + this%have_CFL_x_estim = .false.; this%have_CFL_x_exact = .false.; + this%have_CFL_y_estim = .false.; this%have_CFL_y_exact = .false.; + this%have_CFL_z_estim = .false.; this%have_CFL_z_exact = .false.; + + ! initialize monitoring + allocate(this%Umin(N), this%Umax(N), this%Uint(N)) + this%have_Urange = .false. + + end function + + !> solver print function + subroutine muscl_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(muscl), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("MUSCL-type solver [",a,"] for config [",a,"]")') & + & trim(this%name), trim(this%cfg%name) + end if + + end subroutine + + !> Add a boundary condition + subroutine add_bcond(this, name, type, locator, dir) + use iterator_class, only: locator_gen_ftype + use string, only: lowercase + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + character(len=*), intent(in) :: name + integer(1), intent(in) :: type + procedure(locator_gen_ftype) :: locator + character(len=2), intent(in) :: dir + type(muscl_bc), pointer :: new_bc + integer :: i, j, k, n + integer(1) :: wbc + + ! prepare new bcond + allocate(new_bc) + new_bc%name = trim(adjustl(name)) + new_bc%type = type + new_bc%itr = iterator(pg=this%cfg, name=new_bc%name, locator=locator) + select case (lowercase(dir)) + case ('c'); new_bc%dir = 0_1 + case ('-x', 'x-', 'xl'); new_bc%dir = 2_1 + case ('+x', 'x+', 'xr'); new_bc%dir = 1_1 + case ('-y', 'y-', 'yl'); new_bc%dir = 4_1 + case ('+y', 'y+', 'yr'); new_bc%dir = 3_1 + case ('-z', 'z-', 'zl'); new_bc%dir = 6_1 + case ('+z', 'z+', 'zr'); new_bc%dir = 5_1 + case default; call die('[MUSCL add_bcond] unknown bcond direction') + end select + + ! insert it in front + new_bc%next => this%first_bc + this%first_bc => new_bc + this%nbc = this%nbc + 1 + + ! update wave zeroing array + wbc = ishft(iand(type, 96_1), -4_1) + if (mod(new_bc%dir, 2_1) .eq. 0_1 .and. new_bc%dir .ne. 0_1) then + select case (wbc) + case (0_1); wbc = 0_1 + case (1_1); wbc = 2_1 + case (2_1); wbc = 1_1 + case default; call die("assertion error") + end select + end if + wbc = ishft(wbc, 2 * ((new_bc%dir - 1_1) / 2_1)) + do n = 1, new_bc%itr%n_ + i = new_bc%itr%map(1,n) + j = new_bc%itr%map(2,n) + k = new_bc%itr%map(3,n) + this%wavebcs(i,j,k) = this%wavebcs(i,j,k) + wbc + end do + + end subroutine add_bcond + + !> get a boundary condition + subroutine get_bcond(this, name, my_bc) + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + character(len=*), intent(in) :: name + type(muscl_bc), pointer, intent(out) :: my_bc + + my_bc => this%first_bc + do while (associated(my_bc)) + if (trim(my_bc%name) .eq. trim(name)) return + my_bc => my_bc%next + end do + + call die('[muscl get_bcond] Boundary condition was not found') + + end subroutine get_bcond + + !> enforce boundary condition + !> note that this interpolates (ensuring ghost cells have the right value), + !> but all wave-related constraints are imposed during the step + subroutine apply_bcond(this, t, dt) + use messager, only: die + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: t, dt + integer(1) :: masked_type + logical, dimension(this%N) :: vel_mask + integer :: i, j, k, m, n, iref, jref, kref + type(muscl_bc), pointer :: my_bc + + ! Traverse bcond list + my_bc => this%first_bc + do while (associated(my_bc)) + + ! Only processes inside the bcond work here + if (my_bc%itr%amIn) then + + ! Select appropriate action based on the bcond type + masked_type = iand(my_bc%type, 3_1) + select case (masked_type) + case (0_1) !< do nothing + case (2_1) !< interpolate + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + this%Uc(:,i,j,k) = this%Uc(:,iref,jref,kref) + end do + case (3_1) !< reflect + do m = 1, my_bc%itr%no_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + iref = min(this%cfg%imax, max(this%cfg%imin, i)) + jref = min(this%cfg%jmax, max(this%cfg%jmin, j)) + kref = min(this%cfg%kmax, max(this%cfg%kmin, k)) + if (i .ne. iref) then + if (i .lt. iref) then + iref = i + 2 * (iref - i) - 1 + else + iref = i - 2 * (i - iref) + 1 + end if + vel_mask(:) = this%vel_mask_x(:) + end if + if (j .ne. jref) then + if (j .lt. jref) then + jref = j + 2 * (jref - j) - 1 + else + jref = j - 2 * (j - jref) + 1 + end if + vel_mask(:) = this%vel_mask_y(:) + end if + if (k .ne. kref) then + if (k .lt. kref) then + kref = k + 2 * (kref - k) - 1 + else + kref = k - 2 * (k - kref) + 1 + end if + vel_mask(:) = this%vel_mask_z(:) + end if + do n = 1, this%N + if (vel_mask(n)) then + this%Uc(n,i,j,k) = - this%Uc(n,iref,jref,kref) + else + this%Uc(n,i,j,k) = + this%Uc(n,iref,jref,kref) + end if + end do + end do + case (1_1) + call die('[muscl apply_bcond] Unknown bcond type') + case default + call die('[muscl apply_bcond] Unknown bcond type') + end select + + ! zero normal velocity? + masked_type = iand(my_bc%type, 4_1) + if (masked_type .eq. 4_1) then + select case (my_bc%dir) + case (0_1) + vel_mask(:) = this%vel_mask_x(:) .and. this%vel_mask_y(:) .and. & + & this%vel_mask_z(:) + case (1_1, 2_1) + vel_mask(:) = this%vel_mask_x(:) + case (3_1, 4_1) + vel_mask(:) = this%vel_mask_y(:) + case (5_1, 6_1) + vel_mask(:) = this%vel_mask_z(:) + end select + do m = 1, my_bc%itr%n_ + i = my_bc%itr%map(1,m) + j = my_bc%itr%map(2,m) + k = my_bc%itr%map(3,m) + do n = 1, this%N + if (vel_mask(n)) this%Uc(n,i,j,k) = 0.0_WP + end do + end do + end if + end if + + ! Sync full fields after each bcond - this should be optimized + call this%cfg%sync(this%Uc) + call this%cfg%sync(this%dU) + + ! Move on to the next bcond + my_bc => my_bc%next + + end do + + end subroutine apply_bcond + + !> get CFL number + subroutine get_cfl(this, dt, cfl) + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + logical :: have_CFL_estim, have_CFL_exact + + have_CFL_estim = this%have_CFL_x_estim .and. this%have_CFL_y_estim .and. & + & this%have_CFL_z_estim + + have_CFL_exact = this%have_CFL_x_exact .and. this%have_CFL_y_exact .and. & + this%have_CFL_z_exact + + if (.not. have_CFL_estim) call this%recalc_cfl() + + cfl = dt * max(this%CFL_x, this%CFL_y, this%CFL_z) + + if (.not. have_CFL_exact) cfl = this%CFL_safety * cfl + + end subroutine get_cfl + + !> get min/max field values + subroutine get_range(this) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MIN, MPI_MAX, MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), dimension(this%N) :: task_Umin, task_Umax, task_Uint + integer :: i, j, k, ierr + + if (.not. this%have_Urange) then + + task_Umin(:) = + huge(1.0_WP) + task_Umax(:) = - huge(1.0_WP) + task_Uint(:) = 0.0_WP + + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + task_Umin = min(task_Umin, this%Uc(:,i,j,k)) + task_Umax = max(task_Umax, this%Uc(:,i,j,k)) + task_Uint = task_Uint + this%Uc(:,i,j,k) * this%cfg%dx(i) * & + & this%cfg%dy(j) * this%cfg%dz(k) + end do + end do + end do + + call MPI_ALLREDUCE(task_Umin, this%Umin, this%N, MPI_REAL_WP, MPI_MIN, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umin") + call MPI_ALLREDUCE(task_Umax, this%Umax, this%N, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Umax") + call MPI_ALLREDUCE(task_Uint, this%Uint, this%N, MPI_REAL_WP, MPI_SUM, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing Uint") + + this%have_Urange = .true. + + end if + + end subroutine get_range + + !> compute dU in x direction + subroutine calc_dU_x(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, ierr + integer(1), dimension(:), allocatable :: bc1d + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; M = size(this%Uc, 2); cfl = 0.0_WP; + + allocate(bc1d(this%cfg%imino_:this%cfg%imaxo_)) + + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + bc1d(:) = this%wavebcs(:,j,k) + do i = this%cfg%imino_, this%cfg%imaxo_ + bc1d(i) = iand(this%wavebcs(i,j,k), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_x, this%cfg%dx, bc1d, dt, & + & this%params(:,:,j,k), this%Uc(:,:,j,k), this%dU(:,:,j,k), cfl) + end do + end do + + deallocate(bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_x, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_x_estim = .true.; this%have_CFL_x_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_x + + !> compute dU in y direction + subroutine calc_dU_y(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, jmino_, jmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + if (this%cfg%ny .lt. 2) return + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; cfl = 0.0_WP; + jmino_ = this%cfg%jmino_; jmaxo_ = this%cfg%jmaxo_; + + allocate(U1d(N,jmino_:jmaxo_), p1d(P,jmino_:jmaxo_)) + allocate(dU1d(N,jmino_:jmaxo_), bc1d(jmino_:jmaxo_)) + + M = size(U1d, 2); + do k = this%cfg%kmin_, this%cfg%kmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d = this%Uc(:,i,jmino_:jmaxo_,k) + dU1d = this%dU(:,i,jmino_:jmaxo_,k) + p1d = this%params(:,i,jmino_:jmaxo_,k) + do j = jmino_, jmaxo_ + bc1d(j) = iand(ishft(this%wavebcs(i,j,k), -2), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_y, this%cfg%dy, bc1d, dt, p1d, U1d, dU1d, cfl) + this%dU(:,i,jmino_:jmaxo_,k) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d, bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_y, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_y_estim = .true.; this%have_CFL_y_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_y + + !> compute dU in z direction + subroutine calc_dU_z(this, dt) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: cfl + integer :: N, P, M, i, j, k, kmino_, kmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + if (this%cfg%nz .lt. 2) return + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; cfl = 0.0_WP; + kmino_ = this%cfg%kmino_; kmaxo_ = this%cfg%kmaxo_; + + allocate(U1d(N,kmino_:kmaxo_), p1d(P,kmino_:kmaxo_)) + allocate(dU1d(N,kmino_:kmaxo_), bc1d(kmino_:kmaxo_)) + + M = size(U1d, 2); + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + U1d = this%Uc(:,i,j,kmino_:kmaxo_) + dU1d = this%dU(:,i,j,kmino_:kmaxo_) + p1d = this%params(:,i,j,kmino_:kmaxo_) + bc1d = this%wavebcs(i,j,kmino_:kmaxo_) + do k = kmino_, kmaxo_ + bc1d(k) = iand(ishft(this%wavebcs(i,j,k), -4), 3_1) + end do + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_z, this%cfg%dz, bc1d, dt, p1d, U1d, dU1d, cfl) + this%dU(:,i,j,kmino_:kmaxo_) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d, bc1d) + + call this%cfg%sync(this%dU) + + call MPI_ALLREDUCE(cfl, this%CFL_z, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierr) + if (ierr .ne. 0) call die("error reducing CFL") + + this%have_CFL_z_estim = .true.; this%have_CFL_z_exact = .false.; + this%have_Urange = .false. + + end subroutine calc_dU_z + + ! requires two ghost cells even if using the `upwind' limiter + ! left as an independent function, but called is by class + pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & + & params, U, dU, CFLmax) + implicit none + integer, intent(in) :: N, P, M + procedure(limiter_ftype), pointer, intent(in) :: limfun + real(WP), intent(in) :: eps + procedure(rsolver_ftype), pointer, intent(in) :: rsolver + real(WP), dimension(M), intent(in) :: dxs ! size M + integer(1), dimension(:), intent(in) :: wbcs ! size MI + real(WP), intent(in) :: dt + real(WP), dimension(P,M), intent(in) :: params ! size (P, M) + real(WP), dimension(N,M), intent(in) :: U ! size (N, M) + real(WP), dimension(N,M), intent(inout) :: dU ! size (N, M) + real(WP), intent(inout) :: CFLmax + real(WP), dimension(N,N+4) :: ll, lc, rc, rr ! size (N, N+4) + real(WP), dimension(N) :: phil, phir + integer :: j + + call rsolver(P, N, params(:,1), U(:,1), params(:,2), U(:,2), ll) + call rsolver(P, N, params(:,2), U(:,2), params(:,3), U(:,3), lc) + call rsolver(P, N, params(:,3), U(:,3), params(:,4), U(:,4), rc) + + call handle_wavebc(wbcs(1), ll) + call handle_wavebc(wbcs(2), lc) + call handle_wavebc(wbcs(3), rc) + + CFLmax = max(CFLmax, maxval(abs(ll(:,1:2))) / min(dxs(1), dxs(2))) + CFLmax = max(CFLmax, maxval(abs(lc(:,1:2))) / min(dxs(2), dxs(3))) + CFLmax = max(CFLmax, maxval(abs(rc(:,1:2))) / min(dxs(3), dxs(4))) + + call compute_limval(N, limfun, eps, ll, lc, rc, phil) + + do j = 3, M-2 + call rsolver(P, N, params(:,j+1), U(:,j+1), params(:,j+2), U(:,j+2), rr) + call handle_wavebc(wbcs(j+1), rr) + call compute_limval(N, limfun, eps, lc, rc, rr, phir) + CFLmax = max(CFLmax, maxval(abs(rr(:,1:2))) / min(dxs(j+1), dxs(j+2))) + call wavestep_firstorder_single(N, dxs(j), dt, lc, rc, dU(:,j)) + call wavestep_limitedcorrection_single(N, dxs(j), dt, lc, rc, & + & phil, phir, dU(:, j)) + ll(:, :) = lc(:, :) + lc(:, :) = rc(:, :) + rc(:, :) = rr(:, :) + phil = phir + end do + + end subroutine wavestep_1d + + pure subroutine handle_wavebc(bc, rs) + implicit none + integer(1), intent(in) :: bc + real(WP), dimension(:,:), intent(inout) :: rs + integer :: N + + N = size(rs, 1) + + ! zero negative waves? + if (iand(bc, 1_1) .eq. 1_1) rs(:, 3:4) = max(rs(:, 3:4), 0.0_WP) + + ! zero positive waves? + if (iand(bc, 2_1) .eq. 2_1) rs(:, 3:4) = min(rs(:, 3:4), 0.0_WP) + + end subroutine handle_wavebc + + ! this is called by the class, but is left as an independent function + pure subroutine compute_limval(N, limfun, eps, l_rs, c_rs, r_rs, limvals) + implicit none + procedure(limiter_ftype), pointer, intent(in) :: limfun + real(WP), intent(in) :: eps + integer, intent(in) :: N + real(WP), dimension(:,:), intent(in) :: l_rs, c_rs, r_rs + real(WP), dimension(:), intent(out) :: limvals + real(WP) :: r + integer :: p + + do p = 1,N + !TODO replace this with eigenvector projections + r = c_rs(p, 1) + c_rs(p, 2) + if (r .gt. 0.0_WP) then + r = l_rs(p, 3) * c_rs(p, 3) / (c_rs(p, 3) * c_rs(p, 3) + eps) + else + r = r_rs(p, 3) * c_rs(p, 3) / (c_rs(p, 3) * c_rs(p, 3) + eps) + end if + limvals(p) = limfun(r) + end do + + end subroutine compute_limval + + ! standard Roe/MUSCL/Leveque style wave step with limiters + ! the step has been split up to improve performance + ! this function has been made painful to look at in the interest of speed in + ! the julia implementation, then it stayed that way because I didn't want to + ! rewrite it + ! this is called by the class, but is left as an independent function + pure subroutine wavestep_firstorder_single(N, dx, k, lc_rs, rc_rs, dU) + implicit none + integer, intent(in) :: N + real(WP), intent(in) :: dx, k + real(WP), dimension(N,N+4), intent(in) :: lc_rs, rc_rs + real(WP), dimension(N), intent(inout) :: dU + real(WP), dimension(N) :: tmp1, tmp2 + + ! waves from left + tmp1 = lc_rs(:, 2) * lc_rs(:, 3) + !l_dxbeta : block + ! integer :: j + ! tmp2 = lc_rs(:, 1) + lc_rs(:, 2) + ! ! this probably isn't necessary for anything physical + ! do j = 1, N + ! if (tmp2(j) .eq. 0.0_WP) then + ! tmp2(j) = 0.5_WP + ! else if (tmp2(j) .gt. 0.0_WP) then + ! tmp2(j) = 1.0_WP + ! else + ! tmp2(j) = 0.0_WP + ! end if + ! end do + ! tmp2 = tmp2 * lc_rs(:, 4) + ! tmp2 = dx * tmp2 + !end block l_dxbeta + !tmp1 = tmp1 - tmp2 + tmp2 = matmul(lc_rs(:, 5:(N+4)), tmp1) + tmp2 = k / dx * tmp2 + dU = dU - tmp2 + + ! waves from right + tmp1 = rc_rs(:, 1) * rc_rs(:, 3) + !r_dxbeta : block + ! integer :: j + ! tmp2 = rc_rs(:, 1) + rc_rs(:, 2) + ! do j = 1, N + ! if (tmp2(j) .eq. 0.0_WP) then + ! tmp2(j) = 0.5_WP + ! else if (tmp2(j) .lt. 0.0_WP) then + ! tmp2(j) = 1.0_WP + ! else + ! tmp2(j) = 0.0_WP + ! end if + ! end do + ! tmp2 = tmp2 * rc_rs(:, 4) + ! tmp2 = dx * tmp2 + !end block r_dxbeta + !tmp1 = tmp1 - tmp2 + tmp2 = matmul(rc_rs(:, 5:(N+4)), tmp1) + tmp2 = k / dx * tmp2 + dU = dU - tmp2 + + end subroutine wavestep_firstorder_single + + ! this is called by the class, but is left as an independent function + pure subroutine wavestep_limitedcorrection_single(N, dx, k, lc_rs, & + & rc_rs, phil, phir, dU) + implicit none + integer, intent(in) :: N + real(WP), intent(in) :: dx, k + real(WP), dimension(:,:), intent(in) :: lc_rs, rc_rs + real(WP), dimension(:), intent(in) :: phil, phir + real(WP), dimension(:), intent(inout) :: dU + real(WP), dimension(N) :: tmp1, tmp2 + + tmp1 = (1.0_WP - k / dx * (rc_rs(:,2) - rc_rs(:,1))) + tmp1 = tmp1 * (rc_rs(:,2) - rc_rs(:,1)) * rc_rs(:, 3) * phir(:) + tmp2 = matmul(rc_rs(:, 5:(N+4)), tmp1) + tmp2 = - 0.5_WP * k / dx * tmp2 + dU = dU + tmp2 + + tmp1 = (1.0_WP - k / dx * (lc_rs(:,2) - lc_rs(:,1))) + tmp1 = tmp1 * (lc_rs(:,2) - lc_rs(:,1)) * lc_rs(:, 3) * phil(:) + tmp2 = matmul(lc_rs(:, 5:(N+4)), tmp1) + tmp2 = 0.5_WP * k / dx * tmp2 + dU = dU + tmp2 + + end subroutine + + !! muscl-specific class functions + + !> check for transsonic rarefaction waves + !TODO +! pure subroutine check_transonic(this) +! implicit none +! class(muscl), intent(inout) :: this +! real(WP) :: dim_CFL +! real(WP), dimension(N) :: evals_l, evals_r +! integer :: imin, imax, jmin, jmax, kmin, kmax +! integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo + +! this%trans_flags(:,:,:) = 0 +! this%trans_total = 0 + +! imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; +! jmino = this%cfg%jmino_; jmaxo = this%cfg%jmaxo_; +! kmino = this%cfg%kmino_; kmaxo = this%cfg%kmaxo_; +! imin = this%cfg%imin_; imax = this%cfg%imax_; +! jmin = this%cfg%jmin_; jmax = this%cfg%jmax_; +! kmin = this%cfg%kmin_; kmax = this%cfg%kmax_; + +! dim_CFL = 0.0_WP +! do k=this%cfg%kmin_,this%cfg%kmax_ +! do j=this%cfg%jmin_,this%cfg%jmax_ +! call check_transsonic_1d(this%evals_x, 1, this%params(:,imino:imaxo,j,k), & +! &this%Uc(:,imino:imaxo,j,k), flags(imino:imaxo-1,j,k), this%trans_total, & +! &dim_CFL) +! end do +! end do + +! this%loc_CFL_x = dim_CFL + +! dim_CFL = 0.0_WP +! do k = this%cfg%kmin_, this%cfg%kmax_ +! do i = this%cfg%imin_, this%cfg%imax_ +! this%Ucache1(:,jmino:jmaxo) = this%Uc(:,i,jmino:jmaxo,:) +! this%pcache(:,jmino:jmaxo) = this%params(:,i,jmino:jmaxo,:) +! this%tcache(:) = 0 +! call check_transsonic_1d(this%evals_y, 2, this%pcache(:,jmino:jmaxo), & +! &this%Ucache1(:,jmino:jmaxo), this%tcache(jmino:jmaxo-1), & +! &this%trans_total, dim_CFL) +! flags(i,jmin:jmax-1) = flags(i,jmin:jmax-1) + this%tcache(jmin:jmax-1) +! end do +! end do + +! this%loc_CFL_y = dim_CFL + +! dim_CFL = 0.0_WP +! do j = this%cfg%jmin_, this%cfg%jmax_ +! do i = this%cfg%imin_, this%cfg%imax_ +! this%Ucache1(:,kmino:kmaxo) = this%Uc(:,i,:,kmino:kmaxo) +! this%pcache(:,kmino:kmaxo) = this%params(:,i,:,kmino:kmaxo) +! this%tcache(:) = 0 +! call check_transsonic_1d(this%evals_z, 4, this%pcache(:,kmino:kmaxo), & +! &this%Ucache1(:,kmino:kmaxo), this%tcache(kmino:kmaxo-1), & +! &this%trans_total, dim_CFL) +! flags(i,kmin:kmax-1) = flags(i,kmin:kmax-1) + this%tcache(kmin:kmax-1) +! end do +! end do + +! this%loc_CFL_z = dim_CFL + +! this%have_trans_flags = .true. +! this%have_CFL_estim = .true. +! this%have_CFL_exact = .true. +! this%CFL_reduced = .false. + +! end subroutine check_transsonic + + ! called by class, but kept as independent function +! pure subroutine check_transsonic_1d(evalf, flaginc, dxs, params, U, flags, total, CFL) +! procedure(eigenvals_ftype), intent(in) :: evalf +! integer(1), intent(in) :: flaginc +! integer, intent(in) :: P, N, M, MI +! integer, intent(in) :: M2, M3 +! real(WP), dimension(M), intent(in) :: dxs +! real(WP), dimension(P,M2), intent(in) :: params +! real(WP), dimension(N,M3), intent(in) :: U +! integer(1), dimension(MI), intent(inout) :: flags +! integer, intent(inout) :: total +! real(WP), intent(inout) :: CFL +! real(WP), dimension(N) :: evals +! logical, dimension(N) :: gtzl, gtzr +! integer :: i + +! call evalf(U(:,1), params(:,1), evals) +! do i = 1, N; gtzr(i) = evals(i) .gt. 0.0_WP; end do + +! do i = 2, M +! CFL = max(CFL, maxval(abs(dxs(i) * evals))) +! gtzl(:) = gtzr(:) +! call evalf(U(:,1), params(:,1), evals) +! gtzr(:) = evals(:) .gt. 0.0_WP +! if (any((.not. gtzl) .and. gtzr)) then +! flags(i-1) = flags(i-1) + flaginc +! total = total + 1 +! end if +! end do + +! end subroutine check_transsonic_1d + + !> calculate CFL from cell values + subroutine recalc_cfl(this) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), dimension(this%N) :: evals + real(WP) :: task_CFL_x, task_CFL_y, task_CFL_z + integer :: i, j, k, ierrx, ierry, ierrz + + call this%cfg%sync(this%Uc) + + task_CFL_x = 0.0_WP; task_CFL_y = 0.0_WP; task_CFL_z = 0.0_WP; + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + do i = this%cfg%imin_, this%cfg%imax_ + call this%evals_x(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_x = max(task_CFL_x, this%cfg%dxi(i) * maxval(abs(evals))) + call this%evals_y(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_y = max(task_CFL_y, this%cfg%dyi(i) * maxval(abs(evals))) + call this%evals_z(this%P, this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + task_CFL_z = max(task_CFL_z, this%cfg%dzi(i) * maxval(abs(evals))) + end do + end do + end do + + call MPI_ALLREDUCE(task_CFL_x, this%CFL_x, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrx) + call MPI_ALLREDUCE(task_CFL_y, this%CFL_y, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierry) + call MPI_ALLREDUCE(task_CFL_z, this%CFL_z, 1, MPI_REAL_WP, MPI_MAX, & + & this%cfg%comm, ierrz) + + if (ierrx .ne. 0) call die("error reducing CFL") + if (ierry .ne. 0) call die("error reducing CFL") + if (ierrz .ne. 0) call die("error reducing CFL") + + this%have_CFL_x_estim = .true.; this%have_CFL_x_exact = .true.; + this%have_CFL_y_estim = .true.; this%have_CFL_y_exact = .true.; + this%have_CFL_z_estim = .true.; this%have_CFL_z_exact = .true.; + + end subroutine recalc_cfl + +end module + diff --git a/tools/GNUMake/Make.local b/tools/GNUMake/Make.local index e0b436202..4feb6db08 100644 --- a/tools/GNUMake/Make.local +++ b/tools/GNUMake/Make.local @@ -41,7 +41,7 @@ endif # When I run on my local desktop, I like to add this gfortran flag. FFLAGS += -fcheck=array-temps -F90FLAGS += -fcheck=array-temps +F90FLAGS += -fcheck=array-temps # --std=f2008 # Instead of linking to static gfortran library, I like to use shared libraries. @@ -69,3 +69,4 @@ CFLAGS = MY_AWESOME_CFLAGS ifeq ($(lowercase_comp),pg?compiler) CXXFLAGS := $(filter-out --c++11,$(CXXFLAGS)) endif + From 7e71780c913166d83443b0f2a817425956d99d8f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 13:18:15 -0500 Subject: [PATCH 116/152] Update pgrid_class.f90 Removed unused variable --- src/grid/pgrid_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 964116cee..37bb8008c 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -244,7 +244,7 @@ subroutine pgrid_domain_decomp(self) use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none class(pgrid), intent(inout) :: self - integer :: strat_,ierr,q,r + integer :: ierr,q,r type(MPI_Comm) :: tmp_comm integer, parameter :: ndims=3 logical, parameter :: reorder=.true. From 5bb6c65b606cefef8c376c66eeb06e87bf7ae6a1 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 16:45:19 -0500 Subject: [PATCH 117/152] Update sgsmodel_class.f90 Apparently the dynamic Smagorinsky model is working now --- src/subgrid/sgsmodel_class.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index e5aeb2264..cd524954a 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -413,7 +413,6 @@ subroutine visc_dynamic(this,dt,rho,Ui,Vi,Wi,SR,gradu) else Cs=0.0_WP end if - Cs = this%Cs_ref this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*Cs*this%delta(i,j,k)**2 end do end do @@ -444,7 +443,7 @@ subroutine visc_cst(this,rho,SR) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref*this%delta(i,j,k)**2 + this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref**2*this%delta(i,j,k)**2 end do end do end do From 70252d594749b1b68fa8b8e0672252c1f7712457 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 17:06:57 -0500 Subject: [PATCH 118/152] Update sgsmodel_class.f90 Nothing to see here --- src/subgrid/sgsmodel_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/subgrid/sgsmodel_class.f90 b/src/subgrid/sgsmodel_class.f90 index cd524954a..4fdf728c6 100644 --- a/src/subgrid/sgsmodel_class.f90 +++ b/src/subgrid/sgsmodel_class.f90 @@ -443,7 +443,7 @@ subroutine visc_cst(this,rho,SR) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ - this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*this%Cs_ref**2*this%delta(i,j,k)**2 + this%visc(i,j,k)=rho(i,j,k)*S_(i,j,k)*(this%Cs_ref*this%delta(i,j,k))**2 end do end do end do From e2bcef77b6ac0fd7de2fd20769ee557e7dc7b963 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 21:41:29 -0500 Subject: [PATCH 119/152] Update input Nothing important --- examples/riser/input | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/riser/input b/examples/riser/input index 1f1fe64e4..8fad940b4 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 4 1 +Partition : 4 1 1 # Mesh definition Pipe length : 0.08 @@ -20,7 +20,7 @@ Density : 1.2 Gravity : -9.81 0 0 # Particle properties -Particle volume fraction : 0.012 +Particle volume fraction : 0.02 Particle mean diameter : 58e-6 Particle standard deviation : 25-6 Particle min diameter : 21e-6 @@ -43,4 +43,4 @@ Postproc output period : 200e-5 # Restart files Restart output period : 200e-5 -!Restart from : 2.00000E-04 \ No newline at end of file +!Restart from : 2.00000E-04 From f93b10a3bea7a3400168a6313696a7ef6b475b83 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 21:48:33 -0500 Subject: [PATCH 120/152] Squashed commit of the following: commit 09434395ec56bcd42e9833a99bb88d87aa20f2ee Author: Olivier Desjardins Date: Thu Feb 9 18:14:09 2023 -0500 Reverting the squaring of Cs for the dynamic smago model commit 3d43243eb795de6f9b53f671aed594d0154f651e Author: Olivier Desjardins Date: Thu Feb 9 17:44:27 2023 -0500 This makes the drop-ib impact test 3D commit 8440aa1b318a4d1b7818b6c0fce6a9a72bf29dea Author: Olivier Desjardins Date: Thu Feb 9 17:31:06 2023 -0500 New class ibconfig which extends config. Implemented standard normal vector calculation, and Bigot's VF expression. Drop impact on curved surface seems to work well. Also absorbed SGS model typo correction from UMich. commit 73cc558bfa4fe8f9d35627b820d8b0e621da72af Author: Olivier Desjardins Date: Thu Feb 9 14:14:41 2023 -0500 New falling drop with IB case, exposed locator function type (thanks Jack!) commit b261de58d4b018762e5f1e9f09ab5dfb7ba59e83 Author: Olivier Desjardins Date: Wed Feb 8 16:01:25 2023 -0500 Absorbed Jesse's changes with lpt cfl and collision flag. commit 0bca3e86d38e65d82bcf05e26ad2d4884d15fbac Author: Olivier Desjardins Date: Tue Feb 7 23:19:41 2023 -0500 Added IB-particle collision from Jesse. Switched all solvers (except MAST!) to new linsol class. ALMOST ALL EXAMPLES WILL NEED TO BE UPDATED! commit 26b4fe29243963770710ed5b59b9b912dbec536b Author: Olivier Desjardins Date: Tue Feb 7 22:29:02 2023 -0500 Switched fourier3d to c2c... commit 19ae45186b1966242d8e3675f8f66be17bd5ea05 Author: Olivier Desjardins Date: Tue Feb 7 22:09:34 2023 -0500 Commit what I think is the cleanest implementation of r2r fftw solver - but that requires another strategy for building the operator commit a9becb0343bc7f3b07d3c8b230c9882426b5b3bb Author: Olivier Desjardins Date: Tue Feb 7 16:22:59 2023 -0500 p3dfft is also removed as decomposition strategy commit 31219cef08bbbbf0c0a4cac2985d47ac89f32938 Author: Olivier Desjardins Date: Tue Feb 7 16:16:07 2023 -0500 May not be working yet - this commit removes p3dfft altogether, replaces it with our in-house fourier solver. commit ff795e1aa35e23c9fcabe11d79fae700d605ed57 Author: Olivier Desjardins Date: Tue Feb 7 09:49:15 2023 -0500 Started adding a multiphase_pipe case. Started adding back in-house fourier solver. Fixed bug with hit. commit ec57c3a84e25f3af98e0a7ea79615efe3841aa2d Author: Olivier Desjardins Date: Mon Feb 6 13:41:15 2023 -0500 Proper non-dimensionalization of the swirl injection case commit 49d5325fd38e0624ff6a5d66c0e75ebbf4c02960 Author: Olivier Desjardins Date: Mon Feb 6 13:17:20 2023 -0500 Moved library directory specification to my .zshrc to remove all reference to 'desjardi'... commit 7937d14022734d4ccf24315e24f2fade3a7914a6 Author: Olivier Desjardins Date: Mon Feb 6 10:59:56 2023 -0500 Adding a swirl atomizer test case. commit c70dd8ba887f39b40510b75409d30dd525e58390 Author: Olivier Desjardins Date: Sun Feb 5 21:51:08 2023 -0500 Particles with id=0 do not modify the flow and are not advanced. They're just kinda... there. commit 305694cffbe3ff5ccc5f544adef497eebcd0f40d Author: Olivier Desjardins Date: Sun Feb 5 21:35:21 2023 -0500 Removed shock-particle case, it's not ready. commit 4bf8f61d4996c35aff2581a5e8f2987d0e05e9a8 Author: Olivier Desjardins Date: Sun Feb 5 21:34:04 2023 -0500 Updated shit_p routines to make use of newly defined integration tools and fluid_vol variable. commit af17f44d5ce8eb088e9433e3e0b1188d6b0e5066 Author: Olivier Desjardins Date: Sun Feb 5 20:01:42 2023 -0500 Absorded range of modifications from Jesse's repository. Most important is the use of p3dfft for fourier-based linear solvers. commit f962bc2b278e419c8d8d09e5e45d5ea677bf9d6e Author: Olivier Desjardins Date: Fri Feb 3 17:17:33 2023 -0500 Clean-up ib_pipe to make it a proper pipe flow LES. Cleaned up Vreman's sgs model. commit 6c4766c03f875933dc4435d09b36cc43908e77b5 Author: Olivier Desjardins Date: Fri Feb 3 14:19:32 2023 -0500 Slight clean-up of the turbulent ib_pipe case. commit bf6f53909e43e24aed0f4cfb802118bb447f61fd Author: Olivier Desjardins Date: Thu Feb 2 22:57:49 2023 -0500 ib_pipe modified to absorb Jesse's changes, and pushed to turbulent conditions. commit d7892206a0a67fc87a3357270811944df00e26bc Author: Olivier Desjardins Date: Thu Feb 2 14:56:07 2023 -0500 Small changes to falling_drop, added new ib_drop case. commit 1ceb7d2b0dced02f0bbb0782a4c386ab350bce29 Author: Olivier Desjardins Date: Wed Feb 1 10:41:13 2023 -0500 Reindent df_class. Need to think about role of rho here for two-phase flows. --- examples/falling_drop_ib/GNUmakefile | 46 +++ examples/falling_drop_ib/README | 2 + examples/falling_drop_ib/input | 34 ++ examples/falling_drop_ib/src/Make.package | 2 + examples/falling_drop_ib/src/geometry.f90 | 87 +++++ examples/falling_drop_ib/src/simulation.f90 | 367 ++++++++++++++++++++ examples/multiphase_pipe/GNUmakefile | 6 +- examples/multiphase_pipe/README | 3 +- examples/multiphase_pipe/input | 14 +- examples/multiphase_pipe/src/geometry.f90 | 11 +- examples/multiphase_pipe/src/simulation.f90 | 271 ++++++++------- src/config/Make.package | 2 +- src/config/ibconfig_class.f90 | 157 +++++++++ src/constant_density/incomp_class.f90 | 14 +- src/constant_density/scalar_class.f90 | 14 +- src/data/ensight_class.f90 | 16 +- src/grid/iterator_class.f90 | 18 +- src/two_phase/mast_class.f90 | 14 +- src/two_phase/tpns_class.f90 | 14 +- src/two_phase/vfs_class.f90 | 14 +- src/variable_density/lowmach_class.f90 | 14 +- src/variable_density/vdscalar_class.f90 | 14 +- 22 files changed, 910 insertions(+), 224 deletions(-) create mode 100644 examples/falling_drop_ib/GNUmakefile create mode 100644 examples/falling_drop_ib/README create mode 100644 examples/falling_drop_ib/input create mode 100644 examples/falling_drop_ib/src/Make.package create mode 100644 examples/falling_drop_ib/src/geometry.f90 create mode 100644 examples/falling_drop_ib/src/simulation.f90 create mode 100644 src/config/ibconfig_class.f90 diff --git a/examples/falling_drop_ib/GNUmakefile b/examples/falling_drop_ib/GNUmakefile new file mode 100644 index 000000000..466227c85 --- /dev/null +++ b/examples/falling_drop_ib/GNUmakefile @@ -0,0 +1,46 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := core two_phase data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/falling_drop_ib/README b/examples/falling_drop_ib/README new file mode 100644 index 000000000..307507a55 --- /dev/null +++ b/examples/falling_drop_ib/README @@ -0,0 +1,2 @@ +This is an implementation of a falling drop problem. This is currently intended as a test of +the two-phase velocity solver. diff --git a/examples/falling_drop_ib/input b/examples/falling_drop_ib/input new file mode 100644 index 000000000..13fef1940 --- /dev/null +++ b/examples/falling_drop_ib/input @@ -0,0 +1,34 @@ +# Parallelization +Partition : 1 1 8 + +# Mesh definition +Lx : 0.001 +Ly : 0.1 +Lz : 0.1 +nx : 1 +ny : 100 +nz : 100 + +# Fluid properties +Gravity : 0 -9.81 0 +Liquid dynamic viscosity : 1.137e-3 +Gas dynamic viscosity : 1.780e-5 +Liquid density : 1000 +Gas density : 1.226 +Surface tension coefficient : 0.0728 + +# Time integration +Max timestep size : 1e-3 +Max cfl number : 0.9 +Max time : 5 + +# Pressure solver +Pressure tolerance : 1e-6 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 1e-2 \ No newline at end of file diff --git a/examples/falling_drop_ib/src/Make.package b/examples/falling_drop_ib/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/falling_drop_ib/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/falling_drop_ib/src/geometry.f90 b/examples/falling_drop_ib/src/geometry.f90 new file mode 100644 index 000000000..f75851eae --- /dev/null +++ b/examples/falling_drop_ib/src/geometry.f90 @@ -0,0 +1,87 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use ibconfig_class, only: ibconfig + use precision, only: WP + implicit none + private + + !> Single config + type(ibconfig), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx-0.5_WP*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='FallingDrop') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + ! Read in partition + call param_read('Partition',partition,short='p') + ! Create partitioned grid + cfg=ibconfig(grp=group,decomp=partition,grid=grid) + end block create_cfg + + + ! Create IB walls for this config + create_walls: block + use mathtools, only: twoPi + use ibconfig_class, only: bigot + integer :: i,j,k + ! Create IB field + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + cfg%Gib(i,j,k)=0.02_WP+0.01_WP*cos(3.0_WP*twoPi*cfg%zm(k)/cfg%zL)*cos(3.0_WP*twoPi*cfg%xm(i)/cfg%xL)-cfg%ym(j) + end do + end do + end do + ! Get normal vector + call cfg%calculate_normal() + ! Get VF field + call cfg%calculate_vf(method=bigot) + end block create_walls + + + end subroutine geometry_init + + +end module geometry \ No newline at end of file diff --git a/examples/falling_drop_ib/src/simulation.f90 b/examples/falling_drop_ib/src/simulation.f90 new file mode 100644 index 000000000..1df188b2b --- /dev/null +++ b/examples/falling_drop_ib/src/simulation.f90 @@ -0,0 +1,367 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Droplet definition + real(WP), dimension(3) :: center + real(WP) :: radius + +contains + + + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet + G=radius-sqrt(sum((xyz-center)**2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.075_WP,0.0_WP]; radius=0.01_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_scalar('Gib',cfg%Gib) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply direct IB forcing + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=sum(fs%itpr_x(:,i,j,k)*cfg%VF(i-1:i,j,k))*fs%U(i,j,k) + fs%V(i,j,k)=sum(fs%itpr_y(:,i,j,k)*cfg%VF(i,j-1:j,k))*fs%V(i,j,k) + fs%W(i,j,k)=sum(fs%itpr_z(:,i,j,k)*cfg%VF(i,j,k-1:k))*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + +end module simulation \ No newline at end of file diff --git a/examples/multiphase_pipe/GNUmakefile b/examples/multiphase_pipe/GNUmakefile index b92867b7c..3565ccea4 100644 --- a/examples/multiphase_pipe/GNUmakefile +++ b/examples/multiphase_pipe/GNUmakefile @@ -6,8 +6,8 @@ PRECISION = DOUBLE USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE -USE_FFTW = TRUE -USE_IRL = FALSE +USE_FFTW = FALSE +USE_IRL = TRUE PROFILE = FALSE DEBUG = FALSE COMP = gnu @@ -29,7 +29,7 @@ VPATH_LOCATIONS += $(Ulocs) include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := subgrid constant_density core data solver config grid libraries +Bdirs := subgrid two_phase core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/multiphase_pipe/README b/examples/multiphase_pipe/README index ba28b9a69..dd2da5e9d 100644 --- a/examples/multiphase_pipe/README +++ b/examples/multiphase_pipe/README @@ -1,2 +1 @@ -Simple periodic pipe flow simulation using a direct forcing immersed boundary approach following: -Bigot, B., Bonometti, T., Lacaze, L., & Thual, O. (2014). A simple immersed-boundary method for solid–fluid interaction in constant-and stratified-density flows. Computers & Fluids, 97, 126-142. +Multiphase periodic pipe flow simulation using a volumetric direct forcing immersed boundary approach. \ No newline at end of file diff --git a/examples/multiphase_pipe/input b/examples/multiphase_pipe/input index 3a98424db..67dae06fa 100644 --- a/examples/multiphase_pipe/input +++ b/examples/multiphase_pipe/input @@ -8,18 +8,18 @@ nx : 256 ny : 64 nz : 64 -# Pipe properties -Bulk velocity : 1 -Fluctuation amp : 0.2 - # Time integration Max timestep size : 0.01 Max cfl number : 0.9 Max time : 1000 # Fluid properties -Dynamic viscosity : 2e-4 -Density : 1 +Bulk velocity : 1 +Liquid dynamic viscosity : 1e-1 +Gas dynamic viscosity : 1e-3 +Liquid density : 1000 +Gas density : 1 +Surface tension coefficient : 1e-3 # Pressure solver Pressure tolerance : 1e-4 @@ -30,4 +30,4 @@ Implicit tolerance : 1e-4 Implicit iteration : 100 # Ensight output -Ensight output period : 1 +Ensight output period : 0.1 \ No newline at end of file diff --git a/examples/multiphase_pipe/src/geometry.f90 b/examples/multiphase_pipe/src/geometry.f90 index 9f2df8dae..bfd96c2f7 100644 --- a/examples/multiphase_pipe/src/geometry.f90 +++ b/examples/multiphase_pipe/src/geometry.f90 @@ -9,9 +9,9 @@ module geometry type(config), public :: cfg !> Pipe diameter - real(WP), public :: D + real(WP) :: D - public :: geometry_init,get_VF + public :: geometry_init,get_VF,D contains @@ -64,7 +64,7 @@ subroutine geometry_init end do ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') + grid=sgrid(coord=cartesian,no=3,x=x,y=y,z=z,xper=.true.,yper=.true.,zper=.true.,name='pipe') end block create_grid @@ -72,14 +72,13 @@ subroutine geometry_init ! Create a config from that grid on our entire group create_cfg: block use parallel, only: group - use pgrid_class, only: p3dfft_decomp integer, dimension(3) :: partition ! Read in partition call param_read('Partition',partition,short='p') ! Create partitioned grid - cfg=config(grp=group,decomp=partition,grid=grid,strat=p3dfft_decomp) + cfg=config(grp=group,decomp=partition,grid=grid) end block create_cfg @@ -133,4 +132,4 @@ function get_VF(i,j,k,dir) result(VF) end function get_VF -end module geometry \ No newline at end of file +end module geometry diff --git a/examples/multiphase_pipe/src/simulation.f90 b/examples/multiphase_pipe/src/simulation.f90 index 052f8051d..73ee2ce3a 100644 --- a/examples/multiphase_pipe/src/simulation.f90 +++ b/examples/multiphase_pipe/src/simulation.f90 @@ -3,7 +3,8 @@ module simulation use precision, only: WP use geometry, only: cfg,D,get_VF use hypre_str_class, only: hypre_str - use incomp_class, only: incomp + use vfs_class, only: vfs + use tpns_class, only: tpns use sgsmodel_class, only: sgsmodel use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -12,12 +13,13 @@ module simulation implicit none private - !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(sgsmodel), public :: sgs - type(timetracker), public :: time + !> Declare the main objects we'll use for this case + type(hypre_str), public :: ps !< Linear solver for pressure + type(hypre_str), public :: vs !< Linear solver for implicit NS + type(tpns), public :: fs !< Two-phase NS solver + type(vfs), public :: vf !< VOF solver + type(sgsmodel), public :: sgs !< SGS model + type(timetracker), public :: time !< Time discretization !> Ensight postprocessing type(ensight) :: ens_out @@ -33,55 +35,41 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi real(WP), dimension(:,:,:), allocatable :: G - real(WP) :: visc,mfr_target,mfr,bforce contains - !> Compute massflow rate - function get_bodyforce_mfr(srcU) result(mfr) - use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE - use parallel, only: MPI_REAL_WP - real(WP), dimension(fs%cfg%imino_:,fs%cfg%jmino_:,fs%cfg%kmino_:), intent(in), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr - real(WP) :: vol,myRhoU,myUvol,Uvol,mfr - myRhoU=0.0_WP; myUvol=0.0_WP - if (present(srcU)) then - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') - myUvol=myUvol+vol - !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho+vol*srcU(i,j,k) - myRhoU=myRhoU+vol*(fs%rho*fs%U(i,j,k)+srcU(i,j,k)) - end do - end do - end do - else - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - vol=fs%cfg%dxm(i)*fs%cfg%dy(j)*fs%cfg%dz(k)*get_VF(i,j,k,'U') - myUvol=myUvol+vol - !myRhoU=myRhoU+vol*(2.0_WP*fs%U(i,j,k)-fs%Uold(i,j,k))*fs%rho - myRhoU=myRhoU+vol*fs%rho*fs%U(i,j,k) - end do - end do - end do - end if - call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol - end function get_bodyforce_mfr - + !> Function that defines a level set function for initial conditions + function levelset_init(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + G=-0.25_WP*D-xyz(2) + end function levelset_init + !> Initialization of problem solver subroutine simulation_init use param, only: param_read implicit none + + ! Allocate work arrays + allocate_work_arrays: block + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + - ! Initialize time tracker with 1 subiterations + ! Initialize time tracker with 2 subiterations initialize_timetracker: block time=timetracker(amRoot=cfg%amRoot) call param_read('Max timestep size',time%dtmax) @@ -90,19 +78,78 @@ subroutine simulation_init time%dt=time%dtmax time%itmax=2 end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: lvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') + ! Initialize based on levelset + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_init,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof - ! Create an incompressible flow solver without bconds - create_flow_solver: block + ! Create a two-phase flow solver without bconds + create_flow_solver: block use hypre_str_class, only: pcg_pfmg ! Create flow solver - fs=incomp(cfg=cfg,name='Incompressible NS') - ! Set the flow properties - call param_read('Density',fs%rho) - call param_read('Dynamic viscosity',visc); fs%visc=visc + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) ! Configure pressure solver ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - ps%maxlevel=14 call param_read('Pressure iteration',ps%maxit) call param_read('Pressure tolerance',ps%rcvg) ! Configure implicit velocity solver @@ -114,19 +161,6 @@ subroutine simulation_init end block create_flow_solver - ! Allocate work arrays - allocate_work_arrays: block - allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - ! Initialize our velocity field initialize_velocity: block use mathtools, only: twoPi @@ -136,28 +170,10 @@ subroutine simulation_init ! Initial fields call param_read('Bulk velocity',Ubulk) fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP - ! For faster transition - call param_read('Fluctuation amp',amp,default=0.0_WP) - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=fs%U(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%zm(k)/fs%cfg%zL)*cos(8.0_WP*twoPi*fs%cfg%ym(j)/fs%cfg%yL) - fs%V(i,j,k)=fs%V(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) - fs%W(i,j,k)=fs%W(i,j,k)+Ubulk*random_uniform(lo=-0.5_WP*amp,hi=0.5_WP*amp)+amp*Ubulk*cos(8.0_WP*twoPi*fs%cfg%xm(i)/fs%cfg%xL) - end do - end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) ! Compute cell-centered velocity call fs%interp_vel(Ui,Vi,Wi) ! Compute divergence call fs%get_div() - ! Get target MFR and zero bodyforce - mfr=get_bodyforce_mfr() - mfr_target=mfr - bforce=0.0_WP end block initialize_velocity @@ -191,7 +207,8 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('levelset',G) call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('visc_sgs',sgs%visc) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('curvature',vf%curv) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -202,18 +219,20 @@ subroutine simulation_init ! Prepare some info about fields call fs%get_cfl(time%dt,time%cfl) call fs%get_max() + call vf%get_max() ! Create simulation monitor mfile=monitor(fs%cfg%amRoot,'simulation') call mfile%add_column(time%n,'Timestep number') call mfile%add_column(time%t,'Time') call mfile%add_column(time%dt,'Timestep size') call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(mfr,'MFR') - call mfile%add_column(bforce,'Body force') call mfile%add_column(fs%Umax,'Umax') call mfile%add_column(fs%Vmax,'Vmax') call mfile%add_column(fs%Wmax,'Wmax') call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') call mfile%add_column(fs%divmax,'Maximum divergence') call mfile%add_column(fs%psolv%it,'Pressure iteration') call mfile%add_column(fs%psolv%rerr,'Pressure error') @@ -222,6 +241,7 @@ subroutine simulation_init cflfile=monitor(fs%cfg%amRoot,'cfl') call cflfile%add_column(time%n,'Timestep number') call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') call cflfile%add_column(fs%CFLc_x,'Convective xCFL') call cflfile%add_column(fs%CFLc_y,'Convective yCFL') call cflfile%add_column(fs%CFLc_z,'Convective zCFL') @@ -246,20 +266,32 @@ subroutine simulation_run call time%adjust_dt() call time%increment() + ! Remember old VOF + vf%VFold=vf%VF + ! Remember old velocity fs%Uold=fs%U fs%Vold=fs%V fs%Wold=fs%W - ! Turbulence modeling - sgs_modeling: block - use sgsmodel_class, only: vreman - resU=fs%rho - call fs%get_gradu(gradU) - call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) - fs%visc=visc+sgs%visc - end block sgs_modeling + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + ! Turbulence modeling + !sgs_modeling: block + ! use sgsmodel_class, only: vreman + ! resU=fs%rho + ! call fs%get_gradu(gradU) + ! call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) + ! fs%visc=visc+sgs%visc + !end block sgs_modeling + ! Perform sub-iterations do while (time%it.le.time%itmax) @@ -267,21 +299,21 @@ subroutine simulation_run fs%U=0.5_WP*(fs%U+fs%Uold) fs%V=0.5_WP*(fs%V+fs%Vold) fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) ! Explicit calculation of drho*u/dt from NS call fs%get_dmomdt(resU,resV,resW) ! Assemble explicit residual - resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU - resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV - resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + ! Add body forcing bodyforcing: block - real(WP) :: mfr - mfr=get_bodyforce_mfr(resU) - bforce=(mfr_target-mfr)/time%dtmid - resU=resU+time%dt*bforce + resU=resU+time%dt*0.1_WP end block bodyforcing ! Apply IB forcing to enforce BC at the pipe walls @@ -302,10 +334,10 @@ subroutine simulation_run call fs%solve_implicit(time%dt,resU,resV,resW) ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + ! Apply IB forcing to enforce BC at the pipe walls ibforcing: block integer :: i,j,k @@ -327,19 +359,21 @@ subroutine simulation_run call fs%apply_bcond(time%t,time%dt) ! Solve Poisson equation - call fs%correct_mfr() - call fs%get_div() - fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho - fs%V=fs%V-time%dt*resV/fs%rho - fs%W=fs%W-time%dt*resW/fs%rho + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W ! Increment sub-iteration counter time%it=time%it+1 @@ -355,6 +389,7 @@ subroutine simulation_run ! Perform and output monitoring call fs%get_max() + call vf%get_max() call mfile%write() call cflfile%write() diff --git a/src/config/Make.package b/src/config/Make.package index af34f6184..2610dcf0a 100644 --- a/src/config/Make.package +++ b/src/config/Make.package @@ -1,4 +1,4 @@ -f90EXE_sources += config_class.f90 +f90EXE_sources += config_class.f90 ibconfig_class.f90 INCLUDE_LOCATIONS += $(NGA_HOME)/src/config VPATH_LOCATIONS += $(NGA_HOME)/src/config diff --git a/src/config/ibconfig_class.f90 b/src/config/ibconfig_class.f90 new file mode 100644 index 000000000..a1d453e90 --- /dev/null +++ b/src/config/ibconfig_class.f90 @@ -0,0 +1,157 @@ +!> Single-grid IB-capable config concept is defined here: this is a partitioned grid +!> as well as geometry based on VF augmented with a level set and its normal and a few methods +module ibconfig_class + use precision, only: WP + use config_class, only: config + implicit none + private + + ! Expose type/constructor/methods + public :: ibconfig + + ! List of known available methods for calculating VF from G + integer, parameter, public :: bigot=1 + + !> Config object definition as an extension of config + type, extends(config) :: ibconfig + + real(WP), dimension(:,:,:), allocatable :: Gib !< Level set function, negative in fluid and positive in solid + real(WP), dimension(:,:,:,:), allocatable :: Nib !< IB normal vector, oriented into the solid + + contains + procedure :: calculate_normal !< Calculate robustly the normal vector from G field + procedure :: calculate_vf !< Calculate fluid volume fraction + end type ibconfig + + + !> Declare single-grid ibconfig constructor + interface ibconfig + procedure construct_from_sgrid + end interface ibconfig + + +contains + + + !> Single-grid config constructor from a serial grid + function construct_from_sgrid(grp,decomp,grid) result(self) + use sgrid_class, only: sgrid + use string, only: str_medium + use mpi_f08, only: MPI_Group + implicit none + type(ibconfig) :: self + type(sgrid), intent(in) :: grid + type(MPI_Group), intent(in) :: grp + integer, dimension(3), intent(in) :: decomp + ! Create a config with the provided group and decomposition + self%config=config(grp,decomp,grid) + ! Allocate IB info + allocate(self%Gib( self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)); self%Gib=-1.0_WP + allocate(self%Nib(1:3,self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)); self%Nib=+0.0_WP + end function construct_from_sgrid + + + !> Specialized normal vector calculation from G + !> Well suited to handle G discontinuities + subroutine calculate_normal(this) + implicit none + class(ibconfig), intent(inout) :: this + integer :: i,j,k,ii,jj,kk,stx,sty,stz + real(WP), dimension(3) :: Gx,Gy,Gz + real(WP) :: norm,norm_test + ! Get the normal vector + do k=this%kmino_+1,this%kmaxo_-1 + do j=this%jmino_+1,this%jmaxo_-1 + do i=this%imino_+1,this%imaxo_-1 + ! Consider 3 stencils in x + Gx(1)=(this%Gib(i+1,j,k)-this%Gib(i-1,j,k))/(this%xm(i+1)-this%xm(i-1)) + Gx(2)=(this%Gib(i ,j,k)-this%Gib(i-1,j,k))/(this%xm(i )-this%xm(i-1)) + Gx(3)=(this%Gib(i+1,j,k)-this%Gib(i ,j,k))/(this%xm(i+1)-this%xm(i )) + ! Consider 3 stencils in y + Gy(1)=(this%Gib(i,j+1,k)-this%Gib(i,j-1,k))/(this%ym(j+1)-this%ym(j-1)) + Gy(2)=(this%Gib(i,j ,k)-this%Gib(i,j-1,k))/(this%ym(j )-this%ym(j-1)) + Gy(3)=(this%Gib(i,j+1,k)-this%Gib(i,j ,k))/(this%ym(j+1)-this%ym(j )) + ! Consider 3 stencils in z + Gz(1)=(this%Gib(i,j,k+1)-this%Gib(i,j,k-1))/(this%zm(k+1)-this%zm(k-1)) + Gz(2)=(this%Gib(i,j,k )-this%Gib(i,j,k-1))/(this%zm(k )-this%zm(k-1)) + Gz(3)=(this%Gib(i,j,k+1)-this%Gib(i,j,k ))/(this%zm(k+1)-this%zm(k )) + ! Find stencil combination closest to unity norm + norm=huge(1.0_WP) + do kk=1,3 + do jj=1,3 + do ii=1,3 + norm_test=sqrt(Gx(ii)**2+Gy(jj)**2+Gz(kk)**2) + if (abs(norm_test-1.0_WP).lt.abs(norm-1.0_WP)) then + norm=norm_test; stx=ii; sty=jj; stz=kk + end if + end do + end do + end do + norm=max(norm,epsilon(1.0_WP)) + this%Nib(1:3,i,j,k)=[Gx(stx),Gy(sty),Gz(stz)]/norm + end do + end do + end do + ! Synchronize it + call this%sync(this%Nib) + ! Extend to non-periodic edges + if (.not.this%xper) then + if (this%iproc.eq.1) then + this%Nib(:,this%imino,:,:)=this%Nib(:,this%imino+1,:,:) + else if (this%iproc.eq.this%npx) then + this%Nib(:,this%imaxo,:,:)=this%Nib(:,this%imaxo-1,:,:) + end if + end if + if (.not.this%yper) then + if (this%jproc.eq.1) then + this%Nib(:,:,this%jmino,:)=this%Nib(:,:,this%jmino+1,:) + else if (this%jproc.eq.this%npy) then + this%Nib(:,:,this%jmaxo,:)=this%Nib(:,:,this%jmaxo-1,:) + end if + end if + if (.not.this%zper) then + if (this%kproc.eq.1) then + this%Nib(:,:,:,this%kmino)=this%Nib(:,:,:,this%kmino+1) + else if (this%kproc.eq.this%npz) then + this%Nib(:,:,:,this%kmaxo)=this%Nib(:,:,:,this%kmaxo-1) + end if + end if + end subroutine calculate_normal + + + !> Calculation of VF from G + subroutine calculate_vf(this,method) + use messager, only: die + implicit none + class(ibconfig), intent(inout) :: this + integer, intent(in) :: method + + ! Select the method + select case (method) + case(bigot) + ! Get fluid volume fraction from G using Bigot's expression + bigot: block + integer :: i,j,k + real(WP) :: lambda,eta + do k=this%kmino_,this%kmaxo_ + do j=this%jmino_,this%jmaxo_ + do i=this%imino_,this%imaxo_ + lambda=sum(abs(this%Nib(:,i,j,k))) + eta=0.065_WP*(1.0_WP-lambda**2)+0.39_WP + this%VF(i,j,k)=0.5_WP*(1.0_WP-tanh(this%Gib(i,j,k)/(lambda*eta*this%meshsize(i,j,k)))) + this%VF(i,j,k)=max(this%VF(i,j,k),epsilon(1.0_WP)) + end do + end do + end do + end block bigot + case default + call die('[ibconfig calculate_vf] Unknown method to calculate VF') + end select + + ! Update total fluid volume + call this%calc_fluid_vol() + + end subroutine calculate_vf + + +end module ibconfig_class diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index 8831ca27a..7f180ffa2 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -818,20 +818,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(incomp), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=1), intent(in) :: face integer, intent(in) :: dir logical, intent(in) :: canCorrect diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index a7a877d17..19252f220 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -429,20 +429,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,dir) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(scalar), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=2), optional :: dir type(bcond), pointer :: new_bc integer :: i,j,k,n diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index 9c3a3a305..7f11f0588 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -434,7 +434,7 @@ subroutine write_case(this) ! Write all the variable information write(iunit,'(a)') 'VARIABLE' - write(iunit,'(a)') 'scalar per element: wall geometry.wall' + write(iunit,'(a)') 'scalar per element: fvf geometry.fvf' my_scl=>this%first_scl do while (associated(my_scl)) write(iunit,'(a)') 'scalar per element: 1 '//trim(my_scl%name)//' '//trim(my_scl%name)//'/'//trim(my_scl%name)//'.******' @@ -519,13 +519,13 @@ subroutine write_geom(this,cfg,name) end if - ! Root process starts writing the file header for wall data + ! Root process starts writing the file header for VF data if (cfg%amRoot) then ! Open the file - open(newunit=iunit,file='ensight/'//trim(this%name)//'/'//trim(name)//'.wall',form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[ensight write data] Could not open file: '//'ensight/'//trim(this%name)//'/'//trim(name)//'.wall') + open(newunit=iunit,file='ensight/'//trim(this%name)//'/'//trim(name)//'.fvf',form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[ensight write data] Could not open file: '//'ensight/'//trim(this%name)//'/'//trim(name)//'.fvf') ! Write the header - cbuff='wall' ; write(iunit) cbuff + cbuff='fvf' ; write(iunit) cbuff cbuff='part' ; write(iunit) cbuff ibuff=1 ; write(iunit) ibuff cbuff='block' ; write(iunit) cbuff @@ -536,9 +536,9 @@ subroutine write_geom(this,cfg,name) ! Prepare the SP buffer allocate(spbuff(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)) - ! Now parallel-write the wall data - call MPI_FILE_OPEN(cfg%comm,'ensight/'//trim(this%name)//'/'//trim(name)//'.wall',IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[ensight write geom] Problem encountered while parallel writing wall data file: '//'ensight/'//trim(this%name)//'/'//trim(name)//'.wall') + ! Now parallel-write the VF data + call MPI_FILE_OPEN(cfg%comm,'ensight/'//trim(this%name)//'/'//trim(name)//'.fvf',IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[ensight write geom] Problem encountered while parallel writing fvf data file: '//'ensight/'//trim(this%name)//'/'//trim(name)//'.fvf') call MPI_FILE_GET_POSITION(ifile,disp,ierr) call MPI_FILE_SET_VIEW(ifile,disp,MPI_REAL_SP,cfg%SPview,'native',info_mpiio,ierr) spbuff(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_)=real(cfg%VF(cfg%imin_:cfg%imax_,cfg%jmin_:cfg%jmax_,cfg%kmin_:cfg%kmax_),SP) diff --git a/src/grid/iterator_class.f90 b/src/grid/iterator_class.f90 index 90a319ddb..c06d09961 100644 --- a/src/grid/iterator_class.f90 +++ b/src/grid/iterator_class.f90 @@ -10,7 +10,7 @@ module iterator_class private ! Expose type/constructor/methods - public :: iterator, locator_gen_ftype + public :: iterator,locator_ftype !> itr object definition type :: iterator @@ -32,14 +32,14 @@ module iterator_class contains procedure :: print=>iterator_print !< Output iterator to the screen end type iterator - - !> iterator generating function type + + !> Type of the locator function used to generate an iterator interface - logical function locator_gen_ftype(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator_gen_ftype + logical function locator_ftype(pargrid,ind1,ind2,ind3) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pargrid + integer, intent(in) :: ind1,ind2,ind3 + end function locator_ftype end interface !> Declare single-grid iterator constructor @@ -58,7 +58,7 @@ function construct_from_function(pg,name,locator,face) result(self) type(iterator) :: self class(pgrid), target, intent(in) :: pg character(len=*), intent(in) :: name - procedure(locator_gen_ftype) :: locator + procedure(locator_ftype) :: locator character(len=1), optional :: face integer :: i,j,k,cnt integer :: color,key,ierr diff --git a/src/two_phase/mast_class.f90 b/src/two_phase/mast_class.f90 index 4d106e6f7..345eef0ce 100644 --- a/src/two_phase/mast_class.f90 +++ b/src/two_phase/mast_class.f90 @@ -684,20 +684,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,face,dir,celldir) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(mast), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=1), intent(in), optional :: face integer, intent(in), optional :: dir character(len=2), intent(in), optional :: celldir diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index 9eaf88f1a..a6cd1b0a7 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -888,20 +888,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(tpns), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=1), intent(in) :: face integer, intent(in) :: dir logical, intent(in) :: canCorrect diff --git a/src/two_phase/vfs_class.f90 b/src/two_phase/vfs_class.f90 index 34a4354bc..c360f15a9 100644 --- a/src/two_phase/vfs_class.f90 +++ b/src/two_phase/vfs_class.f90 @@ -569,20 +569,14 @@ end subroutine copy_interface_to_old !> Add a boundary condition subroutine add_bcond(this,name,type,locator,dir) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(vfs), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=2), optional :: dir type(bcond), pointer :: new_bc integer :: i,j,k,n diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index d194ff686..a87e99f95 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -831,20 +831,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(lowmach), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=1), intent(in) :: face integer, intent(in) :: dir logical, intent(in) :: canCorrect diff --git a/src/variable_density/vdscalar_class.f90 b/src/variable_density/vdscalar_class.f90 index 89747e49b..942be4d4d 100644 --- a/src/variable_density/vdscalar_class.f90 +++ b/src/variable_density/vdscalar_class.f90 @@ -404,20 +404,14 @@ end subroutine setup !> Add a boundary condition subroutine add_bcond(this,name,type,locator,dir) - use string, only: lowercase - use messager, only: die + use string, only: lowercase + use messager, only: die + use iterator_class, only: locator_ftype implicit none class(vdscalar), intent(inout) :: this character(len=*), intent(in) :: name integer, intent(in) :: type - external :: locator - interface - logical function locator(pargrid,ind1,ind2,ind3) - use pgrid_class, only: pgrid - class(pgrid), intent(in) :: pargrid - integer, intent(in) :: ind1,ind2,ind3 - end function locator - end interface + procedure(locator_ftype) :: locator character(len=2), optional :: dir type(bcond), pointer :: new_bc integer :: i,j,k,n From 0880680ec7b2954ab0dc78cfd2b7af281a5e034b Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 10 Feb 2023 10:49:23 -0500 Subject: [PATCH 121/152] Update simulation.f90 Use new linsol implicit solvers --- examples/collision/src/simulation.f90 | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/examples/collision/src/simulation.f90 b/examples/collision/src/simulation.f90 index 580bf8280..df872511f 100644 --- a/examples/collision/src/simulation.f90 +++ b/examples/collision/src/simulation.f90 @@ -3,6 +3,7 @@ module simulation use precision, only: WP use geometry, only: cfg use tpns_class, only: tpns + use hypre_str_class, only: hypre_str use vfs_class, only: vfs use timetracker_class, only: timetracker use ensight_class, only: ensight @@ -14,6 +15,8 @@ module simulation !> Single two-phase flow solver and volume fraction solver and corresponding time tracker type(tpns), public :: fs + type(hypre_str), public :: ps + type(hypre_str), public :: vs type(vfs), public :: vf type(timetracker), public :: time @@ -142,7 +145,7 @@ subroutine simulation_init ! Create a two-phase flow solver without bconds create_and_initialize_flow_solver: block - use ils_class, only: gmres_amg + use hypre_str_class, only: pcg_pfmg use mathtools, only: Pi integer :: i,j,k real(WP), dimension(3) :: xyz @@ -157,13 +160,15 @@ subroutine simulation_init ! Read in surface tension coefficient call param_read('Surface tension coefficient',fs%sigma) ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=gmres_amg,implicit_ils=gmres_amg) + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) ! Initial droplet velocity call param_read('Droplet 1 velocity',vel1) call param_read('Droplet 2 velocity',vel2) From aa0a61464efb57707066bfacef12c3657b519f33 Mon Sep 17 00:00:00 2001 From: maxzog Date: Fri, 10 Feb 2023 17:17:24 -0500 Subject: [PATCH 122/152] HIT src/ added --- examples/hit/input | 25 +- examples/hit/src/Make.package | 2 +- examples/hit/src/lpt_class.f90 | 1998 +++++++++++++++++++++++++++++++ examples/hit/src/simulation.f90 | 608 ++++++++-- 4 files changed, 2539 insertions(+), 94 deletions(-) create mode 100644 examples/hit/src/lpt_class.f90 diff --git a/examples/hit/input b/examples/hit/input index 7646043ff..ae0bfefdc 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -2,24 +2,37 @@ Partition : 1 1 4 # Mesh definition -Lx : 1 +Lx : 6.2832 nx : 64 # Fluid properties -Dynamic viscosity : 0.01 +Dynamic viscosity : 0.002 Density : 1 -Initial rms : 5 +Initial rms : 10 Eddy turnover time : 0.1 +Linear forcing : .true. + +# Steadt-state (forcing) parameters +Steady-state TKE : 3.0 +Steady-state epsilon : 6.0 +Forcing constant (G) : 50.0 +Force to maximum Re_lambda : .true. # Particle properties -Particle density : 0.018 -Particle diameter : 1 -Number of particles : 0!100000 +Particle density : 1000 +Particle Stokes number : 1.0 +Number of particles : 10000 # 250000 +Use CRW : .false. # Time integration Max timestep size : 1e-3 Max cfl number : 0.9 +Max iter : 1500 # Ensight output Ensight output period : 0.01 +# Restart config +Restart sim : .false. +# Restart from : 1.00044E-02 +Restart output period : 0.001 diff --git a/examples/hit/src/Make.package b/examples/hit/src/Make.package index a7a927853..32bde3e1e 100644 --- a/examples/hit/src/Make.package +++ b/examples/hit/src/Make.package @@ -1,2 +1,2 @@ # List here the extra files here -f90EXE_sources += geometry.f90 simulation.f90 +f90EXE_sources += geometry.f90 lpt_class.f90 simulation.f90 diff --git a/examples/hit/src/lpt_class.f90 b/examples/hit/src/lpt_class.f90 new file mode 100644 index 000000000..a0c441ec7 --- /dev/null +++ b/examples/hit/src/lpt_class.f90 @@ -0,0 +1,1998 @@ +!> Basic Lagrangian particle solver class: +!> Provides support for Lagrangian-transported objects +module lpt_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use diag_class, only: diag + use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION + implicit none + private + + + ! Expose type/constructor/methods + public :: lpt + + !> Pozorski & Apte (2009) model constant + real(WP), public :: C_poz = 1.0_WP + + !> Memory adaptation parameter + real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor + real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor + + !> I/O chunk size to read at a time + integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing + + !> Basic particle object definition + type :: part + !> MPI_INTEGER8 data + integer(kind=8) :: id !< Particle ID + !> MPI_DOUBLE_PRECISION data + real(WP) :: d !< Particle diameter + real(WP), dimension(3) :: pos !< Particle center coordinates + real(WP), dimension(3) :: vel !< Velocity of particle + real(WP), dimension(3) :: angVel !< Angular velocity of particle + real(WP), dimension(3) :: Acol !< Collision acceleration + real(WP), dimension(3) :: Tcol !< Collision torque + real(WP), dimension(3) :: dW !< Wiener increment + real(WP), dimension(3) :: b_ij !< Neighbor contributions to diffusion + real(WP), dimension(3) :: uf !< Stochastic flucutating fluid velocity seen + real(WP) :: corrsum !< Sum of correlation coefficient over neighbors + real(WP) :: a_crw !< OU drift + real(WP) :: b_crw !< OU diffusion + real(WP) :: T !< Temperature + real(WP) :: dt !< Time step size for the particle + !> MPI_INTEGER data + integer , dimension(3) :: ind !< Index of cell containing particle center + integer :: flag !< Control parameter (0=normal, 1=done->will be removed) + end type part + !> Number of blocks, block length, and block types in a particle + integer, parameter :: part_nblock=3 + integer , dimension(part_nblock) :: part_lblock=[1,30,4] + type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] + !> MPI_PART derived datatype and size + type(MPI_Datatype) :: MPI_PART + integer :: MPI_PART_SIZE + + !> Lagrangian particle tracking solver object definition + type :: lpt + + ! This is our underlying config + class(config), pointer :: cfg !< This is the config the solver is build for + + type(diag) :: tridiag !< Tridiagonal solver for implicit filter + + ! This is the name of the solver + character(len=str_medium) :: name='UNNAMED_LPT' !< Solver name (default=UNNAMED_LPT) + + ! Particle data + integer :: np !< Global number of particles + integer :: np_ !< Local number of particles + integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor + type(part), dimension(:), allocatable :: p !< Array of particles of type part + + ! Overlap particle (i.e., ghost) data + integer :: ng_ !< Local number of ghosts + type(part), dimension(:), allocatable :: g !< Array of ghosts of type part + + ! CFL numbers + real(WP) :: CFLp_x,CFLp_y,CFLp_z,CFL_col !< CFL numbers + + ! Particle density + real(WP) :: rho !< Density of particle + + ! Gravitational acceleration + real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity + + ! Solver parameters + real(WP) :: nstep=1 !< Number of substeps (default=1) + character(len=str_medium), public :: drag_model !< Drag model + character(len=str_medium), public :: corr_type !< Spatial correlation function for OU process + logical :: use_lift=.false. !< Compute lift force on particles + + ! Collisional parameters + logical :: use_col=.true. !< Flag for collisions + real(WP) :: tau_col !< Characteristic collision time scale + real(WP) :: e_n !< Normal restitution coefficient + real(WP) :: e_w !< Wall restitution coefficient + real(WP) :: mu_f !< Friction coefficient + real(WP) :: clip_col=0.2_WP !< Maximum allowable overlap + real(WP), dimension(:,:,:), allocatable :: Wdist !< Signed wall distance - naive for now (could be redone with FMM) + real(WP), dimension(:,:,:,:), allocatable :: Wnorm !< Wall normal function - naive for now (could be redone with FMM) + + ! Injection parameters + real(WP) :: mfr !< Mass flow rate for particle injection + real(WP), dimension(3) :: inj_pos !< Center location to inject particles + real(WP), dimension(3) :: inj_vel !< Celocity assigned during injection + real(WP) :: inj_T !< Temperature assigned during injection + real(WP) :: inj_dmean !< Mean diameter assigned during injection + real(WP) :: inj_dsd !< STD diameter assigned during injection + real(WP) :: inj_dmin !< Min diameter assigned during injection + real(WP) :: inj_dmax !< Max diameter assigned during injection + real(WP) :: inj_dshift !< Diameter shift assigned during injection + real(WP) :: inj_d !< Diameter to inject particles within + + ! Monitoring info + real(WP) :: VFmin,VFmax,VFmean,VFvar !< Volume fraction info + real(WP) :: dmin,dmax,dmean,dvar !< Diameter info + real(WP) :: Umin,Umax,Umean,Uvar !< U velocity info + real(WP) :: Vmin,Vmax,Vmean,Vvar !< V velocity info + real(WP) :: Wmin,Wmax,Wmean,Wvar !< W velocity info + integer :: np_new,np_out !< Number of new and removed particles + integer :: ncol=0 !< Number of collisions + + ! Particle volume fraction + real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered + + ! Filtering operation + logical :: implicit_filter !< Solve implicitly + real(WP) :: filter_width !< Characteristic filter width + real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator + real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator + + contains + procedure :: update_partmesh !< Update a partmesh object using current particles + procedure :: collide !< Evaluate interparticle collision force + procedure :: update_dW !< Updates random values assigned to particles + procedure :: advance !< Step forward the particle ODEs + procedure :: get_rhs !< Compute rhs of particle odes + procedure :: resize !< Resize particle array to given size + procedure :: resize_ghost !< Resize ghost array to given size + procedure :: recycle !< Recycle particle array by removing flagged particles + procedure :: sync !< Synchronize particles across interprocessor boundaries + procedure :: share !< Share particles across interprocessor boundaries + procedure :: read !< Parallel read particles from file + procedure :: write !< Parallel write particles to file + procedure :: get_max !< Extract various monitoring data + procedure :: get_cfl !< Calculate maximum CFL + procedure :: update_VF !< Compute particle volume fraction + procedure :: filter !< Apply volume filtering to field + procedure :: inject !< Inject particles at a prescribed boundary + end type lpt + + + !> Declare lpt solver constructor + interface lpt + procedure constructor + end interface lpt + +contains + + + !> Default constructor for lpt solver + function constructor(cfg,name) result(self) + implicit none + type(lpt) :: self + class(config), target, intent(in) :: cfg + character(len=*), optional :: name + integer :: i,j,k + + ! Set the name for the solver + if (present(name)) self%name=trim(adjustl(name)) + + ! Point to pgrid object + self%cfg=>cfg + + ! Create tridiagonal solver object + self%tridiag=diag(cfg=self%cfg,name='Tridiagonal',n=3) + + ! Allocate variables + allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 + self%np_=0; self%np=0 + call self%resize(0) + self%np_new=0; self%np_out=0 + + ! Initialize MPI derived datatype for a particle + call prepare_mpi_part() + + ! Allocate VF and src arrays on cfg mesh + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + + ! Set filter width to zero by default + self%filter_width=0.0_WP + + ! Solve implicitly by default + self%implicit_filter=.true. + + ! Set default drag + self%drag_model='Schiller-Naumann' + + ! Zero friction by default + self%mu_f=0.0_WP + + ! Allocate finite volume divergence operators + allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + allocate(self%div_y(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + allocate(self%div_z(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered + ! Create divergence operator to cell center [xm,ym,zm] + do k=self%cfg%kmin_,self%cfg%kmax_ + do j=self%cfg%jmin_,self%cfg%jmax_ + do i=self%cfg%imin_,self%cfg%imax_ + self%div_x(:,i,j,k)=self%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< Divergence from [x ,ym,zm] + self%div_y(:,i,j,k)=self%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,y ,zm] + self%div_z(:,i,j,k)=self%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,ym,z ] + end do + end do + end do + + ! Allocate finite difference velocity gradient operators + allocate(self%grd_x(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< X-face-centered + allocate(self%grd_y(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Y-face-centered + allocate(self%grd_z(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Z-face-centered + ! Create gradient coefficients to cell faces + do k=self%cfg%kmin_,self%cfg%kmax_+1 + do j=self%cfg%jmin_,self%cfg%jmax_+1 + do i=self%cfg%imin_,self%cfg%imax_+1 + self%grd_x(:,i,j,k)=self%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< Gradient in x from [xm,ym,zm] to [x,ym,zm] + self%grd_y(:,i,j,k)=self%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< Gradient in y from [xm,ym,zm] to [xm,y,zm] + self%grd_z(:,i,j,k)=self%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< Gradient in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + + ! Loop over the domain and zero divergence in walls + do k=self%cfg%kmin_,self%cfg%kmax_ + do j=self%cfg%jmin_,self%cfg%jmax_ + do i=self%cfg%imin_,self%cfg%imax_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) then + self%div_x(:,i,j,k)=0.0_WP + self%div_y(:,i,j,k)=0.0_WP + self%div_z(:,i,j,k)=0.0_WP + end if + end do + end do + end do + + ! Zero out gradient to wall faces + do k=self%cfg%kmin_,self%cfg%kmax_+1 + do j=self%cfg%jmin_,self%cfg%jmax_+1 + do i=self%cfg%imin_,self%cfg%imax_+1 + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i-1,j,k).eq.0.0_WP) self%grd_x(:,i,j,k)=0.0_WP + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j-1,k).eq.0.0_WP) self%grd_y(:,i,j,k)=0.0_WP + if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j,k-1).eq.0.0_WP) self%grd_z(:,i,j,k)=0.0_WP + end do + end do + end do + + ! Adjust metrics to account for lower dimensionality + if (self%cfg%nx.eq.1) then + self%div_x=0.0_WP + self%grd_x=0.0_WP + end if + if (self%cfg%ny.eq.1) then + self%div_y=0.0_WP + self%grd_y=0.0_WP + end if + if (self%cfg%nz.eq.1) then + self%div_z=0.0_WP + self%grd_z=0.0_WP + end if + + ! Generate a wall distance/norm function + allocate(self%Wdist( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) + allocate(self%Wnorm(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) + ! First pass to set correct sign + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%cfg%VF(i,j,k).eq.0.0_WP) then + self%Wdist(i,j,k)=-sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) + else + self%Wdist(i,j,k)=+sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) + end if + self%Wnorm(:,i,j,k)=0.0_WP + end do + end do + end do + ! Second pass to compute local distance + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_+1,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i-1,j,k).lt.0.0_WP) then + ! There is a wall at x(i) + if (abs(self%cfg%xm(i )-self%cfg%x(i)).lt.abs(self%Wdist(i ,j,k))) then + self%Wdist(i ,j,k)=sign(self%cfg%xm(i )-self%cfg%x(i),self%Wdist(i ,j,k)) + self%Wnorm(:,i ,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] + end if + if (abs(self%cfg%xm(i-1)-self%cfg%x(i)).lt.abs(self%Wdist(i-1,j,k))) then + self%Wdist(i-1,j,k)=sign(self%cfg%xm(i-1)-self%cfg%x(i),self%Wdist(i-1,j,k)) + self%Wnorm(:,i-1,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + do k=self%cfg%kmino_,self%cfg%kmaxo_ + do j=self%cfg%jmino_+1,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i,j-1,k).lt.0.0_WP) then + ! There is a wall at y(j) + if (abs(self%cfg%ym(j )-self%cfg%y(j)).lt.abs(self%Wdist(i,j ,k))) then + self%Wdist(i,j ,k)=sign(self%cfg%ym(j )-self%cfg%y(j),self%Wdist(i,j ,k)) + self%Wnorm(:,i,j ,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] + end if + if (abs(self%cfg%ym(j-1)-self%cfg%y(j)).lt.abs(self%Wdist(i,j-1,k))) then + self%Wdist(i,j-1,k)=sign(self%cfg%ym(j-1)-self%cfg%y(j),self%Wdist(i,j-1,k)) + self%Wnorm(:,i,j-1,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + do k=self%cfg%kmino_+1,self%cfg%kmaxo_ + do j=self%cfg%jmino_,self%cfg%jmaxo_ + do i=self%cfg%imino_,self%cfg%imaxo_ + if (self%Wdist(i,j,k)*self%Wdist(i,j,k-1).lt.0.0_WP) then + ! There is a wall at z(k) + if (abs(self%cfg%zm(k )-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k ))) then + self%Wdist(i,j,k )=sign(self%cfg%zm(k )-self%cfg%z(k),self%Wdist(i,j,k )) + self%Wnorm(:,i,j,k )=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] + end if + if (abs(self%cfg%zm(k-1)-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k-1))) then + self%Wdist(i,j,k-1)=sign(self%cfg%zm(k-1)-self%cfg%z(k),self%Wdist(i,j,k-1)) + self%Wnorm(:,i,j,k-1)=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] + end if + end if + end do + end do + end do + call self%cfg%sync(self%Wdist) + call self%cfg%sync(self%Wnorm) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (self%cfg%amRoot) then + write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + end function constructor + + + !> Resolve collisional interaction between particles + !> Requires tau_col, e_n, e_w and mu_f to be set beforehand + subroutine collide(this,dt) + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + + ! Start by zeroing out the collision force + zero_force: block + integer :: i + do i=1,this%np_ + this%p(i)%Acol=0.0_WP + this%p(i)%Tcol=0.0_WP + end do + end block zero_force + + ! Return if not used + if (.not.this%use_col) return + + ! Then share particles across overlap + call this%share() + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i + end do + + end block pic_prep + + ! Finally, calculate collision force + collision_force: block + use mpi_f08 + use mathtools, only: Pi,normalize,cross_product + integer :: i1,i2,ii,jj,kk,nn,ierr + real(WP) :: d1,m1,d2,m2,d12,m12 + real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t + real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv + real(WP), parameter :: aclipnorm=1.0e-6_WP + real(WP), parameter :: acliptan=1.0e-9_WP + real(WP), parameter :: rcliptan=0.05_WP + + ! Reset collision counter + this%ncol=0 + + ! Precompute coefficients for k and eta + k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 + eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col + k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 + eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col + + ! Loop over all local particles + collision: do i1=1,this%np_ + + ! Cycle if id<=0 + if (this%p(i1)%id.le.0) cycle collision + + ! Store particle data + r1=this%p(i1)%pos + v1=this%p(i1)%vel + w1=this%p(i1)%angVel + d1=this%p(i1)%d + m1=this%rho*Pi/6.0_WP*d1**3 + + ! First collide with walls + d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') + n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) + n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) + rnv=dot_product(v1,n12) + r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) + delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + k_n=m1*k_coeff_w + eta_n=m1*eta_coeff_w + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt/d1.gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + end if + + ! Loop over nearest cells + do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 + do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 + do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + v2=this%p(i2)%vel + w2=this%p(i2)%angVel + d2=this%p(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + v2=this%g(i2)%vel + w2=this%g(i2)%angVel + d2=this%g(i2)%d + m2=this%rho*Pi/6.0_WP*d2**3 + end if + + ! Compute relative information + d12=norm2(r1-r2) + if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision + n12=(r2-r1)/d12 + v12=v1-v2 + rnv=dot_product(v12,n12) + r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) + delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) + + ! Assess if there is collision + if (delta_n.gt.0.0_WP) then + ! Normal collision + m12=m1*m2/(m1+m2) + k_n=m12*k_coeff + eta_n=m12*eta_coeff + f_n=-k_n*delta_n*n12-eta_n*rnv*n12 + ! Tangential collision + f_t=0.0_WP + if (this%mu_f.gt.0.0_WP) then + t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) + rtv = sqrt(sum(t12*t12)) + if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then + if (rtv/rnv.lt.rcliptan) rtv=0.0_WP + else + if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP + end if + if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv + end if + ! Calculate collision force + f_n=f_n/m1; f_t=f_t/m1 + this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t + ! Calculate collision torque + this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) + ! Add up the collisions + this%ncol=this%ncol+1 + end if + + end do + + end do + end do + end do + + ! Deal with dimensionality + if (this%cfg%nx.eq.1) then + this%p(i1)%Acol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%ny.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Acol(2)=0.0_WP + this%p(i1)%Tcol(3)=0.0_WP + end if + if (this%cfg%nz.eq.1) then + this%p(i1)%Tcol(1)=0.0_WP + this%p(i1)%Tcol(2)=0.0_WP + this%p(i1)%Acol(3)=0.0_WP + end if + + end do collision + + ! Determine total number of collisions + call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 + + end block collision_force + + end subroutine collide + + !> Assigns new random numbers (dim 3) to particles from N~(0,sqrt(dt)) + subroutine update_dW(this, dt) + use random, only: random_normal + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP) :: rdt + integer :: i + rdt = sqrt(dt) + do i=1,this%np_ + this%p(i)%dW = [random_normal(m=0.0_WP,sd=rdt), & + random_normal(m=0.0_WP,sd=rdt), & + random_normal(m=0.0_WP,sd=rdt)] + end do + end subroutine update_dW + + !> Advance the particle equations by a specified time step dt + !> p%id=0 => no coll, no solve + !> p%id=-1=> no coll, no move + subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T,srcU,srcV,srcW,srcE,use_crw,sgs) + use mpi_f08, only : MPI_SUM,MPI_INTEGER + use mathtools, only: Pi + use sgsmodel_class, only: sgsmodel!, get_sgstke + use random, only: random_normal + implicit none + class(lpt), intent(inout) :: this + class(sgsmodel), intent(in), optional :: sgs + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcE !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + integer :: i,j,k,ierr,no + real(WP) :: mydt,dt_done,deng,Ip,rdt,tke,sig_sg,tau_crwi + real(WP) :: tmp1,tmp2,tmp3 + real(WP), dimension(3) :: acc,torque,dmom + integer :: iii,jjj,kkk + integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell + integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell + real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz + type(part) :: myp,pold + logical :: spatial + logical, intent(in), optional :: use_crw + + rdt = sqrt(dt) + spatial = .true. + + ! Zero out source term arrays + if (present(srcU)) srcU=0.0_WP + if (present(srcV)) srcV=0.0_WP + if (present(srcW)) srcW=0.0_WP + if (present(srcE)) srcE=0.0_WP + + ! Get fluid stress + if (present(stress_x)) then + sx=stress_x + else + sx=0.0_WP + end if + if (present(stress_y)) then + sy=stress_y + else + sy=0.0_WP + end if + if (present(stress_z)) then + sz=stress_z + else + sz=0.0_WP + end if + + ! Zero out number of particles removed + this%np_out=0 + + if (spatial) then + no = 2 + + ! Share particles across overlap + call this%share(no) + + ! We can now assemble particle-in-cell information + pic_prep: block + use mpi_f08 + integer :: i,ip,jp,kp,ierr + integer :: mymax_npic,max_npic + + ! Allocate number of particle in cell + allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 + + ! Count particles and ghosts per cell + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + end do + + ! Get maximum number of particle in cell + mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) + + ! Allocate pic map + allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 + + ! Assemble pic map + npic=0 + do i=1,this%np_ + ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=i + end do + do i=1,this%ng_ + ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) + npic(ip,jp,kp)=npic(ip,jp,kp)+1 + ipic(npic(ip,jp,kp),ip,jp,kp)=-i + end do + + end block pic_prep + end if + if (use_crw) call this%update_dW(dt=dt) + ! Advance the equations + do i=1,this%np_ + ! Avoid particles with id=0 + if (this%p(i)%id.eq.0) cycle + ! Create local copy of particle + myp=this%p(i) + ! Time-integrate until dt_done=dt + dt_done=0.0_WP + do while (dt_done.lt.dt) + ! Decide the timestep size + mydt=min(myp%dt,dt-dt_done) + ! Remember the particle + pold=myp + ! Particle moment of inertia per unit mass + Ip = 0.1_WP*myp%d**2 + ! Advance with Euler prediction + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt,use_crw=use_crw) + !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) + myp%pos=pold%pos+0.5_WP*mydt*myp%vel + myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip + if (use_crw) then + iii = this%p(i)%ind(1) + jjj = this%p(i)%ind(2) + kkk = this%p(i)%ind(3) + tke = 0.1_WP !get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) + + sig_sg = sqrt(0.6666_WP*tke) + tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz + + this%p(i)%a_crw = tau_crwi + this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) + + if (spatial) then + correlate_neighbors: block + use mathtools, only: Pi,normalize + integer :: i2,ii,jj,kk,nn + real(WP), dimension(3) :: r1,r2 + real(WP) :: k_n,eta_n,lne,pilne2,rnv,r_influ,delta_n,corr,d12 + + ! Store particle data + r1=this%p(i)%pos + + ! Zero out neighbor contribution + this%p(i)%b_ij = 0.0_WP + this%p(i)%corrsum = 0.0_WP + + ! Loop over nearest cells + do kk=this%p(i)%ind(3)-no,this%p(i)%ind(3)+no + do jj=this%p(i)%ind(2)-no,this%p(i)%ind(2)+no + do ii=this%p(i)%ind(1)-no,this%p(i)%ind(1)+no + + ! Loop over particles in that cell + do nn=1,npic(ii,jj,kk) + ! Get index of neighbor particle + i2=ipic(nn,ii,jj,kk) + + ! Get relevant data from correct storage + if (i2.gt.0) then + r2=this%p(i2)%pos + else if (i2.lt.0) then + i2=-i2 + r2=this%g(i2)%pos + end if + + ! Compute relative information + d12=norm2(r1-r2) + corr = corr_func(d12) + + this%p(i)%corrsum = this%p(i)%corrsum + corr + this%p(i)%b_ij = this%p(i)%b_ij + corr*this%p(i2)%dW + end do + end do + end do + end do + end block correlate_neighbors + + ! Increment OU process - 1st order + tmp1 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(1) + this%p(i)%b_crw*this%p(i)%b_ij(1)/this%p(i)%corrsum! - & + !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(1)**2 - mydt) + tmp2 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(2) + this%p(i)%b_crw*this%p(i)%b_ij(2)/this%p(i)%corrsum! - & + !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(2)**2 - mydt) + tmp3 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(3) + this%p(i)%b_crw*this%p(i)%b_ij(3)/this%p(i)%corrsum! - & + !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(3)**2 - mydt) + else + this%p(i)%dW = [random_normal(m=0.0_WP,sd=rdt), & + random_normal(m=0.0_WP,sd=rdt), & + random_normal(m=0.0_WP,sd=rdt)] + tmp1 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(1) + this%p(i)%b_crw*this%p(i)%dW(1) + tmp2 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(2) + this%p(i)%b_crw*this%p(i)%dW(2) + tmp3 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(3) + this%p(i)%b_crw*this%p(i)%dW(3) + end if + end if + ! Correct with midpoint rule + call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt,use_crw=use_crw) + myp%pos=pold%pos+mydt*myp%vel + myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) + myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip + if (use_crw) then + tke = 0.01_WP! get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) + sig_sg = sqrt(0.6666_WP*tke) + tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz + this%p(i)%a_crw = tau_crwi + this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) + + this%p(i)%uf(1) = tmp1! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW1**2 - mydt) + this%p(i)%uf(2) = tmp2! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW2**2 - mydt) + this%p(i)%uf(3) = tmp3! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW3**2 - mydt) + end if + ! Relocalize + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) + ! Send source term back to the mesh + dmom=mydt*acc*this%rho*Pi/6.0_WP*myp%d**3 + deng=sum(dmom*myp%vel) + if (this%cfg%nx.gt.1.and.present(srcU)) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcU,bc='n') + if (this%cfg%ny.gt.1.and.present(srcV)) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcV,bc='n') + if (this%cfg%nz.gt.1.and.present(srcW)) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcW,bc='n') + if (present(srcE)) call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcE,bc='n') + ! Increment + dt_done=dt_done+mydt + end do + ! Correct the position to take into account periodicity + if (this%cfg%xper) myp%pos(1)=this%cfg%x(this%cfg%imin)+modulo(myp%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) + if (this%cfg%yper) myp%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(myp%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) + if (this%cfg%zper) myp%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(myp%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) + ! Handle particles that have left the domain + if (myp%pos(1).lt.this%cfg%x(this%cfg%imin).or.myp%pos(1).gt.this%cfg%x(this%cfg%imax+1)) myp%flag=1 + if (myp%pos(2).lt.this%cfg%y(this%cfg%jmin).or.myp%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) myp%flag=1 + if (myp%pos(3).lt.this%cfg%z(this%cfg%kmin).or.myp%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) myp%flag=1 + ! Relocalize the particle + myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) + ! Count number of particles removed + if (myp%flag.eq.1) this%np_out=this%np_out+1 + ! Copy back to particle + if (myp%id.ne.-1) this%p(i)=myp + if (use_crw) then + tke = 0.01_WP !get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) + sig_sg = sqrt(0.6666_WP*tke) + tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz + this%p(i)%a_crw = tau_crwi + this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) + end if + end do + + ! Communicate particles + call this%sync() + + ! Sum up particles removed + call MPI_ALLREDUCE(this%np_out,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_out=i + + ! Divide source arrays by volume, sum at boundaries, and volume filter if present + if (present(srcU)) then + srcU=srcU/this%cfg%vol; call this%cfg%syncsum(srcU); call this%filter(srcU) + end if + if (present(srcV)) then + srcV=srcV/this%cfg%vol; call this%cfg%syncsum(srcV); call this%filter(srcV) + end if + if (present(srcW)) then + srcW=srcW/this%cfg%vol; call this%cfg%syncsum(srcW); call this%filter(srcW) + end if + if (present(srcE)) then + srcE=srcE/this%cfg%vol; call this%cfg%syncsum(srcE); call this%filter(srcE) + end if + + ! Recompute volume fraction + call this%update_VF() + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np + if (verbose.gt.1) write(output_unit,'(a)') trim(message) + if (verbose.gt.0) call log(message) + end if + end block logging + + contains + + function corr_func(r) result(rhoij) + real(WP) :: r, rhoij + + select case(trim(this%corr_type)) + case('exp') + rhoij = 1.0_WP + ! case('inferred') + ! rhoij = inferredcorr(r) + case('linear') + rhoij = 1.0_WP - 2.5_WP*r + case default + rhoij = 1.0_WP + end select + + end function corr_func + + end subroutine advance + + + !> Calculate RHS of the particle ODEs + subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque,opt_dt,use_crw) + implicit none + class(lpt), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + type(part), intent(in) :: p + logical, intent(in) :: use_crw + real(WP), dimension(3), intent(out) :: acc,torque + real(WP), intent(out) :: opt_dt + real(WP) :: fvisc,frho,pVF,fVF,fT + real(WP), dimension(3) :: fvel,fstress,fvort + + ! Interpolate fluid quantities to particle location + interpolate: block + ! Interpolate the fluid phase velocity to the particle location + fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + if (use_crw) then + fvel=fvel+p%uf + end if + ! Interpolate the fluid phase stress to the particle location + fstress=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=stress_x,V=stress_y,W=stress_z) + ! Interpolate the fluid phase viscosity to the particle location + fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') + fvisc=fvisc+epsilon(1.0_WP) + ! Interpolate the fluid phase density to the particle location + frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') + ! Interpolate the particle volume fraction to the particle location + pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') + fVF=1.0_WP-pVF + ! Interpolate the fluid temperature to the particle location if present + if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') + ! Interpolate the fluid vorticity to the particle location if needed + !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) + end block interpolate + + ! Compute acceleration due to drag + compute_drag: block + real(WP) :: Re,tau,corr,b1,b2 + ! Particle Reynolds number + Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) + ! Drag correction + select case(trim(this%drag_model)) + case('None','none') + corr=epsilon(1.0_WP) + case('Stokes') + corr=1.0_WP + case('Schiller-Naumann','Schiller Naumann','SN') + corr=1.0_WP+0.15_WP*Re**(0.687_WP) + case('Tenneti') + ! Tenneti and Subramaniam (2011) + b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 + b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) + corr=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) + case('Khalloufi Capecelatro','KC') + !> Todo + case default + corr=1.0_WP + end select + ! Particle response time + tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) + ! Return acceleration and optimal timestep size + acc=(fvel-p%vel)/tau+fstress/this%rho + opt_dt=tau/real(this%nstep,WP) + end block compute_drag + + ! Compute acceleration due to Saffman lift + compute_lift: block + use mathtools, only: Pi,cross_product + real(WP) :: omegag,Cl,Reg + if (this%use_lift) then + omegag=sqrt(sum(fvort**2)) + if (omegag.gt.0.0_WP) then + Reg = p%d**2*omegag*frho/fvisc + Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) + acc=acc+Cl*cross_product(fvel-p%vel,fvort) + end if + end if + end block compute_lift + + ! Compute fluid torque (assumed Stokes drag) + compute_torque: block + torque=0.0_WP!6.0_WP*fvisc*(0.5_WP*fvort-p%angVel)/this%rho + end block compute_torque + + ! Compute heat transfer + compute_heat_transfer: block + !> Todo + end block compute_heat_transfer + + end subroutine get_rhs + + + !> Update particle volume fraction using our current particles + subroutine update_VF(this) + use mathtools, only: Pi + implicit none + class(lpt), intent(inout) :: this + integer :: i + real(WP) :: Vp + ! Reset volume fraction + this%VF=0.0_WP + ! Transfer particle volume + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle + ! Transfer particle volume + Vp=Pi/6.0_WP*this%p(i)%d**3 + call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') + end do + this%VF=this%VF/this%cfg%vol + ! Sum at boundaries + call this%cfg%syncsum(this%VF) + ! Apply volume filter + call this%filter(this%VF) + end subroutine update_VF + + + !> Laplacian filtering operation + subroutine filter(this,A) + implicit none + class(lpt), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP) :: filter_coeff + integer :: i,j,k,n,nstep + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ + + ! Return without filtering if filter width is zero + if (this%filter_width.le.0.0_WP) return + + ! Recompute filter coeff and number of explicit steps needed + filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 + + if (this%implicit_filter) then !< Apply filter implicitly via approximate factorization + ! Inverse in X-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) + this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & + + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) + this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(0,i+1,j,k) + this%tridiag%Rx(j,k,i) = A(i,j,k) + end do + end do + end do + call this%tridiag%linsol_x() + ! Inverse in Y-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) + this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & + + this%div_y(1,i,j,k) * filter_coeff * this%grd_y(-1,i,j+1,k)) + this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) + this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) + end do + end do + end do + call this%tridiag%linsol_y() + ! Inverse in Z-direction + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%tridiag%Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) + this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & + + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) + this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) + this%tridiag%Rz(i,j,k) = this%tridiag%Ry(i,k,j) + end do + end do + end do + call this%tridiag%linsol_z() + ! Update A + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + A(i,j,k)=this%tridiag%Rz(i,j,k) + end do + end do + end do + else !< Apply filter explicitly + ! Allocate flux arrays + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) + filter_coeff=filter_coeff/real(nstep,WP) + do n=1,nstep + ! Diffusive flux of A + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) + FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) + FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) + end do + end do + end do + ! Divergence of fluxes + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) + end do + end do + end do + end do + ! Deallocate flux arrays + deallocate(FX,FY,FZ) + end if + + ! Sync A + call this%cfg%sync(A) + + end subroutine filter + + + !> Inject particles from a prescribed location with given mass flowrate + !> Requires injection parameters to be set beforehand + subroutine inject(this,dt) + use mpi_f08 + use parallel, only: MPI_REAL_WP + use mathtools, only: Pi + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection + real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters + real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep + integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id + integer :: i,j,np0_,np2,np_tmp,count,ierr + integer, dimension(:), allocatable :: nrecv + type(part), dimension(:), allocatable :: p2 + type(MPI_Status) :: status + logical :: overlap + + ! Initial number of particles + np0_=this%np_ + this%np_new=0 + + ! Get the particle mass that should be added to the system + Mgoal = this%mfr*dt+previous_error + Madded = 0.0_WP + + ! Determine id to assign to particle + maxid_=0 + do i=1,this%np_ + maxid_=max(maxid_,this%p(i)%id) + end do + call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) + + ! Communicate nearby particles to check for overlap + if (this%use_col) then + allocate(nrecv(this%cfg%nproc)) + count=0 + inj_min(1)=this%cfg%x(this%cfg%imino) + inj_max(1)=this%inj_pos(1)+this%inj_dmax + inj_min(2)=this%inj_pos(2)-0.5_WP*this%inj_d-this%inj_dmax + inj_max(2)=this%inj_pos(2)+0.5_WP*this%inj_d+this%inj_dmax + inj_min(3)=this%inj_pos(3)-0.5_WP*this%inj_d-this%inj_dmax + inj_max(3)=this%inj_pos(3)+0.5_WP*this%inj_d+this%inj_dmax + do i=1,this%np_ + if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& + this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& + this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) count=count+1 + end do + call MPI_GATHER(count,1,MPI_INTEGER,nrecv,1,MPI_INTEGER,0,this%cfg%comm,ierr) + if (this%cfg%amRoot) then + np2=sum(nrecv) + allocate(p2(np2)) + else + allocate(p2(count)) + end if + count=0 + do i=1,this%np_ + if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& + this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& + this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) then + count=count+1 + p2(count)=this%p(i) + end if + end do + if (this%cfg%amRoot) then + do i=2,this%cfg%nproc + if (nrecv(i).gt.0) then + call MPI_recv(p2(sum(nrecv(1:i-1))+1:sum(nrecv(1:i))),nrecv(i),MPI_PART,i-1,0,this%cfg%comm,status,ierr) + end if + end do + else + if (count.gt.0) call MPI_send(p2,count,MPI_PART,0,0,this%cfg%comm,ierr) + end if + deallocate(nrecv) + end if + + ! Add new particles until desired mass is achieved + do while (Madded.lt.Mgoal) + + if (this%cfg%amRoot) then + ! Initialize parameters + Mtmp = 0.0_WP + np_tmp = 0 + ! Loop while the added volume is not sufficient + do while (Mtmp.lt.Mgoal-Madded) + ! Increment counter + np_tmp=np_tmp+1 + count = np0_+np_tmp + ! Create space for new particle + call this%resize(count) + ! Generate a diameter + this%p(count)%d=get_diameter() + ! Set various parameters for the particle + this%p(count)%id =maxid+int(np_tmp,8) + this%p(count)%dt =0.0_WP + this%p(count)%Acol =0.0_WP + this%p(count)%Tcol =0.0_WP + this%p(count)%T =this%inj_T + this%p(count)%angVel=0.0_WP + ! Give a position at the injector to the particle + this%p(count)%pos=get_position() + overlap=.false. + ! Check overlap with particles recently injected + if (this%use_col) then + do j=1,np_tmp-1 + if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. + end do + ! Check overlap with all other particles + if (.not.overlap) then + do j=1,np2 + if (norm2(this%p(count)%pos-p2(j)%pos).lt.0.5_WP*(this%p(count)%d+p2(j)%d)) overlap=.true. + end do + end if + end if + + if (overlap) then + ! Try again + np_tmp=np_tmp-1 + else + ! Localize the particle + this%p(count)%ind(1)=this%cfg%imin; this%p(count)%ind(2)=this%cfg%jmin; this%p(count)%ind(3)=this%cfg%kmin + this%p(count)%ind=this%cfg%get_ijk_global(this%p(count)%pos,this%p(count)%ind) + ! Give it a velocity + this%p(count)%vel=this%inj_vel + ! Make it an "official" particle + this%p(count)%flag=0 + ! Update the added mass for the timestep + Mtmp = Mtmp + this%rho*Pi/6.0_WP*this%p(count)%d**3 + end if + end do + end if + ! Communicate particles + call this%sync() + ! Loop through newly created particles + buf=0.0_WP + do i=np0_+1,this%np_ + ! Remove if out of bounds + if (this%cfg%VF(this%p(i)%ind(1),this%p(i)%ind(2),this%p(i)%ind(3)).le.0.0_WP) this%p(i)%flag=1 + if (this%p(i)%flag.eq.0) then + ! Update the added mass for the timestep + buf = buf + this%rho*Pi/6.0_WP*this%p(i)%d**3 + ! Update the max particle id + maxid = max(maxid,this%p(i)%id) + ! Increment counter + this%np_new=this%np_new+1 + end if + end do + ! Total mass added + call MPI_ALLREDUCE(buf,Mtmp,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); Madded=Madded+Mtmp + ! Clean up particles + call this%recycle() + ! Update initial npart + np0_=this%np_ + ! Maximum particle id + call MPI_ALLREDUCE(maxid,maxid_,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr); maxid=maxid_ + end do + + ! Remember the error + previous_error = Mgoal-Madded + + ! Sum up injected particles + call MPI_ALLREDUCE(this%np_new,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_new=i + + if (allocated(p2)) deallocate(p2) + + contains + + ! Compute particle diameter + function get_diameter() result(dp) + use random, only: random_lognormal + implicit none + real(WP) :: dp + dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift + do while (dp.gt.this%inj_dmax+epsilon(1.0_WP).or.dp.lt.this%inj_dmin-epsilon(1.0_WP)) + dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift + end do + end function get_diameter + + ! Position for bulk injection of particles + function get_position() result(pos) + use random, only: random_uniform + use mathtools, only: twoPi + implicit none + real(WP), dimension(3) :: pos + real(WP) :: rand,r,theta + integer :: ip,jp,kp + ! Set x position + pos(1) = this%inj_pos(1) + ! Random y & z position within a circular region + if (this%cfg%nz.eq.1) then + pos(2)=random_uniform(lo=this%inj_pos(2)-0.5_WP*this%inj_d,hi=this%inj_pos(3)+0.5_WP*this%inj_d) + pos(3) = this%cfg%zm(this%cfg%kmin_) + else + rand=random_uniform(lo=0.0_WP,hi=1.0_WP) + r=0.5_WP*this%inj_d*sqrt(rand) !< sqrt(rand) avoids accumulation near the center + call random_number(rand) + theta=random_uniform(lo=0.0_WP,hi=twoPi) + pos(2) = this%inj_pos(2)+r*sin(theta) + pos(3) = this%inj_pos(3)+r*cos(theta) + end if + end function get_position + + end subroutine inject + + + !> Calculate the CFL + subroutine get_cfl(this,dt,cfl) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(lpt), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + integer :: i,ierr + real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col + + ! Set the CFLs to zero + my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP; my_CFL_col=0.0_WP + do i=1,this%np_ + my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) + my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) + my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) + my_CFL_col=max(my_CFL_col,sqrt(sum(this%p(i)%vel**2))/this%p(i)%d) + end do + my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt + + ! Get the parallel max + call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + + ! Return the maximum convective CFL + cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) + if (this%use_col) then + my_CFL_col=10.0_WP*my_CFL_col*dt + call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) + cfl = max(cfl,this%CFL_col) + else + this%CFL_col=0.0_WP + end if + + end subroutine get_cfl + + + !> Extract various monitoring data from particle field + subroutine get_max(this) + use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(lpt), intent(inout) :: this + real(WP) :: buf,safe_np + integer :: i,j,k,ierr + + ! Create safe np + safe_np=real(max(this%np,1),WP) + + ! Diameter and velocity min/max/mean + this%dmin=huge(1.0_WP); this%dmax=-huge(1.0_WP); this%dmean=0.0_WP + this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP + this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP + this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP + do i=1,this%np_ + this%dmin=min(this%dmin,this%p(i)%d ); this%dmax=max(this%dmax,this%p(i)%d ); this%dmean=this%dmean+this%p(i)%d + this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) + this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) + this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) + end do + call MPI_ALLREDUCE(this%dmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%dmin =buf + call MPI_ALLREDUCE(this%dmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%dmax =buf + call MPI_ALLREDUCE(this%dmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dmean=buf/safe_np + call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf + call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf + call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np + call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf + call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf + call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np + call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf + call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf + call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np + + ! Diameter and velocity variance + this%dvar=0.0_WP + this%Uvar=0.0_WP + this%Vvar=0.0_WP + this%Wvar=0.0_WP + do i=1,this%np_ + this%dvar=this%dvar+(this%p(i)%d -this%dmean)**2.0_WP + this%Uvar=this%Uvar+(this%p(i)%vel(1)-this%Umean)**2.0_WP + this%Vvar=this%Vvar+(this%p(i)%vel(2)-this%Vmean)**2.0_WP + this%Wvar=this%Wvar+(this%p(i)%vel(3)-this%Wmean)**2.0_WP + end do + call MPI_ALLREDUCE(this%dvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dvar=buf/safe_np + call MPI_ALLREDUCE(this%Uvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Uvar=buf/safe_np + call MPI_ALLREDUCE(this%Vvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vvar=buf/safe_np + call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np + + ! Get mean, max, and min volume fraction + this%VFmean=0.0_WP + this%VFmax =-huge(1.0_WP) + this%VFmin =+huge(1.0_WP) + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) + this%VFmax =max(this%VFmax,this%VF(i,j,k)) + this%VFmin =min(this%VFmin,this%VF(i,j,k)) + end do + end do + end do + call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol + call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf + call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf + + ! Get volume fraction variance + this%VFvar=0.0_WP + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + this%VFvar=this%VFvar+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*(this%VF(i,j,k)-this%VFmean)**2.0_WP + end do + end do + end do + call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol + + end subroutine get_max + + + !> Update particle mesh using our current particles + subroutine update_partmesh(this,pmesh) + use partmesh_class, only: partmesh + implicit none + class(lpt), intent(inout) :: this + class(partmesh), intent(inout) :: pmesh + integer :: i + ! Reset particle mesh storage + call pmesh%reset() + ! Nothing else to do if no particle is present + if (this%np_.eq.0) return + ! Copy particle info + call pmesh%set_size(this%np_) + do i=1,this%np_ + pmesh%pos(:,i)=this%p(i)%pos + end do + end subroutine update_partmesh + + + !> Creation of the MPI datatype for particle + subroutine prepare_mpi_part() + use mpi_f08 + use messager, only: die + implicit none + integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp + integer(MPI_ADDRESS_KIND) :: lb,extent + type(MPI_Datatype) :: MPI_PART_TMP + integer :: i,mysize,ierr + ! Prepare the displacement array + disp(1)=0 + do i=2,part_nblock + call MPI_Type_size(part_tblock(i-1),mysize,ierr) + disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) + end do + ! Create and commit the new type + call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) + call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) + call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) + call MPI_Type_commit(MPI_PART,ierr) + ! If a problem was encountered, say it + if (ierr.ne.0) call die('[lpt prepare_mpi_part] MPI Particle type creation failed') + ! Get the size of this type + call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) + end subroutine prepare_mpi_part + + + !> Synchronize particle arrays across processors + subroutine sync(this) + use mpi_f08 + implicit none + class(lpt), intent(inout) :: this + integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc + integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp + integer :: n,prank,ierr + type(part), dimension(:), allocatable :: buf_send + ! Recycle first to minimize communication load + call this%recycle() + ! Prepare information about what to send + nsend_proc=0 + do n=1,this%np_ + prank=this%cfg%get_rank(this%p(n)%ind) + nsend_proc(prank)=nsend_proc(prank)+1 + end do + nsend_proc(this%cfg%rank)=0 + ! Inform processors of what they will receive + call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + ! Prepare displacements for all-to-all + nsend_disp(0)=0 + nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array + do n=1,this%cfg%nproc-1 + nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) + nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) + end do + ! Allocate buffer to send particles + allocate(buf_send(sum(nsend_proc))) + ! Pack the particles in the send buffer + nsend_proc=0 + do n=1,this%np_ + ! Get the rank + prank=this%cfg%get_rank(this%p(n)%ind) + ! Skip particles still inside + if (prank.eq.this%cfg%rank) cycle + ! Pack up for sending + nsend_proc(prank)=nsend_proc(prank)+1 + buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) + ! Flag particle for removal + this%p(n)%flag=1 + end do + ! Allocate buffer for receiving particles + call this%resize(this%np_+sum(nrecv_proc)) + ! Perform communication + call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) + ! Deallocate buffer + deallocate(buf_send) + ! Recycle to remove duplicate particles + call this%recycle() + end subroutine sync + + + !> Share particles across processor boundaries + subroutine share(this,nover) + use mpi_f08 + use messager, only: warn,die + implicit none + class(lpt), intent(inout) :: this + integer, optional :: nover + type(part), dimension(:), allocatable :: tosend + type(part), dimension(:), allocatable :: torecv + integer :: no,nsend,nrecv + type(MPI_Status) :: status + integer :: icnt,isrc,idst,ierr + integer :: i,n + + ! Check overlap size + if (present(nover)) then + no=nover + if (no.gt.this%cfg%no) then + call warn('[lpt_class share] Specified overlap is larger than that of cfg - reducing no') + no=this%cfg%no + else if (no.le.0) then + call die('[lpt_class share] Specified overlap cannot be less or equal to zero') + end if + else + no=1 + end if + + ! Clean up ghost array + call this%resize_ghost(n=0); this%ng_=0 + + ! Share ghost particles to the left in x + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).lt.this%cfg%imin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).lt.this%cfg%imin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%xper.and.tosend(nsend)%ind(1).lt.this%cfg%imin+no) then + tosend(nsend)%pos(1)=tosend(nsend)%pos(1)+this%cfg%xL + tosend(nsend)%ind(1)=tosend(nsend)%ind(1)+this%cfg%nx + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,0,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in x + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).gt.this%cfg%imax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(1).gt.this%cfg%imax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%xper.and.tosend(nsend)%ind(1).gt.this%cfg%imax-no) then + tosend(nsend)%pos(1)=tosend(nsend)%pos(1)-this%cfg%xL + tosend(nsend)%ind(1)=tosend(nsend)%ind(1)-this%cfg%nx + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,0,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the left in y + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%yper.and.tosend(nsend)%ind(2).lt.this%cfg%jmin+no) then + tosend(nsend)%pos(2)=tosend(nsend)%pos(2)+this%cfg%yL + tosend(nsend)%ind(2)=tosend(nsend)%ind(2)+this%cfg%ny + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,1,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in y + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%yper.and.tosend(nsend)%ind(2).gt.this%cfg%jmax-no) then + tosend(nsend)%pos(2)=tosend(nsend)%pos(2)-this%cfg%yL + tosend(nsend)%ind(2)=tosend(nsend)%ind(2)-this%cfg%ny + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,1,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the left in z + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%zper.and.tosend(nsend)%ind(3).lt.this%cfg%kmin+no) then + tosend(nsend)%pos(3)=tosend(nsend)%pos(3)+this%cfg%zL + tosend(nsend)%ind(3)=tosend(nsend)%ind(3)+this%cfg%nz + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,2,-1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + ! Share ghost particles to the right in z + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) nsend=nsend+1 + end do + allocate(tosend(nsend)) + nsend=0 + do n=1,this%np_ + if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) then + nsend=nsend+1 + tosend(nsend)=this%p(n) + if (this%cfg%zper.and.tosend(nsend)%ind(3).gt.this%cfg%kmax-no) then + tosend(nsend)%pos(3)=tosend(nsend)%pos(3)-this%cfg%zL + tosend(nsend)%ind(3)=tosend(nsend)%ind(3)-this%cfg%nz + end if + end if + end do + nrecv=0 + call MPI_CART_SHIFT(this%cfg%comm,2,+1,isrc,idst,ierr) + call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) + allocate(torecv(nrecv)) + call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) + call this%resize_ghost(this%ng_+nrecv) + this%g(this%ng_+1:this%ng_+nrecv)=torecv + this%ng_=this%ng_+nrecv + if (allocated(tosend)) deallocate(tosend) + if (allocated(torecv)) deallocate(torecv) + + end subroutine share + + + !> Adaptation of particle array size + subroutine resize(this,n) + implicit none + class(lpt), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize particle array to size n + if (.not.allocated(this%p)) then + ! Allocate directly to size n + allocate(this%p(n)) + this%p(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%p,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%p + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%p) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%p(1:n) + call move_alloc(tmp,this%p) + end if + end if + end subroutine resize + + + !> Adaptation of ghost array size + subroutine resize_ghost(this,n) + implicit none + class(lpt), intent(inout) :: this + integer, intent(in) :: n + type(part), dimension(:), allocatable :: tmp + integer :: size_now,size_new + ! Resize ghost array to size n + if (.not.allocated(this%g)) then + ! Allocate directly to size n + allocate(this%g(n)) + this%g(1:n)%flag=1 + else + ! Update from a non-zero size to another non-zero size + size_now=size(this%g,dim=1) + if (n.gt.size_now) then + size_new=max(n,int(real(size_now,WP)*coeff_up)) + allocate(tmp(size_new)) + tmp(1:size_now)=this%g + tmp(size_now+1:)%flag=1 + call move_alloc(tmp,this%g) + else if (n.lt.int(real(size_now,WP)*coeff_dn)) then + allocate(tmp(n)) + tmp(1:n)=this%g(1:n) + call move_alloc(tmp,this%g) + end if + end if + end subroutine resize_ghost + + + !> Clean-up of particle array by removing flag=1 particles + subroutine recycle(this) + implicit none + class(lpt), intent(inout) :: this + integer :: new_size,i,ierr + ! Compact all active particles at the beginning of the array + new_size=0 + if (allocated(this%p)) then + do i=1,size(this%p,dim=1) + if (this%p(i)%flag.ne.1) then + new_size=new_size+1 + if (i.ne.new_size) then + this%p(new_size)=this%p(i) + this%p(i)%flag=1 + end if + end if + end do + end if + ! Resize to new size + call this%resize(new_size) + ! Update number of particles + this%np_=new_size + call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) + this%np=sum(this%np_proc) + end subroutine recycle + + + !> Parallel write particles to file + subroutine write(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(lpt), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset + integer :: i,ierr,iunit + + ! Root serial-writes the file header + if (this%cfg%amRoot) then + ! Open the file + open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) + if (ierr.ne.0) call die('[lpt write] Problem encountered while serial-opening data file: '//trim(filename)) + ! Number of particles and particle object size + write(iunit) this%np,MPI_PART_SIZE + ! Done with the header + close(iunit) + end if + + ! The rest is done in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[lpt write] Problem encountered while parallel-opening data file: '//trim(filename)) + + ! Get current position + call MPI_FILE_GET_POSITION(ifile,offset,ierr) + + ! Compute the offset and write + do i=1,this%cfg%rank + offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) + end do + if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine write + + + !> Parallel read particles to file + subroutine read(this,filename) + use mpi_f08 + use messager, only: die + use parallel, only: info_mpiio + implicit none + class(lpt), intent(inout) :: this + character(len=*), intent(in) :: filename + type(MPI_File) :: ifile + type(MPI_Status):: status + integer(kind=MPI_OFFSET_KIND) :: offset,header_offset + integer :: i,j,ierr,npadd,psize,nchunk,cnt + integer, dimension(:,:), allocatable :: ppp + + ! First open the file in parallel + call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) + if (ierr.ne.0) call die('[lpt read] Problem encountered while reading data file: '//trim(filename)) + + ! Read file header first + call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) + call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) + + ! Remember current position + call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) + + ! Check compatibility of particle type + if (psize.ne.MPI_PART_SIZE) call die('[lpt read] Particle type unreadable') + + ! Naively share reading task among all processors + nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 + allocate(ppp(this%cfg%nproc,nchunk)) + ppp=int(npadd/(this%cfg%nproc*nchunk)) + cnt=0 + out:do j=1,nchunk + do i=1,this%cfg%nproc + cnt=cnt+1 + if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out + ppp(i,j)=ppp(i,j)+1 + end do + end do out + + ! Read by chunk + do j=1,nchunk + ! Find offset + offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) + ! Resize particle array + call this%resize(this%np_+ppp(this%cfg%rank+1,j)) + ! Read this file + call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) + ! Most general case: relocate every droplet + do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) + this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) + end do + ! Exchange all that + call this%sync() + end do + + ! Close the file + call MPI_FILE_CLOSE(ifile,ierr) + + ! Log/screen output + logging: block + use, intrinsic :: iso_fortran_env, only: output_unit + use param, only: verbose + use messager, only: log + use string, only: str_long + character(len=str_long) :: message + if (this%cfg%amRoot) then + write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) + if (verbose.gt.2) write(output_unit,'(a)') trim(message) + if (verbose.gt.1) call log(message) + end if + end block logging + + end subroutine read + + +end module lpt_class diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index be6cbba4e..a7c69358e 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,6 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg + !use hypre_str_class, only: hypre_str use fourier3d_class, only: fourier3d use incomp_class, only: incomp use lpt_class, only: lpt @@ -10,33 +11,64 @@ module simulation use partmesh_class, only: partmesh use event_class, only: event use monitor_class, only: monitor + use sgsmodel_class, only: sgsmodel + use datafile_class, only: datafile + use string, only: str_medium implicit none private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + !type(hypre_str), public :: ps type(fourier3d), public :: ps type(incomp), public :: fs type(timetracker), public :: time type(lpt), public :: lp + type(sgsmodel), public :: sgs !> Ensight postprocessing type(partmesh) :: pmesh type(ensight) :: ens_out type(event) :: ens_evt + + !> Provide a datafile and an event tracker for saving restarts + type(event) :: save_evt + type(datafile) :: df + logical :: restarted !> Simulation monitor file - type(monitor) :: mfile,cflfile,lptfile + type(monitor) :: mfile,cflfile,hitfile,lptfile,sgsfile,tfile,ssfile public :: simulation_init,simulation_run,simulation_final !> Private work arrays real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:,:), allocatable :: SR + real(WP), dimension(:,:,:,:,:), allocatable :: gradu - !> Fluid and forcing parameters - real(WP) :: visc - real(WP) :: Urms0,KE0,KE - real(WP) :: tau_eddy + !> Fluid, forcing, and particle parameters + real(WP) :: visc,meanU,meanV,meanW + real(WP) :: Urms0,TKE0,EPS0,Re_max + real(WP) :: TKE,URMS,sgsTKE,EPSp + real(WP) :: stk,tau_eta + real(WP) :: meanvisc,Lx,N + real(WP) :: tauinf,G,Gdtau,Gdtaui,dx + logical :: linforce,use_sgs,maxRe,use_crw + integer :: sgs_type + + !> For monitoring + real(WP) :: EPS,sgsEPSp + real(WP) :: Re_L,Re_lambda + real(WP) :: eta,ell + real(WP) :: dx_eta,ell_Lx,Re_ratio,eps_ratio,tke_ratio,nondtime + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest,wt_sgs,wt_stat,wt_force contains @@ -55,6 +87,8 @@ subroutine simulation_init allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(SR (1:6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(gradu(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -63,10 +97,57 @@ subroutine simulation_init time=timetracker(amRoot=cfg%amRoot) call param_read('Max timestep size',time%dtmax) call param_read('Max cfl number',time%cflmax) + call param_read('Max iter',time%nmax) time%dt=time%dtmax time%itmax=2 end block initialize_timetracker - + + ! Handle restart/saves here + restart_and_save: block + character(len=str_medium) :: timestamp + ! Create event for saving restart files + save_evt=event(time,'Restart output') + call param_read('Restart output period',save_evt%tper) + ! Check if we are restarting + call param_read(tag='Restart from',val=timestamp,short='r',default='') + restarted=.false.; if (len_trim(timestamp).gt.0) restarted=.true. + if (restarted) then + ! If we are, read the name of the directory + call param_read('Restart from',timestamp,'r') + ! Read the datafile + df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) + else + ! If we are not restarting, we will still need a datafile for saving restart files + df=datafile(pg=cfg,filename=trim(cfg%name),nval=2,nvar=4) + df%valname(1)='t' + df%valname(2)='dt' + df%varname(1)='U' + df%varname(2)='V' + df%varname(3)='W' + df%varname(4)='P' + end if + end block restart_and_save + + ! Revisit timetracker to adjust time and time step values if this is a restart + update_timetracker: block + if (restarted) then + call df%pullval(name='t' ,val=time%t ) + call df%pullval(name='dt',val=time%dt) + time%told=time%t-time%dt + end if + end block update_timetracker + + ! Initialize timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP + wt_stat%time=0.0_WP; wt_stat%percent=0.0_WP + wt_force%time=0.0_WP; wt_force%percent=0.0_WP + end block initialize_timers ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block @@ -78,35 +159,85 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver + !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + !ps%maxlevel=10 + !call param_read('Pressure iteration',ps%maxit) + !call param_read('Pressure tolerance',ps%rcvg) ps=fourier3d(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver + ! Create an LES model + create_sgs: block + call param_read(tag='Use SGS model',val=use_sgs,default=.false.) + if (use_sgs) call param_read('SGS model type',sgs_type) + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + sgs%Cs_ref=0.1_WP + end block create_sgs ! Prepare initial velocity field initialize_velocity: block use random, only: random_normal use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM use parallel, only: MPI_REAL_WP - integer :: i,j,k,ierr - real(WP) :: myKE - ! Read in velocity rms and forcing time scale - call param_read('Initial rms',Urms0) - call param_read('Eddy turnover time',tau_eddy) - ! Gaussian initial field - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) - fs%V(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) - fs%W(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + use mathtools,only: Pi + integer :: i,j,k + ! Read in forcing, grid, and initial velocity field parameters + call param_read('Linear forcing',linforce) + call param_read('Force to maximum Re_lambda',maxRe) + call param_read('Forcing constant (G)', G) + call param_read('Lx', Lx) + call param_read('nx', N) + dx=Lx/N + if (linforce) then + if (maxRE) then + EPS0 = (visc/fs%rho)**3*(Pi*N/(1.5_WP*Lx))**4 + TKE0 = 1.5_WP*(0.2_WP*Lx*EPS0)**(0.6667_WP) + else + call param_read('Steady-state TKE',TKE0) + EPS0 = 5.0_WP*(0.6667_WP*TKE0)**1.5_WP / Lx + end if + Re_max = sqrt(15.0_WP*sqrt(0.6667_WP*TKE0)*0.2_WP*Lx/visc) + tauinf = 2.0_WP*TKE0/(3.0_WP*EPS0) + Gdtau = G/tauinf + Gdtaui= 1/Gdtau + else + TKE0 = 0.0_WP + tauinf = 99999.0_WP + end if + + if (restarted) then + call df%pullvar(name='U',var=fs%U) + call df%pullvar(name='V',var=fs%V) + call df%pullvar(name='W',var=fs%W) + call df%pullvar(name='P',var=fs%P) + else + Urms0 = sqrt(0.6667_WP*TKE0) + ! Gaussian initial field + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + fs%V(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + fs%W(i,j,k)=random_normal(m=0.0_WP,sd=Urms0) + end do end do end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end if + + ! Compute mean and remove it from the velocity field to obtain =0 + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + + fs%U = fs%U - meanU + fs%V = fs%V - meanV + fs%W = fs%W - meanW + ! Project to ensure divergence-free call fs%get_div() fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt @@ -118,28 +249,81 @@ subroutine simulation_init fs%U=fs%U-time%dt*resU/fs%rho fs%V=fs%V-time%dt*resV/fs%rho fs%W=fs%W-time%dt*resW/fs%rho + ! Calculate cell-centered velocities and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() - ! Calculate KE0 - myKE=0.0_WP + end block initialize_velocity + + ! Compute turbulence statistics for monitor at time=0 + compute_stats: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + real(WP) :: mysgstke,myvisc,myTKE,myEPS,gu2buf + real(WP) :: mysgsEPSp,myEPSp + integer :: i,j,k,ierr + + myvisc=0.0_WP; myTKE=0.0_WP; myEPS=0.0_WP + sgsTKE=0.0_WP; mysgstke=0.0_WP; + mysgsEPSp=0.0_WP; myEPSp=0.0_WP + + call fs%get_strainrate(SR=SR) + call fs%get_gradu(gradu=gradu) + do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - myKE=myKE+0.5_WP*(Ui(i,j,k)**2+Vi(i,j,k)**2+Wi(i,j,k)**2) + ! LES stats + mysgsTKE = mysgsTKE + fs%cfg%vol(i,j,k)*(sgs%visc(i,j,k)/0.067_WP/sgs%delta(i,j,k)/fs%rho)**2 + myvisc = myvisc+fs%visc(i,j,k)*fs%cfg%vol(i,j,k) + + ! Resolved TKE + myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) + + ! Dissipation + myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho + + ! Pseudo-dissipation (sgs, total) + gu2buf = gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & + gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & + gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2 + + mysgsEPSp=mysgsEPSp+fs%cfg%vol(i,j,k)*sgs%visc(i,j,k)*gu2buf + myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*gu2buf end do end do end do - call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - KE0=KE - end block initialize_velocity - + + call MPI_ALLREDUCE(myvisc,meanvisc,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanvisc=meanvisc/fs%cfg%vol_total + + call MPI_ALLREDUCE(mysgstke,sgsTKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsTKE=sgsTKE/fs%cfg%vol_total + call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE=TKE/fs%cfg%vol_total + + call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPS=EPS/fs%cfg%vol_total + call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp=EPSp/fs%cfg%vol_total + call MPI_ALLREDUCE(mysgsEPSp,sgsEPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsEPSp=sgsEPSp/fs%cfg%vol_total + + URMS = sqrt(2.0_WP/3.0_WP*(TKE+sgsTKE)) + Re_L = (TKE+sgsTKE)**2.0_WP/EPS/meanvisc + Re_lambda = sqrt(20.0_WP*Re_L/3.0_WP) + eta = (meanvisc**3.0_WP/EPS)**0.25_WP + ell = (0.6667_WP*TKE)**1.5_WP / EPS + tau_eta = sqrt(visc/EPS0) + + nondtime = time%t/tauinf + dx_eta = dx/eta + eps_ratio = EPS/EPS0 + tke_ratio = TKE/TKE0 + ell_Lx = ell/Lx + Re_ratio = Re_lambda/Re_max + end block compute_stats ! Initialize LPT solver initialize_lpt: block - use random, only: random_uniform + use random, only: random_uniform, random_normal real(WP) :: dp integer :: i,np + character(len=str_medium) :: timestamp ! Create solver lp=lpt(cfg=cfg,name='LPT') ! Get drag model from the inpit @@ -147,42 +331,72 @@ subroutine simulation_init ! Get particle density from the input call param_read('Particle density',lp%rho) ! Get particle diameter from the input - call param_read('Particle diameter',dp) + call param_read('Particle Stokes number', stk) ! Get number of particles call param_read('Number of particles',np) + ! Check if a stochastic SGS model is used + call param_read('Use CRW', use_crw) + if (.false.) then + call param_read('Restart from',timestamp,'r') + ! Read the part file + call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) + else ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin),lp%cfg%x(lp%cfg%imax+1)),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! Give zero dt - lp%p(i)%dt=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do + if (lp%cfg%amRoot) then + dp = sqrt(18.0_WP*visc*stk*tau_eta/lp%rho) + call lp%resize(np) + do i=1,np + ! Give id + lp%p(i)%id=int(i,8) + ! Set the diameter + lp%p(i)%d=dp + ! Assign random position in the domain + lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin),lp%cfg%x(lp%cfg%imax+1)),& + & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& + & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! OU + lp%p(i)%uf=0.0_WP + if (use_crw) then + lp%p(i)%uf= [random_normal(m=0.0_WP,sd=0.1_WP),& + random_normal(m=0.0_WP,sd=0.1_WP),& + random_normal(m=0.0_WP,sd=0.1_WP)] + end if + ! Give zero dt + lp%p(i)%dt=0.0_WP + lp%p(i)%a_crw=0.0_WP + lp%p(i)%b_crw=0.0_WP + ! Locate the particle on the mesh + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + ! Activate the particle + lp%p(i)%flag=0 + end do + end if + ! Distribute particles + call lp%sync() end if - ! Distribute particles - call lp%sync() end block initialize_lpt ! Create partmesh object for Lagrangian particle output create_pmesh: block - pmesh=partmesh(nvar=0,nvec=0,name='lpt') + integer :: np,i + call param_read('Number of particles',np) + pmesh=partmesh(nvar=1,nvec=3,name='lpt') + pmesh%varname(1)="id" + pmesh%vecname(1)="vel" + pmesh%vecname(2)="fld" + pmesh%vecname(3)="uf" + call lp%resize(np) call lp%update_partmesh(pmesh) + do i = 1,lp%np_ + pmesh%var(1,i) = lp%p(i)%id + pmesh%vec(:,1,i) = lp%p(i)%vel + pmesh%vec(:,2,i) = lp%cfg%get_velocity(pos=lp%p(i)%pos,i0=lp%p(i)%ind(1),j0=lp%p(i)%ind(2),k0=lp%p(i)%ind(3),U=Ui,V=Vi,W=Wi) + pmesh%vec(:,3,i) = lp%p(i)%uf + end do end block create_pmesh - ! Add Ensight output create_ensight: block @@ -194,6 +408,7 @@ subroutine simulation_init ! Add variables to output call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc',sgs%visc) call ens_out%add_particle('particles',pmesh) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) @@ -212,10 +427,13 @@ subroutine simulation_init call mfile%add_column(time%dt,'Timestep size') call mfile%add_column(time%cfl,'Maximum CFL') call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(meanU,'Umean') call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(meanV,'Vmean') call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(meanW,'Wmean') call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(KE,'Kinetic energy') + call mfile%add_column(TKE,'Kinetic energy') call mfile%add_column(fs%divmax,'Maximum divergence') call mfile%add_column(fs%psolv%it,'Pressure iteration') call mfile%add_column(fs%psolv%rerr,'Pressure error') @@ -231,6 +449,32 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') call cflfile%write() + ! Create hit monitor + hitfile=monitor(fs%cfg%amRoot,'hit') + call hitfile%add_column(time%n,'Timestep number') + call hitfile%add_column(time%t,'Time') + call hitfile%add_column(Re_L,'Re_L') + call hitfile%add_column(Re_lambda,'Re_lambda') + call hitfile%add_column(meanvisc,'mean visc') + call hitfile%add_column(eta,'eta') + call hitfile%add_column(sgsTKE,'sgsTKE') + call hitfile%add_column(TKE,'TKE') + call hitfile%add_column(URMS,'URMS') + call hitfile%add_column(EPS,'EPS') + call hitfile%add_column(EPSp,'EPSp') + call hitfile%add_column(ell,'Integral lengthscale') + call hitfile%write() + ! Create hit convergence monitor + ssfile=monitor(fs%cfg%amRoot,'convergence') + call ssfile%add_column(time%n,'Timestep number') + call ssfile%add_column(time%t,'Time') + call ssfile%add_column(nondtime,'Time/t_int') + call ssfile%add_column(Re_ratio,'Re_ratio') + call ssfile%add_column(eps_ratio,'EPS_ratio') + call ssfile%add_column(tke_ratio,'TKE_ratio') + call ssfile%add_column(dx_eta,'dx/eta') + call ssfile%add_column(ell_Lx,'ell/Lx') + call ssfile%write() ! Create LPT monitor call lp%get_max() lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') @@ -246,6 +490,35 @@ subroutine simulation_init call lptfile%add_column(lp%dmin,'Particle dmin') call lptfile%add_column(lp%dmax,'Particle dmax') call lptfile%write() + ! Create SGS monitor + sgsfile=monitor(fs%cfg%amroot,'sgs') + call sgsfile%add_column(time%n,'Timestep number') + call sgsfile%add_column(time%t,'Time') + call sgsfile%add_column(sgs%min_visc,'Min eddy visc') + call sgsfile%add_column(sgs%max_visc,'Max eddy visc') + call sgsfile%add_column(sgsEPSp,'SGSEPS') + call sgsfile%add_column(sgsTKE,'sgsTKE') + call sgsfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_sgs%time,'SGS [s]') + call tfile%add_column(wt_sgs%percent,'SGS [%]') + call tfile%add_column(wt_stat%time,'Stats [s]') + call tfile%add_column(wt_stat%percent,'Stats [%]') + call tfile%add_column(wt_force%time,'Forcing [s]') + call tfile%add_column(wt_force%percent,'Forcing [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() end block create_monitor @@ -254,30 +527,53 @@ end subroutine simulation_init !> Time integrate our problem subroutine simulation_run + use parallel, only: parallel_time implicit none + integer :: ii ! Perform time integration do while (.not.time%done()) + + ! init wallclock + wt_total%time_in=parallel_time() ! Increment time call fs%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() - + + + wt_lpt%time_in=parallel_time() ! Advance particles by dt resU=fs%rho; resV=fs%visc - call lp%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=resV) + call lp%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=resV,use_crw=use_crw,sgs=sgs) + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in ! Remember old velocity fs%Uold=fs%U fs%Vold=fs%V fs%Wold=fs%W - - ! Apply time-varying Dirichlet conditions - ! This is where time-dpt Dirichlet would be enforced + + ! Turbulence modeling + call fs%interp_vel(Ui,Vi,Wi) + wt_sgs%time_in=parallel_time() + if (use_sgs) then + fs%visc=visc + call fs%get_strainrate(SR=SR) + call fs%get_gradu(gradu=gradu) + resU=fs%rho + call sgs%get_visc(type=sgs_type,rho=resU,gradu=gradu,dt=time%dt,SR=SR,Ui=Ui,Vi=Vi,Wi=Wi) + where (sgs%visc.lt.-fs%visc) + sgs%visc=-fs%visc + end where + fs%visc=fs%visc+sgs%visc + end if + wt_sgs%time=wt_sgs%time+parallel_time()-wt_sgs%time_in ! Perform sub-iterations do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() ! Build mid-time velocity fs%U=0.5_WP*(fs%U+fs%Uold) @@ -292,32 +588,53 @@ subroutine simulation_run resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - ! Add linear forcing term - linear_forcing: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - real(WP) :: meanU,meanV,meanW,myKE - integer :: i,j,k,ierr - ! Calculate KE - call fs%interp_vel(Ui,Vi,Wi) - myKE=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - myKE=myKE+0.5_WP*(Ui(i,j,k)**2+Vi(i,j,k)**2+Wi(i,j,k)**2) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + wt_force%time_in=parallel_time() + if (linforce) then + ! Add linear forcing term + ! See Bassenne et al. (2016) + linear_forcing: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + use messager, only: die + real(WP) :: myTKE,A,myvisc,myEPSp + integer :: i,j,k,ierr + + ! Calculate mean velocity + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + + ! Calculate TKE and EPS + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_gradu(gradu=gradu) + myvisc=0.0_WP; myTKE=0.0_WP; myEPSp=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + myTKE=myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) + + ! Pseudo-dissipation + myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*( & + gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & + gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & + gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2) + end do end do end do - end do - call MPI_ALLREDUCE(myKE,KE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) - ! Calculate mean velocity - call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%fluid_vol - call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%fluid_vol - call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%fluid_vol - ! Add forcing term - resU=resU+time%dt*KE0/KE*(fs%U-meanU)/(2.0_WP*tau_eddy) - resV=resV+time%dt*KE0/KE*(fs%V-meanV)/(2.0_WP*tau_eddy) - resW=resW+time%dt*KE0/KE*(fs%W-meanW)/(2.0_WP*tau_eddy) - end block linear_forcing + call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE = TKE/fs%cfg%vol_total + call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp = EPSp/fs%cfg%vol_total/fs%rho + + if (Gdtaui.lt.time%dt) call die("[linear_forcing] Controller time constant less than timestep") + A = (EPSp - Gdtau*(TKE-TKE0))/(2.0_WP*TKE)*fs%rho ! - Eq. (7) (forcing constant TKE) + + resU=resU+time%dt*(fs%U-meanU)*A + resV=resV+time%dt*(fs%V-meanV)*A + resW=resW+time%dt*(fs%W-meanW)*A + end block linear_forcing + end if + wt_force%time=wt_force%time+parallel_time()-wt_force%time_in + wt_vel%time_in=parallel_time() ! Apply these residuals fs%U=2.0_WP*fs%U-fs%Uold+resU/fs%rho @@ -326,8 +643,10 @@ subroutine simulation_run ! Apply other boundary conditions on the resulting fields call fs%apply_bcond(time%t,time%dt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in ! Solve Poisson equation + wt_pres%time_in=parallel_time() call fs%correct_mfr() call fs%get_div() fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt @@ -341,19 +660,90 @@ subroutine simulation_run fs%U=fs%U-time%dt*resU/fs%rho fs%V=fs%V-time%dt*resV/fs%rho fs%W=fs%W-time%dt*resW/fs%rho + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in ! Increment sub-iteration counter time%it=time%it+1 - + end do + wt_vel%time_in=parallel_time() ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + wt_stat%time_in=parallel_time() + ! Compute turbulence statistics for monitor + compute_stats: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + real(WP) :: mysgstke,myvisc,myTKE,myEPS + real(WP) :: mysgsEPSp,myEPSp + integer :: i,j,k,ierr + + myvisc=0.0_WP; myTKE=0.0_WP; myEPS=0.0_WP + sgsTKE=0.0_WP; mysgstke=0.0_WP; + mysgsEPSp=0.0_WP; myEPSp=0.0_WP + + call fs%get_strainrate(SR=SR) + call fs%get_gradu(gradu=gradu) + + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + ! LES stats + mysgsTKE = mysgsTKE + fs%cfg%vol(i,j,k)*(sgs%visc(i,j,k)/0.067_WP/sgs%delta(i,j,k)/fs%rho)**2 + myvisc = myvisc+fs%visc(i,j,k)*fs%cfg%vol(i,j,k) + + ! Resolved TKE + myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) + + ! Dissipation + myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho + + ! Pseudo-dissipation (sgs, resolved, total) + mysgsEPSp=mysgsEPSp+fs%cfg%vol(i,j,k)*sgs%visc(i,j,k)*( & + gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & + gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & + gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2) + end do + end do + end do + + call MPI_ALLREDUCE(myvisc,meanvisc,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanvisc=meanvisc/fs%cfg%vol_total + + call MPI_ALLREDUCE(mysgstke,sgsTKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsTKE=sgsTKE/fs%cfg%vol_total + call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE=TKE/fs%cfg%vol_total + + call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPS=EPS/fs%cfg%vol_total + call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp=EPSp/fs%cfg%vol_total + call MPI_ALLREDUCE(mysgsEPSp,sgsEPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsEPSp=sgsEPSp/fs%cfg%vol_total + + URMS = sqrt(2.0_WP/3.0_WP*(TKE+sgsTKE)) + Re_L = (TKE+sgsTKE)**2.0_WP/EPS/meanvisc + Re_lambda = sqrt(20.0_WP*Re_L/3.0_WP) + eta = (meanvisc**3.0_WP/EPS)**0.25_WP + ell = (0.6667_WP*TKE)**1.5_WP / EPS + + nondtime = time%t/tauinf + dx_eta = dx/eta + eps_ratio = EPS/EPS0 + tke_ratio = TKE/TKE0 + ell_Lx = ell/Lx + Re_ratio = Re_lambda/Re_max + end block compute_stats + wt_stat%time=wt_stat%time+parallel_time()-wt_stat%time_in ! Output to ensight if (ens_evt%occurs()) then call lp%update_partmesh(pmesh) + do ii = 1,lp%np_ + pmesh%var(1,ii) = lp%p(ii)%id + pmesh%vec(:,1,ii) = lp%p(ii)%vel + pmesh%vec(:,2,ii) = lp%cfg%get_velocity(pos=lp%p(ii)%pos,i0=lp%p(ii)%ind(1),j0=lp%p(ii)%ind(2),k0=lp%p(ii)%ind(3),U=Ui,V=Vi,W=Wi) + pmesh%vec(:,3,ii) = lp%p(ii)%uf + end do call ens_out%write_data(time%t) end if @@ -361,8 +751,52 @@ subroutine simulation_run call fs%get_max() call mfile%write() call cflfile%write() + call hitfile%write() call lp%get_max() call lptfile%write() + call sgsfile%write() + call ssfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_sgs%percent=wt_sgs%time/wt_total%time*100.0_WP + wt_stat%percent=wt_stat%time/wt_total%time*100.0_WP + wt_force%percent=wt_force%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time-wt_sgs%time-wt_stat%time-wt_force%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP + wt_stat%time=0.0_WP; wt_stat%percent=0.0_WP + wt_force%time=0.0_WP; wt_force%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + ! Finally, see if it's time to save restart files + if (save_evt%occurs()) then + save_restart: block + character(len=str_medium) :: timestamp + ! Prefix for files + write(timestamp,'(es12.5)') time%t + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Populate df and write it + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt ) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) + call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) + ! Write particle file + call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) + end block save_restart + end if end do @@ -380,7 +814,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) + deallocate(resU,resV,resW,Ui,Vi,Wi,SR,gradu) end subroutine simulation_final From 8b22914b08989a8f58a6451418d4418cd7f8ce53 Mon Sep 17 00:00:00 2001 From: maxzog Date: Fri, 10 Feb 2023 17:44:08 -0500 Subject: [PATCH 123/152] DNStoLES interpolation case, fixed dissipation calc in HIT --- examples/DNStoLES/GNUmakefile | 52 +++++++ examples/DNStoLES/input | 15 ++ examples/DNStoLES/src/Make.package | 2 + examples/DNStoLES/src/geometry.f90 | 141 ++++++++++++++++++ examples/DNStoLES/src/simulation.f90 | 211 +++++++++++++++++++++++++++ examples/hit/GNUmakefile | 5 +- examples/hit/src/simulation.f90 | 7 +- 7 files changed, 428 insertions(+), 5 deletions(-) create mode 100644 examples/DNStoLES/GNUmakefile create mode 100644 examples/DNStoLES/input create mode 100644 examples/DNStoLES/src/Make.package create mode 100644 examples/DNStoLES/src/geometry.f90 create mode 100644 examples/DNStoLES/src/simulation.f90 diff --git a/examples/DNStoLES/GNUmakefile b/examples/DNStoLES/GNUmakefile new file mode 100644 index 000000000..784ca56ff --- /dev/null +++ b/examples/DNStoLES/GNUmakefile @@ -0,0 +1,52 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +USE_FFTW = TRUE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# Define external libraries - this can also be in .profile +#HDF5_DIR = /Users/desjardi/Builds/hdf5 +LAPACK_DIR= /usr/local/Cellar/lapack/3.11 +HYPRE_DIR = /Users/maxzog/builds/hypre/src/hypre +FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1 +#IRL_DIR = /Users/maxzog/IRL/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := particles constant_density core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/DNStoLES/input b/examples/DNStoLES/input new file mode 100644 index 000000000..653c375ba --- /dev/null +++ b/examples/DNStoLES/input @@ -0,0 +1,15 @@ +# First mesh definition +1 Partition : 1 1 4 +1 Number of cells : 128 128 128 +1 Domain size : 6.2832 6.2832 6.2832 +1 Domain center : 3.1416 3.1416 3.1416 + +# Second mesh definition +2 Partition : 1 1 4 +2 Number of cells : 64 64 64 +2 Domain size : 6.2832 6.2832 6.2832 +2 Domain center : 3.1416 3.1416 3.1416 + +# i/o +DNS file (i) : ./dns/ +LES file (o) : ./les/ diff --git a/examples/DNStoLES/src/Make.package b/examples/DNStoLES/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/DNStoLES/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/DNStoLES/src/geometry.f90 b/examples/DNStoLES/src/geometry.f90 new file mode 100644 index 000000000..09082050f --- /dev/null +++ b/examples/DNStoLES/src/geometry.f90 @@ -0,0 +1,141 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use mpi_f08, only: MPI_Group + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Public declarations + public :: geometry_init + public :: cfg1,grp1,isInGrp1 + public :: cfg2,grp2,isInGrp2 + + !> Two groups and partitions, along with logicals + integer, dimension(3) :: partition1,partition2 + logical :: isInGrp1,isInGrp2 + type(MPI_Group) :: grp1,grp2 + + !> These are the two configs + type(config) :: cfg1,cfg2 + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use param, only: param_read + use parallel, only: comm,group,nproc,rank + use mpi_f08, only: MPI_Group,MPI_Group_range_incl + implicit none + integer, dimension(3,1) :: grange + integer :: ierr + + ! We start by reading in the two partitions + call param_read('1 Partition',partition1) + call param_read('2 Partition',partition2) + + ! Create an MPI group along with logical for the first grid on the lowest ranks + grange(:,1)=[0,product(partition1)-1,1] + call MPI_Group_range_incl(group,1,grange,grp1,ierr) + isInGrp1=.false.; if (rank.le.product(partition1)-1) isInGrp1=.true. + + ! Create an MPI group along with logical for the second grid on the highest ranks + grange(:,1)=[nproc-product(partition2),nproc-1,1] + call MPI_Group_range_incl(group,1,grange,grp2,ierr) + isInGrp2=.false.; if (rank.ge.nproc-product(partition2)) isInGrp2=.true. + + ! Initialize grid 1 + if (isInGrp1) then + + create_cfg1: block + use param, only: param_read + use sgrid_class, only: cartesian,sgrid + type(sgrid) :: grid + integer :: i,j,k + integer, dimension(3) :: ncell + real(WP), dimension(3) :: dsize + real(WP), dimension(3) :: dcent + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('1 Number of cells',ncell) + call param_read('1 Domain size' ,dsize) + call param_read('1 Domain center' ,dcent) + allocate(x(ncell(1)+1)) + allocate(y(ncell(2)+1)) + allocate(z(ncell(3)+1)) + + ! Create simple rectilinear grid + do i=1,ncell(1)+1 + x(i)=real(i-1,WP)/real(ncell(1),WP)*dsize(1)-0.5_WP*dsize(1)+dcent(1) + end do + do j=1,ncell(2)+1 + y(j)=real(j-1,WP)/real(ncell(2),WP)*dsize(2)-0.5_WP*dsize(2)+dcent(2) + end do + do k=1,ncell(3)+1 + z(k)=real(k-1,WP)/real(ncell(3),WP)*dsize(3)-0.5_WP*dsize(3)+dcent(3) + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=1,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='grid1') + + ! Use it to create a config + cfg1=config(grp=grp1,decomp=partition1,grid=grid) + + ! Do not place walls + cfg1%VF=1.0_WP + + end block create_cfg1 + + end if + + ! Initialize grid 2 + if (isInGrp2) then + + create_cfg2: block + use param, only: param_read + use sgrid_class, only: cartesian,sgrid + type(sgrid) :: grid + integer :: i,j,k + integer, dimension(3) :: ncell + real(WP), dimension(3) :: dsize + real(WP), dimension(3) :: dcent + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('2 Number of cells',ncell) + call param_read('2 Domain size' ,dsize) + call param_read('2 Domain center' ,dcent) + allocate(x(ncell(1)+1)) + allocate(y(ncell(2)+1)) + allocate(z(ncell(3)+1)) + + ! Create simple rectilinear grid + do i=1,ncell(1)+1 + x(i)=real(i-1,WP)/real(ncell(1),WP)*dsize(1)-0.5_WP*dsize(1)+dcent(1) + end do + do j=1,ncell(2)+1 + y(j)=real(j-1,WP)/real(ncell(2),WP)*dsize(2)-0.5_WP*dsize(2)+dcent(2) + end do + do k=1,ncell(3)+1 + z(k)=real(k-1,WP)/real(ncell(3),WP)*dsize(3)-0.5_WP*dsize(3)+dcent(3) + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=1,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.false.,name='grid2') + + ! Use it to create a config + cfg2=config(grp=grp2,decomp=partition2,grid=grid) + + ! Do not place walls + cfg2%VF=1.0_WP + + end block create_cfg2 + + end if + + end subroutine geometry_init + + +end module geometry diff --git a/examples/DNStoLES/src/simulation.f90 b/examples/DNStoLES/src/simulation.f90 new file mode 100644 index 000000000..d87fdbd5c --- /dev/null +++ b/examples/DNStoLES/src/simulation.f90 @@ -0,0 +1,211 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use string, only: str_medium + use geometry, only: cfg1,grp1,isInGrp1 + use geometry, only: cfg2,grp2,isInGrp2 + use ensight_class, only: ensight + use coupler_class, only: coupler + use datafile_class,only: datafile + use incomp_class, only: incomp + implicit none + private + + !> Public declarations + public :: simulation_init,simulation_run,simulation_final + + !> Ensight postprocessing + type(ensight) :: ens1,ens2 + + !> Give ourselves work arrays + real(WP), dimension(:,:,:), allocatable :: Uid,Vid,Wid + real(WP), dimension(:,:,:), allocatable :: Uil,Vil,Wil + + !> Datafile declaration + type(datafile) :: dfDNS + type(datafile) :: dfLES + + character(len=str_medium) :: dir_write + real(WP) :: dt + + !> Solver declaration + type(incomp), public :: fsd + type(incomp), public :: fsl + + !> Coupler + type(coupler) :: cpl + +contains + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + InitDummySolv: block + fsd=incomp(cfg=cfg1,name='DNS') + fsl=incomp(cfg=cfg2,name='LES') + end block InitDummySolv + + allocate(Uid (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_)) + allocate(Vid (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_)) + allocate(Wid (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_)) + + allocate(Uil (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_)) + allocate(Vil (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_)) + allocate(Wil (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_)) + + ! Read in DNS datafile + readDNS: block + character(len=str_medium) :: dir_read + call param_read('DNS file (i)', dir_read) + ! Read the datafile + dfDNS=datafile(pg=cfg1,fdata=trim(adjustl(dir_read))) + call dfDNS%pullvar(name='U',var=fsd%U) + call dfDNS%pullvar(name='V',var=fsd%V) + call dfDNS%pullvar(name='W',var=fsd%W) + call dfDNS%pullvar(name='P',var=fsd%P) + end block readDNS + + ! Init LES datafile + initLES: block + call param_read('LES file (o)', dir_write) + ! Init the datafile to write + dfLES=datafile(pg=cfg2,filename=trim(dir_write),nval=2,nvar=4) + dfLES%valname(1)='t' + dfLES%valname(2)='dt' + dfLES%varname(1)='U' + dfLES%varname(2)='V' + dfLES%varname(3)='W' + dfLES%varname(4)='P' + end block initlES + + ! Both groups prepare the coupler + if (isInGrp1.or.isInGrp2) then + ! Create the coupler + cpl=coupler(src_grp=grp1,dst_grp=grp2,name='LESfromDNS') + ! Set the grids + if (isInGrp1) call cpl%set_src(cfg1) + if (isInGrp2) call cpl%set_dst(cfg2) + ! Initialize the metrics + call cpl%initialize() + end if + + ! Group1 does its initialization work here + if (isInGrp1) then + + ! Group1 also outputs to Ensight + ens1=ensight(cfg=cfg1,name='DNS') + call ens1%add_scalar('U',fsd%U) + call ens1%add_scalar('V',fsd%V) + call ens1%add_scalar('W',fsd%W) + call ens1%add_scalar('P',fsd%P) + call ens1%write_data(0.0_WP) + + end if + + ! Group2 allocates the field to receive + if (isInGrp2) then + fsl%U=0.0_WP + fsl%V=0.0_WP + fsl%W=0.0_WP + fsl%P=0.0_WP + end if + + if (isInGrp2) then + ens2=ensight(cfg=cfg2,name='LES') + end if + + ! Both groups work on the coupling + ! NOTE: Data to be transfered is attached to the coupler object one at a time. + ! Each interpolated variable must then be treated separately unless + ! the coupler class source code is modified. + + coupling: block + if (isInGrp1) call cpl%push(fsd%U) + call cpl%transfer() + if (isInGrp2) call cpl%pull(fsl%U) + call ens2%add_scalar('U',fsl%U) + call dfLES%pushvar(name='U' ,var=fsl%U ) + + if (isInGrp1) call cpl%push(fsd%V) + call cpl%transfer() + if (isInGrp2) call cpl%pull(fsl%V) + call ens2%add_scalar('V',fsl%V) + call dfLES%pushvar(name='V' ,var=fsl%V ) + + if (isInGrp1) call cpl%push(fsd%W) + call cpl%transfer() + if (isInGrp2) call cpl%pull(fsl%W) + call ens2%add_scalar('W',fsl%W) + call dfLES%pushvar(name='W' ,var=fsl%W ) + + if (isInGrp1) call cpl%push(fsd%P) + call cpl%transfer() + if (isInGrp2) call cpl%pull(fsl%P) + call ens2%add_scalar('P',fsl%P) + call dfLES%pushvar(name='P' ,var=fsl%P ) + + call dfDNS%pullval(name='dt' ,val=dt ) + call dfLES%pushval(name='dt' ,val=dt ) + end block coupling + + ! Group2 outputs its received data + if (isInGrp2) then + call ens2%add_scalar('overlap',cpl%overlap) + call ens2%write_data(0.0_WP) + + call dfLES%write(fdata=trim(adjustl(dir_write))) + end if + + end subroutine simulation_init + + + !> Check TKE of LES and DNS + subroutine simulation_run + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel,only: MPI_REAL_WP + implicit none + integer :: i,j,k,ierr + real(WP) :: myKE,KELES,KEDNS,ratio + + call dfLES%pullvar(name='U',var=fsl%U) + call dfLES%pullvar(name='V',var=fsl%V) + call dfLES%pullvar(name='W',var=fsl%W) + + call fsd%interp_vel(Uid,Vid,Wid) + call fsl%interp_vel(Uil,Vil,Wil) + + myKE=0.0_WP + do k=fsd%cfg%kmin_,fsd%cfg%kmax_ + do j=fsd%cfg%jmin_,fsd%cfg%jmax_ + do i=fsd%cfg%imin_,fsd%cfg%imax_ + myKE=myKE+0.5_WP*(Uid(i,j,k)**2+Vid(i,j,k)**2+Wid(i,j,k)**2)*fsd%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(myKE,KEDNS,1,MPI_REAL_WP,MPI_SUM,fsd%cfg%comm,ierr); KEDNS = KEDNS/fsd%cfg%vol_total + + myKE=0.0_WP + do k=fsl%cfg%kmin_,fsl%cfg%kmax_ + do j=fsl%cfg%jmin_,fsl%cfg%jmax_ + do i=fsl%cfg%imin_,fsl%cfg%imax_ + myKE=myKE+0.5_WP*(Uil(i,j,k)**2+Vil(i,j,k)**2+Wil(i,j,k)**2)*fsl%cfg%vol(i,j,k) + end do + end do + end do + call MPI_ALLREDUCE(myKE,KELES,1,MPI_REAL_WP,MPI_SUM,fsl%cfg%comm,ierr); KELES = KELES/fsl%cfg%vol_total + + ratio = KELES / KEDNS + if (fsd%cfg%amRoot) print *, "TKE_interp / TKE_input = ", ratio + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + deallocate(Uid,Vid,Wid,Uil,Vil,Wil) + end subroutine simulation_final + +end module simulation diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index 52dbd4c18..76c85b766 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -24,12 +24,15 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well +HYPRE_DIR = /Users/maxzog/hypre/ +LAPACK_DIR= /usr/local/Cellar/lapack/3.11/ +FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1/ # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := particles core constant_density data solver config grid libraries +Bdirs := particles core constant_density subgrid data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index a7c69358e..ad64dd537 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -281,7 +281,7 @@ subroutine simulation_init myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) ! Dissipation - myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho + myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho ! Pseudo-dissipation (sgs, total) gu2buf = gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & @@ -684,7 +684,7 @@ subroutine simulation_run myvisc=0.0_WP; myTKE=0.0_WP; myEPS=0.0_WP sgsTKE=0.0_WP; mysgstke=0.0_WP; - mysgsEPSp=0.0_WP; myEPSp=0.0_WP + mysgsEPSp=0.0_WP call fs%get_strainrate(SR=SR) call fs%get_gradu(gradu=gradu) @@ -700,7 +700,7 @@ subroutine simulation_run myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) ! Dissipation - myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho + myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho ! Pseudo-dissipation (sgs, resolved, total) mysgsEPSp=mysgsEPSp+fs%cfg%vol(i,j,k)*sgs%visc(i,j,k)*( & @@ -717,7 +717,6 @@ subroutine simulation_run call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE=TKE/fs%cfg%vol_total call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPS=EPS/fs%cfg%vol_total - call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp=EPSp/fs%cfg%vol_total call MPI_ALLREDUCE(mysgsEPSp,sgsEPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsEPSp=sgsEPSp/fs%cfg%vol_total URMS = sqrt(2.0_WP/3.0_WP*(TKE+sgsTKE)) From da1fd611e701c9b19e3573ee80cc4fed01ebcc4a Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 10 Feb 2023 15:56:02 -0500 Subject: [PATCH 124/152] Update simulation.f90 small changes --- examples/riser/src/simulation.f90 | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index eff547c6e..78d778d18 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -432,6 +432,7 @@ subroutine simulation_init ! Form momentum call fs%rho_multiply fs%rhoUold=fs%rhoU + dRHOdt=0.0_WP ! Apply all other boundary conditions call fs%interp_vel(Ui,Vi,Wi) call fs%get_div(drhodt=dRHOdt) @@ -481,7 +482,6 @@ subroutine simulation_init call ens_out%add_particle('particles',pmesh) call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('levelset',G) - call ens_out%add_scalar('ibm_vf',fs%cfg%VF) call ens_out%add_scalar('pressure',fs%P) call ens_out%add_scalar('epsp',lp%VF) ! Output to ensight @@ -683,26 +683,22 @@ subroutine simulation_run fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW -!!$ ! Apply direct forcing to enforce BC at the pipe walls -!!$ ibm_correction: block +!!$ ! Apply IB forcing to enforce BC at the pipe walls +!!$ ibforcing: block !!$ integer :: i,j,k -!!$ real(WP) :: VFx,VFy,VFz !!$ do k=fs%cfg%kmin_,fs%cfg%kmax_ !!$ do j=fs%cfg%jmin_,fs%cfg%jmax_ !!$ do i=fs%cfg%imin_,fs%cfg%imax_ -!!$ VFx=get_VF(i,j,k,'U') -!!$ VFy=get_VF(i,j,k,'V') -!!$ VFz=get_VF(i,j,k,'W') -!!$ fs%U(i,j,k)=fs%U(i,j,k)*VFx -!!$ fs%V(i,j,k)=fs%V(i,j,k)*VFy -!!$ fs%W(i,j,k)=fs%W(i,j,k)*VFz +!!$ fs%U(i,j,k)=get_VF(i,j,k,'U')*fs%U(i,j,k) +!!$ fs%V(i,j,k)=get_VF(i,j,k,'V')*fs%V(i,j,k) +!!$ fs%W(i,j,k)=get_VF(i,j,k,'W')*fs%W(i,j,k) !!$ end do !!$ end do !!$ end do !!$ call fs%cfg%sync(fs%U) !!$ call fs%cfg%sync(fs%V) !!$ call fs%cfg%sync(fs%W) -!!$ end block ibm_correction +!!$ end block ibforcing ! Apply other boundary conditions and update momentum call fs%apply_bcond(time%tmid,time%dtmid) From 5d6b42482ba8d429bbf0bd76a13805127b81850f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 10 Feb 2023 16:53:48 -0500 Subject: [PATCH 125/152] Update simulation.f90 small cleanup --- examples/riser/src/simulation.f90 | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 78d778d18..02851b4b9 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -650,19 +650,14 @@ subroutine simulation_run ! Apply direct forcing to enforce BC at the pipe walls ibm_correction: block integer :: i,j,k - real(WP) :: VFx,VFy,VFz,RHOx,RHOy,RHOz + real(WP) :: VFx,VFy,VFz do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ do i=fs%cfg%imin_,fs%cfg%imax_ - VFx=get_VF(i,j,k,'U') - VFy=get_VF(i,j,k,'V') - VFz=get_VF(i,j,k,'W') - RHOx=sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k)) - RHOy=sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k)) - RHOz=sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k)) - resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*RHOx*fs%U(i,j,k) - resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*RHOy*fs%V(i,j,k) - resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*RHOz*fs%W(i,j,k) + VFx=get_VF(i,j,k,'U'); VFy=get_VF(i,j,k,'V'); VFz=get_VF(i,j,k,'W') + resU(i,j,k)=resU(i,j,k)-(1.0_WP-VFx)*sum(fs%itpr_x(:,i,j,k)*fs%rho(i-1:i,j,k))*fs%U(i,j,k) + resV(i,j,k)=resV(i,j,k)-(1.0_WP-VFy)*sum(fs%itpr_y(:,i,j,k)*fs%rho(i,j-1:j,k))*fs%V(i,j,k) + resW(i,j,k)=resW(i,j,k)-(1.0_WP-VFz)*sum(fs%itpr_z(:,i,j,k)*fs%rho(i,j,k-1:k))*fs%W(i,j,k) end do end do end do From 24b9db93909ac30c8c763bfe5038bfeb56d320be Mon Sep 17 00:00:00 2001 From: jessecaps Date: Sat, 11 Feb 2023 12:23:40 -0500 Subject: [PATCH 126/152] Squashed commit of the following: commit 7a005e1973d84d442c10cb6aead6bd43bde9e08a Author: Olivier Desjardins Date: Sat Feb 11 09:32:32 2023 -0500 Added an optional variable to allow or not VF=zero commit a82838a891e3f200f81b4014ad2ebfeae3dd0027 Author: Olivier Desjardins Date: Sat Feb 11 09:07:18 2023 -0500 Finished implementation of sharp VF calculation from Gib commit 08d1de1d02eaf23ed0f8cc068f5cb13de9ae4014 Author: Olivier Desjardins Date: Fri Feb 10 16:09:41 2023 -0500 1- Added (but commented) a rho/rho_avg rescaling of pressure jump 2- Added (but didn't quite finish) a sharp VF calculation from Gib 3- Switched falling_drop_ib case to an ELVIRA reconstruction commit 09434395ec56bcd42e9833a99bb88d87aa20f2ee Author: Olivier Desjardins Date: Thu Feb 9 18:14:09 2023 -0500 Reverting the squaring of Cs for the dynamic smago model commit 3d43243eb795de6f9b53f671aed594d0154f651e Author: Olivier Desjardins Date: Thu Feb 9 17:44:27 2023 -0500 This makes the drop-ib impact test 3D commit 8440aa1b318a4d1b7818b6c0fce6a9a72bf29dea Author: Olivier Desjardins Date: Thu Feb 9 17:31:06 2023 -0500 New class ibconfig which extends config. Implemented standard normal vector calculation, and Bigot's VF expression. Drop impact on curved surface seems to work well. Also absorbed SGS model typo correction from UMich. commit 73cc558bfa4fe8f9d35627b820d8b0e621da72af Author: Olivier Desjardins Date: Thu Feb 9 14:14:41 2023 -0500 New falling drop with IB case, exposed locator function type (thanks Jack!) commit b261de58d4b018762e5f1e9f09ab5dfb7ba59e83 Author: Olivier Desjardins Date: Wed Feb 8 16:01:25 2023 -0500 Absorbed Jesse's changes with lpt cfl and collision flag. commit 0bca3e86d38e65d82bcf05e26ad2d4884d15fbac Author: Olivier Desjardins Date: Tue Feb 7 23:19:41 2023 -0500 Added IB-particle collision from Jesse. Switched all solvers (except MAST!) to new linsol class. ALMOST ALL EXAMPLES WILL NEED TO BE UPDATED! commit 26b4fe29243963770710ed5b59b9b912dbec536b Author: Olivier Desjardins Date: Tue Feb 7 22:29:02 2023 -0500 Switched fourier3d to c2c... commit 19ae45186b1966242d8e3675f8f66be17bd5ea05 Author: Olivier Desjardins Date: Tue Feb 7 22:09:34 2023 -0500 Commit what I think is the cleanest implementation of r2r fftw solver - but that requires another strategy for building the operator commit a9becb0343bc7f3b07d3c8b230c9882426b5b3bb Author: Olivier Desjardins Date: Tue Feb 7 16:22:59 2023 -0500 p3dfft is also removed as decomposition strategy commit 31219cef08bbbbf0c0a4cac2985d47ac89f32938 Author: Olivier Desjardins Date: Tue Feb 7 16:16:07 2023 -0500 May not be working yet - this commit removes p3dfft altogether, replaces it with our in-house fourier solver. commit ff795e1aa35e23c9fcabe11d79fae700d605ed57 Author: Olivier Desjardins Date: Tue Feb 7 09:49:15 2023 -0500 Started adding a multiphase_pipe case. Started adding back in-house fourier solver. Fixed bug with hit. commit ec57c3a84e25f3af98e0a7ea79615efe3841aa2d Author: Olivier Desjardins Date: Mon Feb 6 13:41:15 2023 -0500 Proper non-dimensionalization of the swirl injection case commit 49d5325fd38e0624ff6a5d66c0e75ebbf4c02960 Author: Olivier Desjardins Date: Mon Feb 6 13:17:20 2023 -0500 Moved library directory specification to my .zshrc to remove all reference to 'desjardi'... commit 7937d14022734d4ccf24315e24f2fade3a7914a6 Author: Olivier Desjardins Date: Mon Feb 6 10:59:56 2023 -0500 Adding a swirl atomizer test case. commit c70dd8ba887f39b40510b75409d30dd525e58390 Author: Olivier Desjardins Date: Sun Feb 5 21:51:08 2023 -0500 Particles with id=0 do not modify the flow and are not advanced. They're just kinda... there. commit 305694cffbe3ff5ccc5f544adef497eebcd0f40d Author: Olivier Desjardins Date: Sun Feb 5 21:35:21 2023 -0500 Removed shock-particle case, it's not ready. commit 4bf8f61d4996c35aff2581a5e8f2987d0e05e9a8 Author: Olivier Desjardins Date: Sun Feb 5 21:34:04 2023 -0500 Updated shit_p routines to make use of newly defined integration tools and fluid_vol variable. commit af17f44d5ce8eb088e9433e3e0b1188d6b0e5066 Author: Olivier Desjardins Date: Sun Feb 5 20:01:42 2023 -0500 Absorded range of modifications from Jesse's repository. Most important is the use of p3dfft for fourier-based linear solvers. commit f962bc2b278e419c8d8d09e5e45d5ea677bf9d6e Author: Olivier Desjardins Date: Fri Feb 3 17:17:33 2023 -0500 Clean-up ib_pipe to make it a proper pipe flow LES. Cleaned up Vreman's sgs model. commit 6c4766c03f875933dc4435d09b36cc43908e77b5 Author: Olivier Desjardins Date: Fri Feb 3 14:19:32 2023 -0500 Slight clean-up of the turbulent ib_pipe case. commit bf6f53909e43e24aed0f4cfb802118bb447f61fd Author: Olivier Desjardins Date: Thu Feb 2 22:57:49 2023 -0500 ib_pipe modified to absorb Jesse's changes, and pushed to turbulent conditions. commit d7892206a0a67fc87a3357270811944df00e26bc Author: Olivier Desjardins Date: Thu Feb 2 14:56:07 2023 -0500 Small changes to falling_drop, added new ib_drop case. commit 1ceb7d2b0dced02f0bbb0782a4c386ab350bce29 Author: Olivier Desjardins Date: Wed Feb 1 10:41:13 2023 -0500 Reindent df_class. Need to think about role of rho here for two-phase flows. --- examples/falling_drop_ib/src/geometry.f90 | 6 +- examples/falling_drop_ib/src/simulation.f90 | 724 ++++++++++---------- src/config/ibconfig_class.f90 | 39 +- src/two_phase/tpns_class.f90 | 6 +- 4 files changed, 405 insertions(+), 370 deletions(-) diff --git a/examples/falling_drop_ib/src/geometry.f90 b/examples/falling_drop_ib/src/geometry.f90 index f75851eae..2c8475f56 100644 --- a/examples/falling_drop_ib/src/geometry.f90 +++ b/examples/falling_drop_ib/src/geometry.f90 @@ -64,7 +64,7 @@ subroutine geometry_init ! Create IB walls for this config create_walls: block use mathtools, only: twoPi - use ibconfig_class, only: bigot + use ibconfig_class, only: bigot,sharp integer :: i,j,k ! Create IB field do k=cfg%kmino_,cfg%kmaxo_ @@ -77,11 +77,11 @@ subroutine geometry_init ! Get normal vector call cfg%calculate_normal() ! Get VF field - call cfg%calculate_vf(method=bigot) + call cfg%calculate_vf(method=sharp) end block create_walls end subroutine geometry_init -end module geometry \ No newline at end of file +end module geometry diff --git a/examples/falling_drop_ib/src/simulation.f90 b/examples/falling_drop_ib/src/simulation.f90 index 1df188b2b..c6332e1f1 100644 --- a/examples/falling_drop_ib/src/simulation.f90 +++ b/examples/falling_drop_ib/src/simulation.f90 @@ -1,367 +1,367 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use hypre_str_class, only: hypre_str - use tpns_class, only: tpns - use vfs_class, only: vfs - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor - implicit none - private - - !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker - type(hypre_str), public :: ps - type(hypre_str), public :: vs - type(tpns), public :: fs - type(vfs), public :: vf - type(timetracker), public :: time - - !> Ensight postprocessing - type(ensight) :: ens_out - type(event) :: ens_evt - - !> Simulation monitor file - type(monitor) :: mfile,cflfile - - public :: simulation_init,simulation_run,simulation_final - - !> Private work arrays - real(WP), dimension(:,:,:), allocatable :: resU,resV,resW - real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi - - !> Droplet definition - real(WP), dimension(3) :: center - real(WP) :: radius - + use precision, only: WP + use geometry, only: cfg + use hypre_str_class, only: hypre_str + use tpns_class, only: tpns + use vfs_class, only: vfs + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get a couple linear solvers, a two-phase flow solver and volume fraction solver and corresponding time tracker + type(hypre_str), public :: ps + type(hypre_str), public :: vs + type(tpns), public :: fs + type(vfs), public :: vf + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + + !> Droplet definition + real(WP), dimension(3) :: center + real(WP) :: radius + contains - !> Function that defines a level set function for a falling drop problem - function levelset_falling_drop(xyz,t) result(G) - implicit none - real(WP), dimension(3),intent(in) :: xyz - real(WP), intent(in) :: t - real(WP) :: G - ! Create the droplet - G=radius-sqrt(sum((xyz-center)**2)) - end function levelset_falling_drop - - - !> Initialization of problem solver - subroutine simulation_init - use param, only: param_read - implicit none - - - ! Allocate work arrays - allocate_work_arrays: block - allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) - end block allocate_work_arrays - - - ! Initialize time tracker with 2 subiterations - initialize_timetracker: block - time=timetracker(amRoot=cfg%amRoot) - call param_read('Max timestep size',time%dtmax) - call param_read('Max cfl number',time%cflmax) - call param_read('Max time',time%tmax) - time%dt=time%dtmax - time%itmax=2 - end block initialize_timetracker - - - ! Initialize our VOF solver and field - create_and_initialize_vof: block - use mms_geom, only: cube_refine_vol - use vfs_class, only: lvira,VFhi,VFlo - integer :: i,j,k,n,si,sj,sk - real(WP), dimension(3,8) :: cube_vertex - real(WP), dimension(3) :: v_cent,a_cent - real(WP) :: vol,area - integer, parameter :: amr_ref_lvl=4 - ! Create a VOF solver - vf=vfs(cfg=cfg,reconstruction_method=lvira,name='VOF') - ! Initialize to a droplet and a pool - center=[0.0_WP,0.075_WP,0.0_WP]; radius=0.01_WP - do k=vf%cfg%kmino_,vf%cfg%kmaxo_ - do j=vf%cfg%jmino_,vf%cfg%jmaxo_ - do i=vf%cfg%imino_,vf%cfg%imaxo_ - ! Set cube vertices - n=0 - do sk=0,1 - do sj=0,1 - do si=0,1 - n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] - end do - end do - end do - ! Call adaptive refinement code to get volume and barycenters recursively - vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP - call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) - vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) - if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then - vf%Lbary(:,i,j,k)=v_cent - vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) - else - vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] - end if - end do - end do - end do - ! Update the band - call vf%update_band() - ! Perform interface reconstruction from VOF field - call vf%build_interface() - ! Create discontinuous polygon mesh from IRL interface - call vf%polygonalize_interface() - ! Calculate distance from polygons - call vf%distance_from_polygon() - ! Calculate subcell phasic volumes - call vf%subcell_vol() - ! Calculate curvature - call vf%get_curvature() - ! Reset moments to guarantee compatibility with interface reconstruction - call vf%reset_volume_moments() - end block create_and_initialize_vof - - - ! Create a two-phase flow solver without bconds - create_and_initialize_flow_solver: block - use hypre_str_class, only: pcg_pfmg - ! Create flow solver - fs=tpns(cfg=cfg,name='Two-phase NS') - ! Assign constant viscosity to each phase - call param_read('Liquid dynamic viscosity',fs%visc_l) - call param_read('Gas dynamic viscosity',fs%visc_g) - ! Assign constant density to each phase - call param_read('Liquid density',fs%rho_l) - call param_read('Gas density',fs%rho_g) - ! Read in surface tension coefficient - call param_read('Surface tension coefficient',fs%sigma) - ! Assign acceleration of gravity - call param_read('Gravity',fs%gravity) - ! Configure pressure solver - ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - call param_read('Pressure iteration',ps%maxit) - call param_read('Pressure tolerance',ps%rcvg) - ! Configure implicit velocity solver - vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) - call param_read('Implicit iteration',vs%maxit) - call param_read('Implicit tolerance',vs%rcvg) - ! Setup the solver - call fs%setup(pressure_solver=ps,implicit_solver=vs) - ! Zero initial field - fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Calculate cell-centered velocities and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - end block create_and_initialize_flow_solver - - - ! Add Ensight output - create_ensight: block - ! Create Ensight output from cfg - ens_out=ensight(cfg=cfg,name='FallingDrop') - ! Create event for Ensight output - ens_evt=event(time=time,name='Ensight output') - call param_read('Ensight output period',ens_evt%tper) - ! Add variables to output - call ens_out%add_vector('velocity',Ui,Vi,Wi) - call ens_out%add_scalar('VOF',vf%VF) - call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('curvature',vf%curv) - call ens_out%add_scalar('Gib',cfg%Gib) - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - end block create_ensight - - - ! Create a monitor file - create_monitor: block - ! Prepare some info about fields - call fs%get_cfl(time%dt,time%cfl) - call fs%get_max() - call vf%get_max() - ! Create simulation monitor - mfile=monitor(fs%cfg%amRoot,'simulation') - call mfile%add_column(time%n,'Timestep number') - call mfile%add_column(time%t,'Time') - call mfile%add_column(time%dt,'Timestep size') - call mfile%add_column(time%cfl,'Maximum CFL') - call mfile%add_column(fs%Umax,'Umax') - call mfile%add_column(fs%Vmax,'Vmax') - call mfile%add_column(fs%Wmax,'Wmax') - call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(vf%VFmax,'VOF maximum') - call mfile%add_column(vf%VFmin,'VOF minimum') - call mfile%add_column(vf%VFint,'VOF integral') - call mfile%add_column(fs%divmax,'Maximum divergence') - call mfile%add_column(fs%psolv%it,'Pressure iteration') - call mfile%add_column(fs%psolv%rerr,'Pressure error') - call mfile%write() - ! Create CFL monitor - cflfile=monitor(fs%cfg%amRoot,'cfl') - call cflfile%add_column(time%n,'Timestep number') - call cflfile%add_column(time%t,'Time') - call cflfile%add_column(fs%CFLst,'STension CFL') - call cflfile%add_column(fs%CFLc_x,'Convective xCFL') - call cflfile%add_column(fs%CFLc_y,'Convective yCFL') - call cflfile%add_column(fs%CFLc_z,'Convective zCFL') - call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') - call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') - call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') - call cflfile%write() - end block create_monitor - - - end subroutine simulation_init - - - !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase - subroutine simulation_run - implicit none - - ! Perform time integration - do while (.not.time%done()) - - ! Increment time - call fs%get_cfl(time%dt,time%cfl) - call time%adjust_dt() - call time%increment() - - ! Remember old VOF - vf%VFold=vf%VF - - ! Remember old velocity - fs%Uold=fs%U - fs%Vold=fs%V - fs%Wold=fs%W - - ! Apply time-varying Dirichlet conditions - ! This is where time-dpt Dirichlet would be enforced - - ! Prepare old staggered density (at n) - call fs%get_olddensity(vf=vf) - - ! VOF solver step - call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) - - ! Prepare new staggered viscosity (at n+1) - call fs%get_viscosity(vf=vf) - - ! Perform sub-iterations - do while (time%it.le.time%itmax) - - ! Build mid-time velocity - fs%U=0.5_WP*(fs%U+fs%Uold) - fs%V=0.5_WP*(fs%V+fs%Vold) - fs%W=0.5_WP*(fs%W+fs%Wold) - - ! Preliminary mass and momentum transport step at the interface - call fs%prepare_advection_upwind(dt=time%dt) - - ! Explicit calculation of drho*u/dt from NS - call fs%get_dmomdt(resU,resV,resW) - - ! Add momentum source terms - call fs%addsrc_gravity(resU,resV,resW) - - ! Assemble explicit residual - resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU - resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV - resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW - - ! Form implicit residuals - call fs%solve_implicit(time%dt,resU,resV,resW) - - ! Apply these residuals - fs%U=2.0_WP*fs%U-fs%Uold+resU - fs%V=2.0_WP*fs%V-fs%Vold+resV - fs%W=2.0_WP*fs%W-fs%Wold+resW - - ! Apply direct IB forcing - ibforcing: block - integer :: i,j,k - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - fs%U(i,j,k)=sum(fs%itpr_x(:,i,j,k)*cfg%VF(i-1:i,j,k))*fs%U(i,j,k) - fs%V(i,j,k)=sum(fs%itpr_y(:,i,j,k)*cfg%VF(i,j-1:j,k))*fs%V(i,j,k) - fs%W(i,j,k)=sum(fs%itpr_z(:,i,j,k)*cfg%VF(i,j,k-1:k))*fs%W(i,j,k) - end do - end do - end do - call fs%cfg%sync(fs%U) - call fs%cfg%sync(fs%V) - call fs%cfg%sync(fs%W) - end block ibforcing - - ! Apply other boundary conditions - call fs%apply_bcond(time%t,time%dt) - - ! Solve Poisson equation - call fs%update_laplacian() - call fs%correct_mfr() - call fs%get_div() - call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) - fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt - fs%psolv%sol=0.0_WP - call fs%psolv%solve() - call fs%shift_p(fs%psolv%sol) - - ! Correct velocity - call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) - fs%P=fs%P+fs%psolv%sol - fs%U=fs%U-time%dt*resU/fs%rho_U - fs%V=fs%V-time%dt*resV/fs%rho_V - fs%W=fs%W-time%dt*resW/fs%rho_W - - ! Increment sub-iteration counter - time%it=time%it+1 - - end do - - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_div() - - ! Output to ensight - if (ens_evt%occurs()) call ens_out%write_data(time%t) - - ! Perform and output monitoring - call fs%get_max() - call vf%get_max() - call mfile%write() - call cflfile%write() - - end do - - end subroutine simulation_run - - - !> Finalize the NGA2 simulation - subroutine simulation_final - implicit none - - ! Get rid of all objects - need destructors - ! monitor - ! ensight - ! bcond - ! timetracker - - ! Deallocate work arrays - deallocate(resU,resV,resW,Ui,Vi,Wi) - - end subroutine simulation_final - - -end module simulation \ No newline at end of file + !> Function that defines a level set function for a falling drop problem + function levelset_falling_drop(xyz,t) result(G) + implicit none + real(WP), dimension(3),intent(in) :: xyz + real(WP), intent(in) :: t + real(WP) :: G + ! Create the droplet + G=radius-sqrt(sum((xyz-center)**2)) + end function levelset_falling_drop + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + call param_read('Max time',time%tmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our VOF solver and field + create_and_initialize_vof: block + use mms_geom, only: cube_refine_vol + use vfs_class, only: elvira,VFhi,VFlo + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: cube_vertex + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + integer, parameter :: amr_ref_lvl=4 + ! Create a VOF solver + vf=vfs(cfg=cfg,reconstruction_method=elvira,name='VOF') + ! Initialize to a droplet and a pool + center=[0.0_WP,0.075_WP,0.0_WP]; radius=0.01_WP + do k=vf%cfg%kmino_,vf%cfg%kmaxo_ + do j=vf%cfg%jmino_,vf%cfg%jmaxo_ + do i=vf%cfg%imino_,vf%cfg%imaxo_ + ! Set cube vertices + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1; cube_vertex(:,n)=[vf%cfg%x(i+si),vf%cfg%y(j+sj),vf%cfg%z(k+sk)] + end do + end do + end do + ! Call adaptive refinement code to get volume and barycenters recursively + vol=0.0_WP; area=0.0_WP; v_cent=0.0_WP; a_cent=0.0_WP + call cube_refine_vol(cube_vertex,vol,area,v_cent,a_cent,levelset_falling_drop,0.0_WP,amr_ref_lvl) + vf%VF(i,j,k)=vol/vf%cfg%vol(i,j,k) + if (vf%VF(i,j,k).ge.VFlo.and.vf%VF(i,j,k).le.VFhi) then + vf%Lbary(:,i,j,k)=v_cent + vf%Gbary(:,i,j,k)=([vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)]-vf%VF(i,j,k)*vf%Lbary(:,i,j,k))/(1.0_WP-vf%VF(i,j,k)) + else + vf%Lbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + vf%Gbary(:,i,j,k)=[vf%cfg%xm(i),vf%cfg%ym(j),vf%cfg%zm(k)] + end if + end do + end do + end do + ! Update the band + call vf%update_band() + ! Perform interface reconstruction from VOF field + call vf%build_interface() + ! Create discontinuous polygon mesh from IRL interface + call vf%polygonalize_interface() + ! Calculate distance from polygons + call vf%distance_from_polygon() + ! Calculate subcell phasic volumes + call vf%subcell_vol() + ! Calculate curvature + call vf%get_curvature() + ! Reset moments to guarantee compatibility with interface reconstruction + call vf%reset_volume_moments() + end block create_and_initialize_vof + + + ! Create a two-phase flow solver without bconds + create_and_initialize_flow_solver: block + use hypre_str_class, only: pcg_pfmg + ! Create flow solver + fs=tpns(cfg=cfg,name='Two-phase NS') + ! Assign constant viscosity to each phase + call param_read('Liquid dynamic viscosity',fs%visc_l) + call param_read('Gas dynamic viscosity',fs%visc_g) + ! Assign constant density to each phase + call param_read('Liquid density',fs%rho_l) + call param_read('Gas density',fs%rho_g) + ! Read in surface tension coefficient + call param_read('Surface tension coefficient',fs%sigma) + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Calculate cell-centered velocities and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + end block create_and_initialize_flow_solver + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='FallingDrop') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('VOF',vf%VF) + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('curvature',vf%curv) + call ens_out%add_scalar('Gib',cfg%Gib) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call vf%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(vf%VFmax,'VOF maximum') + call mfile%add_column(vf%VFmin,'VOF minimum') + call mfile%add_column(vf%VFint,'VOF integral') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLst,'STension CFL') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation - this mimicks NGA's old time integration for multiphase + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old VOF + vf%VFold=vf%VF + + ! Remember old velocity + fs%Uold=fs%U + fs%Vold=fs%V + fs%Wold=fs%W + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Prepare old staggered density (at n) + call fs%get_olddensity(vf=vf) + + ! VOF solver step + call vf%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W) + + ! Prepare new staggered viscosity (at n+1) + call fs%get_viscosity(vf=vf) + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! Build mid-time velocity + fs%U=0.5_WP*(fs%U+fs%Uold) + fs%V=0.5_WP*(fs%V+fs%Vold) + fs%W=0.5_WP*(fs%W+fs%Wold) + + ! Preliminary mass and momentum transport step at the interface + call fs%prepare_advection_upwind(dt=time%dt) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=-2.0_WP*fs%rho_U*fs%U+(fs%rho_Uold+fs%rho_U)*fs%Uold+time%dt*resU + resV=-2.0_WP*fs%rho_V*fs%V+(fs%rho_Vold+fs%rho_V)*fs%Vold+time%dt*resV + resW=-2.0_WP*fs%rho_W*fs%W+(fs%rho_Wold+fs%rho_W)*fs%Wold+time%dt*resW + + ! Form implicit residuals + call fs%solve_implicit(time%dt,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply direct IB forcing + ibforcing: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + fs%U(i,j,k)=sum(fs%itpr_x(:,i,j,k)*cfg%VF(i-1:i,j,k))*fs%U(i,j,k) + fs%V(i,j,k)=sum(fs%itpr_y(:,i,j,k)*cfg%VF(i,j-1:j,k))*fs%V(i,j,k) + fs%W(i,j,k)=sum(fs%itpr_z(:,i,j,k)*cfg%VF(i,j,k-1:k))*fs%W(i,j,k) + end do + end do + end do + call fs%cfg%sync(fs%U) + call fs%cfg%sync(fs%V) + call fs%cfg%sync(fs%W) + end block ibforcing + + ! Apply other boundary conditions + call fs%apply_bcond(time%t,time%dt) + + ! Solve Poisson equation + call fs%update_laplacian() + call fs%correct_mfr() + call fs%get_div() + call fs%add_surface_tension_jump(dt=time%dt,div=fs%div,vf=vf) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dt + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%U=fs%U-time%dt*resU/fs%rho_U + fs%V=fs%V-time%dt*resV/fs%rho_V + fs%W=fs%W-time%dt*resW/fs%rho_W + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div() + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call vf%get_max() + call mfile%write() + call cflfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + +end module simulation diff --git a/src/config/ibconfig_class.f90 b/src/config/ibconfig_class.f90 index a1d453e90..57142c021 100644 --- a/src/config/ibconfig_class.f90 +++ b/src/config/ibconfig_class.f90 @@ -11,6 +11,7 @@ module ibconfig_class ! List of known available methods for calculating VF from G integer, parameter, public :: bigot=1 + integer, parameter, public :: sharp=2 !> Config object definition as an extension of config type, extends(config) :: ibconfig @@ -120,11 +121,12 @@ end subroutine calculate_normal !> Calculation of VF from G - subroutine calculate_vf(this,method) + subroutine calculate_vf(this,method,allow_zero_vf) use messager, only: die implicit none class(ibconfig), intent(inout) :: this integer, intent(in) :: method + logical, intent(in), optional :: allow_zero_vf ! Select the method select case (method) @@ -139,15 +141,48 @@ subroutine calculate_vf(this,method) lambda=sum(abs(this%Nib(:,i,j,k))) eta=0.065_WP*(1.0_WP-lambda**2)+0.39_WP this%VF(i,j,k)=0.5_WP*(1.0_WP-tanh(this%Gib(i,j,k)/(lambda*eta*this%meshsize(i,j,k)))) - this%VF(i,j,k)=max(this%VF(i,j,k),epsilon(1.0_WP)) end do end do end do end block bigot + case (sharp) + ! Get fluid volume fraction from G using marching tets + sharp: block + use mms_geom, only: marching_tets + integer :: i,j,k,n,si,sj,sk + real(WP), dimension(3,8) :: hex_vertex + real(WP), dimension(8) :: G + real(WP), dimension(3) :: v_cent,a_cent + real(WP) :: vol,area + do k=this%kmino_,this%kmaxo_ + do j=this%jmino_,this%jmaxo_ + do i=this%imino_,this%imaxo_ + n=0 + do sk=0,1 + do sj=0,1 + do si=0,1 + n=n+1 + hex_vertex(:,n)=[this%x(i+si),this%y(j+sj),this%z(k+sk)] + G(n)=-this%get_scalar(hex_vertex(:,n),i,j,k,this%Gib,'n') + end do + end do + end do + call marching_tets(hex_vertex,G,vol,area,v_cent,a_cent) + this%VF(i,j,k)=vol/this%vol(i,j,k) + end do + end do + end do + call this%sync(this%VF) !< Sync needed because of the Gib interpolation above + end block sharp case default call die('[ibconfig calculate_vf] Unknown method to calculate VF') end select + ! Check if VF=0 is allowed + if (present(allow_zero_vf)) then + if (.not.allow_zero_vf) this%VF=max(this%VF,epsilon(1.0_WP)) + end if + ! Update total fluid volume call this%calc_fluid_vol() diff --git a/src/two_phase/tpns_class.f90 b/src/two_phase/tpns_class.f90 index a6cd1b0a7..7ca8d041c 100644 --- a/src/two_phase/tpns_class.f90 +++ b/src/two_phase/tpns_class.f90 @@ -1641,7 +1641,7 @@ subroutine add_surface_tension_jump(this,dt,div,vf,contact_model) else mycurv=0.0_WP end if - this%Pjx(i,j,k)=this%sigma*mycurv*sum(this%divu_x(:,i,j,k)*vf%VF(i-1:i,j,k)) + this%Pjx(i,j,k)=this%sigma*mycurv*sum(this%divu_x(:,i,j,k)*vf%VF(i-1:i,j,k))!*2.0_WP*this%rho_U(i,j,k)/(this%rho_l+this%rho_g) ! Y face mysurf=sum(vf%SD(i,j-1:j,k)*this%cfg%vol(i,j-1:j,k)) if (mysurf.gt.0.0_WP) then @@ -1649,7 +1649,7 @@ subroutine add_surface_tension_jump(this,dt,div,vf,contact_model) else mycurv=0.0_WP end if - this%Pjy(i,j,k)=this%sigma*mycurv*sum(this%divv_y(:,i,j,k)*vf%VF(i,j-1:j,k)) + this%Pjy(i,j,k)=this%sigma*mycurv*sum(this%divv_y(:,i,j,k)*vf%VF(i,j-1:j,k))!*2.0_WP*this%rho_V(i,j,k)/(this%rho_l+this%rho_g) ! Z face mysurf=sum(vf%SD(i,j,k-1:k)*this%cfg%vol(i,j,k-1:k)) if (mysurf.gt.0.0_WP) then @@ -1657,7 +1657,7 @@ subroutine add_surface_tension_jump(this,dt,div,vf,contact_model) else mycurv=0.0_WP end if - this%Pjz(i,j,k)=this%sigma*mycurv*sum(this%divw_z(:,i,j,k)*vf%VF(i,j,k-1:k)) + this%Pjz(i,j,k)=this%sigma*mycurv*sum(this%divw_z(:,i,j,k)*vf%VF(i,j,k-1:k))!*2.0_WP*this%rho_W(i,j,k)/(this%rho_l+this%rho_g) end do end do end do From 0889fc7a8d87fb0ae4da055168fe53fea5e7a5cf Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 13 Feb 2023 12:24:06 -0500 Subject: [PATCH 127/152] HIT updates HIT updates --- examples/hit/GNUmakefile | 8 +- examples/hit/input | 24 +- examples/hit/src/Make.package | 2 +- examples/hit/src/lpt_class.f90 | 1998 ------------------------------- examples/hit/src/simulation.f90 | 505 ++------ 5 files changed, 137 insertions(+), 2400 deletions(-) delete mode 100644 examples/hit/src/lpt_class.f90 diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index 76c85b766..dc04f19b6 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -24,15 +24,15 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well -HYPRE_DIR = /Users/maxzog/hypre/ -LAPACK_DIR= /usr/local/Cellar/lapack/3.11/ -FFTW_DIR = /usr/local/Cellar/fftw/3.3.10_1/ +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := particles core constant_density subgrid data solver config grid libraries +Bdirs := core constant_density data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/hit/input b/examples/hit/input index ae0bfefdc..195d10e86 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 1 1 4 +Partition : 2 2 1 # Mesh definition Lx : 6.2832 @@ -10,29 +10,19 @@ Dynamic viscosity : 0.002 Density : 1 Initial rms : 10 Eddy turnover time : 0.1 -Linear forcing : .true. # Steadt-state (forcing) parameters -Steady-state TKE : 3.0 -Steady-state epsilon : 6.0 -Forcing constant (G) : 50.0 Force to maximum Re_lambda : .true. - -# Particle properties -Particle density : 1000 -Particle Stokes number : 1.0 -Number of particles : 10000 # 250000 -Use CRW : .false. +Forcing constant : 50.0 # Time integration Max timestep size : 1e-3 Max cfl number : 0.9 -Max iter : 1500 +Max iter : 9999999 # Ensight output -Ensight output period : 0.01 +Ensight output period : 0.1 -# Restart config -Restart sim : .false. -# Restart from : 1.00044E-02 -Restart output period : 0.001 +# Restart +Restart output period : 200e-3 +# Restart from : 1.00044E-02 \ No newline at end of file diff --git a/examples/hit/src/Make.package b/examples/hit/src/Make.package index 32bde3e1e..a7a927853 100644 --- a/examples/hit/src/Make.package +++ b/examples/hit/src/Make.package @@ -1,2 +1,2 @@ # List here the extra files here -f90EXE_sources += geometry.f90 lpt_class.f90 simulation.f90 +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/hit/src/lpt_class.f90 b/examples/hit/src/lpt_class.f90 deleted file mode 100644 index a0c441ec7..000000000 --- a/examples/hit/src/lpt_class.f90 +++ /dev/null @@ -1,1998 +0,0 @@ -!> Basic Lagrangian particle solver class: -!> Provides support for Lagrangian-transported objects -module lpt_class - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use diag_class, only: diag - use mpi_f08, only: MPI_Datatype,MPI_INTEGER8,MPI_INTEGER,MPI_DOUBLE_PRECISION - implicit none - private - - - ! Expose type/constructor/methods - public :: lpt - - !> Pozorski & Apte (2009) model constant - real(WP), public :: C_poz = 1.0_WP - - !> Memory adaptation parameter - real(WP), parameter :: coeff_up=1.3_WP !< Particle array size increase factor - real(WP), parameter :: coeff_dn=0.7_WP !< Particle array size decrease factor - - !> I/O chunk size to read at a time - integer, parameter :: part_chunk_size=1000 !< Read 1000 particles at a time before redistributing - - !> Basic particle object definition - type :: part - !> MPI_INTEGER8 data - integer(kind=8) :: id !< Particle ID - !> MPI_DOUBLE_PRECISION data - real(WP) :: d !< Particle diameter - real(WP), dimension(3) :: pos !< Particle center coordinates - real(WP), dimension(3) :: vel !< Velocity of particle - real(WP), dimension(3) :: angVel !< Angular velocity of particle - real(WP), dimension(3) :: Acol !< Collision acceleration - real(WP), dimension(3) :: Tcol !< Collision torque - real(WP), dimension(3) :: dW !< Wiener increment - real(WP), dimension(3) :: b_ij !< Neighbor contributions to diffusion - real(WP), dimension(3) :: uf !< Stochastic flucutating fluid velocity seen - real(WP) :: corrsum !< Sum of correlation coefficient over neighbors - real(WP) :: a_crw !< OU drift - real(WP) :: b_crw !< OU diffusion - real(WP) :: T !< Temperature - real(WP) :: dt !< Time step size for the particle - !> MPI_INTEGER data - integer , dimension(3) :: ind !< Index of cell containing particle center - integer :: flag !< Control parameter (0=normal, 1=done->will be removed) - end type part - !> Number of blocks, block length, and block types in a particle - integer, parameter :: part_nblock=3 - integer , dimension(part_nblock) :: part_lblock=[1,30,4] - type(MPI_Datatype), dimension(part_nblock) :: part_tblock=[MPI_INTEGER8,MPI_DOUBLE_PRECISION,MPI_INTEGER] - !> MPI_PART derived datatype and size - type(MPI_Datatype) :: MPI_PART - integer :: MPI_PART_SIZE - - !> Lagrangian particle tracking solver object definition - type :: lpt - - ! This is our underlying config - class(config), pointer :: cfg !< This is the config the solver is build for - - type(diag) :: tridiag !< Tridiagonal solver for implicit filter - - ! This is the name of the solver - character(len=str_medium) :: name='UNNAMED_LPT' !< Solver name (default=UNNAMED_LPT) - - ! Particle data - integer :: np !< Global number of particles - integer :: np_ !< Local number of particles - integer, dimension(:), allocatable :: np_proc !< Number of particles on each processor - type(part), dimension(:), allocatable :: p !< Array of particles of type part - - ! Overlap particle (i.e., ghost) data - integer :: ng_ !< Local number of ghosts - type(part), dimension(:), allocatable :: g !< Array of ghosts of type part - - ! CFL numbers - real(WP) :: CFLp_x,CFLp_y,CFLp_z,CFL_col !< CFL numbers - - ! Particle density - real(WP) :: rho !< Density of particle - - ! Gravitational acceleration - real(WP), dimension(3) :: gravity=0.0_WP !< Acceleration of gravity - - ! Solver parameters - real(WP) :: nstep=1 !< Number of substeps (default=1) - character(len=str_medium), public :: drag_model !< Drag model - character(len=str_medium), public :: corr_type !< Spatial correlation function for OU process - logical :: use_lift=.false. !< Compute lift force on particles - - ! Collisional parameters - logical :: use_col=.true. !< Flag for collisions - real(WP) :: tau_col !< Characteristic collision time scale - real(WP) :: e_n !< Normal restitution coefficient - real(WP) :: e_w !< Wall restitution coefficient - real(WP) :: mu_f !< Friction coefficient - real(WP) :: clip_col=0.2_WP !< Maximum allowable overlap - real(WP), dimension(:,:,:), allocatable :: Wdist !< Signed wall distance - naive for now (could be redone with FMM) - real(WP), dimension(:,:,:,:), allocatable :: Wnorm !< Wall normal function - naive for now (could be redone with FMM) - - ! Injection parameters - real(WP) :: mfr !< Mass flow rate for particle injection - real(WP), dimension(3) :: inj_pos !< Center location to inject particles - real(WP), dimension(3) :: inj_vel !< Celocity assigned during injection - real(WP) :: inj_T !< Temperature assigned during injection - real(WP) :: inj_dmean !< Mean diameter assigned during injection - real(WP) :: inj_dsd !< STD diameter assigned during injection - real(WP) :: inj_dmin !< Min diameter assigned during injection - real(WP) :: inj_dmax !< Max diameter assigned during injection - real(WP) :: inj_dshift !< Diameter shift assigned during injection - real(WP) :: inj_d !< Diameter to inject particles within - - ! Monitoring info - real(WP) :: VFmin,VFmax,VFmean,VFvar !< Volume fraction info - real(WP) :: dmin,dmax,dmean,dvar !< Diameter info - real(WP) :: Umin,Umax,Umean,Uvar !< U velocity info - real(WP) :: Vmin,Vmax,Vmean,Vvar !< V velocity info - real(WP) :: Wmin,Wmax,Wmean,Wvar !< W velocity info - integer :: np_new,np_out !< Number of new and removed particles - integer :: ncol=0 !< Number of collisions - - ! Particle volume fraction - real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered - - ! Filtering operation - logical :: implicit_filter !< Solve implicitly - real(WP) :: filter_width !< Characteristic filter width - real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator - real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator - - contains - procedure :: update_partmesh !< Update a partmesh object using current particles - procedure :: collide !< Evaluate interparticle collision force - procedure :: update_dW !< Updates random values assigned to particles - procedure :: advance !< Step forward the particle ODEs - procedure :: get_rhs !< Compute rhs of particle odes - procedure :: resize !< Resize particle array to given size - procedure :: resize_ghost !< Resize ghost array to given size - procedure :: recycle !< Recycle particle array by removing flagged particles - procedure :: sync !< Synchronize particles across interprocessor boundaries - procedure :: share !< Share particles across interprocessor boundaries - procedure :: read !< Parallel read particles from file - procedure :: write !< Parallel write particles to file - procedure :: get_max !< Extract various monitoring data - procedure :: get_cfl !< Calculate maximum CFL - procedure :: update_VF !< Compute particle volume fraction - procedure :: filter !< Apply volume filtering to field - procedure :: inject !< Inject particles at a prescribed boundary - end type lpt - - - !> Declare lpt solver constructor - interface lpt - procedure constructor - end interface lpt - -contains - - - !> Default constructor for lpt solver - function constructor(cfg,name) result(self) - implicit none - type(lpt) :: self - class(config), target, intent(in) :: cfg - character(len=*), optional :: name - integer :: i,j,k - - ! Set the name for the solver - if (present(name)) self%name=trim(adjustl(name)) - - ! Point to pgrid object - self%cfg=>cfg - - ! Create tridiagonal solver object - self%tridiag=diag(cfg=self%cfg,name='Tridiagonal',n=3) - - ! Allocate variables - allocate(self%np_proc(1:self%cfg%nproc)); self%np_proc=0 - self%np_=0; self%np=0 - call self%resize(0) - self%np_new=0; self%np_out=0 - - ! Initialize MPI derived datatype for a particle - call prepare_mpi_part() - - ! Allocate VF and src arrays on cfg mesh - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP - - ! Set filter width to zero by default - self%filter_width=0.0_WP - - ! Solve implicitly by default - self%implicit_filter=.true. - - ! Set default drag - self%drag_model='Schiller-Naumann' - - ! Zero friction by default - self%mu_f=0.0_WP - - ! Allocate finite volume divergence operators - allocate(self%div_x(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - allocate(self%div_y(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - allocate(self%div_z(0:+1,self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) !< Cell-centered - ! Create divergence operator to cell center [xm,ym,zm] - do k=self%cfg%kmin_,self%cfg%kmax_ - do j=self%cfg%jmin_,self%cfg%jmax_ - do i=self%cfg%imin_,self%cfg%imax_ - self%div_x(:,i,j,k)=self%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< Divergence from [x ,ym,zm] - self%div_y(:,i,j,k)=self%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,y ,zm] - self%div_z(:,i,j,k)=self%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< Divergence from [xm,ym,z ] - end do - end do - end do - - ! Allocate finite difference velocity gradient operators - allocate(self%grd_x(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< X-face-centered - allocate(self%grd_y(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Y-face-centered - allocate(self%grd_z(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Z-face-centered - ! Create gradient coefficients to cell faces - do k=self%cfg%kmin_,self%cfg%kmax_+1 - do j=self%cfg%jmin_,self%cfg%jmax_+1 - do i=self%cfg%imin_,self%cfg%imax_+1 - self%grd_x(:,i,j,k)=self%cfg%dxmi(i)*[-1.0_WP,+1.0_WP] !< Gradient in x from [xm,ym,zm] to [x,ym,zm] - self%grd_y(:,i,j,k)=self%cfg%dymi(j)*[-1.0_WP,+1.0_WP] !< Gradient in y from [xm,ym,zm] to [xm,y,zm] - self%grd_z(:,i,j,k)=self%cfg%dzmi(k)*[-1.0_WP,+1.0_WP] !< Gradient in z from [xm,ym,zm] to [xm,ym,z] - end do - end do - end do - - ! Loop over the domain and zero divergence in walls - do k=self%cfg%kmin_,self%cfg%kmax_ - do j=self%cfg%jmin_,self%cfg%jmax_ - do i=self%cfg%imin_,self%cfg%imax_ - if (self%cfg%VF(i,j,k).eq.0.0_WP) then - self%div_x(:,i,j,k)=0.0_WP - self%div_y(:,i,j,k)=0.0_WP - self%div_z(:,i,j,k)=0.0_WP - end if - end do - end do - end do - - ! Zero out gradient to wall faces - do k=self%cfg%kmin_,self%cfg%kmax_+1 - do j=self%cfg%jmin_,self%cfg%jmax_+1 - do i=self%cfg%imin_,self%cfg%imax_+1 - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i-1,j,k).eq.0.0_WP) self%grd_x(:,i,j,k)=0.0_WP - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j-1,k).eq.0.0_WP) self%grd_y(:,i,j,k)=0.0_WP - if (self%cfg%VF(i,j,k).eq.0.0_WP.or.self%cfg%VF(i,j,k-1).eq.0.0_WP) self%grd_z(:,i,j,k)=0.0_WP - end do - end do - end do - - ! Adjust metrics to account for lower dimensionality - if (self%cfg%nx.eq.1) then - self%div_x=0.0_WP - self%grd_x=0.0_WP - end if - if (self%cfg%ny.eq.1) then - self%div_y=0.0_WP - self%grd_y=0.0_WP - end if - if (self%cfg%nz.eq.1) then - self%div_z=0.0_WP - self%grd_z=0.0_WP - end if - - ! Generate a wall distance/norm function - allocate(self%Wdist( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) - allocate(self%Wnorm(3,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)) - ! First pass to set correct sign - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%cfg%VF(i,j,k).eq.0.0_WP) then - self%Wdist(i,j,k)=-sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) - else - self%Wdist(i,j,k)=+sqrt(self%cfg%xL**2+self%cfg%yL**2+self%cfg%zL**2) - end if - self%Wnorm(:,i,j,k)=0.0_WP - end do - end do - end do - ! Second pass to compute local distance - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_+1,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i-1,j,k).lt.0.0_WP) then - ! There is a wall at x(i) - if (abs(self%cfg%xm(i )-self%cfg%x(i)).lt.abs(self%Wdist(i ,j,k))) then - self%Wdist(i ,j,k)=sign(self%cfg%xm(i )-self%cfg%x(i),self%Wdist(i ,j,k)) - self%Wnorm(:,i ,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] - end if - if (abs(self%cfg%xm(i-1)-self%cfg%x(i)).lt.abs(self%Wdist(i-1,j,k))) then - self%Wdist(i-1,j,k)=sign(self%cfg%xm(i-1)-self%cfg%x(i),self%Wdist(i-1,j,k)) - self%Wnorm(:,i-1,j,k)=[self%cfg%VF(i,j,k)-self%cfg%VF(i-1,j,k),0.0_WP,0.0_WP] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - do k=self%cfg%kmino_,self%cfg%kmaxo_ - do j=self%cfg%jmino_+1,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i,j-1,k).lt.0.0_WP) then - ! There is a wall at y(j) - if (abs(self%cfg%ym(j )-self%cfg%y(j)).lt.abs(self%Wdist(i,j ,k))) then - self%Wdist(i,j ,k)=sign(self%cfg%ym(j )-self%cfg%y(j),self%Wdist(i,j ,k)) - self%Wnorm(:,i,j ,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] - end if - if (abs(self%cfg%ym(j-1)-self%cfg%y(j)).lt.abs(self%Wdist(i,j-1,k))) then - self%Wdist(i,j-1,k)=sign(self%cfg%ym(j-1)-self%cfg%y(j),self%Wdist(i,j-1,k)) - self%Wnorm(:,i,j-1,k)=[0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j-1,k),0.0_WP] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - do k=self%cfg%kmino_+1,self%cfg%kmaxo_ - do j=self%cfg%jmino_,self%cfg%jmaxo_ - do i=self%cfg%imino_,self%cfg%imaxo_ - if (self%Wdist(i,j,k)*self%Wdist(i,j,k-1).lt.0.0_WP) then - ! There is a wall at z(k) - if (abs(self%cfg%zm(k )-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k ))) then - self%Wdist(i,j,k )=sign(self%cfg%zm(k )-self%cfg%z(k),self%Wdist(i,j,k )) - self%Wnorm(:,i,j,k )=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] - end if - if (abs(self%cfg%zm(k-1)-self%cfg%z(k)).lt.abs(self%Wdist(i,j,k-1))) then - self%Wdist(i,j,k-1)=sign(self%cfg%zm(k-1)-self%cfg%z(k),self%Wdist(i,j,k-1)) - self%Wnorm(:,i,j,k-1)=[0.0_WP,0.0_WP,self%cfg%VF(i,j,k)-self%cfg%VF(i,j,k-1)] - end if - end if - end do - end do - end do - call self%cfg%sync(self%Wdist) - call self%cfg%sync(self%Wnorm) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (self%cfg%amRoot) then - write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]")') trim(self%name),trim(self%cfg%name) - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) - end if - end block logging - - end function constructor - - - !> Resolve collisional interaction between particles - !> Requires tau_col, e_n, e_w and mu_f to be set beforehand - subroutine collide(this,dt) - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - - ! Start by zeroing out the collision force - zero_force: block - integer :: i - do i=1,this%np_ - this%p(i)%Acol=0.0_WP - this%p(i)%Tcol=0.0_WP - end do - end block zero_force - - ! Return if not used - if (.not.this%use_col) return - - ! Then share particles across overlap - call this%share() - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - - ! Finally, calculate collision force - collision_force: block - use mpi_f08 - use mathtools, only: Pi,normalize,cross_product - integer :: i1,i2,ii,jj,kk,nn,ierr - real(WP) :: d1,m1,d2,m2,d12,m12 - real(WP), dimension(3) :: r1,v1,w1,r2,v2,w2,v12,n12,f_n,t12,f_t - real(WP) :: k_n,eta_n,k_coeff,eta_coeff,k_coeff_w,eta_coeff_w,rnv,r_influ,delta_n,rtv - real(WP), parameter :: aclipnorm=1.0e-6_WP - real(WP), parameter :: acliptan=1.0e-9_WP - real(WP), parameter :: rcliptan=0.05_WP - - ! Reset collision counter - this%ncol=0 - - ! Precompute coefficients for k and eta - k_coeff=(Pi**2+log(this%e_n)**2)/this%tau_col**2 - eta_coeff=-2.0_WP*log(this%e_n)/this%tau_col - k_coeff_w=(Pi**2+log(this%e_w)**2)/this%tau_col**2 - eta_coeff_w=-2.0_WP*log(this%e_w)/this%tau_col - - ! Loop over all local particles - collision: do i1=1,this%np_ - - ! Cycle if id<=0 - if (this%p(i1)%id.le.0) cycle collision - - ! Store particle data - r1=this%p(i1)%pos - v1=this%p(i1)%vel - w1=this%p(i1)%angVel - d1=this%p(i1)%d - m1=this%rho*Pi/6.0_WP*d1**3 - - ! First collide with walls - d12=this%cfg%get_scalar(pos=this%p(i1)%pos,i0=this%p(i1)%ind(1),j0=this%p(i1)%ind(2),k0=this%p(i1)%ind(3),S=this%Wdist,bc='d') - n12=this%Wnorm(:,this%p(i1)%ind(1),this%p(i1)%ind(2),this%p(i1)%ind(3)) - n12=-normalize(n12+[epsilon(1.0_WP),epsilon(1.0_WP),epsilon(1.0_WP)]) - rnv=dot_product(v1,n12) - r_influ=min(2.0_WP*abs(rnv)*dt,0.2_WP*d1) - delta_n=min(0.5_WP*d1+r_influ-d12,this%clip_col*0.5_WP*d1) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - k_n=m1*k_coeff_w - eta_n=m1*eta_coeff_w - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v1-rnv*n12+cross_product(0.5_WP*d1*w1,n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt/d1.gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt/d1.lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - end if - - ! Loop over nearest cells - do kk=this%p(i1)%ind(3)-1,this%p(i1)%ind(3)+1 - do jj=this%p(i1)%ind(2)-1,this%p(i1)%ind(2)+1 - do ii=this%p(i1)%ind(1)-1,this%p(i1)%ind(1)+1 - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - v2=this%p(i2)%vel - w2=this%p(i2)%angVel - d2=this%p(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - v2=this%g(i2)%vel - w2=this%g(i2)%angVel - d2=this%g(i2)%d - m2=this%rho*Pi/6.0_WP*d2**3 - end if - - ! Compute relative information - d12=norm2(r1-r2) - if (d12.lt.10.0_WP*epsilon(d12)) cycle !< this should skip auto-collision - n12=(r2-r1)/d12 - v12=v1-v2 - rnv=dot_product(v12,n12) - r_influ=min(abs(rnv)*dt,0.1_WP*(d1+d2)) - delta_n=min(0.5_WP*(d1+d2)+r_influ-d12,this%clip_col*0.5_WP*(d1+d2)) - - ! Assess if there is collision - if (delta_n.gt.0.0_WP) then - ! Normal collision - m12=m1*m2/(m1+m2) - k_n=m12*k_coeff - eta_n=m12*eta_coeff - f_n=-k_n*delta_n*n12-eta_n*rnv*n12 - ! Tangential collision - f_t=0.0_WP - if (this%mu_f.gt.0.0_WP) then - t12 = v12-rnv*n12+cross_product(0.5_WP*(d1*w1+d2*w2),n12) - rtv = sqrt(sum(t12*t12)) - if (rnv*dt*2.0_WP/(d1+d2).gt.aclipnorm) then - if (rtv/rnv.lt.rcliptan) rtv=0.0_WP - else - if (rtv*dt*2.0_WP/(d1+d2).lt.acliptan) rtv=0.0_WP - end if - if (rtv.gt.0.0_WP) f_t=-this%mu_f*sqrt(sum(f_n*f_n))*t12/rtv - end if - ! Calculate collision force - f_n=f_n/m1; f_t=f_t/m1 - this%p(i1)%Acol=this%p(i1)%Acol+f_n+f_t - ! Calculate collision torque - this%p(i1)%Tcol=this%p(i1)%Tcol+cross_product(0.5_WP*d1*n12,f_t) - ! Add up the collisions - this%ncol=this%ncol+1 - end if - - end do - - end do - end do - end do - - ! Deal with dimensionality - if (this%cfg%nx.eq.1) then - this%p(i1)%Acol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%ny.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Acol(2)=0.0_WP - this%p(i1)%Tcol(3)=0.0_WP - end if - if (this%cfg%nz.eq.1) then - this%p(i1)%Tcol(1)=0.0_WP - this%p(i1)%Tcol(2)=0.0_WP - this%p(i1)%Acol(3)=0.0_WP - end if - - end do collision - - ! Determine total number of collisions - call MPI_ALLREDUCE(this%ncol,nn,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%ncol=nn/2 - - end block collision_force - - end subroutine collide - - !> Assigns new random numbers (dim 3) to particles from N~(0,sqrt(dt)) - subroutine update_dW(this, dt) - use random, only: random_normal - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(in) :: dt - real(WP) :: rdt - integer :: i - rdt = sqrt(dt) - do i=1,this%np_ - this%p(i)%dW = [random_normal(m=0.0_WP,sd=rdt), & - random_normal(m=0.0_WP,sd=rdt), & - random_normal(m=0.0_WP,sd=rdt)] - end do - end subroutine update_dW - - !> Advance the particle equations by a specified time step dt - !> p%id=0 => no coll, no solve - !> p%id=-1=> no coll, no move - subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty,vortz,T,srcU,srcV,srcW,srcE,use_crw,sgs) - use mpi_f08, only : MPI_SUM,MPI_INTEGER - use mathtools, only: Pi - use sgsmodel_class, only: sgsmodel!, get_sgstke - use random, only: random_normal - implicit none - class(lpt), intent(inout) :: this - class(sgsmodel), intent(in), optional :: sgs - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortx !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vorty !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: vortz !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcE !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr,no - real(WP) :: mydt,dt_done,deng,Ip,rdt,tke,sig_sg,tau_crwi - real(WP) :: tmp1,tmp2,tmp3 - real(WP), dimension(3) :: acc,torque,dmom - integer :: iii,jjj,kkk - integer, dimension(:,:,:), allocatable :: npic !< Number of particle in cell - integer, dimension(:,:,:,:), allocatable :: ipic !< Index of particle in cell - real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz - type(part) :: myp,pold - logical :: spatial - logical, intent(in), optional :: use_crw - - rdt = sqrt(dt) - spatial = .true. - - ! Zero out source term arrays - if (present(srcU)) srcU=0.0_WP - if (present(srcV)) srcV=0.0_WP - if (present(srcW)) srcW=0.0_WP - if (present(srcE)) srcE=0.0_WP - - ! Get fluid stress - if (present(stress_x)) then - sx=stress_x - else - sx=0.0_WP - end if - if (present(stress_y)) then - sy=stress_y - else - sy=0.0_WP - end if - if (present(stress_z)) then - sz=stress_z - else - sz=0.0_WP - end if - - ! Zero out number of particles removed - this%np_out=0 - - if (spatial) then - no = 2 - - ! Share particles across overlap - call this%share(no) - - ! We can now assemble particle-in-cell information - pic_prep: block - use mpi_f08 - integer :: i,ip,jp,kp,ierr - integer :: mymax_npic,max_npic - - ! Allocate number of particle in cell - allocate(npic(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); npic=0 - - ! Count particles and ghosts per cell - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - end do - - ! Get maximum number of particle in cell - mymax_npic=maxval(npic); call MPI_ALLREDUCE(mymax_npic,max_npic,1,MPI_INTEGER,MPI_MAX,this%cfg%comm,ierr) - - ! Allocate pic map - allocate(ipic(1:max_npic,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); ipic=0 - - ! Assemble pic map - npic=0 - do i=1,this%np_ - ip=this%p(i)%ind(1); jp=this%p(i)%ind(2); kp=this%p(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=i - end do - do i=1,this%ng_ - ip=this%g(i)%ind(1); jp=this%g(i)%ind(2); kp=this%g(i)%ind(3) - npic(ip,jp,kp)=npic(ip,jp,kp)+1 - ipic(npic(ip,jp,kp),ip,jp,kp)=-i - end do - - end block pic_prep - end if - if (use_crw) call this%update_dW(dt=dt) - ! Advance the equations - do i=1,this%np_ - ! Avoid particles with id=0 - if (this%p(i)%id.eq.0) cycle - ! Create local copy of particle - myp=this%p(i) - ! Time-integrate until dt_done=dt - dt_done=0.0_WP - do while (dt_done.lt.dt) - ! Decide the timestep size - mydt=min(myp%dt,dt-dt_done) - ! Remember the particle - pold=myp - ! Particle moment of inertia per unit mass - Ip = 0.1_WP*myp%d**2 - ! Advance with Euler prediction - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt,use_crw=use_crw) - !if (this%use_lift.and.present(vortx).and.present(vorty).and.present(vortz)) call this%get_lift(vortx,vorty,vortz,acc=acc) - myp%pos=pold%pos+0.5_WP*mydt*myp%vel - myp%vel=pold%vel+0.5_WP*mydt*(acc+this%gravity+myp%Acol) - myp%angVel=pold%angVel+0.5_WP*mydt*(torque+myp%Tcol)/Ip - if (use_crw) then - iii = this%p(i)%ind(1) - jjj = this%p(i)%ind(2) - kkk = this%p(i)%ind(3) - tke = 0.1_WP !get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) - - sig_sg = sqrt(0.6666_WP*tke) - tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz - - this%p(i)%a_crw = tau_crwi - this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) - - if (spatial) then - correlate_neighbors: block - use mathtools, only: Pi,normalize - integer :: i2,ii,jj,kk,nn - real(WP), dimension(3) :: r1,r2 - real(WP) :: k_n,eta_n,lne,pilne2,rnv,r_influ,delta_n,corr,d12 - - ! Store particle data - r1=this%p(i)%pos - - ! Zero out neighbor contribution - this%p(i)%b_ij = 0.0_WP - this%p(i)%corrsum = 0.0_WP - - ! Loop over nearest cells - do kk=this%p(i)%ind(3)-no,this%p(i)%ind(3)+no - do jj=this%p(i)%ind(2)-no,this%p(i)%ind(2)+no - do ii=this%p(i)%ind(1)-no,this%p(i)%ind(1)+no - - ! Loop over particles in that cell - do nn=1,npic(ii,jj,kk) - ! Get index of neighbor particle - i2=ipic(nn,ii,jj,kk) - - ! Get relevant data from correct storage - if (i2.gt.0) then - r2=this%p(i2)%pos - else if (i2.lt.0) then - i2=-i2 - r2=this%g(i2)%pos - end if - - ! Compute relative information - d12=norm2(r1-r2) - corr = corr_func(d12) - - this%p(i)%corrsum = this%p(i)%corrsum + corr - this%p(i)%b_ij = this%p(i)%b_ij + corr*this%p(i2)%dW - end do - end do - end do - end do - end block correlate_neighbors - - ! Increment OU process - 1st order - tmp1 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(1) + this%p(i)%b_crw*this%p(i)%b_ij(1)/this%p(i)%corrsum! - & - !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(1)**2 - mydt) - tmp2 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(2) + this%p(i)%b_crw*this%p(i)%b_ij(2)/this%p(i)%corrsum! - & - !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(2)**2 - mydt) - tmp3 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(3) + this%p(i)%b_crw*this%p(i)%b_ij(3)/this%p(i)%corrsum! - & - !this%p(i)%b_crw*0.5_WP*(mydt + epsilon(1.0_WP))**(-0.5_WP)*(this%p(i)%dW(3)**2 - mydt) - else - this%p(i)%dW = [random_normal(m=0.0_WP,sd=rdt), & - random_normal(m=0.0_WP,sd=rdt), & - random_normal(m=0.0_WP,sd=rdt)] - tmp1 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(1) + this%p(i)%b_crw*this%p(i)%dW(1) - tmp2 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(2) + this%p(i)%b_crw*this%p(i)%dW(2) - tmp3 = (1.0_WP - this%p(i)%a_crw*mydt)*this%p(i)%uf(3) + this%p(i)%b_crw*this%p(i)%dW(3) - end if - end if - ! Correct with midpoint rule - call this%get_rhs(U=U,V=V,W=W,rho=rho,visc=visc,stress_x=sx,stress_y=sy,stress_z=sz,p=myp,acc=acc,torque=torque,opt_dt=myp%dt,use_crw=use_crw) - myp%pos=pold%pos+mydt*myp%vel - myp%vel=pold%vel+mydt*(acc+this%gravity+myp%Acol) - myp%angVel=pold%angVel+mydt*(torque+myp%Tcol)/Ip - if (use_crw) then - tke = 0.01_WP! get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) - sig_sg = sqrt(0.6666_WP*tke) - tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz - this%p(i)%a_crw = tau_crwi - this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) - - this%p(i)%uf(1) = tmp1! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW1**2 - mydt) - this%p(i)%uf(2) = tmp2! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW2**2 - mydt) - this%p(i)%uf(3) = tmp3! + this%p(i)%b_crw*0.5_WP*(mydt+epsilon(1.0_WP))**(-0.5_WP)*(dW3**2 - mydt) - end if - ! Relocalize - myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) - ! Send source term back to the mesh - dmom=mydt*acc*this%rho*Pi/6.0_WP*myp%d**3 - deng=sum(dmom*myp%vel) - if (this%cfg%nx.gt.1.and.present(srcU)) call this%cfg%set_scalar(Sp=-dmom(1),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcU,bc='n') - if (this%cfg%ny.gt.1.and.present(srcV)) call this%cfg%set_scalar(Sp=-dmom(2),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcV,bc='n') - if (this%cfg%nz.gt.1.and.present(srcW)) call this%cfg%set_scalar(Sp=-dmom(3),pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcW,bc='n') - if (present(srcE)) call this%cfg%set_scalar(Sp=-deng ,pos=myp%pos,i0=myp%ind(1),j0=myp%ind(2),k0=myp%ind(3),S=srcE,bc='n') - ! Increment - dt_done=dt_done+mydt - end do - ! Correct the position to take into account periodicity - if (this%cfg%xper) myp%pos(1)=this%cfg%x(this%cfg%imin)+modulo(myp%pos(1)-this%cfg%x(this%cfg%imin),this%cfg%xL) - if (this%cfg%yper) myp%pos(2)=this%cfg%y(this%cfg%jmin)+modulo(myp%pos(2)-this%cfg%y(this%cfg%jmin),this%cfg%yL) - if (this%cfg%zper) myp%pos(3)=this%cfg%z(this%cfg%kmin)+modulo(myp%pos(3)-this%cfg%z(this%cfg%kmin),this%cfg%zL) - ! Handle particles that have left the domain - if (myp%pos(1).lt.this%cfg%x(this%cfg%imin).or.myp%pos(1).gt.this%cfg%x(this%cfg%imax+1)) myp%flag=1 - if (myp%pos(2).lt.this%cfg%y(this%cfg%jmin).or.myp%pos(2).gt.this%cfg%y(this%cfg%jmax+1)) myp%flag=1 - if (myp%pos(3).lt.this%cfg%z(this%cfg%kmin).or.myp%pos(3).gt.this%cfg%z(this%cfg%kmax+1)) myp%flag=1 - ! Relocalize the particle - myp%ind=this%cfg%get_ijk_global(myp%pos,myp%ind) - ! Count number of particles removed - if (myp%flag.eq.1) this%np_out=this%np_out+1 - ! Copy back to particle - if (myp%id.ne.-1) this%p(i)=myp - if (use_crw) then - tke = 0.01_WP !get_sgstke(visc=sgs%visc(iii,jjj,kkk), delta=sgs%delta(iii,jjj,kkk), rho=rho(iii,jjj,kkk)) - sig_sg = sqrt(0.6666_WP*tke) - tau_crwi = sig_sg/sgs%delta(iii,jjj,kkk)/C_poz - this%p(i)%a_crw = tau_crwi - this%p(i)%b_crw = sig_sg*sqrt(2.0_WP*tau_crwi) - end if - end do - - ! Communicate particles - call this%sync() - - ! Sum up particles removed - call MPI_ALLREDUCE(this%np_out,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_out=i - - ! Divide source arrays by volume, sum at boundaries, and volume filter if present - if (present(srcU)) then - srcU=srcU/this%cfg%vol; call this%cfg%syncsum(srcU); call this%filter(srcU) - end if - if (present(srcV)) then - srcV=srcV/this%cfg%vol; call this%cfg%syncsum(srcV); call this%filter(srcV) - end if - if (present(srcW)) then - srcW=srcW/this%cfg%vol; call this%cfg%syncsum(srcW); call this%filter(srcW) - end if - if (present(srcE)) then - srcE=srcE/this%cfg%vol; call this%cfg%syncsum(srcE); call this%filter(srcE) - end if - - ! Recompute volume fraction - call this%update_VF() - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Particle solver [",a,"] on partitioned grid [",a,"]: ",i0," particles were advanced")') trim(this%name),trim(this%cfg%name),this%np - if (verbose.gt.1) write(output_unit,'(a)') trim(message) - if (verbose.gt.0) call log(message) - end if - end block logging - - contains - - function corr_func(r) result(rhoij) - real(WP) :: r, rhoij - - select case(trim(this%corr_type)) - case('exp') - rhoij = 1.0_WP - ! case('inferred') - ! rhoij = inferredcorr(r) - case('linear') - rhoij = 1.0_WP - 2.5_WP*r - case default - rhoij = 1.0_WP - end select - - end function corr_func - - end subroutine advance - - - !> Calculate RHS of the particle ODEs - subroutine get_rhs(this,U,V,W,rho,visc,stress_x,stress_y,stress_z,T,p,acc,torque,opt_dt,use_crw) - implicit none - class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: U !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: V !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: W !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_x !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_y !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: stress_z !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: T !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - type(part), intent(in) :: p - logical, intent(in) :: use_crw - real(WP), dimension(3), intent(out) :: acc,torque - real(WP), intent(out) :: opt_dt - real(WP) :: fvisc,frho,pVF,fVF,fT - real(WP), dimension(3) :: fvel,fstress,fvort - - ! Interpolate fluid quantities to particle location - interpolate: block - ! Interpolate the fluid phase velocity to the particle location - fvel=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) - if (use_crw) then - fvel=fvel+p%uf - end if - ! Interpolate the fluid phase stress to the particle location - fstress=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=stress_x,V=stress_y,W=stress_z) - ! Interpolate the fluid phase viscosity to the particle location - fvisc=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=visc,bc='n') - fvisc=fvisc+epsilon(1.0_WP) - ! Interpolate the fluid phase density to the particle location - frho=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=rho,bc='n') - ! Interpolate the particle volume fraction to the particle location - pVF=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=this%VF,bc='n') - fVF=1.0_WP-pVF - ! Interpolate the fluid temperature to the particle location if present - if (present(T)) fT=this%cfg%get_scalar(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),S=T,bc='n') - ! Interpolate the fluid vorticity to the particle location if needed - !if (this%use_lift) fvort=this%cfg%get_velocity(pos=p%pos,i0=p%ind(1),j0=p%ind(2),k0=p%ind(3),U=U,V=V,W=W) - end block interpolate - - ! Compute acceleration due to drag - compute_drag: block - real(WP) :: Re,tau,corr,b1,b2 - ! Particle Reynolds number - Re=frho*norm2(p%vel-fvel)*p%d/fvisc+epsilon(1.0_WP) - ! Drag correction - select case(trim(this%drag_model)) - case('None','none') - corr=epsilon(1.0_WP) - case('Stokes') - corr=1.0_WP - case('Schiller-Naumann','Schiller Naumann','SN') - corr=1.0_WP+0.15_WP*Re**(0.687_WP) - case('Tenneti') - ! Tenneti and Subramaniam (2011) - b1=5.81_WP*pVF/fVF**3+0.48_WP*pVF**(1.0_WP/3.0_WP)/fVF**4 - b2=pVF**3*Re*(0.95_WP+0.61_WP*pVF**3/fVF**2) - corr=fVF*(1.0_WP+0.15_WP*Re**(0.687_WP)/fVF**3+b1+b2) - case('Khalloufi Capecelatro','KC') - !> Todo - case default - corr=1.0_WP - end select - ! Particle response time - tau=this%rho*p%d**2/(18.0_WP*fvisc*corr) - ! Return acceleration and optimal timestep size - acc=(fvel-p%vel)/tau+fstress/this%rho - opt_dt=tau/real(this%nstep,WP) - end block compute_drag - - ! Compute acceleration due to Saffman lift - compute_lift: block - use mathtools, only: Pi,cross_product - real(WP) :: omegag,Cl,Reg - if (this%use_lift) then - omegag=sqrt(sum(fvort**2)) - if (omegag.gt.0.0_WP) then - Reg = p%d**2*omegag*frho/fvisc - Cl = 9.69_WP/Pi/p%d**2/this%rho*fvisc/omegag*sqrt(Reg) - acc=acc+Cl*cross_product(fvel-p%vel,fvort) - end if - end if - end block compute_lift - - ! Compute fluid torque (assumed Stokes drag) - compute_torque: block - torque=0.0_WP!6.0_WP*fvisc*(0.5_WP*fvort-p%angVel)/this%rho - end block compute_torque - - ! Compute heat transfer - compute_heat_transfer: block - !> Todo - end block compute_heat_transfer - - end subroutine get_rhs - - - !> Update particle volume fraction using our current particles - subroutine update_VF(this) - use mathtools, only: Pi - implicit none - class(lpt), intent(inout) :: this - integer :: i - real(WP) :: Vp - ! Reset volume fraction - this%VF=0.0_WP - ! Transfer particle volume - do i=1,this%np_ - ! Skip inactive particle - if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle - ! Transfer particle volume - Vp=Pi/6.0_WP*this%p(i)%d**3 - call this%cfg%set_scalar(Sp=Vp,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') - end do - this%VF=this%VF/this%cfg%vol - ! Sum at boundaries - call this%cfg%syncsum(this%VF) - ! Apply volume filter - call this%filter(this%VF) - end subroutine update_VF - - - !> Laplacian filtering operation - subroutine filter(this,A) - implicit none - class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP) :: filter_coeff - integer :: i,j,k,n,nstep - real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ - - ! Return without filtering if filter width is zero - if (this%filter_width.le.0.0_WP) return - - ! Recompute filter coeff and number of explicit steps needed - filter_coeff=0.5_WP*(this%filter_width/(2.0_WP*sqrt(2.0_WP*log(2.0_WP))))**2 - - if (this%implicit_filter) then !< Apply filter implicitly via approximate factorization - ! Inverse in X-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Ax(j,k,i,-1) = - this%div_x(0,i,j,k) * filter_coeff * this%grd_x(-1,i,j,k) - this%tridiag%Ax(j,k,i, 0) = 1.0_WP - (this%div_x(0,i,j,k) * filter_coeff * this%grd_x(0,i,j,k) & - + this%div_x(1,i,j,k) * filter_coeff * this%grd_x(-1,i+1,j,k)) - this%tridiag%Ax(j,k,i,+1) = - this%div_x(1,i,j,k) * filter_coeff * this%grd_x(0,i+1,j,k) - this%tridiag%Rx(j,k,i) = A(i,j,k) - end do - end do - end do - call this%tridiag%linsol_x() - ! Inverse in Y-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Ay(i,k,j,-1) = - this%div_y(0,i,j,k) * filter_coeff * this%grd_y(-1,i,j,k) - this%tridiag%Ay(i,k,j, 0) = 1.0_WP - (this%div_y(0,i,j,k)* filter_coeff * this%grd_y(0,i,j,k) & - + this%div_y(1,i,j,k) * filter_coeff * this%grd_y(-1,i,j+1,k)) - this%tridiag%Ay(i,k,j,+1) = - this%div_y(1,i,j,k) * filter_coeff * this%grd_y(0,i,j+1,k) - this%tridiag%Ry(i,k,j) = this%tridiag%Rx(j,k,i) - end do - end do - end do - call this%tridiag%linsol_y() - ! Inverse in Z-direction - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%tridiag%Az(i,j,k,-1) = - this%div_z(0,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k) - this%tridiag%Az(i,j,k, 0) = 1.0_WP - (this%div_z(0,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) & - + this%div_z(1,i,j,k) * filter_coeff * this%grd_z(-1,i,j,k)) - this%tridiag%Az(i,j,k,+1) = - this%div_z(1,i,j,k) * filter_coeff * this%grd_z(0,i,j,k) - this%tridiag%Rz(i,j,k) = this%tridiag%Ry(i,k,j) - end do - end do - end do - call this%tridiag%linsol_z() - ! Update A - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=this%tridiag%Rz(i,j,k) - end do - end do - end do - else !< Apply filter explicitly - ! Allocate flux arrays - allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - nstep=ceiling(6.0_WP*filter_coeff/this%cfg%min_meshsize**2) - filter_coeff=filter_coeff/real(nstep,WP) - do n=1,nstep - ! Diffusive flux of A - do k=this%cfg%kmin_,this%cfg%kmax_+1 - do j=this%cfg%jmin_,this%cfg%jmax_+1 - do i=this%cfg%imin_,this%cfg%imax_+1 - FX(i,j,k)=filter_coeff*sum(this%grd_x(:,i,j,k)*A(i-1:i,j,k)) - FY(i,j,k)=filter_coeff*sum(this%grd_y(:,i,j,k)*A(i,j-1:j,k)) - FZ(i,j,k)=filter_coeff*sum(this%grd_z(:,i,j,k)*A(i,j,k-1:k)) - end do - end do - end do - ! Divergence of fluxes - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - A(i,j,k)=A(i,j,k)+sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1)) - end do - end do - end do - end do - ! Deallocate flux arrays - deallocate(FX,FY,FZ) - end if - - ! Sync A - call this%cfg%sync(A) - - end subroutine filter - - - !> Inject particles from a prescribed location with given mass flowrate - !> Requires injection parameters to be set beforehand - subroutine inject(this,dt) - use mpi_f08 - use parallel, only: MPI_REAL_WP - use mathtools, only: Pi - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(inout) :: dt !< Timestep size over which to advance - real(WP) :: inj_min(3),inj_max(3) !< Min/max extents of injection - real(WP) :: Mgoal,Madded,Mtmp,buf !< Mass flow rate parameters - real(WP), save :: previous_error=0.0_WP !< Store mass left over from previous timestep - integer(kind=8) :: maxid_,maxid !< Keep track of maximum particle id - integer :: i,j,np0_,np2,np_tmp,count,ierr - integer, dimension(:), allocatable :: nrecv - type(part), dimension(:), allocatable :: p2 - type(MPI_Status) :: status - logical :: overlap - - ! Initial number of particles - np0_=this%np_ - this%np_new=0 - - ! Get the particle mass that should be added to the system - Mgoal = this%mfr*dt+previous_error - Madded = 0.0_WP - - ! Determine id to assign to particle - maxid_=0 - do i=1,this%np_ - maxid_=max(maxid_,this%p(i)%id) - end do - call MPI_ALLREDUCE(maxid_,maxid,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr) - - ! Communicate nearby particles to check for overlap - if (this%use_col) then - allocate(nrecv(this%cfg%nproc)) - count=0 - inj_min(1)=this%cfg%x(this%cfg%imino) - inj_max(1)=this%inj_pos(1)+this%inj_dmax - inj_min(2)=this%inj_pos(2)-0.5_WP*this%inj_d-this%inj_dmax - inj_max(2)=this%inj_pos(2)+0.5_WP*this%inj_d+this%inj_dmax - inj_min(3)=this%inj_pos(3)-0.5_WP*this%inj_d-this%inj_dmax - inj_max(3)=this%inj_pos(3)+0.5_WP*this%inj_d+this%inj_dmax - do i=1,this%np_ - if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& - this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& - this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) count=count+1 - end do - call MPI_GATHER(count,1,MPI_INTEGER,nrecv,1,MPI_INTEGER,0,this%cfg%comm,ierr) - if (this%cfg%amRoot) then - np2=sum(nrecv) - allocate(p2(np2)) - else - allocate(p2(count)) - end if - count=0 - do i=1,this%np_ - if ( this%p(i)%pos(1).gt.inj_min(1).and.this%p(i)%pos(1).lt.inj_max(1) .and.& - this%p(i)%pos(2).gt.inj_min(2).and.this%p(i)%pos(2).lt.inj_max(2) .and.& - this%p(i)%pos(3).gt.inj_min(3).and.this%p(i)%pos(3).lt.inj_max(3)) then - count=count+1 - p2(count)=this%p(i) - end if - end do - if (this%cfg%amRoot) then - do i=2,this%cfg%nproc - if (nrecv(i).gt.0) then - call MPI_recv(p2(sum(nrecv(1:i-1))+1:sum(nrecv(1:i))),nrecv(i),MPI_PART,i-1,0,this%cfg%comm,status,ierr) - end if - end do - else - if (count.gt.0) call MPI_send(p2,count,MPI_PART,0,0,this%cfg%comm,ierr) - end if - deallocate(nrecv) - end if - - ! Add new particles until desired mass is achieved - do while (Madded.lt.Mgoal) - - if (this%cfg%amRoot) then - ! Initialize parameters - Mtmp = 0.0_WP - np_tmp = 0 - ! Loop while the added volume is not sufficient - do while (Mtmp.lt.Mgoal-Madded) - ! Increment counter - np_tmp=np_tmp+1 - count = np0_+np_tmp - ! Create space for new particle - call this%resize(count) - ! Generate a diameter - this%p(count)%d=get_diameter() - ! Set various parameters for the particle - this%p(count)%id =maxid+int(np_tmp,8) - this%p(count)%dt =0.0_WP - this%p(count)%Acol =0.0_WP - this%p(count)%Tcol =0.0_WP - this%p(count)%T =this%inj_T - this%p(count)%angVel=0.0_WP - ! Give a position at the injector to the particle - this%p(count)%pos=get_position() - overlap=.false. - ! Check overlap with particles recently injected - if (this%use_col) then - do j=1,np_tmp-1 - if (norm2(this%p(count)%pos-this%p(j)%pos).lt.0.5_WP*(this%p(count)%d+this%p(j)%d)) overlap=.true. - end do - ! Check overlap with all other particles - if (.not.overlap) then - do j=1,np2 - if (norm2(this%p(count)%pos-p2(j)%pos).lt.0.5_WP*(this%p(count)%d+p2(j)%d)) overlap=.true. - end do - end if - end if - - if (overlap) then - ! Try again - np_tmp=np_tmp-1 - else - ! Localize the particle - this%p(count)%ind(1)=this%cfg%imin; this%p(count)%ind(2)=this%cfg%jmin; this%p(count)%ind(3)=this%cfg%kmin - this%p(count)%ind=this%cfg%get_ijk_global(this%p(count)%pos,this%p(count)%ind) - ! Give it a velocity - this%p(count)%vel=this%inj_vel - ! Make it an "official" particle - this%p(count)%flag=0 - ! Update the added mass for the timestep - Mtmp = Mtmp + this%rho*Pi/6.0_WP*this%p(count)%d**3 - end if - end do - end if - ! Communicate particles - call this%sync() - ! Loop through newly created particles - buf=0.0_WP - do i=np0_+1,this%np_ - ! Remove if out of bounds - if (this%cfg%VF(this%p(i)%ind(1),this%p(i)%ind(2),this%p(i)%ind(3)).le.0.0_WP) this%p(i)%flag=1 - if (this%p(i)%flag.eq.0) then - ! Update the added mass for the timestep - buf = buf + this%rho*Pi/6.0_WP*this%p(i)%d**3 - ! Update the max particle id - maxid = max(maxid,this%p(i)%id) - ! Increment counter - this%np_new=this%np_new+1 - end if - end do - ! Total mass added - call MPI_ALLREDUCE(buf,Mtmp,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); Madded=Madded+Mtmp - ! Clean up particles - call this%recycle() - ! Update initial npart - np0_=this%np_ - ! Maximum particle id - call MPI_ALLREDUCE(maxid,maxid_,1,MPI_INTEGER8,MPI_MAX,this%cfg%comm,ierr); maxid=maxid_ - end do - - ! Remember the error - previous_error = Mgoal-Madded - - ! Sum up injected particles - call MPI_ALLREDUCE(this%np_new,i,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr); this%np_new=i - - if (allocated(p2)) deallocate(p2) - - contains - - ! Compute particle diameter - function get_diameter() result(dp) - use random, only: random_lognormal - implicit none - real(WP) :: dp - dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift - do while (dp.gt.this%inj_dmax+epsilon(1.0_WP).or.dp.lt.this%inj_dmin-epsilon(1.0_WP)) - dp=random_lognormal(m=this%inj_dmean-this%inj_dshift,sd=this%inj_dsd)+this%inj_dshift - end do - end function get_diameter - - ! Position for bulk injection of particles - function get_position() result(pos) - use random, only: random_uniform - use mathtools, only: twoPi - implicit none - real(WP), dimension(3) :: pos - real(WP) :: rand,r,theta - integer :: ip,jp,kp - ! Set x position - pos(1) = this%inj_pos(1) - ! Random y & z position within a circular region - if (this%cfg%nz.eq.1) then - pos(2)=random_uniform(lo=this%inj_pos(2)-0.5_WP*this%inj_d,hi=this%inj_pos(3)+0.5_WP*this%inj_d) - pos(3) = this%cfg%zm(this%cfg%kmin_) - else - rand=random_uniform(lo=0.0_WP,hi=1.0_WP) - r=0.5_WP*this%inj_d*sqrt(rand) !< sqrt(rand) avoids accumulation near the center - call random_number(rand) - theta=random_uniform(lo=0.0_WP,hi=twoPi) - pos(2) = this%inj_pos(2)+r*sin(theta) - pos(3) = this%inj_pos(3)+r*cos(theta) - end if - end function get_position - - end subroutine inject - - - !> Calculate the CFL - subroutine get_cfl(this,dt,cfl) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX - use parallel, only: MPI_REAL_WP - implicit none - class(lpt), intent(inout) :: this - real(WP), intent(in) :: dt - real(WP), intent(out) :: cfl - integer :: i,ierr - real(WP) :: my_CFLp_x,my_CFLp_y,my_CFLp_z,my_CFL_col - - ! Set the CFLs to zero - my_CFLp_x=0.0_WP; my_CFLp_y=0.0_WP; my_CFLp_z=0.0_WP; my_CFL_col=0.0_WP - do i=1,this%np_ - my_CFLp_x=max(my_CFLp_x,abs(this%p(i)%vel(1))*this%cfg%dxi(this%p(i)%ind(1))) - my_CFLp_y=max(my_CFLp_y,abs(this%p(i)%vel(2))*this%cfg%dyi(this%p(i)%ind(2))) - my_CFLp_z=max(my_CFLp_z,abs(this%p(i)%vel(3))*this%cfg%dzi(this%p(i)%ind(3))) - my_CFL_col=max(my_CFL_col,sqrt(sum(this%p(i)%vel**2))/this%p(i)%d) - end do - my_CFLp_x=my_CFLp_x*dt; my_CFLp_y=my_CFLp_y*dt; my_CFLp_z=my_CFLp_z*dt - - ! Get the parallel max - call MPI_ALLREDUCE(my_CFLp_x,this%CFLp_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_y,this%CFLp_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - call MPI_ALLREDUCE(my_CFLp_z,this%CFLp_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - - ! Return the maximum convective CFL - cfl=max(this%CFLp_x,this%CFLp_y,this%CFLp_z) - if (this%use_col) then - my_CFL_col=10.0_WP*my_CFL_col*dt - call MPI_ALLREDUCE(my_CFL_col,this%CFL_col,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - cfl = max(cfl,this%CFL_col) - else - this%CFL_col=0.0_WP - end if - - end subroutine get_cfl - - - !> Extract various monitoring data from particle field - subroutine get_max(this) - use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(lpt), intent(inout) :: this - real(WP) :: buf,safe_np - integer :: i,j,k,ierr - - ! Create safe np - safe_np=real(max(this%np,1),WP) - - ! Diameter and velocity min/max/mean - this%dmin=huge(1.0_WP); this%dmax=-huge(1.0_WP); this%dmean=0.0_WP - this%Umin=huge(1.0_WP); this%Umax=-huge(1.0_WP); this%Umean=0.0_WP - this%Vmin=huge(1.0_WP); this%Vmax=-huge(1.0_WP); this%Vmean=0.0_WP - this%Wmin=huge(1.0_WP); this%Wmax=-huge(1.0_WP); this%Wmean=0.0_WP - do i=1,this%np_ - this%dmin=min(this%dmin,this%p(i)%d ); this%dmax=max(this%dmax,this%p(i)%d ); this%dmean=this%dmean+this%p(i)%d - this%Umin=min(this%Umin,this%p(i)%vel(1)); this%Umax=max(this%Umax,this%p(i)%vel(1)); this%Umean=this%Umean+this%p(i)%vel(1) - this%Vmin=min(this%Vmin,this%p(i)%vel(2)); this%Vmax=max(this%Vmax,this%p(i)%vel(2)); this%Vmean=this%Vmean+this%p(i)%vel(2) - this%Wmin=min(this%Wmin,this%p(i)%vel(3)); this%Wmax=max(this%Wmax,this%p(i)%vel(3)); this%Wmean=this%Wmean+this%p(i)%vel(3) - end do - call MPI_ALLREDUCE(this%dmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%dmin =buf - call MPI_ALLREDUCE(this%dmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%dmax =buf - call MPI_ALLREDUCE(this%dmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dmean=buf/safe_np - call MPI_ALLREDUCE(this%Umin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Umin =buf - call MPI_ALLREDUCE(this%Umax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Umax =buf - call MPI_ALLREDUCE(this%Umean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Umean=buf/safe_np - call MPI_ALLREDUCE(this%Vmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Vmin =buf - call MPI_ALLREDUCE(this%Vmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Vmax =buf - call MPI_ALLREDUCE(this%Vmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vmean=buf/safe_np - call MPI_ALLREDUCE(this%Wmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%Wmin =buf - call MPI_ALLREDUCE(this%Wmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%Wmax =buf - call MPI_ALLREDUCE(this%Wmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wmean=buf/safe_np - - ! Diameter and velocity variance - this%dvar=0.0_WP - this%Uvar=0.0_WP - this%Vvar=0.0_WP - this%Wvar=0.0_WP - do i=1,this%np_ - this%dvar=this%dvar+(this%p(i)%d -this%dmean)**2.0_WP - this%Uvar=this%Uvar+(this%p(i)%vel(1)-this%Umean)**2.0_WP - this%Vvar=this%Vvar+(this%p(i)%vel(2)-this%Vmean)**2.0_WP - this%Wvar=this%Wvar+(this%p(i)%vel(3)-this%Wmean)**2.0_WP - end do - call MPI_ALLREDUCE(this%dvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%dvar=buf/safe_np - call MPI_ALLREDUCE(this%Uvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Uvar=buf/safe_np - call MPI_ALLREDUCE(this%Vvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Vvar=buf/safe_np - call MPI_ALLREDUCE(this%Wvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%Wvar=buf/safe_np - - ! Get mean, max, and min volume fraction - this%VFmean=0.0_WP - this%VFmax =-huge(1.0_WP) - this%VFmin =+huge(1.0_WP) - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFmean=this%VFmean+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*this%VF(i,j,k) - this%VFmax =max(this%VFmax,this%VF(i,j,k)) - this%VFmin =min(this%VFmin,this%VF(i,j,k)) - end do - end do - end do - call MPI_ALLREDUCE(this%VFmean,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFmean=buf/this%cfg%fluid_vol - call MPI_ALLREDUCE(this%VFmax ,buf,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr); this%VFmax =buf - call MPI_ALLREDUCE(this%VFmin ,buf,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr); this%VFmin =buf - - ! Get volume fraction variance - this%VFvar=0.0_WP - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - this%VFvar=this%VFvar+this%cfg%VF(i,j,k)*this%cfg%vol(i,j,k)*(this%VF(i,j,k)-this%VFmean)**2.0_WP - end do - end do - end do - call MPI_ALLREDUCE(this%VFvar,buf,1,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr); this%VFvar=buf/this%cfg%fluid_vol - - end subroutine get_max - - - !> Update particle mesh using our current particles - subroutine update_partmesh(this,pmesh) - use partmesh_class, only: partmesh - implicit none - class(lpt), intent(inout) :: this - class(partmesh), intent(inout) :: pmesh - integer :: i - ! Reset particle mesh storage - call pmesh%reset() - ! Nothing else to do if no particle is present - if (this%np_.eq.0) return - ! Copy particle info - call pmesh%set_size(this%np_) - do i=1,this%np_ - pmesh%pos(:,i)=this%p(i)%pos - end do - end subroutine update_partmesh - - - !> Creation of the MPI datatype for particle - subroutine prepare_mpi_part() - use mpi_f08 - use messager, only: die - implicit none - integer(MPI_ADDRESS_KIND), dimension(part_nblock) :: disp - integer(MPI_ADDRESS_KIND) :: lb,extent - type(MPI_Datatype) :: MPI_PART_TMP - integer :: i,mysize,ierr - ! Prepare the displacement array - disp(1)=0 - do i=2,part_nblock - call MPI_Type_size(part_tblock(i-1),mysize,ierr) - disp(i)=disp(i-1)+int(mysize,MPI_ADDRESS_KIND)*int(part_lblock(i-1),MPI_ADDRESS_KIND) - end do - ! Create and commit the new type - call MPI_Type_create_struct(part_nblock,part_lblock,disp,part_tblock,MPI_PART_TMP,ierr) - call MPI_Type_get_extent(MPI_PART_TMP,lb,extent,ierr) - call MPI_Type_create_resized(MPI_PART_TMP,lb,extent,MPI_PART,ierr) - call MPI_Type_commit(MPI_PART,ierr) - ! If a problem was encountered, say it - if (ierr.ne.0) call die('[lpt prepare_mpi_part] MPI Particle type creation failed') - ! Get the size of this type - call MPI_type_size(MPI_PART,MPI_PART_SIZE,ierr) - end subroutine prepare_mpi_part - - - !> Synchronize particle arrays across processors - subroutine sync(this) - use mpi_f08 - implicit none - class(lpt), intent(inout) :: this - integer, dimension(0:this%cfg%nproc-1) :: nsend_proc,nrecv_proc - integer, dimension(0:this%cfg%nproc-1) :: nsend_disp,nrecv_disp - integer :: n,prank,ierr - type(part), dimension(:), allocatable :: buf_send - ! Recycle first to minimize communication load - call this%recycle() - ! Prepare information about what to send - nsend_proc=0 - do n=1,this%np_ - prank=this%cfg%get_rank(this%p(n)%ind) - nsend_proc(prank)=nsend_proc(prank)+1 - end do - nsend_proc(this%cfg%rank)=0 - ! Inform processors of what they will receive - call MPI_ALLtoALL(nsend_proc,1,MPI_INTEGER,nrecv_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - ! Prepare displacements for all-to-all - nsend_disp(0)=0 - nrecv_disp(0)=this%np_ !< Directly add particles at the end of main array - do n=1,this%cfg%nproc-1 - nsend_disp(n)=nsend_disp(n-1)+nsend_proc(n-1) - nrecv_disp(n)=nrecv_disp(n-1)+nrecv_proc(n-1) - end do - ! Allocate buffer to send particles - allocate(buf_send(sum(nsend_proc))) - ! Pack the particles in the send buffer - nsend_proc=0 - do n=1,this%np_ - ! Get the rank - prank=this%cfg%get_rank(this%p(n)%ind) - ! Skip particles still inside - if (prank.eq.this%cfg%rank) cycle - ! Pack up for sending - nsend_proc(prank)=nsend_proc(prank)+1 - buf_send(nsend_disp(prank)+nsend_proc(prank))=this%p(n) - ! Flag particle for removal - this%p(n)%flag=1 - end do - ! Allocate buffer for receiving particles - call this%resize(this%np_+sum(nrecv_proc)) - ! Perform communication - call MPI_ALLtoALLv(buf_send,nsend_proc,nsend_disp,MPI_PART,this%p,nrecv_proc,nrecv_disp,MPI_PART,this%cfg%comm,ierr) - ! Deallocate buffer - deallocate(buf_send) - ! Recycle to remove duplicate particles - call this%recycle() - end subroutine sync - - - !> Share particles across processor boundaries - subroutine share(this,nover) - use mpi_f08 - use messager, only: warn,die - implicit none - class(lpt), intent(inout) :: this - integer, optional :: nover - type(part), dimension(:), allocatable :: tosend - type(part), dimension(:), allocatable :: torecv - integer :: no,nsend,nrecv - type(MPI_Status) :: status - integer :: icnt,isrc,idst,ierr - integer :: i,n - - ! Check overlap size - if (present(nover)) then - no=nover - if (no.gt.this%cfg%no) then - call warn('[lpt_class share] Specified overlap is larger than that of cfg - reducing no') - no=this%cfg%no - else if (no.le.0) then - call die('[lpt_class share] Specified overlap cannot be less or equal to zero') - end if - else - no=1 - end if - - ! Clean up ghost array - call this%resize_ghost(n=0); this%ng_=0 - - ! Share ghost particles to the left in x - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).lt.this%cfg%imin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).lt.this%cfg%imin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%xper.and.tosend(nsend)%ind(1).lt.this%cfg%imin+no) then - tosend(nsend)%pos(1)=tosend(nsend)%pos(1)+this%cfg%xL - tosend(nsend)%ind(1)=tosend(nsend)%ind(1)+this%cfg%nx - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,0,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in x - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).gt.this%cfg%imax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(1).gt.this%cfg%imax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%xper.and.tosend(nsend)%ind(1).gt.this%cfg%imax-no) then - tosend(nsend)%pos(1)=tosend(nsend)%pos(1)-this%cfg%xL - tosend(nsend)%ind(1)=tosend(nsend)%ind(1)-this%cfg%nx - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,0,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the left in y - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).lt.this%cfg%jmin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%yper.and.tosend(nsend)%ind(2).lt.this%cfg%jmin+no) then - tosend(nsend)%pos(2)=tosend(nsend)%pos(2)+this%cfg%yL - tosend(nsend)%ind(2)=tosend(nsend)%ind(2)+this%cfg%ny - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,1,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in y - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(2).gt.this%cfg%jmax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%yper.and.tosend(nsend)%ind(2).gt.this%cfg%jmax-no) then - tosend(nsend)%pos(2)=tosend(nsend)%pos(2)-this%cfg%yL - tosend(nsend)%ind(2)=tosend(nsend)%ind(2)-this%cfg%ny - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,1,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the left in z - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).lt.this%cfg%kmin_+no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%zper.and.tosend(nsend)%ind(3).lt.this%cfg%kmin+no) then - tosend(nsend)%pos(3)=tosend(nsend)%pos(3)+this%cfg%zL - tosend(nsend)%ind(3)=tosend(nsend)%ind(3)+this%cfg%nz - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,2,-1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - ! Share ghost particles to the right in z - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) nsend=nsend+1 - end do - allocate(tosend(nsend)) - nsend=0 - do n=1,this%np_ - if (this%p(n)%ind(3).gt.this%cfg%kmax_-no) then - nsend=nsend+1 - tosend(nsend)=this%p(n) - if (this%cfg%zper.and.tosend(nsend)%ind(3).gt.this%cfg%kmax-no) then - tosend(nsend)%pos(3)=tosend(nsend)%pos(3)-this%cfg%zL - tosend(nsend)%ind(3)=tosend(nsend)%ind(3)-this%cfg%nz - end if - end if - end do - nrecv=0 - call MPI_CART_SHIFT(this%cfg%comm,2,+1,isrc,idst,ierr) - call MPI_SENDRECV(nsend,1,MPI_INTEGER,idst,0,nrecv,1,MPI_INTEGER,isrc,0,this%cfg%comm,status,ierr) - allocate(torecv(nrecv)) - call MPI_SENDRECV(tosend,nsend,MPI_PART,idst,0,torecv,nrecv,MPI_PART,isrc,0,this%cfg%comm,status,ierr) - call this%resize_ghost(this%ng_+nrecv) - this%g(this%ng_+1:this%ng_+nrecv)=torecv - this%ng_=this%ng_+nrecv - if (allocated(tosend)) deallocate(tosend) - if (allocated(torecv)) deallocate(torecv) - - end subroutine share - - - !> Adaptation of particle array size - subroutine resize(this,n) - implicit none - class(lpt), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize particle array to size n - if (.not.allocated(this%p)) then - ! Allocate directly to size n - allocate(this%p(n)) - this%p(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%p,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%p - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%p) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%p(1:n) - call move_alloc(tmp,this%p) - end if - end if - end subroutine resize - - - !> Adaptation of ghost array size - subroutine resize_ghost(this,n) - implicit none - class(lpt), intent(inout) :: this - integer, intent(in) :: n - type(part), dimension(:), allocatable :: tmp - integer :: size_now,size_new - ! Resize ghost array to size n - if (.not.allocated(this%g)) then - ! Allocate directly to size n - allocate(this%g(n)) - this%g(1:n)%flag=1 - else - ! Update from a non-zero size to another non-zero size - size_now=size(this%g,dim=1) - if (n.gt.size_now) then - size_new=max(n,int(real(size_now,WP)*coeff_up)) - allocate(tmp(size_new)) - tmp(1:size_now)=this%g - tmp(size_now+1:)%flag=1 - call move_alloc(tmp,this%g) - else if (n.lt.int(real(size_now,WP)*coeff_dn)) then - allocate(tmp(n)) - tmp(1:n)=this%g(1:n) - call move_alloc(tmp,this%g) - end if - end if - end subroutine resize_ghost - - - !> Clean-up of particle array by removing flag=1 particles - subroutine recycle(this) - implicit none - class(lpt), intent(inout) :: this - integer :: new_size,i,ierr - ! Compact all active particles at the beginning of the array - new_size=0 - if (allocated(this%p)) then - do i=1,size(this%p,dim=1) - if (this%p(i)%flag.ne.1) then - new_size=new_size+1 - if (i.ne.new_size) then - this%p(new_size)=this%p(i) - this%p(i)%flag=1 - end if - end if - end do - end if - ! Resize to new size - call this%resize(new_size) - ! Update number of particles - this%np_=new_size - call MPI_ALLGATHER(this%np_,1,MPI_INTEGER,this%np_proc,1,MPI_INTEGER,this%cfg%comm,ierr) - this%np=sum(this%np_proc) - end subroutine recycle - - - !> Parallel write particles to file - subroutine write(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(lpt), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset - integer :: i,ierr,iunit - - ! Root serial-writes the file header - if (this%cfg%amRoot) then - ! Open the file - open(newunit=iunit,file=trim(filename),form='unformatted',status='replace',access='stream',iostat=ierr) - if (ierr.ne.0) call die('[lpt write] Problem encountered while serial-opening data file: '//trim(filename)) - ! Number of particles and particle object size - write(iunit) this%np,MPI_PART_SIZE - ! Done with the header - close(iunit) - end if - - ! The rest is done in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),IOR(MPI_MODE_WRONLY,MPI_MODE_APPEND),info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[lpt write] Problem encountered while parallel-opening data file: '//trim(filename)) - - ! Get current position - call MPI_FILE_GET_POSITION(ifile,offset,ierr) - - ! Compute the offset and write - do i=1,this%cfg%rank - offset=offset+int(this%np_proc(i),MPI_OFFSET_KIND)*int(MPI_PART_SIZE,MPI_OFFSET_KIND) - end do - if (this%np_.gt.0) call MPI_FILE_WRITE_AT(ifile,offset,this%p,this%np_,MPI_PART,status,ierr) - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Wrote ",i0," particles to file [",a,"] on partitioned grid [",a,"]")') this%np,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) - end if - end block logging - - end subroutine write - - - !> Parallel read particles to file - subroutine read(this,filename) - use mpi_f08 - use messager, only: die - use parallel, only: info_mpiio - implicit none - class(lpt), intent(inout) :: this - character(len=*), intent(in) :: filename - type(MPI_File) :: ifile - type(MPI_Status):: status - integer(kind=MPI_OFFSET_KIND) :: offset,header_offset - integer :: i,j,ierr,npadd,psize,nchunk,cnt - integer, dimension(:,:), allocatable :: ppp - - ! First open the file in parallel - call MPI_FILE_OPEN(this%cfg%comm,trim(filename),MPI_MODE_RDONLY,info_mpiio,ifile,ierr) - if (ierr.ne.0) call die('[lpt read] Problem encountered while reading data file: '//trim(filename)) - - ! Read file header first - call MPI_FILE_READ_ALL(ifile,npadd,1,MPI_INTEGER,status,ierr) - call MPI_FILE_READ_ALL(ifile,psize,1,MPI_INTEGER,status,ierr) - - ! Remember current position - call MPI_FILE_GET_POSITION(ifile,header_offset,ierr) - - ! Check compatibility of particle type - if (psize.ne.MPI_PART_SIZE) call die('[lpt read] Particle type unreadable') - - ! Naively share reading task among all processors - nchunk=int(npadd/(this%cfg%nproc*part_chunk_size))+1 - allocate(ppp(this%cfg%nproc,nchunk)) - ppp=int(npadd/(this%cfg%nproc*nchunk)) - cnt=0 - out:do j=1,nchunk - do i=1,this%cfg%nproc - cnt=cnt+1 - if (cnt.gt.mod(npadd,this%cfg%nproc*nchunk)) exit out - ppp(i,j)=ppp(i,j)+1 - end do - end do out - - ! Read by chunk - do j=1,nchunk - ! Find offset - offset=header_offset+int(MPI_PART_SIZE,MPI_OFFSET_KIND)*int(sum(ppp(1:this%cfg%rank,:))+sum(ppp(this%cfg%rank+1,1:j-1)),MPI_OFFSET_KIND) - ! Resize particle array - call this%resize(this%np_+ppp(this%cfg%rank+1,j)) - ! Read this file - call MPI_FILE_READ_AT(ifile,offset,this%p(this%np_+1:this%np_+ppp(this%cfg%rank+1,j)),ppp(this%cfg%rank+1,j),MPI_PART,status,ierr) - ! Most general case: relocate every droplet - do i=this%np_+1,this%np_+ppp(this%cfg%rank+1,j) - this%p(i)%ind=this%cfg%get_ijk_global(this%p(i)%pos,this%p(i)%ind) - end do - ! Exchange all that - call this%sync() - end do - - ! Close the file - call MPI_FILE_CLOSE(ifile,ierr) - - ! Log/screen output - logging: block - use, intrinsic :: iso_fortran_env, only: output_unit - use param, only: verbose - use messager, only: log - use string, only: str_long - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("Read ",i0," particles from file [",a,"] on partitioned grid [",a,"]")') npadd,trim(filename),trim(this%cfg%name) - if (verbose.gt.2) write(output_unit,'(a)') trim(message) - if (verbose.gt.1) call log(message) - end if - end block logging - - end subroutine read - - -end module lpt_class diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index ad64dd537..4ef5f9501 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -2,28 +2,22 @@ module simulation use precision, only: WP use geometry, only: cfg - !use hypre_str_class, only: hypre_str use fourier3d_class, only: fourier3d use incomp_class, only: incomp - use lpt_class, only: lpt use timetracker_class, only: timetracker use ensight_class, only: ensight use partmesh_class, only: partmesh use event_class, only: event use monitor_class, only: monitor - use sgsmodel_class, only: sgsmodel use datafile_class, only: datafile use string, only: str_medium implicit none private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - !type(hypre_str), public :: ps type(fourier3d), public :: ps type(incomp), public :: fs type(timetracker), public :: time - type(lpt), public :: lp - type(sgsmodel), public :: sgs !> Ensight postprocessing type(partmesh) :: pmesh @@ -36,7 +30,7 @@ module simulation logical :: restarted !> Simulation monitor file - type(monitor) :: mfile,cflfile,hitfile,lptfile,sgsfile,tfile,ssfile + type(monitor) :: mfile,cflfile,hitfile,tfile,ssfile public :: simulation_init,simulation_run,simulation_final @@ -49,15 +43,13 @@ module simulation !> Fluid, forcing, and particle parameters real(WP) :: visc,meanU,meanV,meanW real(WP) :: Urms0,TKE0,EPS0,Re_max - real(WP) :: TKE,URMS,sgsTKE,EPSp - real(WP) :: stk,tau_eta - real(WP) :: meanvisc,Lx,N + real(WP) :: TKE,URMS + real(WP) :: Lx,N real(WP) :: tauinf,G,Gdtau,Gdtaui,dx - logical :: linforce,use_sgs,maxRe,use_crw - integer :: sgs_type + logical :: maxRe !> For monitoring - real(WP) :: EPS,sgsEPSp + real(WP) :: EPS real(WP) :: Re_L,Re_lambda real(WP) :: eta,ell real(WP) :: dx_eta,ell_Lx,Re_ratio,eps_ratio,tke_ratio,nondtime @@ -68,9 +60,53 @@ module simulation real(WP) :: time real(WP) :: percent end type timer - type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest,wt_sgs,wt_stat,wt_force + type(timer) :: wt_total,wt_vel,wt_pres,wt_rest,wt_stat,wt_force -contains + contains + + + !> Compute turbulence stats + subroutine compute_stats() + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + real(WP) :: myTKE,myEPS + integer :: i,j,k,ierr + + ! Compute mean velocities + call fs%cfg%integrate(A=Ui,integral=meanU); meanU=meanU/fs%cfg%vol_total + call fs%cfg%integrate(A=Vi,integral=meanV); meanV=meanV/fs%cfg%vol_total + call fs%cfg%integrate(A=Wi,integral=meanW); meanW=meanW/fs%cfg%vol_total + + ! Compute strainrate and grad(u) + call fs%get_strainrate(SR=SR) + call fs%get_gradu(gradu=gradu) + + myTKE=0.0_WP; myEPS=0.0_WP + + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) + myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho + end do + end do + end do + call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); TKE=TKE/fs%cfg%vol_total + call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); EPS=EPS/fs%cfg%vol_total + + URMS = sqrt(2.0_WP/3.0_WP*TKE) + Re_L = TKE**2.0_WP/EPS/visc + Re_lambda = sqrt(20.0_WP*Re_L/3.0_WP) + eta = (visc**3.0_WP/EPS)**0.25_WP + ell = (0.6667_WP*TKE)**1.5_WP / EPS + + nondtime = time%t/tauinf + dx_eta = dx/eta + eps_ratio = EPS/EPS0 + tke_ratio = TKE/TKE0 + ell_Lx = ell/Lx + Re_ratio = Re_lambda/Re_max + end subroutine compute_stats !> Initialization of problem solver @@ -142,9 +178,7 @@ subroutine simulation_init wt_total%time=0.0_WP; wt_total%percent=0.0_WP wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP - wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP - wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP wt_stat%time=0.0_WP; wt_stat%percent=0.0_WP wt_force%time=0.0_WP; wt_force%percent=0.0_WP end block initialize_timers @@ -159,23 +193,11 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) - !ps%maxlevel=10 - !call param_read('Pressure iteration',ps%maxit) - !call param_read('Pressure tolerance',ps%rcvg) ps=fourier3d(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver - ! Create an LES model - create_sgs: block - call param_read(tag='Use SGS model',val=use_sgs,default=.false.) - if (use_sgs) call param_read('SGS model type',sgs_type) - sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) - sgs%Cs_ref=0.1_WP - end block create_sgs - ! Prepare initial velocity field initialize_velocity: block use random, only: random_normal @@ -184,28 +206,22 @@ subroutine simulation_init use mathtools,only: Pi integer :: i,j,k ! Read in forcing, grid, and initial velocity field parameters - call param_read('Linear forcing',linforce) call param_read('Force to maximum Re_lambda',maxRe) - call param_read('Forcing constant (G)', G) + call param_read('Forcing constant', G) call param_read('Lx', Lx) call param_read('nx', N) dx=Lx/N - if (linforce) then - if (maxRE) then - EPS0 = (visc/fs%rho)**3*(Pi*N/(1.5_WP*Lx))**4 - TKE0 = 1.5_WP*(0.2_WP*Lx*EPS0)**(0.6667_WP) - else - call param_read('Steady-state TKE',TKE0) - EPS0 = 5.0_WP*(0.6667_WP*TKE0)**1.5_WP / Lx - end if - Re_max = sqrt(15.0_WP*sqrt(0.6667_WP*TKE0)*0.2_WP*Lx/visc) - tauinf = 2.0_WP*TKE0/(3.0_WP*EPS0) - Gdtau = G/tauinf - Gdtaui= 1/Gdtau + if (maxRE) then + EPS0 = (visc/fs%rho)**3*(Pi*N/(1.5_WP*Lx))**4 + TKE0 = 1.5_WP*(0.2_WP*Lx*EPS0)**(0.6667_WP) else - TKE0 = 0.0_WP - tauinf = 99999.0_WP + call param_read('Steady-state TKE',TKE0) + EPS0 = 5.0_WP*(0.6667_WP*TKE0)**1.5_WP / Lx end if + Re_max = sqrt(15.0_WP*sqrt(0.6667_WP*TKE0)*0.2_WP*Lx/visc) + tauinf = 2.0_WP*TKE0/(3.0_WP*EPS0) + Gdtau = G/tauinf + Gdtaui= 1/Gdtau if (restarted) then call df%pullvar(name='U',var=fs%U) @@ -253,150 +269,10 @@ subroutine simulation_init ! Calculate cell-centered velocities and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() - end block initialize_velocity - - ! Compute turbulence statistics for monitor at time=0 - compute_stats: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - real(WP) :: mysgstke,myvisc,myTKE,myEPS,gu2buf - real(WP) :: mysgsEPSp,myEPSp - integer :: i,j,k,ierr - - myvisc=0.0_WP; myTKE=0.0_WP; myEPS=0.0_WP - sgsTKE=0.0_WP; mysgstke=0.0_WP; - mysgsEPSp=0.0_WP; myEPSp=0.0_WP - - call fs%get_strainrate(SR=SR) - call fs%get_gradu(gradu=gradu) - - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - ! LES stats - mysgsTKE = mysgsTKE + fs%cfg%vol(i,j,k)*(sgs%visc(i,j,k)/0.067_WP/sgs%delta(i,j,k)/fs%rho)**2 - myvisc = myvisc+fs%visc(i,j,k)*fs%cfg%vol(i,j,k) - - ! Resolved TKE - myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) - - ! Dissipation - myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho - - ! Pseudo-dissipation (sgs, total) - gu2buf = gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & - gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & - gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2 - - mysgsEPSp=mysgsEPSp+fs%cfg%vol(i,j,k)*sgs%visc(i,j,k)*gu2buf - myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*gu2buf - end do - end do - end do - - call MPI_ALLREDUCE(myvisc,meanvisc,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanvisc=meanvisc/fs%cfg%vol_total - - call MPI_ALLREDUCE(mysgstke,sgsTKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsTKE=sgsTKE/fs%cfg%vol_total - call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE=TKE/fs%cfg%vol_total - - call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPS=EPS/fs%cfg%vol_total - call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp=EPSp/fs%cfg%vol_total - call MPI_ALLREDUCE(mysgsEPSp,sgsEPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsEPSp=sgsEPSp/fs%cfg%vol_total - URMS = sqrt(2.0_WP/3.0_WP*(TKE+sgsTKE)) - Re_L = (TKE+sgsTKE)**2.0_WP/EPS/meanvisc - Re_lambda = sqrt(20.0_WP*Re_L/3.0_WP) - eta = (meanvisc**3.0_WP/EPS)**0.25_WP - ell = (0.6667_WP*TKE)**1.5_WP / EPS - tau_eta = sqrt(visc/EPS0) - - nondtime = time%t/tauinf - dx_eta = dx/eta - eps_ratio = EPS/EPS0 - tke_ratio = TKE/TKE0 - ell_Lx = ell/Lx - Re_ratio = Re_lambda/Re_max - end block compute_stats - - ! Initialize LPT solver - initialize_lpt: block - use random, only: random_uniform, random_normal - real(WP) :: dp - integer :: i,np - character(len=str_medium) :: timestamp - ! Create solver - lp=lpt(cfg=cfg,name='LPT') - ! Get drag model from the inpit - call param_read('Drag model',lp%drag_model,default='Schiller-Naumann') - ! Get particle density from the input - call param_read('Particle density',lp%rho) - ! Get particle diameter from the input - call param_read('Particle Stokes number', stk) - ! Get number of particles - call param_read('Number of particles',np) - ! Check if a stochastic SGS model is used - call param_read('Use CRW', use_crw) - if (.false.) then - call param_read('Restart from',timestamp,'r') - ! Read the part file - call lp%read(filename='restart/part_'//trim(adjustl(timestamp))) - else - ! Root process initializes np particles randomly - if (lp%cfg%amRoot) then - dp = sqrt(18.0_WP*visc*stk*tau_eta/lp%rho) - call lp%resize(np) - do i=1,np - ! Give id - lp%p(i)%id=int(i,8) - ! Set the diameter - lp%p(i)%d=dp - ! Assign random position in the domain - lp%p(i)%pos=[random_uniform(lp%cfg%x(lp%cfg%imin),lp%cfg%x(lp%cfg%imax+1)),& - & random_uniform(lp%cfg%y(lp%cfg%jmin),lp%cfg%y(lp%cfg%jmax+1)),& - & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] - ! Give zero velocity - lp%p(i)%vel=0.0_WP - ! OU - lp%p(i)%uf=0.0_WP - if (use_crw) then - lp%p(i)%uf= [random_normal(m=0.0_WP,sd=0.1_WP),& - random_normal(m=0.0_WP,sd=0.1_WP),& - random_normal(m=0.0_WP,sd=0.1_WP)] - end if - ! Give zero dt - lp%p(i)%dt=0.0_WP - lp%p(i)%a_crw=0.0_WP - lp%p(i)%b_crw=0.0_WP - ! Locate the particle on the mesh - lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) - ! Activate the particle - lp%p(i)%flag=0 - end do - end if - ! Distribute particles - call lp%sync() - end if - end block initialize_lpt - - - ! Create partmesh object for Lagrangian particle output - create_pmesh: block - integer :: np,i - call param_read('Number of particles',np) - pmesh=partmesh(nvar=1,nvec=3,name='lpt') - pmesh%varname(1)="id" - pmesh%vecname(1)="vel" - pmesh%vecname(2)="fld" - pmesh%vecname(3)="uf" - call lp%resize(np) - call lp%update_partmesh(pmesh) - do i = 1,lp%np_ - pmesh%var(1,i) = lp%p(i)%id - pmesh%vec(:,1,i) = lp%p(i)%vel - pmesh%vec(:,2,i) = lp%cfg%get_velocity(pos=lp%p(i)%pos,i0=lp%p(i)%ind(1),j0=lp%p(i)%ind(2),k0=lp%p(i)%ind(3),U=Ui,V=Vi,W=Wi) - pmesh%vec(:,3,i) = lp%p(i)%uf - end do - end block create_pmesh + ! Compute turbulence stats + call compute_stats() + end block initialize_velocity ! Add Ensight output create_ensight: block @@ -408,7 +284,6 @@ subroutine simulation_init ! Add variables to output call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('pressure',fs%P) - call ens_out%add_scalar('visc',sgs%visc) call ens_out%add_particle('particles',pmesh) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) @@ -433,7 +308,6 @@ subroutine simulation_init call mfile%add_column(fs%Wmax,'Wmax') call mfile%add_column(meanW,'Wmean') call mfile%add_column(fs%Pmax,'Pmax') - call mfile%add_column(TKE,'Kinetic energy') call mfile%add_column(fs%divmax,'Maximum divergence') call mfile%add_column(fs%psolv%it,'Pressure iteration') call mfile%add_column(fs%psolv%rerr,'Pressure error') @@ -455,14 +329,11 @@ subroutine simulation_init call hitfile%add_column(time%t,'Time') call hitfile%add_column(Re_L,'Re_L') call hitfile%add_column(Re_lambda,'Re_lambda') - call hitfile%add_column(meanvisc,'mean visc') call hitfile%add_column(eta,'eta') - call hitfile%add_column(sgsTKE,'sgsTKE') call hitfile%add_column(TKE,'TKE') - call hitfile%add_column(URMS,'URMS') + call hitfile%add_column(URMS,'Urms') call hitfile%add_column(EPS,'EPS') - call hitfile%add_column(EPSp,'EPSp') - call hitfile%add_column(ell,'Integral lengthscale') + call hitfile%add_column(ell,'L') call hitfile%write() ! Create hit convergence monitor ssfile=monitor(fs%cfg%amRoot,'convergence') @@ -475,30 +346,6 @@ subroutine simulation_init call ssfile%add_column(dx_eta,'dx/eta') call ssfile%add_column(ell_Lx,'ell/Lx') call ssfile%write() - ! Create LPT monitor - call lp%get_max() - lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') - call lptfile%add_column(time%n,'Timestep number') - call lptfile%add_column(time%t,'Time') - call lptfile%add_column(lp%np,'Particle number') - call lptfile%add_column(lp%Umin,'Particle Umin') - call lptfile%add_column(lp%Umax,'Particle Umax') - call lptfile%add_column(lp%Vmin,'Particle Vmin') - call lptfile%add_column(lp%Vmax,'Particle Vmax') - call lptfile%add_column(lp%Wmin,'Particle Wmin') - call lptfile%add_column(lp%Wmax,'Particle Wmax') - call lptfile%add_column(lp%dmin,'Particle dmin') - call lptfile%add_column(lp%dmax,'Particle dmax') - call lptfile%write() - ! Create SGS monitor - sgsfile=monitor(fs%cfg%amroot,'sgs') - call sgsfile%add_column(time%n,'Timestep number') - call sgsfile%add_column(time%t,'Time') - call sgsfile%add_column(sgs%min_visc,'Min eddy visc') - call sgsfile%add_column(sgs%max_visc,'Max eddy visc') - call sgsfile%add_column(sgsEPSp,'SGSEPS') - call sgsfile%add_column(sgsTKE,'sgsTKE') - call sgsfile%write() ! Create timing monitor tfile=monitor(amroot=fs%cfg%amRoot,name='timing') call tfile%add_column(time%n,'Timestep number') @@ -508,10 +355,6 @@ subroutine simulation_init call tfile%add_column(wt_vel%percent,'Velocity [%]') call tfile%add_column(wt_pres%time,'Pressure [s]') call tfile%add_column(wt_pres%percent,'Pressure [%]') - call tfile%add_column(wt_lpt%time,'LPT [s]') - call tfile%add_column(wt_lpt%percent,'LPT [%]') - call tfile%add_column(wt_sgs%time,'SGS [s]') - call tfile%add_column(wt_sgs%percent,'SGS [%]') call tfile%add_column(wt_stat%time,'Stats [s]') call tfile%add_column(wt_stat%percent,'Stats [%]') call tfile%add_column(wt_force%time,'Forcing [s]') @@ -542,101 +385,75 @@ subroutine simulation_run call time%adjust_dt() call time%increment() - - wt_lpt%time_in=parallel_time() - ! Advance particles by dt - resU=fs%rho; resV=fs%visc - call lp%advance(dt=time%dt,U=fs%U,V=fs%V,W=fs%W,rho=resU,visc=resV,use_crw=use_crw,sgs=sgs) - wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in - ! Remember old velocity fs%Uold=fs%U fs%Vold=fs%V fs%Wold=fs%W - ! Turbulence modeling - call fs%interp_vel(Ui,Vi,Wi) - wt_sgs%time_in=parallel_time() - if (use_sgs) then - fs%visc=visc - call fs%get_strainrate(SR=SR) - call fs%get_gradu(gradu=gradu) - resU=fs%rho - call sgs%get_visc(type=sgs_type,rho=resU,gradu=gradu,dt=time%dt,SR=SR,Ui=Ui,Vi=Vi,Wi=Wi) - where (sgs%visc.lt.-fs%visc) - sgs%visc=-fs%visc - end where - fs%visc=fs%visc+sgs%visc - end if - wt_sgs%time=wt_sgs%time+parallel_time()-wt_sgs%time_in - ! Perform sub-iterations do while (time%it.le.time%itmax) wt_vel%time_in=parallel_time() - + ! Build mid-time velocity fs%U=0.5_WP*(fs%U+fs%Uold) fs%V=0.5_WP*(fs%V+fs%Vold) fs%W=0.5_WP*(fs%W+fs%Wold) - + ! Explicit calculation of drho*u/dt from NS call fs%get_dmomdt(resU,resV,resW) - + ! Assemble explicit residual resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Add linear forcing term: Bassenne et al. (2016) wt_force%time_in=parallel_time() - if (linforce) then - ! Add linear forcing term - ! See Bassenne et al. (2016) - linear_forcing: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - use messager, only: die - real(WP) :: myTKE,A,myvisc,myEPSp - integer :: i,j,k,ierr - - ! Calculate mean velocity - call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total - call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total - - ! Calculate TKE and EPS - call fs%interp_vel(Ui,Vi,Wi) - call fs%get_gradu(gradu=gradu) - myvisc=0.0_WP; myTKE=0.0_WP; myEPSp=0.0_WP - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - myTKE=myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) - - ! Pseudo-dissipation - myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*( & - gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & - gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & - gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2) - end do - end do - end do - call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE = TKE/fs%cfg%vol_total - call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp = EPSp/fs%cfg%vol_total/fs%rho - - if (Gdtaui.lt.time%dt) call die("[linear_forcing] Controller time constant less than timestep") - A = (EPSp - Gdtau*(TKE-TKE0))/(2.0_WP*TKE)*fs%rho ! - Eq. (7) (forcing constant TKE) - - resU=resU+time%dt*(fs%U-meanU)*A - resV=resV+time%dt*(fs%V-meanV)*A - resW=resW+time%dt*(fs%W-meanW)*A - end block linear_forcing - end if + linear_forcing: block + use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM + use parallel, only: MPI_REAL_WP + use messager, only: die + real(WP) :: myTKE,A,myEPSp,EPSp + integer :: i,j,k,ierr + + ! Calculate mean velocity + call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total + call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total + + ! Calculate TKE and EPS + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_gradu(gradu=gradu) + myTKE=0.0_WP; myEPSp=0.0_WP + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + myTKE=myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) + + ! Pseudo-dissipation + myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*( & + gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & + gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & + gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2) + end do + end do + end do + call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE = TKE/fs%cfg%vol_total + call MPI_ALLREDUCE(myEPSp,EPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPSp = EPSp/fs%cfg%vol_total/fs%rho + + if (Gdtaui.lt.time%dt) call die("[linear_forcing] Controller time constant less than timestep") + A = (EPSp - Gdtau*(TKE-TKE0))/(2.0_WP*TKE)*fs%rho ! - Eq. (7) (forcing constant TKE) + + resU=resU+time%dt*(fs%U-meanU)*A + resV=resV+time%dt*(fs%V-meanV)*A + resW=resW+time%dt*(fs%W-meanW)*A + end block linear_forcing wt_force%time=wt_force%time+parallel_time()-wt_force%time_in - wt_vel%time_in=parallel_time() ! Apply these residuals + wt_vel%time_in=parallel_time() fs%U=2.0_WP*fs%U-fs%Uold+resU/fs%rho fs%V=2.0_WP*fs%V-fs%Vold+resV/fs%rho fs%W=2.0_WP*fs%W-fs%Wold+resW/fs%rho @@ -661,6 +478,9 @@ subroutine simulation_run fs%V=fs%V-time%dt*resV/fs%rho fs%W=fs%W-time%dt*resW/fs%rho wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Recompute interpolated velocity + call fs%interp_vel(Ui,Vi,Wi) ! Increment sub-iteration counter time%it=time%it+1 @@ -668,110 +488,37 @@ subroutine simulation_run end do wt_vel%time_in=parallel_time() - ! Recompute interpolated velocity and divergence - call fs%interp_vel(Ui,Vi,Wi) + ! Recompute divergence call fs%get_div() wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + ! Compute turbulence stats wt_stat%time_in=parallel_time() - ! Compute turbulence statistics for monitor - compute_stats: block - use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP - real(WP) :: mysgstke,myvisc,myTKE,myEPS - real(WP) :: mysgsEPSp,myEPSp - integer :: i,j,k,ierr - - myvisc=0.0_WP; myTKE=0.0_WP; myEPS=0.0_WP - sgsTKE=0.0_WP; mysgstke=0.0_WP; - mysgsEPSp=0.0_WP - - call fs%get_strainrate(SR=SR) - call fs%get_gradu(gradu=gradu) - - do k=fs%cfg%kmin_,fs%cfg%kmax_ - do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ - ! LES stats - mysgsTKE = mysgsTKE + fs%cfg%vol(i,j,k)*(sgs%visc(i,j,k)/0.067_WP/sgs%delta(i,j,k)/fs%rho)**2 - myvisc = myvisc+fs%visc(i,j,k)*fs%cfg%vol(i,j,k) - - ! Resolved TKE - myTKE = myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) - - ! Dissipation - myEPS = myEPS + 2.0_WP*fs%visc(i,j,k)*fs%cfg%vol(i,j,k)*(SR(1,i,j,k)**2+SR(2,i,j,k)**2+SR(3,i,j,k)**2+2.0_WP*(SR(4,i,j,k)**2+SR(5,i,j,k)**2+SR(6,i,j,k)**2))/fs%rho - - ! Pseudo-dissipation (sgs, resolved, total) - mysgsEPSp=mysgsEPSp+fs%cfg%vol(i,j,k)*sgs%visc(i,j,k)*( & - gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & - gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & - gradu(3,1,i,j,k)**2+gradu(3,2,i,j,k)**2+gradu(3,3,i,j,k)**2) - end do - end do - end do - - call MPI_ALLREDUCE(myvisc,meanvisc,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); meanvisc=meanvisc/fs%cfg%vol_total - - call MPI_ALLREDUCE(mysgstke,sgsTKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsTKE=sgsTKE/fs%cfg%vol_total - call MPI_ALLREDUCE(myTKE,TKE,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); TKE=TKE/fs%cfg%vol_total - - call MPI_ALLREDUCE(myEPS,EPS,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr ); EPS=EPS/fs%cfg%vol_total - call MPI_ALLREDUCE(mysgsEPSp,sgsEPSp,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); sgsEPSp=sgsEPSp/fs%cfg%vol_total - - URMS = sqrt(2.0_WP/3.0_WP*(TKE+sgsTKE)) - Re_L = (TKE+sgsTKE)**2.0_WP/EPS/meanvisc - Re_lambda = sqrt(20.0_WP*Re_L/3.0_WP) - eta = (meanvisc**3.0_WP/EPS)**0.25_WP - ell = (0.6667_WP*TKE)**1.5_WP / EPS - - nondtime = time%t/tauinf - dx_eta = dx/eta - eps_ratio = EPS/EPS0 - tke_ratio = TKE/TKE0 - ell_Lx = ell/Lx - Re_ratio = Re_lambda/Re_max - end block compute_stats + call compute_stats() wt_stat%time=wt_stat%time+parallel_time()-wt_stat%time_in ! Output to ensight - if (ens_evt%occurs()) then - call lp%update_partmesh(pmesh) - do ii = 1,lp%np_ - pmesh%var(1,ii) = lp%p(ii)%id - pmesh%vec(:,1,ii) = lp%p(ii)%vel - pmesh%vec(:,2,ii) = lp%cfg%get_velocity(pos=lp%p(ii)%pos,i0=lp%p(ii)%ind(1),j0=lp%p(ii)%ind(2),k0=lp%p(ii)%ind(3),U=Ui,V=Vi,W=Wi) - pmesh%vec(:,3,ii) = lp%p(ii)%uf - end do - call ens_out%write_data(time%t) - end if + if (ens_evt%occurs()) call ens_out%write_data(time%t) ! Perform and output monitoring call fs%get_max() call mfile%write() call cflfile%write() call hitfile%write() - call lp%get_max() - call lptfile%write() - call sgsfile%write() call ssfile%write() ! Monitor timing wt_total%time=parallel_time()-wt_total%time_in wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP - wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP - wt_sgs%percent=wt_sgs%time/wt_total%time*100.0_WP wt_stat%percent=wt_stat%time/wt_total%time*100.0_WP wt_force%percent=wt_force%time/wt_total%time*100.0_WP - wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time-wt_sgs%time-wt_stat%time-wt_force%time + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_stat%time-wt_force%time wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP call tfile%write() wt_total%time=0.0_WP; wt_total%percent=0.0_WP wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP - wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP - wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP wt_stat%time=0.0_WP; wt_stat%percent=0.0_WP wt_force%time=0.0_WP; wt_force%percent=0.0_WP wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP @@ -785,15 +532,13 @@ subroutine simulation_run ! Prepare a new directory if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') ! Populate df and write it - call df%pushval(name='t' ,val=time%t ) - call df%pushval(name='dt',val=time%dt ) - call df%pushvar(name='U' ,var=fs%U ) - call df%pushvar(name='V' ,var=fs%V ) - call df%pushvar(name='W' ,var=fs%W ) - call df%pushvar(name='P' ,var=fs%P ) + call df%pushval(name='t' ,val=time%t ) + call df%pushval(name='dt',val=time%dt) + call df%pushvar(name='U' ,var=fs%U ) + call df%pushvar(name='V' ,var=fs%V ) + call df%pushvar(name='W' ,var=fs%W ) + call df%pushvar(name='P' ,var=fs%P ) call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) - ! Write particle file - call lp%write(filename='restart/part_'//trim(adjustl(timestamp))) end block save_restart end if From 17ca6b0184ff121f5a6a5b16c8692055a78ad4ef Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 13 Feb 2023 12:34:58 -0500 Subject: [PATCH 128/152] Update input faster cvg --- examples/hit/input | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/examples/hit/input b/examples/hit/input index 195d10e86..217bfedbe 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -6,10 +6,8 @@ Lx : 6.2832 nx : 64 # Fluid properties -Dynamic viscosity : 0.002 +Dynamic viscosity : 0.1 Density : 1 -Initial rms : 10 -Eddy turnover time : 0.1 # Steadt-state (forcing) parameters Force to maximum Re_lambda : .true. From 306177be62ecf4bfa925c7c035603aec83f2506e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 13 Feb 2023 12:42:21 -0500 Subject: [PATCH 129/152] Update pgrid_class.f90 remove unused var --- src/grid/pgrid_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 964116cee..37bb8008c 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -244,7 +244,7 @@ subroutine pgrid_domain_decomp(self) use parallel, only: MPI_REAL_WP,MPI_REAL_SP implicit none class(pgrid), intent(inout) :: self - integer :: strat_,ierr,q,r + integer :: ierr,q,r type(MPI_Comm) :: tmp_comm integer, parameter :: ndims=3 logical, parameter :: reorder=.true. From e48aa54cfe4f1fb497e6bea0022e44dad012d02d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Mon, 13 Feb 2023 22:05:52 -0500 Subject: [PATCH 130/152] vdjet case update vdjet case now running with scalar transport and simple equation of state. --- examples/vdjet/input | 2 +- examples/vdjet/src/geometry.f90 | 2 +- examples/vdjet/src/simulation.f90 | 150 +++++++++++++++++++----------- 3 files changed, 99 insertions(+), 55 deletions(-) diff --git a/examples/vdjet/input b/examples/vdjet/input index e00fa4cf8..e836f0ebc 100644 --- a/examples/vdjet/input +++ b/examples/vdjet/input @@ -12,7 +12,7 @@ nz : 1 # Fluid properties Dynamic viscosity : 0.001 Dynamic diffusivity : 0.001 -Jet density : 1.0 +Jet density : 0.5 Coflow density : 1.0 Jet diameter : 1.0 Jet velocity : 1.0 diff --git a/examples/vdjet/src/geometry.f90 b/examples/vdjet/src/geometry.f90 index 2ea1158a7..22a0fecd7 100644 --- a/examples/vdjet/src/geometry.f90 +++ b/examples/vdjet/src/geometry.f90 @@ -66,7 +66,7 @@ subroutine geometry_init ! Create masks for this config create_walls: block - cfg%VF=0.0_WP + cfg%VF=1.0_WP end block create_walls diff --git a/examples/vdjet/src/simulation.f90 b/examples/vdjet/src/simulation.f90 index 1e13ad3b9..7d3e3106f 100644 --- a/examples/vdjet/src/simulation.f90 +++ b/examples/vdjet/src/simulation.f90 @@ -2,6 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg + use hypre_uns_class, only: hypre_uns use lowmach_class, only: lowmach use vdscalar_class, only: vdscalar use timetracker_class, only: timetracker @@ -12,6 +13,9 @@ module simulation private !> Single low Mach flow solver and scalar solver and corresponding time tracker + type(hypre_uns), public :: ps + type(hypre_uns), public :: vs + type(hypre_uns), public :: ss type(lowmach), public :: fs type(vdscalar), public :: sc type(timetracker), public :: time @@ -108,11 +112,13 @@ end function coflowsc subroutine get_rho() implicit none integer :: i,j,k + real(WP) :: Z ! Calculate density do k=sc%cfg%kmino_,sc%cfg%kmaxo_ do j=sc%cfg%jmino_,sc%cfg%jmaxo_ do i=sc%cfg%imino_,sc%cfg%imaxo_ - sc%rho(i,j,k)=1.0_WP!rho_jet*rho_cof/((1.0_WP-sc%SC(i,j,k))*rho_jet+sc%SC(i,j,k)*rho_cof) + Z=min(max(sc%SC(i,j,k),0.0_WP),1.0_WP) + sc%rho(i,j,k)=rho_jet*rho_cof/((1.0_WP-Z)*rho_jet+Z*rho_cof) end do end do end do @@ -135,50 +141,53 @@ subroutine simulation_init ! Create an incompressible flow solver with bconds create_solver: block - use ils_class, only: pcg_amg - use lowmach_class, only: dirichlet,clipped_neumann - real(WP) :: visc - ! Create flow solver - fs=lowmach(cfg=cfg,name='Variable density low Mach NS') - ! Assign constant viscosity - call param_read('Dynamic viscosity',visc); fs%visc=visc - ! Define jet and coflow boundary conditions - call fs%add_bcond(name='jet' ,type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=jet ) - call fs%add_bcond(name='coflow',type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=coflow) - ! Outflow on the right - call fs%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true.,locator=right_boundary) - ! Configure pressure solver - call param_read('Pressure iteration',fs%psolv%maxit) - call param_read('Pressure tolerance',fs%psolv%rcvg) - ! Configure implicit velocity solver - call param_read('Implicit iteration',fs%implicit%maxit) - call param_read('Implicit tolerance',fs%implicit%rcvg) - ! Setup the solver - call fs%setup(pressure_ils=pcg_amg,implicit_ils=pcg_amg) + use hypre_uns_class, only: pcg_amg + use lowmach_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define jet and coflow boundary conditions + call fs%add_bcond(name='jet' ,type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=jet ) + call fs%add_bcond(name='coflow',type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=coflow) + ! Outflow on the right + call fs%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true.,locator=right_boundary) + ! Configure pressure solver + ps=hypre_uns(cfg=cfg,name='Pressure',method=pcg_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_uns(cfg=cfg,name='Velocity',method=pcg_amg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_solver - - + + ! Create a scalar solver create_scalar: block - use ils_class, only: pcg_amg - use vdscalar_class, only: dirichlet,neumann,quick - real(WP) :: diffusivity - ! Create scalar solver - sc=vdscalar(cfg=cfg,scheme=quick,name='MixFrac') - ! Define jet and coflow boundary conditions - call sc%add_bcond(name='jet' ,type=dirichlet,locator=jetsc ) - call sc%add_bcond(name='coflow',type=dirichlet,locator=coflowsc) - ! Outflow on the right - call sc%add_bcond(name='outflow',type=neumann,locator=right_boundary,dir='+x') - ! Assign constant diffusivity - call param_read('Dynamic diffusivity',diffusivity) - sc%diff=diffusivity - ! Configure implicit scalar solver - sc%implicit%maxit=fs%implicit%maxit; sc%implicit%rcvg=fs%implicit%rcvg - ! Setup the solver - call sc%setup(implicit_ils=pcg_amg) + use hypre_uns_class, only: pcg_amg + use vdscalar_class, only: dirichlet,neumann,quick + real(WP) :: diffusivity + ! Create scalar solver + sc=vdscalar(cfg=cfg,scheme=quick,name='MixFrac') + ! Define jet and coflow boundary conditions + call sc%add_bcond(name='jet' ,type=dirichlet,locator=jetsc ) + call sc%add_bcond(name='coflow',type=dirichlet,locator=coflowsc) + ! Outflow on the right + call sc%add_bcond(name='outflow',type=neumann,locator=right_boundary,dir='+x') + ! Assign constant diffusivity + call param_read('Dynamic diffusivity',diffusivity) + sc%diff=diffusivity + ! Configure implicit scalar solver + ss=hypre_uns(cfg=cfg,name='Scalar',method=pcg_amg,nst=13) + ss%maxit=vs%maxit; ss%rcvg=vs%rcvg + ! Setup the solver + call sc%setup(implicit_solver=ss) end block create_scalar - + ! Allocate work arrays allocate_work_arrays: block @@ -357,31 +366,48 @@ subroutine simulation_run ! ============= SCALAR SOLVER ======================= ! Build mid-time scalar - !sc%SC=0.5_WP*(sc%SC+sc%SCold) + sc%SC=0.5_WP*(sc%SC+sc%SCold) ! Explicit calculation of drhoSC/dt from scalar equation - !call sc%get_drhoSCdt(resSC,fs%rhoU,fs%rhoV,fs%rhoW) + call sc%get_drhoSCdt(resSC,fs%rhoU,fs%rhoV,fs%rhoW) ! Assemble explicit residual - !resSC=time%dt*resSC-(2.0_WP*sc%rho*sc%SC-(sc%rho+sc%rhoold)*sc%SCold) + resSC=time%dt*resSC-(2.0_WP*sc%rho*sc%SC-(sc%rho+sc%rhoold)*sc%SCold) ! Form implicit residual - !call sc%solve_implicit(time%dt,resSC,fs%rhoU,fs%rhoV,fs%rhoW) + call sc%solve_implicit(time%dt,resSC,fs%rhoU,fs%rhoV,fs%rhoW) ! Apply this residual - !sc%SC=2.0_WP*sc%SC-sc%SCold+resSC + sc%SC=2.0_WP*sc%SC-sc%SCold+resSC ! Apply other boundary conditions on the resulting field - !call sc%apply_bcond(time%t,time%dt) + call sc%apply_bcond(time%t,time%dt) + + dirichlet_scalar: block + use vdscalar_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call sc%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=1.0_WP + end do + call sc%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=0.0_WP + end do + end block dirichlet_scalar + ! =================================================== ! ============ UPDATE PROPERTIES ==================== ! Backup rhoSC - !resSC=sc%rho*sc%SC + resSC=sc%rho*sc%SC ! Update density - !call get_rho() + call get_rho() ! Rescale scalar for conservation - !sc%SC=resSC/sc%rho + sc%SC=resSC/sc%rho ! UPDATE THE VISCOSITY ! UPDATE THE DIFFUSIVITY ! =================================================== @@ -416,10 +442,28 @@ subroutine simulation_run call fs%apply_bcond(time%tmid,time%dtmid) call fs%rho_multiply() call fs%apply_bcond(time%tmid,time%dtmid) - + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_jet + end do + call fs%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_cof + end do + call fs%rho_multiply() + end block dirichlet_velocity + ! Solve Poisson equation - !call sc%get_drhodt(dt=time%dt,drhodt=resSC) - resSC=0.0_WP + call sc%get_drhodt(dt=time%dt,drhodt=resSC) + !resSC=0.0_WP call fs%correct_mfr(drhodt=resSC) call fs%get_div(drhodt=resSC) fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid From 406f89fec37aeafb55ae1974d0f65e6b1bae2959 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 18:01:11 -0500 Subject: [PATCH 131/152] New turbidity current case Added a (2D) turbidity current case. Need to add SGS model. Also need to include lift and added mass due to low density ratio. --- examples/turbidity/GNUmakefile | 48 +++ examples/turbidity/README | 1 + examples/turbidity/input | 41 ++ examples/turbidity/src/Make.package | 2 + examples/turbidity/src/geometry.f90 | 84 ++++ examples/turbidity/src/simulation.f90 | 543 ++++++++++++++++++++++++++ 6 files changed, 719 insertions(+) create mode 100644 examples/turbidity/GNUmakefile create mode 100644 examples/turbidity/README create mode 100644 examples/turbidity/input create mode 100644 examples/turbidity/src/Make.package create mode 100644 examples/turbidity/src/geometry.f90 create mode 100644 examples/turbidity/src/simulation.f90 diff --git a/examples/turbidity/GNUmakefile b/examples/turbidity/GNUmakefile new file mode 100644 index 000000000..b561e0571 --- /dev/null +++ b/examples/turbidity/GNUmakefile @@ -0,0 +1,48 @@ +# NGA location if not yet defined +NGA_HOME ?= ../.. + +# Compilation parameters +PRECISION = DOUBLE +USE_MPI = TRUE +USE_HYPRE = TRUE +USE_LAPACK= TRUE +USE_IRL = FALSE +PROFILE = FALSE +DEBUG = FALSE +COMP = gnu +EXEBASE = nga + +# Directories that contain user-defined code +Udirs := src + +# Include user-defined sources +Upack += $(foreach dir, $(Udirs), $(wildcard $(dir)/Make.package)) +Ulocs += $(foreach dir, $(Udirs), $(wildcard $(dir))) +include $(Upack) +INCLUDE_LOCATIONS += $(Ulocs) +VPATH_LOCATIONS += $(Ulocs) + +# External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well +LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ + +# NGA compilation definitions +include $(NGA_HOME)/tools/GNUMake/Make.defs + +# Include NGA base code +Bdirs := variable_density particles core data solver config grid libraries +Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) +include $(Bpack) + +# Inform user of Make.packages used +ifdef Ulocs + $(info Taking user code from: $(Ulocs)) +endif +$(info Taking base code from: $(Bdirs)) + +# Target definition +all: $(executable) + @echo COMPILATION SUCCESSFUL + +# NGA compilation rules +include $(NGA_HOME)/tools/GNUMake/Make.rules diff --git a/examples/turbidity/README b/examples/turbidity/README new file mode 100644 index 000000000..5ee2acda0 --- /dev/null +++ b/examples/turbidity/README @@ -0,0 +1 @@ +This is a simulation of a turbidity current using LPT and SGS. diff --git a/examples/turbidity/input b/examples/turbidity/input new file mode 100644 index 000000000..7aef793c4 --- /dev/null +++ b/examples/turbidity/input @@ -0,0 +1,41 @@ +# Parallelization +Partition : 4 1 1 + +# Mesh definition +Lx : 0.05 +Ly : 0.01 +Lz : 1e-4 +nx : 250 +ny : 100 +nz : 1 + +# Time integration +Max timestep size : 1e-5 +Max cfl number : 1 +Max time : 10 + +# Fluid properties +Dynamic viscosity : 1.8e-5 +Density : 1000 +Gravity : 0.976030432437939 -9.761324940547519 0 +Inlet velocity : 0.1 + +# Particle parameters +Bed width : 0.01 +Particle volume fraction : 0.01 +Particle density : 1200 +Particle diameter : 50e-6 +Collision timescale : 15e-5 +Coefficient of restitution : 0.8 +Friction coefficient : 0.1 + +# Pressure solver +Pressure tolerance : 1e-5 +Pressure iteration : 100 + +# Implicit velocity solver +Implicit tolerance : 1e-6 +Implicit iteration : 100 + +# Ensight output +Ensight output period : 80e-5 \ No newline at end of file diff --git a/examples/turbidity/src/Make.package b/examples/turbidity/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/turbidity/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/turbidity/src/geometry.f90 b/examples/turbidity/src/geometry.f90 new file mode 100644 index 000000000..bc368dc17 --- /dev/null +++ b/examples/turbidity/src/geometry.f90 @@ -0,0 +1,84 @@ +!> Various definitions and tools for initializing NGA2 config +module geometry + use config_class, only: config + use precision, only: WP + implicit none + private + + !> Single config + type(config), public :: cfg + + public :: geometry_init + +contains + + + !> Initialization of problem geometry + subroutine geometry_init + use sgrid_class, only: sgrid + use param, only: param_read + implicit none + type(sgrid) :: grid + + + ! Create a grid from input params + create_grid: block + use sgrid_class, only: cartesian + integer :: i,j,k,nx,ny,nz + real(WP) :: Lx,Ly,Lz + real(WP), dimension(:), allocatable :: x,y,z + + ! Read in grid definition + call param_read('Lx',Lx); call param_read('nx',nx); allocate(x(nx+1)) + call param_read('Ly',Ly); call param_read('ny',ny); allocate(y(ny+1)) + call param_read('Lz',Lz); call param_read('nz',nz); allocate(z(nz+1)) + + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + do j=1,ny+1 + y(j)=real(j-1,WP)/real(ny,WP)*Ly + end do + do k=1,nz+1 + z(k)=real(k-1,WP)/real(nz,WP)*Lz-0.5_WP*Lz + end do + + ! General serial grid object + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='channel') + + end block create_grid + + + ! Create a config from that grid on our entire group + create_cfg: block + use parallel, only: group + integer, dimension(3) :: partition + + ! Read in partition + call param_read('Partition',partition,short='p') + + ! Create partitioned grid + cfg=config(grp=group,decomp=partition,grid=grid) + + end block create_cfg + + + ! Create masks for this config + create_walls: block + integer :: i,j,k + cfg%VF=1.0_WP + do k=cfg%kmino_,cfg%kmaxo_ + do j=cfg%jmino_,cfg%jmaxo_ + do i=cfg%imino_,cfg%imaxo_ + if (cfg%ym(j).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP + end do + end do + end do + end block create_walls + + + end subroutine geometry_init + + +end module geometry diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 new file mode 100644 index 000000000..c48ef05e2 --- /dev/null +++ b/examples/turbidity/src/simulation.f90 @@ -0,0 +1,543 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use lpt_class, only: lpt + use hypre_uns_class, only: hypre_uns + use hypre_str_class, only: hypre_str + use lowmach_class, only: lowmach + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Get an LPT solver, a lowmach solver, and corresponding time tracker, plus a couple of linear solvers + type(hypre_uns), public :: ps + type(hypre_str), public :: vs + type(lowmach), public :: fs + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(partmesh) :: pmesh + type(ensight) :: ens_out + type(event) :: ens_evt + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,lptfile,tfile + + public :: simulation_init,simulation_run,simulation_final + + !> Work arrays and fluid properties + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP) :: visc,rho,inlet_velocity + + !> Wallclock time for monitoring + type :: timer + real(WP) :: time_in + real(WP) :: time + real(WP) :: percent + end type timer + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + +contains + + + !> Function that localizes the bottom (y-) of the domain + function bottom_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.eq.pg%jmin) isIn=.true. + end function bottom_of_domain + + !> Function that localizes the top (y+) of the domain + function top_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (j.eq.pg%jmax+1) isIn=.true. + end function top_of_domain + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Initialize time tracker with 1 subiterations + initialize_timetracker: block + time=timetracker(amRoot=cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max time',time%tmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize timers + initialize_timers: block + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + end block initialize_timers + + + ! Create a low Mach flow solver with bconds + create_flow_solver: block + use hypre_uns_class, only: gmres_amg + use hypre_str_class, only: pcg_pfmg + use lowmach_class, only: dirichlet,clipped_neumann + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + ! Define boundary conditions + call fs%add_bcond(name='bottom',type=dirichlet,locator=bottom_of_domain,face='y',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='top',type=clipped_neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) + ! Assign constant density + call param_read('Density',rho); fs%rho=rho + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Assign acceleration of gravity + call param_read('Gravity',fs%gravity) + ! Configure pressure solver + ps=hypre_uns(cfg=cfg,name='Pressure',method=gmres_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_flow_solver + + + ! Allocate work arrays + allocate_work_arrays: block + allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(resW (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcUlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcVlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(srcWlp (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Ui (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize our LPT solver + initialize_lpt: block + use random, only: random_uniform + use mathtools, only: Pi + real(WP) :: dp,Wbed,VFavg,Volp + integer :: i,j,np + logical :: overlap + ! Create solver + lp=lpt(cfg=cfg,name='LPT') + ! Get drag model from the inpit + call param_read('Drag model',lp%drag_model,default='Tenneti') + ! Get particle density from the input + call param_read('Particle density',lp%rho) + ! Get particle diameter from the input + call param_read('Particle diameter',dp) + ! Set filter scale to 3.5*dx + lp%filter_width=3.5_WP*cfg%min_meshsize + + ! Root process initializes particles uniformly + call param_read('Bed width',Wbed) + call param_read('Particle volume fraction',VFavg) + if (lp%cfg%amRoot) then + ! Particle volume + Volp = Pi/6.0_WP*dp**3 + ! Get number of particles + np = Wbed*lp%cfg%yL*lp%cfg%zL*VFavg/Volp + call lp%resize(np) + ! Distribute particles + do i=1,np + ! Give position (avoid overlap) + overlap=.true. + do while(overlap) + lp%p(i)%pos=[random_uniform(0.0_WP,Wbed),& + & random_uniform(lp%cfg%y(lp%cfg%jmin)+0.5_WP*dp,lp%cfg%y(lp%cfg%jmax+1)-0.5_WP*dp),& + & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] + if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin_) + overlap=.false. + check: do j=1,i-1 + if (sqrt(sum((lp%p(i)%pos-lp%p(j)%pos)**2)).lt.0.5_WP*(lp%p(i)%d+lp%p(j)%d)) then + overlap=.true. + exit check + end if + end do check + end do + !print *, real(i,WP)/real(np,WP)*100.0_WP,'%' + ! Give id + lp%p(i)%id=int(i,8) + ! Set the diameter + lp%p(i)%d=dp + ! Set the temperature + lp%p(i)%T=298.15_WP + ! Give zero velocity + lp%p(i)%vel=0.0_WP + ! Give zero collision force + lp%p(i)%Acol=0.0_WP + lp%p(i)%Tcol=0.0_WP + ! Give zero dt + lp%p(i)%dt=0.0_WP + ! Locate the particle on the mesh + lp%p(i)%ind=lp%cfg%get_ijk_global(lp%p(i)%pos,[lp%cfg%imin,lp%cfg%jmin,lp%cfg%kmin]) + ! Activate the particle + lp%p(i)%flag=0 + end do + end if + call lp%sync() + + ! Get initial particle volume fraction + call lp%update_VF() + ! Set collision timescale + call param_read('Collision timescale',lp%tau_col,default=15.0_WP*time%dt) + ! Set coefficient of restitution + call param_read('Coefficient of restitution',lp%e_n) + call param_read('Wall restitution',lp%e_w,default=lp%e_n) + call param_read('Friction coefficient',lp%mu_f,default=0.0_WP) + ! Set gravity + call param_read('Gravity',lp%gravity) + if (lp%cfg%amRoot) then + print*,"===== Particle Setup Description =====" + print*,'Number of particles', np + print*,'Mean volume fraction',VFavg + end if + end block initialize_lpt + + + ! Create partmesh object for Lagrangian particle output + create_pmesh: block + integer :: i + pmesh=partmesh(nvar=1,nvec=1,name='lpt') + pmesh%varname(1)='diameter' + pmesh%vecname(1)='velocity' + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block create_pmesh + + + ! Initialize our velocity field + initialize_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Set inflow velocity/momentum + call fs%get_bcond('bottom',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP + fs%U(i,j,k) =0.0_WP + end do + ! Set density from particle volume fraction and store initial density + fs%rho=rho*(1.0_WP-lp%VF) + rho0=rho + ! Form momentum + call fs%rho_multiply + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + end block initialize_velocity + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='turbidity') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_particle('particles',pmesh) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('epsp',lp%VF) + call ens_out%add_scalar('pressure',fs%P) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create monitor filea + create_monitor: block + ! Prepare some info about fields + real(WP) :: cfl + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call fs%get_max() + call lp%get_max() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%add_column(lp%CFL_col,'Collision CFL') + call cflfile%write() + ! Create LPT monitor + lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') + call lptfile%add_column(time%n,'Timestep number') + call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp%VFmean,'VFp mean') + call lptfile%add_column(lp%VFmax,'VFp max') + call lptfile%add_column(lp%np,'Particle number') + call lptfile%add_column(lp%Umin,'Particle Umin') + call lptfile%add_column(lp%Umax,'Particle Umax') + call lptfile%add_column(lp%Vmin,'Particle Vmin') + call lptfile%add_column(lp%Vmax,'Particle Vmax') + call lptfile%add_column(lp%Wmin,'Particle Wmin') + call lptfile%add_column(lp%Wmax,'Particle Wmax') + call lptfile%add_column(lp%dmin,'Particle dmin') + call lptfile%add_column(lp%dmax,'Particle dmax') + call lptfile%write() + ! Create timing monitor + tfile=monitor(amroot=fs%cfg%amRoot,name='timing') + call tfile%add_column(time%n,'Timestep number') + call tfile%add_column(time%t,'Time') + call tfile%add_column(wt_total%time,'Total [s]') + call tfile%add_column(wt_vel%time,'Velocity [s]') + call tfile%add_column(wt_vel%percent,'Velocity [%]') + call tfile%add_column(wt_pres%time,'Pressure [s]') + call tfile%add_column(wt_pres%percent,'Pressure [%]') + call tfile%add_column(wt_lpt%time,'LPT [s]') + call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_rest%time,'Rest [s]') + call tfile%add_column(wt_rest%percent,'Rest [%]') + call tfile%write() + end block create_monitor + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + use mathtools, only: twoPi + use parallel, only: parallel_time + implicit none + real(WP) :: cfl + + ! Perform time integration + do while (.not.time%done()) + + ! Initial wallclock time + wt_total%time_in=parallel_time() + + ! Increment time + call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old density, velocity, and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Get fluid stress + wt_lpt%time_in=parallel_time() + call fs%get_div_stress(resU,resV,resW) + + ! Collide and advance particles + call lp%collide(dt=time%dtmid) + call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) + + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + wt_vel%time_in=parallel_time() + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Add momentum source terms + call fs%addsrc_gravity(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Add momentum source term from lpt + add_lpt_src: block + integer :: i,j,k + do k=fs%cfg%kmin_,fs%cfg%kmax_ + do j=fs%cfg%jmin_,fs%cfg%jmax_ + do i=fs%cfg%imin_,fs%cfg%imax_ + resU(i,j,k)=resU(i,j,k)+sum(fs%itpr_x(:,i,j,k)*srcUlp(i-1:i,j,k)) + resV(i,j,k)=resV(i,j,k)+sum(fs%itpr_y(:,i,j,k)*srcVlp(i,j-1:j,k)) + resW(i,j,k)=resW(i,j,k)+sum(fs%itpr_z(:,i,j,k)*srcWlp(i,j,k-1:k)) + end do + end do + end do + end block add_lpt_src + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('bottom',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP + fs%U(i,j,k) =0.0_WP + end do + end block dirichlet_velocity + + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Solve Poisson equation + wt_pres%time_in=parallel_time() + call fs%correct_mfr(drhodt=dRHOdt) + call fs%get_div(drhodt=dRHOdt) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + wt_pres%time=wt_pres%time+parallel_time()-wt_pres%time_in + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + wt_vel%time_in=parallel_time() + call fs%interp_vel(Ui,Vi,Wi) + call fs%get_div(drhodt=dRHOdt) + wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in + + ! Output to ensight + if (ens_evt%occurs()) then + update_pmesh: block + integer :: i + call lp%update_partmesh(pmesh) + do i=1,lp%np_ + pmesh%var(1,i)=lp%p(i)%d + pmesh%vec(:,1,i)=lp%p(i)%vel + end do + end block update_pmesh + call ens_out%write_data(time%t) + end if + + ! Perform and output monitoring + call fs%get_max() + call lp%get_max() + call mfile%write() + call cflfile%write() + call lptfile%write() + + ! Monitor timing + wt_total%time=parallel_time()-wt_total%time_in + wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP + wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP + wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP + call tfile%write() + wt_total%time=0.0_WP; wt_total%percent=0.0_WP + wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP + wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP + wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt) + + end subroutine simulation_final + +end module simulation From ba2af03244f2ecd025fcd8f418c078b9cd5234db Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 19:30:37 -0500 Subject: [PATCH 132/152] Update input output less frequently --- examples/turbidity/input | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/turbidity/input b/examples/turbidity/input index 7aef793c4..cb959333e 100644 --- a/examples/turbidity/input +++ b/examples/turbidity/input @@ -38,4 +38,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 80e-5 \ No newline at end of file +Ensight output period : 200e-5 \ No newline at end of file From 7110e21fe81fa374d2b65873db79b0bb54c8514b Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 19:31:00 -0500 Subject: [PATCH 133/152] Update ensight_class.f90 use correct file name --- src/data/ensight_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index 7f11f0588..251275920 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -703,7 +703,7 @@ subroutine write_part(this,part) write(iunit,'(a,/,a,/,/,a,/,a,/,a,/)') 'FORMAT','type: ensight gold','GEOMETRY','model: geometry','measured: 1 '//trim(part%name)//'/particle.******' ! Write the variables write(iunit,'(a)') 'VARIABLE' - write(iunit,'(a)') 'scalar per element: wall geometry.wall' + write(iunit,'(a)') 'scalar per element: wall geometry.fvf' do n=1,part%ptr%nvar write(iunit,'(a)') 'scalar per measured node: 1 '//trim(part%ptr%varname(n))//' '//trim(part%name)//'/'//trim(part%ptr%varname(n))//'.******' end do From eddf1b30b4b2c06451bedb27db9c6b7043698908 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 19:54:14 -0500 Subject: [PATCH 134/152] Added SGS to turbidity case Added SGS model to turbidity case --- examples/turbidity/GNUmakefile | 2 +- examples/turbidity/input | 2 +- examples/turbidity/src/simulation.f90 | 36 +++++++++++++++++++++++---- 3 files changed, 33 insertions(+), 7 deletions(-) diff --git a/examples/turbidity/GNUmakefile b/examples/turbidity/GNUmakefile index b561e0571..87a678827 100644 --- a/examples/turbidity/GNUmakefile +++ b/examples/turbidity/GNUmakefile @@ -30,7 +30,7 @@ HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := variable_density particles core data solver config grid libraries +Bdirs := subgrid variable_density particles core data solver config grid libraries Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) diff --git a/examples/turbidity/input b/examples/turbidity/input index cb959333e..629d77f61 100644 --- a/examples/turbidity/input +++ b/examples/turbidity/input @@ -15,7 +15,7 @@ Max cfl number : 1 Max time : 10 # Fluid properties -Dynamic viscosity : 1.8e-5 +Dynamic viscosity : 8.9e-4 Density : 1000 Gravity : 0.976030432437939 -9.761324940547519 0 Inlet velocity : 0.1 diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index c48ef05e2..9060e4f70 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -6,6 +6,7 @@ module simulation use hypre_uns_class, only: hypre_uns use hypre_str_class, only: hypre_str use lowmach_class, only: lowmach + use sgsmodel_class, only: sgsmodel use timetracker_class, only: timetracker use ensight_class, only: ensight use partmesh_class, only: partmesh @@ -19,6 +20,7 @@ module simulation type(hypre_str), public :: vs type(lowmach), public :: fs type(lpt), public :: lp + type(sgsmodel), public :: sgs type(timetracker), public :: time !> Ensight postprocessing @@ -32,6 +34,7 @@ module simulation public :: simulation_init,simulation_run,simulation_final !> Work arrays and fluid properties + real(WP), dimension(:,:,:,:), allocatable :: SR real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp @@ -43,7 +46,7 @@ module simulation real(WP) :: time real(WP) :: percent end type timer - type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_rest + type(timer) :: wt_total,wt_vel,wt_pres,wt_lpt,wt_sgs,wt_rest contains @@ -94,6 +97,7 @@ subroutine simulation_init wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP end block initialize_timers @@ -102,12 +106,12 @@ subroutine simulation_init create_flow_solver: block use hypre_uns_class, only: gmres_amg use hypre_str_class, only: pcg_pfmg - use lowmach_class, only: dirichlet,clipped_neumann + use lowmach_class, only: dirichlet,neumann ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name='bottom',type=dirichlet,locator=bottom_of_domain,face='y',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='top',type=clipped_neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) + call fs%add_bcond(name='top',type=neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity @@ -129,6 +133,7 @@ subroutine simulation_init ! Allocate work arrays allocate_work_arrays: block + allocate(SR (1:6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(dRHOdt (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resU (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resV (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) @@ -268,6 +273,12 @@ subroutine simulation_init call fs%get_mfr() end block initialize_velocity + + ! Create an LES model + create_sgs: block + sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) + end block create_sgs + ! Add Ensight output create_ensight: block @@ -281,6 +292,7 @@ subroutine simulation_init call ens_out%add_vector('velocity',Ui,Vi,Wi) call ens_out%add_scalar('epsp',lp%VF) call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_scalar('visc_sgs',sgs%visc) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -347,6 +359,8 @@ subroutine simulation_init call tfile%add_column(wt_pres%percent,'Pressure [%]') call tfile%add_column(wt_lpt%time,'LPT [s]') call tfile%add_column(wt_lpt%percent,'LPT [%]') + call tfile%add_column(wt_sgs%time,'SGS [s]') + call tfile%add_column(wt_sgs%percent,'SGS [%]') call tfile%add_column(wt_rest%time,'Rest [s]') call tfile%add_column(wt_rest%percent,'Rest [%]') call tfile%write() @@ -394,6 +408,16 @@ subroutine simulation_run dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in + ! Turbulence modeling + wt_sgs%time_in=parallel_time() + sgs_modeling: block + use sgsmodel_class, only: dynamic_smag + call fs%get_strainrate(SR) + call sgs%get_visc(type=dynamic_smag,dt=time%dtold,rho=rho0,Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) + fs%visc=visc+sgs%visc + end block sgs_modeling + wt_sgs%time=wt_sgs%time+parallel_time()-wt_sgs%time_in + ! Perform sub-iterations do while (time%it.le.time%itmax) @@ -511,13 +535,15 @@ subroutine simulation_run wt_vel%percent=wt_vel%time/wt_total%time*100.0_WP wt_pres%percent=wt_pres%time/wt_total%time*100.0_WP wt_lpt%percent=wt_lpt%time/wt_total%time*100.0_WP - wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time + wt_sgs%percent=wt_sgs%time/wt_total%time*100.0_WP + wt_rest%time=wt_total%time-wt_vel%time-wt_pres%time-wt_lpt%time-wt_sgs%time wt_rest%percent=wt_rest%time/wt_total%time*100.0_WP call tfile%write() wt_total%time=0.0_WP; wt_total%percent=0.0_WP wt_vel%time=0.0_WP; wt_vel%percent=0.0_WP wt_pres%time=0.0_WP; wt_pres%percent=0.0_WP wt_lpt%time=0.0_WP; wt_lpt%percent=0.0_WP + wt_sgs%time=0.0_WP; wt_sgs%percent=0.0_WP wt_rest%time=0.0_WP; wt_rest%percent=0.0_WP end do @@ -536,7 +562,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,SR) end subroutine simulation_final From af22221df919c7548209272d4aef2e6d7507db6b Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 20:52:17 -0500 Subject: [PATCH 135/152] Turbidity update Add walls at left and right (closed tank) --- examples/turbidity/src/geometry.f90 | 5 ++-- examples/turbidity/src/simulation.f90 | 39 +++++++++++++++++++++++++-- 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/examples/turbidity/src/geometry.f90 b/examples/turbidity/src/geometry.f90 index bc368dc17..5e7b7f848 100644 --- a/examples/turbidity/src/geometry.f90 +++ b/examples/turbidity/src/geometry.f90 @@ -45,7 +45,7 @@ subroutine geometry_init end do ! General serial grid object - grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.true.,yper=.false.,zper=.true.,name='channel') + grid=sgrid(coord=cartesian,no=2,x=x,y=y,z=z,xper=.false.,yper=.false.,zper=.true.,name='channel') end block create_grid @@ -71,7 +71,8 @@ subroutine geometry_init do k=cfg%kmino_,cfg%kmaxo_ do j=cfg%jmino_,cfg%jmaxo_ do i=cfg%imino_,cfg%imaxo_ - if (cfg%ym(j).lt.0.0_WP) cfg%VF(i,j,k)=0.0_WP + if (cfg%ym(j).lt.0.0_WP.or.cfg%xm(i).lt.0.0_WP.or.cfg%xm(i).gt.cfg%xL) & + & cfg%VF(i,j,k)=0.0_WP end do end do end do diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index 9060e4f70..2008d29a9 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -50,7 +50,28 @@ module simulation contains + !> Function that localizes the left (x-) of the domain + function left_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_of_domain + !> Function that localizes the right (x+) of the domain + function right_of_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + implicit none + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_of_domain + !> Function that localizes the bottom (y-) of the domain function bottom_of_domain(pg,i,j,k) result(isIn) use pgrid_class, only: pgrid @@ -110,6 +131,8 @@ subroutine simulation_init ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions + call fs%add_bcond(name='left',type=dirichlet,locator=left_of_domain,face='x',dir=-1,canCorrect=.false.) + call fs%add_bcond(name='right',type=dirichlet,locator=right_of_domain,face='x',dir=+1,canCorrect=.false.) call fs%add_bcond(name='bottom',type=dirichlet,locator=bottom_of_domain,face='y',dir=-1,canCorrect=.false.) call fs%add_bcond(name='top',type=neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) ! Assign constant density @@ -180,7 +203,7 @@ subroutine simulation_init ! Give position (avoid overlap) overlap=.true. do while(overlap) - lp%p(i)%pos=[random_uniform(0.0_WP,Wbed),& + lp%p(i)%pos=[random_uniform(0.5_WP*dp,Wbed),& & random_uniform(lp%cfg%y(lp%cfg%jmin)+0.5_WP*dp,lp%cfg%y(lp%cfg%jmax+1)-0.5_WP*dp),& & random_uniform(lp%cfg%z(lp%cfg%kmin),lp%cfg%z(lp%cfg%kmax+1))] if (lp%cfg%nz.eq.1) lp%p(i)%pos(3)=lp%cfg%zm(lp%cfg%kmin_) @@ -253,7 +276,19 @@ subroutine simulation_init integer :: n,i,j,k ! Zero initial field fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP - ! Set inflow velocity/momentum + ! Set no-slip walls + call fs%get_bcond('left',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP + fs%U(i,j,k) =0.0_WP + end do + call fs%get_bcond('right',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP + fs%U(i,j,k) =0.0_WP + end do call fs%get_bcond('bottom',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) From 37b768826f20955c24a446bd899d5cadf82974b7 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 21:52:34 -0500 Subject: [PATCH 136/152] Update simulation.f90 Clipped Neumann is more stable. --- examples/turbidity/src/simulation.f90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index 2008d29a9..fbbda5545 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -127,14 +127,14 @@ subroutine simulation_init create_flow_solver: block use hypre_uns_class, only: gmres_amg use hypre_str_class, only: pcg_pfmg - use lowmach_class, only: dirichlet,neumann + use lowmach_class, only: dirichlet,clipped_neumann ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name='left',type=dirichlet,locator=left_of_domain,face='x',dir=-1,canCorrect=.false.) call fs%add_bcond(name='right',type=dirichlet,locator=right_of_domain,face='x',dir=+1,canCorrect=.false.) call fs%add_bcond(name='bottom',type=dirichlet,locator=bottom_of_domain,face='y',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='top',type=neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) + call fs%add_bcond(name='top',type=clipped_neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity @@ -280,20 +280,23 @@ subroutine simulation_init call fs%get_bcond('left',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=0.0_WP - fs%U(i,j,k) =0.0_WP + fs%U(i,j,k)=0.0_WP + fs%V(i,j,k)=0.0_WP + fs%W(i,j,k)=0.0_WP end do call fs%get_bcond('right',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=0.0_WP - fs%U(i,j,k) =0.0_WP + fs%U(i,j,k)=0.0_WP + fs%V(i,j,k)=0.0_WP + fs%W(i,j,k)=0.0_WP end do call fs%get_bcond('bottom',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=0.0_WP - fs%U(i,j,k) =0.0_WP + fs%U(i,j,k)=0.0_WP + fs%V(i,j,k)=0.0_WP + fs%W(i,j,k)=0.0_WP end do ! Set density from particle volume fraction and store initial density fs%rho=rho*(1.0_WP-lp%VF) From 705b68fc8fdec11b6737f6900ddd27c5a13fbff6 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 14 Feb 2023 22:42:43 -0500 Subject: [PATCH 137/152] Turbidity updates. Freeze the fluid and sub-iterate on particles. Also restrict fluid dt using viscous CFL. Turned off SGS model for now, it was causing the viscous timestep to get way too small. --- examples/reacting_bed/src/simulation.f90 | 498 +++++++++++++++++++++++ examples/turbidity/input | 5 +- examples/turbidity/src/simulation.f90 | 79 ++-- 3 files changed, 549 insertions(+), 33 deletions(-) create mode 100644 examples/reacting_bed/src/simulation.f90 diff --git a/examples/reacting_bed/src/simulation.f90 b/examples/reacting_bed/src/simulation.f90 new file mode 100644 index 000000000..e68fb1884 --- /dev/null +++ b/examples/reacting_bed/src/simulation.f90 @@ -0,0 +1,498 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use hypre_uns_class, only: hypre_uns + use lowmach_class, only: lowmach + use vdscalar_class, only: vdscalar + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + implicit none + private + + !> Single low Mach flow solver and scalar solver and corresponding time tracker + type(hypre_uns), public :: ps + type(hypre_uns), public :: vs + type(hypre_uns), public :: ss + type(lowmach), public :: fs + type(vdscalar), public :: sc + type(lpt), public :: lp + type(timetracker), public :: time + + !> Ensight postprocessing + type(ensight) :: ens_out + type(event) :: ens_evt + type(partmesh) :: pmesh + + !> Simulation monitor file + type(monitor) :: mfile,cflfile,consfile,lptfile + + public :: simulation_init,simulation_run,simulation_final + + !> Private work arrays + real(WP), dimension(:,:,:), allocatable :: resU,resV,resW,resSC + real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi + real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + + !> Fluid properties + integer :: nscalar,ind_T,ind_CO2 + real(WP) :: visc,diff,rho,inlet_velocity + +contains + + + !> Function that localizes the right domain boundary + function right_boundary(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imax+1) isIn=.true. + end function right_boundary + + + !> Function that localizes the left domain boundary + function left_domain(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin) isIn=.true. + end function left_domain + + + !> Function that localizes the left domain boundary for scalars + function left_domain_sc(pg,i,j,k) result(isIn) + use pgrid_class, only: pgrid + class(pgrid), intent(in) :: pg + integer, intent(in) :: i,j,k + logical :: isIn + isIn=.false. + if (i.eq.pg%imin-1) isIn=.true. + end function left_domain_sc + + + !> Define here our equation of state + subroutine get_rho() + implicit none + integer :: i,j,k + real(WP) :: Z + ! Calculate density + do k=sc%cfg%kmino_,sc%cfg%kmaxo_ + do j=sc%cfg%jmino_,sc%cfg%jmaxo_ + do i=sc%cfg%imino_,sc%cfg%imaxo_ + Z=min(max(sc%SC(i,j,k),0.0_WP),1.0_WP) + sc%rho(i,j,k)=rho_jet*rho_cof/((1.0_WP-Z)*rho_jet+Z*rho_cof) + end do + end do + end do + end subroutine get_rho + + + !> Initialization of problem solver + subroutine simulation_init + use param, only: param_read + implicit none + + + ! Read in the EOS info and jet diameter + call param_read('Jet density',rho_jet) + call param_read('Coflow density',rho_cof) + call param_read('Jet diameter',D_jet) + call param_read('Jet velocity',U_jet) + call param_read('Coflow velocity',U_cof) + + + ! Create an incompressible flow solver with bconds + create_solver: block + use hypre_uns_class, only: pcg_amg + use lowmach_class, only: dirichlet,clipped_neumann + real(WP) :: visc + ! Create flow solver + fs=lowmach(cfg=cfg,name='Variable density low Mach NS') + ! Assign constant viscosity + call param_read('Dynamic viscosity',visc); fs%visc=visc + ! Define jet and coflow boundary conditions + call fs%add_bcond(name='jet' ,type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=jet ) + call fs%add_bcond(name='coflow',type=dirichlet,face='x',dir=-1,canCorrect=.false.,locator=coflow) + ! Outflow on the right + call fs%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true.,locator=right_boundary) + ! Configure pressure solver + ps=hypre_uns(cfg=cfg,name='Pressure',method=pcg_amg,nst=7) + call param_read('Pressure iteration',ps%maxit) + call param_read('Pressure tolerance',ps%rcvg) + ! Configure implicit velocity solver + vs=hypre_uns(cfg=cfg,name='Velocity',method=pcg_amg,nst=7) + call param_read('Implicit iteration',vs%maxit) + call param_read('Implicit tolerance',vs%rcvg) + ! Setup the solver + call fs%setup(pressure_solver=ps,implicit_solver=vs) + end block create_solver + + + ! Create a scalar solver + create_scalar: block + use hypre_uns_class, only: pcg_amg + use vdscalar_class, only: dirichlet,neumann,quick + real(WP) :: diffusivity + ! Create scalar solver + sc=vdscalar(cfg=cfg,scheme=quick,name='MixFrac') + ! Define jet and coflow boundary conditions + call sc%add_bcond(name='jet' ,type=dirichlet,locator=jetsc ) + call sc%add_bcond(name='coflow',type=dirichlet,locator=coflowsc) + ! Outflow on the right + call sc%add_bcond(name='outflow',type=neumann,locator=right_boundary,dir='+x') + ! Assign constant diffusivity + call param_read('Dynamic diffusivity',diffusivity) + sc%diff=diffusivity + ! Configure implicit scalar solver + ss=hypre_uns(cfg=cfg,name='Scalar',method=pcg_amg,nst=13) + ss%maxit=vs%maxit; ss%rcvg=vs%rcvg + ! Setup the solver + call sc%setup(implicit_solver=ss) + end block create_scalar + + + ! Allocate work arrays + allocate_work_arrays: block + ! Flow solver + allocate(resU(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(resV(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(resW(fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Ui (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Vi (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + allocate(Wi (fs%cfg%imino_:fs%cfg%imaxo_,fs%cfg%jmino_:fs%cfg%jmaxo_,fs%cfg%kmino_:fs%cfg%kmaxo_)) + ! Scalar solver + allocate(resSC(sc%cfg%imino_:sc%cfg%imaxo_,sc%cfg%jmino_:sc%cfg%jmaxo_,sc%cfg%kmino_:sc%cfg%kmaxo_)) + end block allocate_work_arrays + + + ! Initialize time tracker with 2 subiterations + initialize_timetracker: block + time=timetracker(amRoot=fs%cfg%amRoot) + call param_read('Max timestep size',time%dtmax) + call param_read('Max cfl number',time%cflmax) + time%dt=time%dtmax + time%itmax=2 + end block initialize_timetracker + + + ! Initialize our mixture fraction field + initialize_scalar: block + use vdscalar_class, only: bcond + integer :: n,i,j,k + type(bcond), pointer :: mybc + ! Zero initial field + sc%SC=0.0_WP + ! Apply BCs + call sc%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=1.0_WP + end do + call sc%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=0.0_WP + end do + ! Compute density + call get_rho() + end block initialize_scalar + + + ! Initialize our velocity field + initialize_velocity: block + use lowmach_class, only: bcond + integer :: n,i,j,k + type(bcond), pointer :: mybc + ! Zero initial field + fs%U=0.0_WP; fs%V=0.0_WP; fs%W=0.0_WP + ! Apply BCs + call fs%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_jet + end do + call fs%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_cof + end do + ! Set density from scalar + fs%rho=sc%rho + ! Form momentum + call fs%rho_multiply + ! Apply all other boundary conditions + call fs%apply_bcond(time%t,time%dt) + call fs%interp_vel(Ui,Vi,Wi) + resSC=0.0_WP + call fs%get_div(drhodt=resSC) + ! Compute MFR through all boundary conditions + call fs%get_mfr() + end block initialize_velocity + + + ! Add Ensight output + create_ensight: block + ! Create Ensight output from cfg + ens_out=ensight(cfg=cfg,name='vdjet') + ! Create event for Ensight output + ens_evt=event(time=time,name='Ensight output') + call param_read('Ensight output period',ens_evt%tper) + ! Add variables to output + call ens_out%add_scalar('pressure',fs%P) + call ens_out%add_vector('velocity',Ui,Vi,Wi) + call ens_out%add_scalar('divergence',fs%div) + call ens_out%add_scalar('density',sc%rho) + call ens_out%add_scalar('mixfrac',sc%SC) + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + end block create_ensight + + + ! Create a monitor file + create_monitor: block + ! Prepare some info about fields + call fs%get_cfl(time%dt,time%cfl) + call fs%get_max() + call sc%get_max() + call sc%get_int() + ! Create simulation monitor + mfile=monitor(fs%cfg%amRoot,'simulation') + call mfile%add_column(time%n,'Timestep number') + call mfile%add_column(time%t,'Time') + call mfile%add_column(time%dt,'Timestep size') + call mfile%add_column(time%cfl,'Maximum CFL') + call mfile%add_column(fs%Umax,'Umax') + call mfile%add_column(fs%Vmax,'Vmax') + call mfile%add_column(fs%Wmax,'Wmax') + call mfile%add_column(fs%Pmax,'Pmax') + call mfile%add_column(sc%SCmax,'Zmax') + call mfile%add_column(sc%SCmin,'Zmin') + call mfile%add_column(sc%rhomax,'RHOmax') + call mfile%add_column(sc%rhomin,'RHOmin') + call mfile%add_column(fs%divmax,'Maximum divergence') + call mfile%add_column(fs%psolv%it,'Pressure iteration') + call mfile%add_column(fs%psolv%rerr,'Pressure error') + call mfile%write() + ! Create CFL monitor + cflfile=monitor(fs%cfg%amRoot,'cfl') + call cflfile%add_column(time%n,'Timestep number') + call cflfile%add_column(time%t,'Time') + call cflfile%add_column(fs%CFLc_x,'Convective xCFL') + call cflfile%add_column(fs%CFLc_y,'Convective yCFL') + call cflfile%add_column(fs%CFLc_z,'Convective zCFL') + call cflfile%add_column(fs%CFLv_x,'Viscous xCFL') + call cflfile%add_column(fs%CFLv_y,'Viscous yCFL') + call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') + call cflfile%write() + ! Create conservation monitor + consfile=monitor(fs%cfg%amRoot,'conservation') + call consfile%add_column(time%n,'Timestep number') + call consfile%add_column(time%t,'Time') + call consfile%add_column(sc%SCint,'SC integral') + call consfile%add_column(sc%rhoint,'RHO integral') + call consfile%add_column(sc%rhoSCint,'rhoSC integral') + call consfile%write() + end block create_monitor + + + end subroutine simulation_init + + + !> Perform an NGA2 simulation + subroutine simulation_run + implicit none + + ! Perform time integration + do while (.not.time%done()) + + ! Increment time + call fs%get_cfl(time%dt,time%cfl) + call time%adjust_dt() + call time%increment() + + ! Remember old scalar + sc%rhoold=sc%rho + sc%SCold =sc%SC + + ! Remember old velocity and momentum + fs%rhoold=fs%rho + fs%Uold=fs%U; fs%rhoUold=fs%rhoU + fs%Vold=fs%V; fs%rhoVold=fs%rhoV + fs%Wold=fs%W; fs%rhoWold=fs%rhoW + + ! Apply time-varying Dirichlet conditions + ! This is where time-dpt Dirichlet would be enforced + + ! Perform sub-iterations + do while (time%it.le.time%itmax) + + ! ============= SCALAR SOLVER ======================= + ! Build mid-time scalar + sc%SC=0.5_WP*(sc%SC+sc%SCold) + + ! Explicit calculation of drhoSC/dt from scalar equation + call sc%get_drhoSCdt(resSC,fs%rhoU,fs%rhoV,fs%rhoW) + + ! Assemble explicit residual + resSC=time%dt*resSC-(2.0_WP*sc%rho*sc%SC-(sc%rho+sc%rhoold)*sc%SCold) + + ! Form implicit residual + call sc%solve_implicit(time%dt,resSC,fs%rhoU,fs%rhoV,fs%rhoW) + + ! Apply this residual + sc%SC=2.0_WP*sc%SC-sc%SCold+resSC + + ! Apply other boundary conditions on the resulting field + call sc%apply_bcond(time%t,time%dt) + + dirichlet_scalar: block + use vdscalar_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call sc%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=1.0_WP + end do + call sc%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + sc%SC(i,j,k)=0.0_WP + end do + end block dirichlet_scalar + + ! =================================================== + + ! ============ UPDATE PROPERTIES ==================== + ! Backup rhoSC + resSC=sc%rho*sc%SC + ! Update density + call get_rho() + ! Rescale scalar for conservation + sc%SC=resSC/sc%rho + ! UPDATE THE VISCOSITY + ! UPDATE THE DIFFUSIVITY + ! =================================================== + + ! ============ VELOCITY SOLVER ====================== + + ! Build n+1 density + fs%rho=0.5_WP*(sc%rho+sc%rhoold) + + ! Build mid-time velocity and momentum + fs%U=0.5_WP*(fs%U+fs%Uold); fs%rhoU=0.5_WP*(fs%rhoU+fs%rhoUold) + fs%V=0.5_WP*(fs%V+fs%Vold); fs%rhoV=0.5_WP*(fs%rhoV+fs%rhoVold) + fs%W=0.5_WP*(fs%W+fs%Wold); fs%rhoW=0.5_WP*(fs%rhoW+fs%rhoWold) + + ! Explicit calculation of drho*u/dt from NS + call fs%get_dmomdt(resU,resV,resW) + + ! Assemble explicit residual + resU=time%dtmid*resU-(2.0_WP*fs%rhoU-2.0_WP*fs%rhoUold) + resV=time%dtmid*resV-(2.0_WP*fs%rhoV-2.0_WP*fs%rhoVold) + resW=time%dtmid*resW-(2.0_WP*fs%rhoW-2.0_WP*fs%rhoWold) + + ! Form implicit residuals + call fs%solve_implicit(time%dtmid,resU,resV,resW) + + ! Apply these residuals + fs%U=2.0_WP*fs%U-fs%Uold+resU + fs%V=2.0_WP*fs%V-fs%Vold+resV + fs%W=2.0_WP*fs%W-fs%Wold+resW + + ! Apply other boundary conditions and update momentum + call fs%apply_bcond(time%tmid,time%dtmid) + call fs%rho_multiply() + call fs%apply_bcond(time%tmid,time%dtmid) + + ! Reset Dirichlet BCs + dirichlet_velocity: block + use lowmach_class, only: bcond + type(bcond), pointer :: mybc + integer :: n,i,j,k + call fs%get_bcond('jet',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_jet + end do + call fs%get_bcond('coflow',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%U(i,j,k)=U_cof + end do + call fs%rho_multiply() + end block dirichlet_velocity + + ! Solve Poisson equation + call sc%get_drhodt(dt=time%dt,drhodt=resSC) + !resSC=0.0_WP + call fs%correct_mfr(drhodt=resSC) + call fs%get_div(drhodt=resSC) + fs%psolv%rhs=-fs%cfg%vol*fs%div/time%dtmid + fs%psolv%sol=0.0_WP + call fs%psolv%solve() + call fs%shift_p(fs%psolv%sol) + + ! Correct momentum and rebuild velocity + call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) + fs%P=fs%P+fs%psolv%sol + fs%rhoU=fs%rhoU-time%dtmid*resU + fs%rhoV=fs%rhoV-time%dtmid*resV + fs%rhoW=fs%rhoW-time%dtmid*resW + call fs%rho_divide + ! =================================================== + + ! Increment sub-iteration counter + time%it=time%it+1 + + end do + + ! Recompute interpolated velocity and divergence + call fs%interp_vel(Ui,Vi,Wi) + call sc%get_drhodt(dt=time%dt,drhodt=resSC) + call fs%get_div(drhodt=resSC) + + ! Output to ensight + if (ens_evt%occurs()) call ens_out%write_data(time%t) + + ! Perform and output monitoring + call fs%get_max() + call sc%get_max() + call sc%get_int() + call mfile%write() + call cflfile%write() + call consfile%write() + + end do + + end subroutine simulation_run + + + !> Finalize the NGA2 simulation + subroutine simulation_final + implicit none + + ! Get rid of all objects - need destructors + ! monitor + ! ensight + ! bcond + ! timetracker + + ! Deallocate work arrays + deallocate(resSC,resU,resV,resW,Ui,Vi,Wi) + + end subroutine simulation_final + + + + + +end module simulation diff --git a/examples/turbidity/input b/examples/turbidity/input index 629d77f61..490a9f488 100644 --- a/examples/turbidity/input +++ b/examples/turbidity/input @@ -10,7 +10,7 @@ ny : 100 nz : 1 # Time integration -Max timestep size : 1e-5 +Max timestep size : 1e-3 Max cfl number : 1 Max time : 10 @@ -25,6 +25,7 @@ Bed width : 0.01 Particle volume fraction : 0.01 Particle density : 1200 Particle diameter : 50e-6 +LPT timestep size : 1e-5 Collision timescale : 15e-5 Coefficient of restitution : 0.8 Friction coefficient : 0.1 @@ -38,4 +39,4 @@ Implicit tolerance : 1e-6 Implicit iteration : 100 # Ensight output -Ensight output period : 200e-5 \ No newline at end of file +Ensight output period : 100e-4 \ No newline at end of file diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index fbbda5545..a47f70b6e 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -38,7 +38,11 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: tmp1,tmp2,tmp3 real(WP) :: visc,rho,inlet_velocity + + !> Max timestep size for LPT + real(WP) :: lp_dt !> Wallclock time for monitoring type :: timer @@ -168,6 +172,9 @@ subroutine simulation_init allocate(Vi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp1 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp2 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp3 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -188,6 +195,7 @@ subroutine simulation_init call param_read('Particle diameter',dp) ! Set filter scale to 3.5*dx lp%filter_width=3.5_WP*cfg%min_meshsize + call param_read('LPT timestep size',lp_dt,default=huge(1.0_WP)) ! Root process initializes particles uniformly call param_read('Bed width',Wbed) @@ -280,23 +288,17 @@ subroutine simulation_init call fs%get_bcond('left',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=0.0_WP - fs%V(i,j,k)=0.0_WP - fs%W(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP end do call fs%get_bcond('right',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=0.0_WP - fs%V(i,j,k)=0.0_WP - fs%W(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP end do call fs%get_bcond('bottom',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%U(i,j,k)=0.0_WP - fs%V(i,j,k)=0.0_WP - fs%W(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP end do ! Set density from particle volume fraction and store initial density fs%rho=rho*(1.0_WP-lp%VF) @@ -340,8 +342,8 @@ subroutine simulation_init create_monitor: block ! Prepare some info about fields real(WP) :: cfl - call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) - call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call lp%get_cfl(time%dt,cflc=time%cfl) + call fs%get_cfl(time%dt,cfl,cfl); time%cfl=max(time%cfl,cfl) call fs%get_max() call lp%get_max() ! Create simulation monitor @@ -421,8 +423,8 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) - call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) + call lp%get_cfl(time%dt,cflc=time%cfl) + call fs%get_cfl(time%dt,cfl,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() @@ -432,28 +434,43 @@ subroutine simulation_run fs%Vold=fs%V; fs%rhoVold=fs%rhoV fs%Wold=fs%W; fs%rhoWold=fs%rhoW - ! Get fluid stress wt_lpt%time_in=parallel_time() - call fs%get_div_stress(resU,resV,resW) - - ! Collide and advance particles - call lp%collide(dt=time%dtmid) - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& - srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) - - ! Update density based on particle volume fraction - fs%rho=rho*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + ! Particle update + lpt: block + real(WP) :: dt_done,mydt + ! Get fluid stress + call fs%get_div_stress(resU,resV,resW) + ! Zero-out LPT source terms + srcUlp=0.0_WP; srcVlp=0.0_WP; srcWlp=0.0_WP + ! Sub-iteratore + dt_done=0.0_WP + do while (dt_done.lt.time%dtmid) + ! Decide the timestep size + mydt=min(lp_dt,time%dtmid-dt_done) + ! Collide and advance particles + call lp%collide(dt=mydt) + call lp%advance(dt=mydt,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=tmp1,srcV=tmp2,srcW=tmp3) + srcUlp=srcUlp+tmp1 + srcVlp=srcVlp+tmp2 + srcWlp=srcWlp+tmp3 + ! Increment + dt_done=dt_done+mydt + end do + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + end block lpt wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in ! Turbulence modeling wt_sgs%time_in=parallel_time() - sgs_modeling: block - use sgsmodel_class, only: dynamic_smag - call fs%get_strainrate(SR) - call sgs%get_visc(type=dynamic_smag,dt=time%dtold,rho=rho0,Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) - fs%visc=visc+sgs%visc - end block sgs_modeling +!!$ sgs_modeling: block +!!$ use sgsmodel_class, only: dynamic_smag +!!$ call fs%get_strainrate(SR) +!!$ call sgs%get_visc(type=dynamic_smag,dt=time%dtold,rho=rho0,Ui=Ui,Vi=Vi,Wi=Wi,SR=SR) +!!$ fs%visc=visc+sgs%visc +!!$ end block sgs_modeling wt_sgs%time=wt_sgs%time+parallel_time()-wt_sgs%time_in ! Perform sub-iterations @@ -600,7 +617,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,SR) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,SR,tmp1,tmp2,tmp3) end subroutine simulation_final From 1ed02060a6a8151e6e2e61220ae42eaadc5fc7e4 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 15 Feb 2023 07:21:16 -0500 Subject: [PATCH 138/152] Update lowmach_class.f90 Added a slip BC (Neumann+no penetration) --- src/variable_density/lowmach_class.f90 | 31 +++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/src/variable_density/lowmach_class.f90 b/src/variable_density/lowmach_class.f90 index a87e99f95..1552965ca 100644 --- a/src/variable_density/lowmach_class.f90 +++ b/src/variable_density/lowmach_class.f90 @@ -20,6 +20,7 @@ module lowmach_class integer, parameter, public :: neumann=3 !< Zero normal gradient integer, parameter, public :: convective=4 !< Convective outflow condition integer, parameter, public :: clipped_neumann=5 !< Clipped Neumann condition (outflow only) + integer, parameter, public :: slip=6 !< Free-slip condition !> Boundary conditions for the low-Mach solver type :: bcond @@ -874,7 +875,7 @@ subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) ! Now adjust the metrics accordingly select case (new_bc%type) - case (dirichlet) !< Dirichlet is set one face (i.e., velocit component) at the time + case (dirichlet) !< Dirichlet is set one face (i.e., velocity component) at the time select case (new_bc%face) case ('x') do n=1,new_bc%itr%n_ @@ -896,6 +897,7 @@ subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) case (neumann) !< Neumann has to be at existing wall or at domain boundary! case (clipped_neumann) case (convective) + case (slip) case default call die('[lowmach apply_bcond] Unknown bcond type') end select @@ -958,7 +960,7 @@ subroutine apply_bcond(this,t,dt) ! This is done by the user directly ! Unclear whether we want to do this within the solver... - case (neumann,clipped_neumann) !< Apply Neumann condition to all three components + case (neumann,clipped_neumann,slip) !< Apply Neumann condition to all three components ! Handle index shift due to staggering stag=min(my_bc%dir,0) ! Implement based on bcond direction @@ -1026,7 +1028,30 @@ subroutine apply_bcond(this,t,dt) end do end select end if - + ! If needed, no penetration + if (my_bc%type.eq.slip) then + select case (my_bc%face) + case ('x') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%U(i,j,k)=0.0_WP + this%rhoU(i,j,k)=0.0_WP + end do + case ('y') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%V(i,j,k)=0.0_WP + this%rhoV(i,j,k)=0.0_WP + end do + case ('z') + do n=1,my_bc%itr%n_ + i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) + this%W(i,j,k)=0.0_WP + this%rhoW(i,j,k)=0.0_WP + end do + end select + end if + case (convective) ! Not implemented yet! case default From db0c35ecbfd20c1ab6a35aa85c2592fb2735429e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 15 Feb 2023 07:21:31 -0500 Subject: [PATCH 139/152] Update simulation.f90 Use free-sliip BC --- examples/turbidity/src/simulation.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index a47f70b6e..af332eef1 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -131,14 +131,14 @@ subroutine simulation_init create_flow_solver: block use hypre_uns_class, only: gmres_amg use hypre_str_class, only: pcg_pfmg - use lowmach_class, only: dirichlet,clipped_neumann + use lowmach_class, only: dirichlet,clipped_neumann,slip ! Create flow solver fs=lowmach(cfg=cfg,name='Variable density low Mach NS') ! Define boundary conditions call fs%add_bcond(name='left',type=dirichlet,locator=left_of_domain,face='x',dir=-1,canCorrect=.false.) call fs%add_bcond(name='right',type=dirichlet,locator=right_of_domain,face='x',dir=+1,canCorrect=.false.) call fs%add_bcond(name='bottom',type=dirichlet,locator=bottom_of_domain,face='y',dir=-1,canCorrect=.false.) - call fs%add_bcond(name='top',type=clipped_neumann,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) + call fs%add_bcond(name='top',type=slip,locator=top_of_domain,face='y',dir=+1,canCorrect=.true. ) ! Assign constant density call param_read('Density',rho); fs%rho=rho ! Assign constant viscosity From ed6b25e8d29644f5186ddee6c234514208e48053 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 16 Feb 2023 14:09:33 -0500 Subject: [PATCH 140/152] Riser update Define target MFR based on bulk velocity in the absence of particles --- examples/riser/input | 8 ++------ examples/riser/src/simulation.f90 | 22 +++++++++++----------- 2 files changed, 13 insertions(+), 17 deletions(-) diff --git a/examples/riser/input b/examples/riser/input index 113ba63b7..d98d6dd4b 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -1,9 +1,5 @@ # Parallelization -<<<<<<< HEAD -Partition : 1 4 1 -======= Partition : 4 1 1 ->>>>>>> 0880680ec7b2954ab0dc78cfd2b7af281a5e034b # Mesh definition Pipe length : 0.08 @@ -18,7 +14,7 @@ Max cfl number : 1 Max time : 10 # Fluid properties -Bulk velocity : 0.272 +Bulk velocity : 2.3 Dynamic viscosity : 1.8e-5 Density : 1.2 Gravity : -9.81 0 0 @@ -47,4 +43,4 @@ Postproc output period : 200e-5 # Restart files Restart output period : 200e-5 -!Restart from : 2.00000E-04 +!Restart from : 2.00000E-04 \ No newline at end of file diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 02851b4b9..8a8b127fb 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -416,19 +416,26 @@ subroutine simulation_init ! Initialize our velocity field initialize_velocity: block real(WP) :: Ubulk + ! Store fluid density without volume fractioin + fs%rho=rho; rho0=rho + ! Get velocity and mass flowrate if (restarted) then call df%pullvar(name='U',var=fs%U) call df%pullvar(name='V',var=fs%V) call df%pullvar(name='W',var=fs%W) call df%pullvar(name='P',var=fs%P) + call df%pullval(name='mfr',val=mfr) + call df%pullval(name='bforce',val=bforce) else - ! Initial velocity call param_read('Bulk velocity',Ubulk) fs%U=Ubulk; fs%V=0.0_WP; fs%W=0.0_WP; fs%P=0.0_WP + call fs%rho_multiply + ! Get target MFR using bulk velocity in absence of particles + mfr=get_bodyforce_mfr() + bforce=0.0_WP end if - ! Set density from particle volume fraction and store initial density + ! Set density from particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) - rho0=rho ! Form momentum call fs%rho_multiply fs%rhoUold=fs%rhoU @@ -438,14 +445,7 @@ subroutine simulation_init call fs%get_div(drhodt=dRHOdt) ! Compute MFR through all boundary conditions call fs%get_mfr() - ! Set initial MFR and body force - if (restarted) then - call df%pullval(name='mfr',val=mfr) - call df%pullval(name='bforce',val=bforce) - else - mfr=get_bodyforce_mfr() - bforce=0.0_WP - end if + ! Store target MFR mfr_target=mfr end block initialize_velocity From 053345b9a255439a5f445e6644dda1b358851a95 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 16 Feb 2023 14:49:56 -0500 Subject: [PATCH 141/152] Riser update Sub-iterate particles at each fluid timestep. Monitor lpt timestep size. --- examples/riser/input | 3 +- examples/riser/src/simulation.f90 | 58 +++++++++++++++++++++++-------- 2 files changed, 45 insertions(+), 16 deletions(-) diff --git a/examples/riser/input b/examples/riser/input index d98d6dd4b..c6a1cf8ea 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -20,6 +20,8 @@ Density : 1.2 Gravity : -9.81 0 0 # Particle properties +Particle timestep size : 1e-6 +Collision timescale : 15e-6 Particle volume fraction : 0.02 Particle mean diameter : 58e-6 Particle standard deviation : 25-6 @@ -27,7 +29,6 @@ Particle min diameter : 21e-6 Particle max diameter : 140e-6 Particle diameter shift : 8e-6 Particle density : 2250 -Collision timescale : 15e-5 Coefficient of restitution : 0.8 Friction coefficient : 0.1 diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 8a8b127fb..073d48a0c 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -45,10 +45,14 @@ module simulation real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi,rho0,dRHOdt real(WP), dimension(:,:,:), allocatable :: srcUlp,srcVlp,srcWlp + real(WP), dimension(:,:,:), allocatable :: tmp1,tmp2,tmp3 real(WP), dimension(:,:,:), allocatable :: G real(WP), dimension(:,:,:,:), allocatable :: Gnorm real(WP) :: visc,rho,mfr,mfr_target,bforce + !> Max timestep size for LPT + real(WP) :: lp_dt,lp_dt_max + !> Wallclock time for monitoring type :: timer real(WP) :: time_in @@ -246,6 +250,9 @@ subroutine simulation_init allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(rho0 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp1 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp2 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(tmp3 (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(Gnorm (1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays @@ -283,6 +290,9 @@ subroutine simulation_init dmin=dmean dmax=dmean end if + ! Maximum timestep size used for particles + call param_read('Particle timestep size',lp_dt_max,default=huge(1.0_WP)) + lp_dt=lp_dt_max ! Get particle temperature from input call param_read('Particle temperature',Tp,default=298.15_WP) ! Set collision timescale @@ -492,7 +502,7 @@ subroutine simulation_init create_monitor: block real(WP) :: cfl ! Prepare some info about fields - call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl) call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call fs%get_max() call lp%get_max() @@ -528,6 +538,7 @@ subroutine simulation_init lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') call lptfile%add_column(time%n,'Timestep number') call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp_dt,'Particle dt') call lptfile%add_column(lp%VFmean,'VFp mean') call lptfile%add_column(lp%VFmax,'VFp max') call lptfile%add_column(lp%np,'Particle number') @@ -583,7 +594,7 @@ subroutine simulation_run wt_total%time_in=parallel_time() ! Increment time - call lp%get_cfl(time%dt,cflc=time%cfl,cfl=time%cfl) + call lp%get_cfl(time%dt,cflc=time%cfl) call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() @@ -594,19 +605,36 @@ subroutine simulation_run fs%Vold=fs%V; fs%rhoVold=fs%rhoV fs%Wold=fs%W; fs%rhoWold=fs%rhoW - ! Get fluid stress (include mean body force from mfr forcing) + ! Particle update wt_lpt%time_in=parallel_time() - call fs%get_div_stress(resU,resV,resW) - resU=resU+bforce - - ! Collide and advance particles - call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) - call lp%advance(dt=time%dtmid,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& - srcU=srcUlp,srcV=srcVlp,srcW=srcWlp) - - ! Update density based on particle volume fraction - fs%rho=rho*(1.0_WP-lp%VF) - dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + lpt: block + real(WP) :: dt_done,mydt + ! Get fluid stress + call fs%get_div_stress(resU,resV,resW) + resU=resU+bforce + ! Zero-out LPT source terms + srcUlp=0.0_WP; srcVlp=0.0_WP; srcWlp=0.0_WP + ! Sub-iteratore + call lp%get_cfl(lp_dt,cflc=cfl,cfl=cfl) + if (cfl.gt.0.0_WP) lp_dt=min(lp_dt*time%cflmax/cfl,lp_dt_max) + dt_done=0.0_WP + do while (dt_done.lt.time%dtmid) + ! Decide the timestep size + mydt=min(lp_dt,time%dtmid-dt_done) + ! Collide and advance particles + call lp%collide(dt=mydt) + call lp%advance(dt=mydt,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& + srcU=tmp1,srcV=tmp2,srcW=tmp3) + srcUlp=srcUlp+tmp1 + srcVlp=srcVlp+tmp2 + srcWlp=srcWlp+tmp3 + ! Increment + dt_done=dt_done+mydt + end do + ! Update density based on particle volume fraction + fs%rho=rho*(1.0_WP-lp%VF) + dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + end block lpt wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in ! Perform sub-iterations @@ -809,7 +837,7 @@ subroutine simulation_final ! timetracker ! Deallocate work arrays - deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm) + deallocate(resU,resV,resW,srcUlp,srcVlp,srcWlp,Ui,Vi,Wi,dRHOdt,G,Gnorm,tmp1,tmp2,tmp3) end subroutine simulation_final From ae8be77548e24a456f8137aba19f5b7c79846d0e Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 17 Feb 2023 16:45:10 -0500 Subject: [PATCH 142/152] Update simulation.f90 Oops! Need to account for collisions with walls --- examples/riser/src/simulation.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 073d48a0c..9a7b6ca9f 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -622,7 +622,7 @@ subroutine simulation_run ! Decide the timestep size mydt=min(lp_dt,time%dtmid-dt_done) ! Collide and advance particles - call lp%collide(dt=mydt) + call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) call lp%advance(dt=mydt,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& srcU=tmp1,srcV=tmp2,srcW=tmp3) srcUlp=srcUlp+tmp1 From e77a969d853d02ddd8b4009662d96822b4ca9554 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 21 Feb 2023 09:17:28 -0500 Subject: [PATCH 143/152] Update simulation.f90 Probably not needed but explicitly set no-slip --- examples/turbidity/src/simulation.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index af332eef1..0d48e0b5f 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -515,7 +515,7 @@ subroutine simulation_run fs%U=2.0_WP*fs%U-fs%Uold+resU fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW - + ! Apply other boundary conditions and update momentum call fs%apply_bcond(time%tmid,time%dtmid) call fs%rho_multiply() @@ -529,8 +529,20 @@ subroutine simulation_run call fs%get_bcond('bottom',mybc) do n=1,mybc%itr%no_ i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) - fs%rhoU(i,j,k)=0.0_WP - fs%U(i,j,k) =0.0_WP + fs%rhoU(i,j,k)=0.0_WP; fs%rhoV(i,j,k)=0.0_WP; fs%rhoW(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP + end do + call fs%get_bcond('left',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP; fs%rhoV(i,j,k)=0.0_WP; fs%rhoW(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP + end do + call fs%get_bcond('right',mybc) + do n=1,mybc%itr%no_ + i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n) + fs%rhoU(i,j,k)=0.0_WP; fs%rhoV(i,j,k)=0.0_WP; fs%rhoW(i,j,k)=0.0_WP + fs%U(i,j,k)=0.0_WP; fs%V(i,j,k)=0.0_WP; fs%W(i,j,k)=0.0_WP end do end block dirichlet_velocity From dff323049d33412cb7e4d1a0785c4f2abe3724db Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 21 Feb 2023 09:44:45 -0500 Subject: [PATCH 144/152] Changes to turbidity Better sub-iterator and monitor lp_dt --- examples/turbidity/input | 2 +- examples/turbidity/src/simulation.f90 | 17 ++++++++++++----- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/examples/turbidity/input b/examples/turbidity/input index 490a9f488..85a549f9a 100644 --- a/examples/turbidity/input +++ b/examples/turbidity/input @@ -25,7 +25,7 @@ Bed width : 0.01 Particle volume fraction : 0.01 Particle density : 1200 Particle diameter : 50e-6 -LPT timestep size : 1e-5 +Particle timestep size : 1e-5 Collision timescale : 15e-5 Coefficient of restitution : 0.8 Friction coefficient : 0.1 diff --git a/examples/turbidity/src/simulation.f90 b/examples/turbidity/src/simulation.f90 index 0d48e0b5f..120886d0c 100644 --- a/examples/turbidity/src/simulation.f90 +++ b/examples/turbidity/src/simulation.f90 @@ -42,7 +42,7 @@ module simulation real(WP) :: visc,rho,inlet_velocity !> Max timestep size for LPT - real(WP) :: lp_dt + real(WP) :: lp_dt,lp_dt_max !> Wallclock time for monitoring type :: timer @@ -195,7 +195,9 @@ subroutine simulation_init call param_read('Particle diameter',dp) ! Set filter scale to 3.5*dx lp%filter_width=3.5_WP*cfg%min_meshsize - call param_read('LPT timestep size',lp_dt,default=huge(1.0_WP)) + ! Maximum timestep size used for particles + call param_read('Particle timestep size',lp_dt_max,default=huge(1.0_WP)) + lp_dt=lp_dt_max ! Root process initializes particles uniformly call param_read('Bed width',Wbed) @@ -376,6 +378,7 @@ subroutine simulation_init lptfile=monitor(amroot=lp%cfg%amRoot,name='lpt') call lptfile%add_column(time%n,'Timestep number') call lptfile%add_column(time%t,'Time') + call lptfile%add_column(lp_dt,'Particle dt') call lptfile%add_column(lp%VFmean,'VFp mean') call lptfile%add_column(lp%VFmax,'VFp max') call lptfile%add_column(lp%np,'Particle number') @@ -405,7 +408,7 @@ subroutine simulation_init call tfile%add_column(wt_rest%percent,'Rest [%]') call tfile%write() end block create_monitor - + end subroutine simulation_init @@ -424,7 +427,7 @@ subroutine simulation_run ! Increment time call lp%get_cfl(time%dt,cflc=time%cfl) - call fs%get_cfl(time%dt,cfl,cfl); time%cfl=max(time%cfl,cfl) + call fs%get_cfl(time%dt,cfl); time%cfl=max(time%cfl,cfl) call time%adjust_dt() call time%increment() @@ -440,9 +443,13 @@ subroutine simulation_run real(WP) :: dt_done,mydt ! Get fluid stress call fs%get_div_stress(resU,resV,resW) + ! Get vorticity + call fs%get_vorticity(SR(1:3,:,:,:)) ! Zero-out LPT source terms srcUlp=0.0_WP; srcVlp=0.0_WP; srcWlp=0.0_WP ! Sub-iteratore + call lp%get_cfl(lp_dt,cflc=cfl,cfl=cfl) + if (cfl.gt.0.0_WP) lp_dt=min(lp_dt*time%cflmax/cfl,lp_dt_max) dt_done=0.0_WP do while (dt_done.lt.time%dtmid) ! Decide the timestep size @@ -450,7 +457,7 @@ subroutine simulation_run ! Collide and advance particles call lp%collide(dt=mydt) call lp%advance(dt=mydt,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& - srcU=tmp1,srcV=tmp2,srcW=tmp3) + vortx=SR(1,:,:,:),vorty=SR(2,:,:,:),vortz=SR(3,:,:,:),srcU=tmp1,srcV=tmp2,srcW=tmp3) srcUlp=srcUlp+tmp1 srcVlp=srcVlp+tmp2 srcWlp=srcWlp+tmp3 From b672fff73ddbb0b8f0e144cb41d4659fbd4800ae Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 21 Feb 2023 17:18:15 -0500 Subject: [PATCH 145/152] Update simulation.f90 Create restart directory once during initialization to avoid issues on clusters --- examples/riser/src/simulation.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 9a7b6ca9f..542d8e2b2 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -179,6 +179,8 @@ subroutine simulation_init ! Read the datafile df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) else + ! Prepare a new directory + if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') ! If we are not restarting, we will still need a datafile for saving restart files df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) df%valname(1)='t' @@ -805,8 +807,6 @@ subroutine simulation_run character(len=str_medium) :: timestamp ! Prefix for files write(timestamp,'(es12.5)') time%t - ! Prepare a new directory - if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') ! Populate df and write it call df%pushval(name='t' ,val=time%t ) call df%pushval(name='dt',val=time%dt ) From 394de02542e9d10efa410f45b28d0aa123c08d06 Mon Sep 17 00:00:00 2001 From: sthvkbht <121828677+sthvkbht@users.noreply.github.com> Date: Tue, 21 Feb 2023 19:01:39 -0500 Subject: [PATCH 146/152] Updated simulation.f90 for restart (#8) --- examples/riser/src/simulation.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 542d8e2b2..93ba9fe07 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -179,8 +179,8 @@ subroutine simulation_init ! Read the datafile df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) else - ! Prepare a new directory - if (fs%cfg%amRoot) call execute_command_line('mkdir -p restart') + ! Preparing a new directory for storing files for restart + call execute_command_line('mkdir -p restart') ! If we are not restarting, we will still need a datafile for saving restart files df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) df%valname(1)='t' From 8d4ba27fcad35f877bbe0adefcec0ceb3306d420 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 21 Feb 2023 19:19:17 -0500 Subject: [PATCH 147/152] Update simulation.f90 Cosmetic --- examples/riser/src/simulation.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 93ba9fe07..1167858d1 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -179,7 +179,7 @@ subroutine simulation_init ! Read the datafile df=datafile(pg=cfg,fdata='restart/data_'//trim(adjustl(timestamp))) else - ! Preparing a new directory for storing files for restart + ! Prepare a new directory for storing files for restart call execute_command_line('mkdir -p restart') ! If we are not restarting, we will still need a datafile for saving restart files df=datafile(pg=cfg,filename=trim(cfg%name),nval=4,nvar=4) From 7a6c17d2b699abeb0d332edbc59969248f696165 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Wed, 22 Feb 2023 16:42:53 -0500 Subject: [PATCH 148/152] Update lpt_class.f90 Added Aaron's implementation of computing PTKE and pseudo-turbulent Reynolds stress. Need to think carefully how best to take divergence of this and send to fluid. --- src/particles/lpt_class.f90 | 208 +++++++++++++++++++++++++++++++++++- 1 file changed, 206 insertions(+), 2 deletions(-) diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index e7782d88b..369ca6272 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -113,6 +113,9 @@ module lpt_class ! Particle volume fraction real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered + ! Pseudo-turbulent kinetic energy + real(WP), dimension(:,:,:), allocatable :: ptke !< Pseudo-turbulent kinetic energy, cell-centered + ! Filtering operation logical :: implicit_filter !< Solve implicitly real(WP) :: filter_width !< Characteristic filter width @@ -134,6 +137,7 @@ module lpt_class procedure :: get_max !< Extract various monitoring data procedure :: get_cfl !< Calculate maximum CFL procedure :: update_VF !< Compute particle volume fraction + procedure :: get_ptke !< Compute pseudo-turbulent kinetic energy (and Reynolds stress) procedure :: filter !< Apply volume filtering to field procedure :: inject !< Inject particles at a prescribed boundary end type lpt @@ -173,8 +177,9 @@ function constructor(cfg,name) result(self) ! Initialize MPI derived datatype for a particle call prepare_mpi_part() - ! Allocate VF and src arrays on cfg mesh - allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF =0.0_WP + ! Allocate VF and PTKE on cfg mesh + allocate(self%VF (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%VF=0.0_WP + allocate(self%ptke(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%ptke=0.0_WP ! Set filter width to zero by default self%filter_width=0.0_WP @@ -891,6 +896,205 @@ subroutine update_VF(this) end subroutine update_VF + !> Compute pseudo-turbulent kinetic energy and Reynolds stresses + !> Mehrabadi et al. (2015) "Pseudo-turbulent gas-phase velocity + !> fluctuations in homogeneous gas–solid flow: + !> fixed particle assemblies and freely evolving suspensions" + subroutine get_ptke(this,Ui,Vi,Wi,visc,rho,PTRS) + use mathtools, only: Pi + use messager, only: die + implicit none + class(lpt), intent(inout) :: this + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: PTRS !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(:,:,:), allocatable :: slip_x,slip_y,slip_z,Re + integer :: i,j,k + real(WP) :: Vp,frho,fvisc,pVF,Rep,b_par,b_perp + real(WP), dimension(3) :: fvel,slip + real(WP), parameter :: a=0.523_WP,b=0.305_WP,c=0.144_WP,d=3.511_WP,e=1.801_WP,f=0.005_WP + + ! Rotation variables + integer :: ind + real(WP), parameter :: one_third=1.0_WP/3.0_WP + real(WP) :: U1_dot,U2_dot,U3_dot,rhoK + real(WP), dimension(3) :: U1,U2,U3 + real(WP), dimension(3,3) :: Q,temp,bij + + ! Check PTRS's first dimension + if (size(PTRS,dim=1).ne.6) call die('[lpt get_ptke] PTRS should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + + allocate(slip_x(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP + allocate(slip_y(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP + allocate(slip_z(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP + allocate(Re(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); Re=0.0_WP + + ! Loop over all particles + do i=1,this%np_ + ! Skip inactive particle + if (this%p(i)%flag.eq.1.or.this%p(i)%id.eq.0) cycle + + ! Interpolate fluid quantities to particle location + fvel(1)=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Ui,bc='n') + fvel(2)=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Vi,bc='n') + fvel(3)=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Wi,bc='n') + fvisc=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=visc,bc='n') + fvisc=fvisc+epsilon(1.0_WP) + frho=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=rho,bc='n') + pVF=this%cfg%get_scalar(pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=this%VF,bc='n') + pVF=pVF+epsilon(1.0_WP) + + ! Compute particle slip and Reynolds number + slip=this%p(i)%vel-fvel + Rep=frho*norm2(slip)*this%p(i)%d/fvisc + + ! Transfer to the grid + Vp=Pi/6.0_WP*this%p(i)%d**3 + call this%cfg%set_scalar(Sp=Vp*slip(1)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_x,bc='n') + call this%cfg%set_scalar(Sp=Vp*slip(2)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_y,bc='n') + call this%cfg%set_scalar(Sp=Vp*slip(3)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_z,bc='n') + call this%cfg%set_scalar(Sp=Vp*Rep/pVF ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Re ,bc='n') + end do + slip_x=slip_x/this%cfg%vol + slip_y=slip_y/this%cfg%vol + slip_z=slip_z/this%cfg%vol + Re=Re/this%cfg%vol + ! Sum at boundaries + call this%cfg%syncsum(slip_x) + call this%cfg%syncsum(slip_y) + call this%cfg%syncsum(slip_z) + call this%cfg%syncsum(Re) + ! Apply volume filter + call this%filter(slip_x) + call this%filter(slip_y) + call this%filter(slip_z) + call this%filter(Re) + + PTRS=0.0_WP + do k=this%cfg%kmino_,this%cfg%kmaxo_ + do j=this%cfg%jmino_,this%cfg%jmaxo_ + do i=this%cfg%imino_,this%cfg%imaxo_ + ! Get Eulerian particle data (remove volume fraction) + slip(1)=slip_x(i,j,k) + slip(2)=slip_y(i,j,k) + slip(3)=slip_z(i,j,k) + Rep=Re(i,j,k) + pVF=this%VF(i,j,k) + + ! Compute PTKE + this%ptke(i,j,k) = 2.0_WP*pVF + 2.5_WP*pVF*(1.0_WP-pVF)**3*exp(-pVF*sqrt(Rep)) + this%ptke(i,j,k) = this%ptke(i,j,k)*0.5_WP*(Ui(i,j,k)**2+Vi(i,j,k)**2+Wi(i,j,k)**2) + + ! Assume isotropic in 2D + if (this%cfg%nx.eq.1) then + bij = 0.0_WP + bij(2,2) = 0.5_WP + bij(3,3) = 0.5_WP + else if (this%cfg%ny.eq.1) then + bij = 0.0_WP + bij(1,1) = 0.5_WP + bij(3,3) = 0.5_WP + else if (this%cfg%nz.eq.1) then + bij = 0.0_WP + bij(1,1) = 0.5_WP + bij(2,2) = 0.5_WP + else + ! Apply rotation in 3D + b_par = a/(1.0_WP+b*exp(-c*Rep))*exp(-d*pVF/(1.0_WP+e*exp(-f*Rep))) + b_perp = -0.5_WP*b_par + + ! Add trace + b_par = b_par + one_third + b_perp = b_perp + one_third + + ! Compute the reference axes + U1 = slip + U1_dot = dot_product(U1,U1)+epsilon(1.0_WP) + + ! Generate an orthonormal set based on max slip component + ind = maxloc(abs(U1),dim=1) + select case (ind) + case(1) + ! Max slip in x-direction + U2 = -(U1(2)/U1_dot)*U1 + U2(2) = 1.0_WP + U2(2) + U2_dot = dot_product(U2,U2)+epsilon(1.0_WP) + case(2) + ! Max slip in y-direction + U2 = -(U1(1)/U1_dot)*U1 + U2(1) = 1.0_WP + U2(1) + U2_dot = dot_product(U2,U2)+epsilon(1.0_WP) + case(3) + ! Max slip in z-direction + U2 = -(U1(1)/U1_dot)*U1 + U2(1) = 1.0_WP + U2(1) + U2_dot = dot_product(U2,U2)+epsilon(1.0_WP) + end select + + ! U3 right-hand coordinate system (cross product) + U3(1) = U1(2)*U2(3) - U1(3)*U2(2) + U3(2) = U1(3)*U2(1) - U1(1)*U2(3) + U3(3) = U1(1)*U2(2) - U1(2)*U2(1) + U3_dot = dot_product(U3,U3)+epsilon(1.0_WP) + + ! Normalize basis vectors + U1 = U1/sqrt(U1_dot) + U2 = U2/sqrt(U2_dot) + U3 = U3/sqrt(U3_dot) + + ! Construct rotation matrices + Q(:,1) = U1 + Q(:,2) = U2 + Q(:,3) = U3 + + ! Multiply Q by b^dag + temp(1,1) = Q(1,1)*b_par + temp(2,1) = Q(2,1)*b_par + temp(3,1) = Q(3,1)*b_par + + temp(1,2) = Q(1,2)*b_perp + temp(2,2) = Q(2,2)*b_perp + temp(3,2) = Q(3,2)*b_perp + + temp(1,3) = Q(1,3)*b_perp + temp(2,3) = Q(2,3)*b_perp + temp(3,3) = Q(3,3)*b_perp + + ! Multiply Q*b^dag (temp) by Q^T to get bij tensor + bij(1,1) = temp(1,1)*Q(1,1) + temp(1,2)*Q(1,2) + temp(1,3)*Q(1,3) + bij(1,2) = temp(1,1)*Q(2,1) + temp(1,2)*Q(2,2) + temp(1,3)*Q(2,3) + bij(1,3) = temp(1,1)*Q(3,1) + temp(1,2)*Q(3,2) + temp(1,3)*Q(3,3) + + bij(2,1) = temp(2,1)*Q(1,1) + temp(2,2)*Q(1,2) + temp(2,3)*Q(1,3) + bij(2,2) = temp(2,1)*Q(2,1) + temp(2,2)*Q(2,2) + temp(2,3)*Q(2,3) + bij(2,3) = temp(2,1)*Q(3,1) + temp(2,2)*Q(3,2) + temp(2,3)*Q(3,3) + + bij(3,1) = temp(3,1)*Q(1,1) + temp(3,2)*Q(1,2) + temp(3,3)*Q(1,3) + bij(3,2) = temp(3,1)*Q(2,1) + temp(3,2)*Q(2,2) + temp(3,3)*Q(2,3) + bij(3,3) = temp(3,1)*Q(3,1) + temp(3,2)*Q(3,2) + temp(3,3)*Q(3,3) + + end if + + ! Store the Reynolds stress + rhoK=rho(i,j,k)*this%ptke(i,j,k) + PTRS(1,i,j,k) = 2.0_WP*rhoK*bij(1,1) + PTRS(2,i,j,k) = 2.0_WP*rhoK*bij(2,2) + PTRS(3,i,j,k) = 2.0_WP*rhoK*bij(3,3) + PTRS(4,i,j,k) = 2.0_WP*rhoK*bij(1,2) + PTRS(5,i,j,k) = 2.0_WP*rhoK*bij(2,3) + PTRS(6,i,j,k) = 2.0_WP*rhoK*bij(1,3) + end do + end do + end do + + ! Clean up + deallocate(slip_x,slip_y,slip_z,Re) + end subroutine get_ptke + + !> Laplacian filtering operation subroutine filter(this,A) implicit none From 227ea21d00ea2808c39ebfcce681578ace386368 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Fri, 24 Feb 2023 17:26:23 -0500 Subject: [PATCH 149/152] PTKE seems to be working! get_PTKE returns optional (cell-centered) source terms for div of pseudo Reynolds stress. Needed to create interpolation operators in LPT to do this. --- examples/riser/src/simulation.f90 | 18 ++-- src/particles/lpt_class.f90 | 143 +++++++++++++++++++++++++----- 2 files changed, 131 insertions(+), 30 deletions(-) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 1167858d1..c1c950601 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -70,9 +70,9 @@ subroutine postproc() use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM use parallel, only: MPI_REAL_WP implicit none - integer :: iunit,ierr,i,j,k - real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ - character(len=str_medium) :: filename,timestamp +!!$ integer :: iunit,ierr,i,j,k +!!$ real(WP), dimension(:), allocatable :: Uavg,Uavg_,vol,vol_ +!!$ character(len=str_medium) :: filename,timestamp !!$ ! Allocate radial line storage !!$ allocate(Uavg (fs%cfg%jmin:fs%cfg%jmax)); Uavg =0.0_WP !!$ allocate(Uavg_(fs%cfg%jmin:fs%cfg%jmax)); Uavg_=0.0_WP @@ -265,7 +265,7 @@ subroutine simulation_init use mathtools, only: Pi,twoPi use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE,MPI_INTEGER use parallel, only: MPI_REAL_WP - real(WP) :: VFavg,Volp,Vol_,sumVolp,Tp,meand,dist,r,buf + real(WP) :: VFavg,Vol_,sumVolp,Tp,meand,r,buf real(WP) :: dmean,dsd,dmin,dmax,dshift real(WP), dimension(:), allocatable :: dp integer :: i,j,k,ii,jj,kk,nn,ip,jp,kp,np,offset,ierr @@ -323,7 +323,7 @@ subroutine simulation_init end do end do ! Get particle diameters - np=5*VFavg*Vol_/(pi*dmean**3/6.0_WP) + np=5*ceiling(VFavg*Vol_/(pi*dmean**3/6.0_WP)) allocate(dp(np)) sumVolp=0.0_WP; np=0 do while(sumVolp.lt.VFavg*Vol_) @@ -496,6 +496,7 @@ subroutine simulation_init call ens_out%add_scalar('levelset',G) call ens_out%add_scalar('pressure',fs%P) call ens_out%add_scalar('epsp',lp%VF) + call ens_out%add_scalar('ptke',lp%ptke) ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight @@ -624,7 +625,7 @@ subroutine simulation_run ! Decide the timestep size mydt=min(lp_dt,time%dtmid-dt_done) ! Collide and advance particles - call lp%collide(dt=time%dtmid,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) + call lp%collide(dt=mydt,Gib=G,Nxib=Gnorm(1,:,:,:),Nyib=Gnorm(2,:,:,:),Nzib=Gnorm(3,:,:,:)) call lp%advance(dt=mydt,U=fs%U,V=fs%V,W=fs%W,rho=rho0,visc=fs%visc,stress_x=resU,stress_y=resV,stress_z=resW,& srcU=tmp1,srcV=tmp2,srcW=tmp3) srcUlp=srcUlp+tmp1 @@ -636,6 +637,11 @@ subroutine simulation_run ! Update density based on particle volume fraction fs%rho=rho*(1.0_WP-lp%VF) dRHOdt=(fs%RHO-fs%RHOold)/time%dtmid + ! Compute PTKE and store source terms + call lp%get_ptke(dt=time%dtmid,Ui=Ui,Vi=Vi,Wi=Wi,visc=fs%visc,rho=fs%rho,srcU=tmp1,srcV=tmp2,srcW=tmp3) + srcUlp=srcUlp+tmp1 + srcVlp=srcVlp+tmp2 + srcWlp=srcWlp+tmp3 end block lpt wt_lpt%time=wt_lpt%time+parallel_time()-wt_lpt%time_in diff --git a/src/particles/lpt_class.f90 b/src/particles/lpt_class.f90 index 369ca6272..94da8154b 100644 --- a/src/particles/lpt_class.f90 +++ b/src/particles/lpt_class.f90 @@ -113,14 +113,15 @@ module lpt_class ! Particle volume fraction real(WP), dimension(:,:,:), allocatable :: VF !< Particle volume fraction, cell-centered - ! Pseudo-turbulent kinetic energy - real(WP), dimension(:,:,:), allocatable :: ptke !< Pseudo-turbulent kinetic energy, cell-centered - ! Filtering operation logical :: implicit_filter !< Solve implicitly real(WP) :: filter_width !< Characteristic filter width - real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator - real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator + real(WP), dimension(:,:,:,:), allocatable :: div_x,div_y,div_z !< Divergence operator + real(WP), dimension(:,:,:,:), allocatable :: grd_x,grd_y,grd_z !< Gradient operator + + ! Pseudo turbulence + real(WP), dimension(:,:,:), allocatable :: ptke !< Pseudo-turbulent kinetic energy, cell-centered + real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation from cell face to cell center contains procedure :: update_partmesh !< Update a partmesh object using current particles @@ -223,6 +224,21 @@ function constructor(cfg,name) result(self) end do end do + ! Allocate finite difference density interpolation coefficients + allocate(self%itpr_x(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< X-face-centered + allocate(self%itpr_y(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Y-face-centered + allocate(self%itpr_z(-1:0,self%cfg%imin_:self%cfg%imax_+1,self%cfg%jmin_:self%cfg%jmax_+1,self%cfg%kmin_:self%cfg%kmax_+1)) !< Z-face-centered + ! Create density interpolation coefficients to cell face + do k=self%cfg%kmin_,self%cfg%kmax_+1 + do j=self%cfg%jmin_,self%cfg%jmax_+1 + do i=self%cfg%imin_,self%cfg%imax_+1 + self%itpr_x(:,i,j,k)=self%cfg%dxmi(i)*[self%cfg%xm(i)-self%cfg%x(i),self%cfg%x(i)-self%cfg%xm(i-1)] !< Linear interpolation in x from [xm,ym,zm] to [x,ym,zm] + self%itpr_y(:,i,j,k)=self%cfg%dymi(j)*[self%cfg%ym(j)-self%cfg%y(j),self%cfg%y(j)-self%cfg%ym(j-1)] !< Linear interpolation in y from [xm,ym,zm] to [xm,y,zm] + self%itpr_z(:,i,j,k)=self%cfg%dzmi(k)*[self%cfg%zm(k)-self%cfg%z(k),self%cfg%z(k)-self%cfg%zm(k-1)] !< Linear interpolation in z from [xm,ym,zm] to [xm,ym,z] + end do + end do + end do + ! Loop over the domain and zero divergence in walls do k=self%cfg%kmin_,self%cfg%kmax_ do j=self%cfg%jmin_,self%cfg%jmax_ @@ -652,7 +668,7 @@ subroutine advance(this,dt,U,V,W,rho,visc,stress_x,stress_y,stress_z,vortx,vorty real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcE !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - integer :: i,j,k,ierr + integer :: i,ierr real(WP) :: mydt,dt_done,deng,Ip real(WP), dimension(3) :: acc,torque,dmom real(WP), dimension(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_) :: sx,sy,sz @@ -900,18 +916,23 @@ end subroutine update_VF !> Mehrabadi et al. (2015) "Pseudo-turbulent gas-phase velocity !> fluctuations in homogeneous gas–solid flow: !> fixed particle assemblies and freely evolving suspensions" - subroutine get_ptke(this,Ui,Vi,Wi,visc,rho,PTRS) + subroutine get_ptke(this,dt,Ui,Vi,Wi,visc,rho,srcU,srcV,srcW) use mathtools, only: Pi use messager, only: die implicit none class(lpt), intent(inout) :: this - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) - real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: PTRS !< Needs to be (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), intent(inout) :: dt !< Timestep size over which to advance + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Ui !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Vi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: Wi !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: rho !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: visc !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcU !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) + real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout), optional :: srcW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(:,:,:), allocatable :: slip_x,slip_y,slip_z,Re + real(WP), dimension(:,:,:,:), allocatable :: PTRS + real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ integer :: i,j,k real(WP) :: Vp,frho,fvisc,pVF,Rep,b_par,b_perp real(WP), dimension(3) :: fvel,slip @@ -924,13 +945,11 @@ subroutine get_ptke(this,Ui,Vi,Wi,visc,rho,PTRS) real(WP), dimension(3) :: U1,U2,U3 real(WP), dimension(3,3) :: Q,temp,bij - ! Check PTRS's first dimension - if (size(PTRS,dim=1).ne.6) call die('[lpt get_ptke] PTRS should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - allocate(slip_x(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP - allocate(slip_y(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP - allocate(slip_z(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_x=0.0_WP + allocate(slip_y(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_y=0.0_WP + allocate(slip_z(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); slip_z=0.0_WP allocate(Re(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)); Re=0.0_WP + allocate(PTRS(1:6,this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) ! Loop over all particles do i=1,this%np_ @@ -956,7 +975,7 @@ subroutine get_ptke(this,Ui,Vi,Wi,visc,rho,PTRS) call this%cfg%set_scalar(Sp=Vp*slip(1)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_x,bc='n') call this%cfg%set_scalar(Sp=Vp*slip(2)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_y,bc='n') call this%cfg%set_scalar(Sp=Vp*slip(3)/pVF,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=slip_z,bc='n') - call this%cfg%set_scalar(Sp=Vp*Rep/pVF ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Re ,bc='n') + call this%cfg%set_scalar(Sp=Vp*Rep/pVF ,pos=this%p(i)%pos,i0=this%p(i)%ind(1),j0=this%p(i)%ind(2),k0=this%p(i)%ind(3),S=Re ,bc='n') end do slip_x=slip_x/this%cfg%vol slip_y=slip_y/this%cfg%vol @@ -1089,9 +1108,86 @@ subroutine get_ptke(this,Ui,Vi,Wi,visc,rho,PTRS) end do end do end do - + + ! Return source terms + if (present(srcU)) then + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + ! Interpolate PTRS to cell face + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=sum(this%itpr_x(:,i,j,k)*PTRS(1,i-1:i,j,k)) + FY(i,j,k)=sum(this%itpr_y(:,i,j,k)*PTRS(4,i,j-1:j,k)) + FZ(i,j,k)=sum(this%itpr_z(:,i,j,k)*PTRS(6,i,j,k-1:k)) + end do + end do + end do + ! Take divergence + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + srcU(i,j,k)=-dt*(sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1))) + end do + end do + end do + call this%cfg%sync(srcU) + deallocate(FX,FY,FZ) + end if + if (present(srcV)) then + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + ! Interpolate PTRS to cell face + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=sum(this%itpr_x(:,i,j,k)*PTRS(4,i-1:i,j,k)) + FY(i,j,k)=sum(this%itpr_y(:,i,j,k)*PTRS(2,i,j-1:j,k)) + FZ(i,j,k)=sum(this%itpr_z(:,i,j,k)*PTRS(5,i,j,k-1:k)) + end do + end do + end do + ! Take divergence + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + srcV(i,j,k)=-dt*(sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1))) + end do + end do + end do + call this%cfg%sync(srcV) + deallocate(FX,FY,FZ) + end if + if (present(srcW)) then + allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + ! Interpolate PTRS to cell face + do k=this%cfg%kmin_,this%cfg%kmax_+1 + do j=this%cfg%jmin_,this%cfg%jmax_+1 + do i=this%cfg%imin_,this%cfg%imax_+1 + FX(i,j,k)=sum(this%itpr_x(:,i,j,k)*PTRS(6,i-1:i,j,k)) + FY(i,j,k)=sum(this%itpr_y(:,i,j,k)*PTRS(5,i,j-1:j,k)) + FZ(i,j,k)=sum(this%itpr_z(:,i,j,k)*PTRS(3,i,j,k-1:k)) + end do + end do + end do + ! Take divergence + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + srcW(i,j,k)=-dt*(sum(this%div_x(:,i,j,k)*FX(i:i+1,j,k))+sum(this%div_y(:,i,j,k)*FY(i,j:j+1,k))+sum(this%div_z(:,i,j,k)*FZ(i,j,k:k+1))) + end do + end do + end do + call this%cfg%sync(srcW) + deallocate(FX,FY,FZ) + end if + ! Clean up - deallocate(slip_x,slip_y,slip_z,Re) + deallocate(slip_x,slip_y,slip_z,Re,PTRS) end subroutine get_ptke @@ -1384,7 +1480,6 @@ function get_position() result(pos) implicit none real(WP), dimension(3) :: pos real(WP) :: rand,r,theta - integer :: ip,jp,kp ! Set x position pos(1) = this%inj_pos(1) ! Random y & z position within a circular region @@ -1637,8 +1732,8 @@ subroutine share(this,nover) type(part), dimension(:), allocatable :: torecv integer :: no,nsend,nrecv type(MPI_Status) :: status - integer :: icnt,isrc,idst,ierr - integer :: i,n + integer :: isrc,idst,ierr + integer :: n ! Check overlap size if (present(nover)) then From f70757cf4fcf0adbf97c32f15c77a32f643f99eb Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Mon, 27 Feb 2023 16:39:36 -0500 Subject: [PATCH 150/152] separated fourier solver from transform --- examples/hit/GNUmakefile | 6 +- examples/hit/input | 5 +- examples/hit/src/simulation.f90 | 128 +- examples/ib_pipe/src/simulation.f90 | 144 +- examples/riser/GNUmakefile | 6 +- examples/riser/input | 6 +- examples/riser/src/simulation.f90 | 44 +- src/solver/Make.package | 2 +- src/solver/fourier3d_class.f90 | 2300 +++++++++++++-------------- src/solver/fouriersolver_class.f90 | 278 ++++ src/solver/linsol_class.f90 | 34 +- 11 files changed, 1541 insertions(+), 1412 deletions(-) create mode 100644 src/solver/fouriersolver_class.f90 diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index dc04f19b6..f5f8dfd1c 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -24,9 +24,9 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # External libraries are defined in .profile/.bashrc/.zshrc, but could be defined here as well -LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 +#LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +#HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +#FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/hit/input b/examples/hit/input index 217bfedbe..e6ab91b4c 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -22,5 +22,6 @@ Max iter : 9999999 Ensight output period : 0.1 # Restart -Restart output period : 200e-3 -# Restart from : 1.00044E-02 \ No newline at end of file +Restart output period : 200e-3 +# Restart from : 1.00044E-02 + diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index 4ef5f9501..ca379b2c8 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -1,24 +1,24 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use fourier3d_class, only: fourier3d - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - use datafile_class, only: datafile - use string, only: str_medium + use precision, only: WP + use geometry, only: cfg + use fouriersolver_class, only: fouriersolver + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use datafile_class, only: datafile + use string, only: str_medium implicit none private - + !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - type(fourier3d), public :: ps - type(incomp), public :: fs - type(timetracker), public :: time - + type(fouriersolver), public :: ps + type(incomp), public :: fs + type(timetracker), public :: time + !> Ensight postprocessing type(partmesh) :: pmesh type(ensight) :: ens_out @@ -28,18 +28,18 @@ module simulation type(event) :: save_evt type(datafile) :: df logical :: restarted - + !> Simulation monitor file type(monitor) :: mfile,cflfile,hitfile,tfile,ssfile - + public :: simulation_init,simulation_run,simulation_final - + !> Private work arrays real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi real(WP), dimension(:,:,:,:), allocatable :: SR real(WP), dimension(:,:,:,:,:), allocatable :: gradu - + !> Fluid, forcing, and particle parameters real(WP) :: visc,meanU,meanV,meanW real(WP) :: Urms0,TKE0,EPS0,Re_max @@ -61,7 +61,7 @@ module simulation real(WP) :: percent end type timer type(timer) :: wt_total,wt_vel,wt_pres,wt_rest,wt_stat,wt_force - + contains @@ -107,14 +107,14 @@ subroutine compute_stats() ell_Lx = ell/Lx Re_ratio = Re_lambda/Re_max end subroutine compute_stats - - + + !> Initialization of problem solver subroutine simulation_init use param, only: param_read implicit none - - + + ! Allocate work arrays allocate_work_arrays: block allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) @@ -126,8 +126,8 @@ subroutine simulation_init allocate(SR (1:6,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(gradu(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays - - + + ! Initialize time tracker with 2 subiterations initialize_timetracker: block time=timetracker(amRoot=cfg%amRoot) @@ -182,7 +182,7 @@ subroutine simulation_init wt_stat%time=0.0_WP; wt_stat%percent=0.0_WP wt_force%time=0.0_WP; wt_force%percent=0.0_WP end block initialize_timers - + ! Create a single-phase flow solver without bconds create_and_initialize_flow_solver: block use hypre_str_class, only: pcg_pfmg @@ -193,7 +193,7 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -244,16 +244,16 @@ subroutine simulation_init call fs%cfg%sync(fs%V) call fs%cfg%sync(fs%W) end if - + ! Compute mean and remove it from the velocity field to obtain =0 call fs%cfg%integrate(A=fs%U,integral=meanU); meanU=meanU/fs%cfg%vol_total call fs%cfg%integrate(A=fs%V,integral=meanV); meanV=meanV/fs%cfg%vol_total call fs%cfg%integrate(A=fs%W,integral=meanW); meanW=meanW/fs%cfg%vol_total - + fs%U = fs%U - meanU fs%V = fs%V - meanV fs%W = fs%W - meanW - + ! Project to ensure divergence-free call fs%get_div() fs%psolv%rhs=-fs%cfg%vol*fs%div*fs%rho/time%dt @@ -265,7 +265,7 @@ subroutine simulation_init fs%U=fs%U-time%dt*resU/fs%rho fs%V=fs%V-time%dt*resV/fs%rho fs%W=fs%W-time%dt*resW/fs%rho - + ! Calculate cell-centered velocities and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() @@ -273,7 +273,7 @@ subroutine simulation_init ! Compute turbulence stats call compute_stats() end block initialize_velocity - + ! Add Ensight output create_ensight: block ! Create Ensight output from cfg @@ -288,8 +288,8 @@ subroutine simulation_init ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight - - + + ! Create a monitor file create_monitor: block ! Prepare some info about fields @@ -363,23 +363,23 @@ subroutine simulation_init call tfile%add_column(wt_rest%percent,'Rest [%]') call tfile%write() end block create_monitor - - + + end subroutine simulation_init - - + + !> Time integrate our problem subroutine simulation_run use parallel, only: parallel_time implicit none integer :: ii - + ! Perform time integration do while (.not.time%done()) ! init wallclock wt_total%time_in=parallel_time() - + ! Increment time call fs%get_cfl(time%dt,time%cfl) call time%adjust_dt() @@ -429,10 +429,10 @@ subroutine simulation_run myTKE=0.0_WP; myEPSp=0.0_WP do k=fs%cfg%kmin_,fs%cfg%kmax_ do j=fs%cfg%jmin_,fs%cfg%jmax_ - do i=fs%cfg%imin_,fs%cfg%imax_ + do i=fs%cfg%imin_,fs%cfg%imax_ myTKE=myTKE+0.5_WP*((Ui(i,j,k)-meanU)**2+(Vi(i,j,k)-meanV)**2+(Wi(i,j,k)-meanW)**2)*fs%cfg%vol(i,j,k) - ! Pseudo-dissipation + ! Pseudo-dissipation myEPSp=myEPSp+fs%cfg%vol(i,j,k)*fs%visc(i,j,k)*( & gradu(1,1,i,j,k)**2+gradu(1,2,i,j,k)**2+gradu(1,3,i,j,k)**2 + & gradu(2,1,i,j,k)**2+gradu(2,2,i,j,k)**2+gradu(2,3,i,j,k)**2 + & @@ -457,11 +457,11 @@ subroutine simulation_run fs%U=2.0_WP*fs%U-fs%Uold+resU/fs%rho fs%V=2.0_WP*fs%V-fs%Vold+resV/fs%rho fs%W=2.0_WP*fs%W-fs%Wold+resW/fs%rho - + ! Apply other boundary conditions on the resulting fields call fs%apply_bcond(time%t,time%dt) wt_vel%time=wt_vel%time+parallel_time()-wt_vel%time_in - + ! Solve Poisson equation wt_pres%time_in=parallel_time() call fs%correct_mfr() @@ -470,7 +470,7 @@ subroutine simulation_run fs%psolv%sol=0.0_WP call fs%psolv%solve() call fs%shift_p(fs%psolv%sol) - + ! Correct velocity call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) fs%P=fs%P+fs%psolv%sol @@ -481,12 +481,12 @@ subroutine simulation_run ! Recompute interpolated velocity call fs%interp_vel(Ui,Vi,Wi) - + ! Increment sub-iteration counter time%it=time%it+1 - + end do - + wt_vel%time_in=parallel_time() ! Recompute divergence call fs%get_div() @@ -496,10 +496,10 @@ subroutine simulation_run wt_stat%time_in=parallel_time() call compute_stats() wt_stat%time=wt_stat%time+parallel_time()-wt_stat%time_in - + ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) - + ! Perform and output monitoring call fs%get_max() call mfile%write() @@ -541,29 +541,29 @@ subroutine simulation_run call df%write(fdata='restart/data_'//trim(adjustl(timestamp))) end block save_restart end if - + end do - + end subroutine simulation_run - - + + !> Finalize the NGA2 simulation subroutine simulation_final implicit none - + ! Get rid of all objects - need destructors ! monitor ! ensight ! bcond ! timetracker - + ! Deallocate work arrays deallocate(resU,resV,resW,Ui,Vi,Wi,SR,gradu) - + end subroutine simulation_final - - - - - + + + + + end module simulation diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index c767cf64b..fcdf28a86 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,46 +1,46 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg,D,get_VF - use hypre_str_class, only: hypre_str - use fourier3d_class, only: fourier3d - use incomp_class, only: incomp - use sgsmodel_class, only: sgsmodel - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use fouriersolver_class, only: fouriersolver + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor implicit none private - + !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - !type(hypre_str), public :: ps - type(fourier3d), public :: ps - type(hypre_str), public :: vs - type(sgsmodel), public :: sgs - type(timetracker), public :: time - + type(incomp), public :: fs + !type(hypre_str), public :: ps + type(fouriersolver), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time + !> Ensight postprocessing type(ensight) :: ens_out type(event) :: ens_evt - + !> Simulation monitor file type(monitor) :: mfile,cflfile - + public :: simulation_init,simulation_run,simulation_final - + !> Work arrays real(WP), dimension(:,:,:,:,:), allocatable :: gradU real(WP), dimension(:,:,:), allocatable :: resU,resV,resW real(WP), dimension(:,:,:), allocatable :: Ui,Vi,Wi real(WP), dimension(:,:,:), allocatable :: G real(WP) :: visc,mfr_target,mfr,bforce - - + + contains - - + + !> Compute massflow rate function get_bodyforce_mfr(srcU) result(mfr) use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE @@ -75,14 +75,14 @@ function get_bodyforce_mfr(srcU) result(mfr) call MPI_ALLREDUCE(myUvol,Uvol,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr) call MPI_ALLREDUCE(myRhoU,mfr ,1,MPI_REAL_WP,MPI_SUM,fs%cfg%comm,ierr); mfr=mfr/Uvol end function get_bodyforce_mfr - - + + !> Initialization of problem solver subroutine simulation_init use param, only: param_read implicit none - - + + ! Initialize time tracker with 1 subiterations initialize_timetracker: block time=timetracker(amRoot=cfg%amRoot) @@ -93,7 +93,7 @@ subroutine simulation_init time%itmax=2 end block initialize_timetracker - + ! Create an incompressible flow solver without bconds create_flow_solver: block use hypre_str_class, only: pcg_pfmg @@ -103,7 +103,7 @@ subroutine simulation_init call param_read('Density',fs%rho) call param_read('Dynamic viscosity',visc); fs%visc=visc ! Configure pressure solver - ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) !ps%maxlevel=14 !call param_read('Pressure iteration',ps%maxit) @@ -115,11 +115,11 @@ subroutine simulation_init ! Setup the solver call fs%setup(pressure_solver=ps,implicit_solver=vs) end block create_flow_solver - - + + ! Allocate work arrays allocate_work_arrays: block - allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) + allocate(gradU(1:3,1:3,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resU(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resV(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(resW(cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) @@ -128,8 +128,8 @@ subroutine simulation_init allocate(Wi (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) allocate(G (cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_,cfg%kmino_:cfg%kmaxo_)) end block allocate_work_arrays - - + + ! Initialize our velocity field initialize_velocity: block use mathtools, only: twoPi @@ -162,8 +162,8 @@ subroutine simulation_init mfr_target=mfr bforce=0.0_WP end block initialize_velocity - - + + ! Initialize IBM fields initialize_ibm: block integer :: i,j,k @@ -175,8 +175,8 @@ subroutine simulation_init end do end do end block initialize_ibm - - + + ! Create an LES model create_sgs: block sgs=sgsmodel(cfg=fs%cfg,umask=fs%umask,vmask=fs%vmask,wmask=fs%wmask) @@ -198,7 +198,7 @@ subroutine simulation_init ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) end block create_ensight - + ! Create a monitor file create_monitor: block @@ -233,27 +233,27 @@ subroutine simulation_init call cflfile%add_column(fs%CFLv_z,'Viscous zCFL') call cflfile%write() end block create_monitor - + end subroutine simulation_init - - + + !> Perform an NGA2 simulation subroutine simulation_run implicit none - + ! Perform time integration do while (.not.time%done()) - + ! Increment time call fs%get_cfl(time%dt,time%cfl) call time%adjust_dt() call time%increment() - + ! Remember old velocity fs%Uold=fs%U fs%Vold=fs%V fs%Wold=fs%W - + ! Turbulence modeling sgs_modeling: block use sgsmodel_class, only: vreman @@ -262,23 +262,23 @@ subroutine simulation_run call sgs%get_visc(type=vreman,dt=time%dtold,rho=resU,gradu=gradU) fs%visc=visc+sgs%visc end block sgs_modeling - + ! Perform sub-iterations do while (time%it.le.time%itmax) - + ! Build mid-time velocity fs%U=0.5_WP*(fs%U+fs%Uold) fs%V=0.5_WP*(fs%V+fs%Vold) fs%W=0.5_WP*(fs%W+fs%Wold) - + ! Explicit calculation of drho*u/dt from NS call fs%get_dmomdt(resU,resV,resW) - + ! Assemble explicit residual resU=-2.0_WP*(fs%rho*fs%U-fs%rho*fs%Uold)+time%dt*resU resV=-2.0_WP*(fs%rho*fs%V-fs%rho*fs%Vold)+time%dt*resV resW=-2.0_WP*(fs%rho*fs%W-fs%rho*fs%Wold)+time%dt*resW - + ! Add body forcing bodyforcing: block real(WP) :: mfr @@ -286,7 +286,7 @@ subroutine simulation_run bforce=(mfr_target-mfr)/time%dtmid resU=resU+time%dt*bforce end block bodyforcing - + ! Apply IB forcing to enforce BC at the pipe walls !ibforcing: block ! integer :: i,j,k @@ -303,12 +303,12 @@ subroutine simulation_run ! Form implicit residuals call fs%solve_implicit(time%dt,resU,resV,resW) - + ! Apply these residuals fs%U=2.0_WP*fs%U-fs%Uold+resU fs%V=2.0_WP*fs%V-fs%Vold+resV fs%W=2.0_WP*fs%W-fs%Wold+resW - + ! Apply IB forcing to enforce BC at the pipe walls ibforcing: block integer :: i,j,k @@ -325,10 +325,10 @@ subroutine simulation_run call fs%cfg%sync(fs%V) call fs%cfg%sync(fs%W) end block ibforcing - + ! Apply other boundary conditions on the resulting fields call fs%apply_bcond(time%t,time%dt) - + ! Solve Poisson equation call fs%correct_mfr() call fs%get_div() @@ -336,48 +336,48 @@ subroutine simulation_run fs%psolv%sol=0.0_WP call fs%psolv%solve() call fs%shift_p(fs%psolv%sol) - + ! Correct velocity call fs%get_pgrad(fs%psolv%sol,resU,resV,resW) fs%P=fs%P+fs%psolv%sol fs%U=fs%U-time%dt*resU/fs%rho fs%V=fs%V-time%dt*resV/fs%rho fs%W=fs%W-time%dt*resW/fs%rho - + ! Increment sub-iteration counter time%it=time%it+1 - + end do - + ! Recompute interpolated velocity and divergence call fs%interp_vel(Ui,Vi,Wi) call fs%get_div() - + ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) - + ! Perform and output monitoring call fs%get_max() call mfile%write() call cflfile%write() - + end do - + end subroutine simulation_run - - + + !> Finalize the NGA2 simulation subroutine simulation_final implicit none - + ! Get rid of all objects - need destructors ! monitor ! ensight ! timetracker - + ! Deallocate work arrays deallocate(resU,resV,resW,Ui,Vi,Wi,gradU) - + end subroutine simulation_final - + end module simulation diff --git a/examples/riser/GNUmakefile b/examples/riser/GNUmakefile index 44ad3a454..74f27574b 100644 --- a/examples/riser/GNUmakefile +++ b/examples/riser/GNUmakefile @@ -24,9 +24,9 @@ INCLUDE_LOCATIONS += $(Ulocs) VPATH_LOCATIONS += $(Ulocs) # Define external libraries - this can also be in .profile -LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 -HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ -FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 +#LAPACK_DIR= /opt/homebrew/Cellar/lapack/3.10.1_1 +#HYPRE_DIR = /Users/jcaps/Research/Codes/Builds/hypre/ +#FFTW_DIR=/opt/homebrew/Cellar/fftw/3.3.10_1 # NGA compilation definitions include $(NGA_HOME)/tools/GNUMake/Make.defs diff --git a/examples/riser/input b/examples/riser/input index c6a1cf8ea..8a3a3e09a 100644 --- a/examples/riser/input +++ b/examples/riser/input @@ -2,7 +2,7 @@ Partition : 4 1 1 # Mesh definition -Pipe length : 0.08 +Pipe length : 0.08 Pipe diameter : .01 nx : 570 ny : 70 @@ -21,7 +21,7 @@ Gravity : -9.81 0 0 # Particle properties Particle timestep size : 1e-6 -Collision timescale : 15e-6 +Collision timescale : 15e-6 Particle volume fraction : 0.02 Particle mean diameter : 58e-6 Particle standard deviation : 25-6 @@ -44,4 +44,4 @@ Postproc output period : 200e-5 # Restart files Restart output period : 200e-5 -!Restart from : 2.00000E-04 \ No newline at end of file +!Restart from : 2.00000E-04 diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index c1c950601..2b7175fff 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -1,27 +1,27 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use string, only: str_medium - use precision, only: WP - use geometry, only: cfg,D,get_VF - use lowmach_class, only: lowmach - use fourier3d_class, only: fourier3d - use hypre_str_class, only: hypre_str - use lpt_class, only: lpt - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use datafile_class, only: datafile - use monitor_class, only: monitor + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg,D,get_VF + use lowmach_class, only: lowmach + use fouriersolver_class, only: fouriersolver + use hypre_str_class, only: hypre_str + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor implicit none private !> Get an LPT solver, a lowmach solver, and corresponding time tracker - type(lowmach), public :: fs - type(fourier3d), public :: ps - type(hypre_str), public :: vs - type(lpt), public :: lp - type(timetracker), public :: time + type(lowmach), public :: fs + type(fouriersolver), public :: ps + type(hypre_str), public :: vs + type(lpt), public :: lp + type(timetracker), public :: time !> Provide a datafile and an event tracker for saving restarts type(event) :: save_evt @@ -111,7 +111,7 @@ subroutine postproc() !!$ ! Deallocate work arrays !!$ deallocate(Uavg,Uavg_,vol,vol_) end subroutine postproc - + !> Compute massflow rate function get_bodyforce_mfr(srcU) result(mfr) @@ -194,7 +194,7 @@ subroutine simulation_init end if end block restart_and_save - + ! Revisit timetracker to adjust time and time step values if this is a restart update_timetracker: block if (restarted) then @@ -204,7 +204,7 @@ subroutine simulation_init end if end block update_timetracker - + ! Initialize wallclock timers initialize_timers: block wt_total%time=0.0_WP; wt_total%percent=0.0_WP @@ -228,7 +228,7 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - ps=fourier3d(cfg=cfg,name='Pressure',nst=7) + ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) ! Configure implicit velocity solver vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) call param_read('Implicit iteration',vs%maxit) diff --git a/src/solver/Make.package b/src/solver/Make.package index 0e5511f99..a8ffdd616 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -3,7 +3,7 @@ ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif ifeq ($(USE_FFTW),TRUE) - f90EXE_sources += fourier3d_class.f90 + f90EXE_sources += fourier3d_class.f90 fouriersolver_class.f90 endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/fourier3d_class.f90 b/src/solver/fourier3d_class.f90 index b8bc1d930..7d5dfc8a1 100644 --- a/src/solver/fourier3d_class.f90 +++ b/src/solver/fourier3d_class.f90 @@ -1,1257 +1,1107 @@ -!> 3D FFT pressure solver concept is defined by extension of the linsol class -!> This solver is specifically intended to be a FFT-based pressure Poisson solver -!> for 3D periodic uniform computational domains decomposed in at most 2 directions -!> Makes use of FFTW and in-house parallel transpose operations +!> FFT for 3D periodic uniform computational domains decomposed in at most 2 +!> directions. Makes use of FFTW and in-house parallel transpose operations. module fourier3d_class - use precision, only: WP - use config_class, only: config - use string, only: str_short - use linsol_class, only: linsol - use, intrinsic :: iso_c_binding - implicit none - private - - - ! Expose type/constructor/methods - public :: fourier3d - - - !> fourier3d object definition - type, extends(linsol) :: fourier3d - - ! FFT's oddball - logical :: oddball - - ! Data storage for FFTW plans - complex(WP), dimension(:), allocatable :: in_x,out_x - complex(WP), dimension(:), allocatable :: in_y,out_y - complex(WP), dimension(:), allocatable :: in_z,out_z - - ! FFTW plans - type(C_PTR) :: fplan_x,bplan_x - type(C_PTR) :: fplan_y,bplan_y - type(C_PTR) :: fplan_z,bplan_z - - !> Unstrided arrays - complex(WP), dimension(:,:,:), allocatable :: factored_operator - complex(WP), dimension(:,:,:), allocatable :: transformed_rhs - - ! Storage for transposed data - complex(WP), dimension(:,:,:), allocatable :: xtrans - complex(WP), dimension(:,:,:), allocatable :: ytrans - complex(WP), dimension(:,:,:), allocatable :: ztrans - - ! Transpose partition - X - integer, dimension(:), allocatable :: imin_x,imax_x - integer, dimension(:), allocatable :: jmin_x,jmax_x - integer, dimension(:), allocatable :: kmin_x,kmax_x - integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x - integer :: sendcount_x,recvcount_x - character(len=str_short) :: xdir - - ! Transpose partition - Y - integer, dimension(:), allocatable :: imin_y,imax_y - integer, dimension(:), allocatable :: jmin_y,jmax_y - integer, dimension(:), allocatable :: kmin_y,kmax_y - integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y - integer :: sendcount_y,recvcount_y - character(len=str_short) :: ydir - - ! Transpose partition - Z - integer, dimension(:), allocatable :: imin_z,imax_z - integer, dimension(:), allocatable :: jmin_z,jmax_z - integer, dimension(:), allocatable :: kmin_z,kmax_z - integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z - integer :: sendcount_z,recvcount_z - character(len=str_short) :: zdir - - contains - - procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status - procedure :: print=>fourier3d_print !< Long-form printing of solver status - procedure :: log=>fourier3d_log !< Long-form logging of solver status - procedure :: init=>fourier3d_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup=>fourier3d_setup !< Solver setup (every time the operator changes) - procedure :: solve=>fourier3d_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy=>fourier3d_destroy !< Solver destruction (every time the operator changes) - - procedure, private :: fourier3d_fourier_transform - procedure, private :: fourier3d_inverse_transform - - procedure, private :: fourier3d_xtranspose_init - procedure, private :: fourier3d_ytranspose_init - procedure, private :: fourier3d_ztranspose_init - - procedure, private :: fourier3d_xtranspose_forward - procedure, private :: fourier3d_ytranspose_forward - procedure, private :: fourier3d_ztranspose_forward - - procedure, private :: fourier3d_xtranspose_backward - procedure, private :: fourier3d_ytranspose_backward - procedure, private :: fourier3d_ztranspose_backward - - end type fourier3d - - - !> Declare fourier3d constructor - interface fourier3d - procedure fourier3d_from_args - end interface fourier3d - - + use precision, only: WP + use config_class, only: config + use string, only: str_short + use, intrinsic :: iso_c_binding + implicit none + private + + + ! Expose type/constructor/methods + public :: fourier3d + + + !> fourier3d object definition + type :: fourier3d + + ! cfg + class(config), pointer :: cfg + + ! FFT's oddball + logical :: oddball + + ! Data storage for FFTW plans + complex(WP), dimension(:), allocatable :: in_x,out_x + complex(WP), dimension(:), allocatable :: in_y,out_y + complex(WP), dimension(:), allocatable :: in_z,out_z + + ! FFTW plans + type(C_PTR) :: fplan_x,bplan_x + type(C_PTR) :: fplan_y,bplan_y + type(C_PTR) :: fplan_z,bplan_z + + !> Unstrided arrays + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs + + ! Storage for transposed data + complex(WP), dimension(:,:,:), allocatable :: xtrans, ytrans, ztrans + + ! Transpose partition - X + integer, dimension(:), allocatable :: imin_x,imax_x + integer, dimension(:), allocatable :: jmin_x,jmax_x + integer, dimension(:), allocatable :: kmin_x,kmax_x + integer, dimension(:), allocatable :: nx_x,ny_x,nz_x + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + integer :: sendcount_x,recvcount_x + character :: xdir + + ! Transpose partition - Y + integer, dimension(:), allocatable :: imin_y,imax_y + integer, dimension(:), allocatable :: jmin_y,jmax_y + integer, dimension(:), allocatable :: kmin_y,kmax_y + integer, dimension(:), allocatable :: nx_y,ny_y,nz_y + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + integer :: sendcount_y,recvcount_y + character :: ydir + + ! Transpose partition - Z + integer, dimension(:), allocatable :: imin_z,imax_z + integer, dimension(:), allocatable :: jmin_z,jmax_z + integer, dimension(:), allocatable :: kmin_z,kmax_z + integer, dimension(:), allocatable :: nx_z,ny_z,nz_z + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + integer :: sendcount_z,recvcount_z + character :: zdir + + contains + + procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status + procedure :: print=>fourier3d_print !< Long-form printing of solver status + procedure :: log=>fourier3d_log !< Long-form logging of solver status + final :: fourier3d_destroy !< Deconstructor + + procedure :: fourier3d_fourier_transform + procedure :: fourier3d_inverse_transform + + procedure, private :: fourier3d_xtranspose_init + procedure, private :: fourier3d_ytranspose_init + procedure, private :: fourier3d_ztranspose_init + + procedure, private :: fourier3d_xtranspose_forward + procedure, private :: fourier3d_ytranspose_forward + procedure, private :: fourier3d_ztranspose_forward + + procedure, private :: fourier3d_xtranspose_backward + procedure, private :: fourier3d_ytranspose_backward + procedure, private :: fourier3d_ztranspose_backward + + end type fourier3d + + + !> Declare fourier3d constructor + interface fourier3d; procedure fourier3d_from_args; end interface fourier3d; + + contains - - - !> Constructor for a fourier3d object - function fourier3d_from_args(cfg,name,nst) result(self) - use messager, only: die - implicit none - type(fourier3d) :: self - class(config), target, intent(in) :: cfg - character(len=*), intent(in) :: name - integer, intent(in) :: nst - - ! Link the config and store the name - self%cfg=>cfg - self%name=trim(adjustl(name)) - - ! Set solution method - not used - self%method=0 - - ! Set up stencil size and map - self%nst=nst - allocate(self%stc(1:self%nst,1:3)) - self%stc=0 - - ! Allocate operator, rhs, and sol arrays - allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP - allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP - allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP - - ! Zero out some info - self%it=1 - self%aerr=0.0_WP - self%rerr=0.0_WP - - ! Allocate unstrided arrays - allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - allocate(self%transformed_rhs (self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) - - ! Setup is not done - self%setup_done=.false. - - ! Various checks to ensure we can use this solver - check_solver_is_useable: block - integer :: ndim,ndcp - ! Periodicity and uniformity of mesh - if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) call die('[fourier3d constructor] Need x-direction needs to be periodic and uniform') - if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) call die('[fourier3d constructor] Need y-direction needs to be periodic and uniform') - if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) call die('[fourier3d constructor] Need z-direction needs to be periodic and uniform') - ! Ensure that we have at least one non-decomposed direction - ndim=0 - if (self%cfg%nx.gt.1) ndim=ndim+1 - if (self%cfg%ny.gt.1) ndim=ndim+1 - if (self%cfg%nz.gt.1) ndim=ndim+1 - ndcp=0 - if (self%cfg%npx.gt.1) ndcp=ndcp+1 - if (self%cfg%npy.gt.1) ndcp=ndcp+1 - if (self%cfg%npz.gt.1) ndcp=ndcp+1 - if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one NON-decomposed direction') - end block check_solver_is_useable - - end function fourier3d_from_args - - - !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change - !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver - !> Only the stencil needs to be defined at this point - subroutine fourier3d_init(this) - use messager, only: die - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 - integer, dimension(3) :: periodicity,offset - include 'fftw3.f03' - - ! From the provided stencil, generate an inverse map - stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)) - sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)) - stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)) - allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 - do st=1,this%nst - this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + + + !> Constructor for a fourier3d object + function fourier3d_from_args(cfg) result(self) + use messager, only: die + implicit none + type(fourier3d) :: self + class(config), target, intent(in) :: cfg + integer :: ierr + integer, dimension(3) :: periodicity,offset + include 'fftw3.f03' + + ! Link the config and store the name + self%cfg=>cfg + + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + integer :: ndim,ndcp + ! Periodicity and uniformity of mesh + if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) & + call die('[fourier3d constructor] Need x-direction needs to be & + &periodic and uniform') + if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) & + call die('[fourier3d constructor] Need y-direction needs to be & + &periodic and uniform') + if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) & + call die('[fourier3d constructor] Need z-direction needs to be & + &periodic and uniform') + ! Ensure that we have at least one non-decomposed direction + ndim = count((/ self%cfg%nx, self%cfg%ny, self%cfg%nz /) .gt. 1) + ndcp = count((/ self%cfg%npx, self%cfg%npy, self%cfg%npz /) .gt. 1) + if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one & + &NON-decomposed direction') + end block check_solver_is_useable + + ! Initialize transpose and FFTW plans in x + if (self%cfg%nx.gt.1) then + call self%fourier3d_xtranspose_init() + allocate(self%in_x(self%cfg%nx),self%out_x(self%cfg%nx)) + self%fplan_x=fftw_plan_dft_1d(self%cfg%nx,self%in_x,self%out_x,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_x=fftw_plan_dft_1d(self%cfg%nx,self%in_x,self%out_x,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in y + if (self%cfg%ny.gt.1) then + call self%fourier3d_ytranspose_init() + allocate(self%in_y(self%cfg%ny),self%out_y(self%cfg%ny)) + self%fplan_y=fftw_plan_dft_1d(self%cfg%ny,self%in_y,self%out_y,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_y=fftw_plan_dft_1d(self%cfg%ny,self%in_y,self%out_y,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in z + if (self%cfg%nz.gt.1) then + call self%fourier3d_ztranspose_init() + allocate(self%in_z(self%cfg%nz),self%out_z(self%cfg%nz)) + self%fplan_z=fftw_plan_dft_1d(self%cfg%nz,self%in_z,self%out_z,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_z=fftw_plan_dft_1d(self%cfg%nz,self%in_z,self%out_z,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Find who owns the oddball + self%oddball=all((/ self%cfg%iproc, self%cfg%jproc, self%cfg%kproc /) .eq. 1) + + end function fourier3d_from_args + + + !> Initialize transpose tool in x + subroutine fourier3d_xtranspose_init(this) + use mpi_f08 + implicit none + class(fourier3d), intent(inout) :: this + integer :: ierr,ip,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%xdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%xdir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%xdir='z' + end if + + ! Allocate global partitions + allocate( this%nx_x(this%cfg%npx)) + allocate( this%ny_x(this%cfg%npx)) + allocate( this%nz_x(this%cfg%npx)) + allocate(this%imin_x(this%cfg%npx)) + allocate(this%imax_x(this%cfg%npx)) + allocate(this%jmin_x(this%cfg%npx)) + allocate(this%jmax_x(this%cfg%npx)) + allocate(this%kmin_x(this%cfg%npx)) + allocate(this%kmax_x(this%cfg%npx)) + + ! Partition + select case (trim(this%xdir)) + case ('x') + + ! No transpose required, use local partition + this%nx_x=this%cfg%nx_ + this%ny_x=this%cfg%ny_ + this%nz_x=this%cfg%nz_ + this%imin_x=this%cfg%imin_ + this%imax_x=this%cfg%imax_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%ny/this%cfg%npx + r=mod(this%cfg%ny,this%cfg%npx) + if (ip.le.r) then + this%ny_x(ip) =q+1 + this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) + else + this%ny_x(ip) =q + this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q + end if + this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 end do - - ! Initialize transpose and FFTW plans in x - if (this%cfg%nx.gt.1) then - call this%fourier3d_xtranspose_init() - allocate(this%in_x(this%cfg%nx),this%out_x(this%cfg%nx)) - this%fplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_FORWARD,FFTW_MEASURE) - this%bplan_x=fftw_plan_dft_1d(this%cfg%nx,this%in_x,this%out_x,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in y - if (this%cfg%ny.gt.1) then - call this%fourier3d_ytranspose_init() - allocate(this%in_y(this%cfg%ny),this%out_y(this%cfg%ny)) - this%fplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_FORWARD,FFTW_MEASURE) - this%bplan_y=fftw_plan_dft_1d(this%cfg%ny,this%in_y,this%out_y,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in z - if (this%cfg%nz.gt.1) then - call this%fourier3d_ztranspose_init() - allocate(this%in_z(this%cfg%nz),this%out_z(this%cfg%nz)) - this%fplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_FORWARD,FFTW_MEASURE) - this%bplan_z=fftw_plan_dft_1d(this%cfg%nz,this%in_z,this%out_z,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Find who owns the oddball - this%oddball=.false. - if (this%cfg%iproc.eq.1.and.this%cfg%jproc.eq.1.and.this%cfg%kproc.eq.1) this%oddball=.true. - - end subroutine fourier3d_init - - - !> Initialize transpose tool in x - subroutine fourier3d_xtranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,ip,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%xdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%xdir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%xdir='z' - end if - - ! Allocate global partitions - allocate( this%nx_x(this%cfg%npx)) - allocate( this%ny_x(this%cfg%npx)) - allocate( this%nz_x(this%cfg%npx)) - allocate(this%imin_x(this%cfg%npx)) - allocate(this%imax_x(this%cfg%npx)) - allocate(this%jmin_x(this%cfg%npx)) - allocate(this%jmax_x(this%cfg%npx)) - allocate(this%kmin_x(this%cfg%npx)) - allocate(this%kmax_x(this%cfg%npx)) - - ! Partition - select case (trim(this%xdir)) - case ('x') - - ! No transpose required, use local partition - this%nx_x=this%cfg%nx_ - this%ny_x=this%cfg%ny_ - this%nz_x=this%cfg%nz_ - this%imin_x=this%cfg%imin_ - this%imax_x=this%cfg%imax_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%ny/this%cfg%npx - r=mod(this%cfg%ny,this%cfg%npx) - if (ip.le.r) then - this%ny_x(ip) =q+1 - this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) - else - this%ny_x(ip) =q - this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q - end if - this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 - end do - this%nz_x=this%cfg%nz_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%nz/this%cfg%npx - r=mod(this%cfg%nz,this%cfg%npx) - if (ip.le.r) then - this%nz_x(ip) =q+1 - this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) - else - this%nz_x(ip) =q - this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q - end if - this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 - end do - this%ny_x=this%cfg%ny_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - end select - - ! Allocate storage - allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - - end subroutine fourier3d_xtranspose_init - - - !> Initialize transpose tool in y - subroutine fourier3d_ytranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,jp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%ydir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%ydir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%ydir='x' - end if - - ! Allocate global partitions - allocate( this%nx_y(this%cfg%npy)) - allocate( this%ny_y(this%cfg%npy)) - allocate( this%nz_y(this%cfg%npy)) - allocate(this%imin_y(this%cfg%npy)) - allocate(this%imax_y(this%cfg%npy)) - allocate(this%jmin_y(this%cfg%npy)) - allocate(this%jmax_y(this%cfg%npy)) - allocate(this%kmin_y(this%cfg%npy)) - allocate(this%kmax_y(this%cfg%npy)) - - ! Partition - select case (trim(this%ydir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nx/this%cfg%npy - r=mod(this%cfg%nx,this%cfg%npy) - if (jp.le.r) then - this%nx_y(jp) =q+1 - this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) - else - this%nx_y(jp) =q - this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q - end if - this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 - end do - this%nz_y=this%cfg%nz_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - case ('y') - - ! No transpose required, use local partition - this%nx_y=this%cfg%nx_ - this%ny_y=this%cfg%ny_ - this%nz_y=this%cfg%nz_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - this%jmin_y=this%cfg%jmin_ - this%jmax_y=this%cfg%jmax_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nz/this%cfg%npy - r=mod(this%cfg%nz,this%cfg%npy) - if (jp.le.r) then - this%nz_y(jp) =q+1 - this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) - else - this%nz_y(jp) =q - this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q - end if - this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 - end do - this%nx_y=this%cfg%nx_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - end select - - ! Allocate storage - allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - - end subroutine fourier3d_ytranspose_init - - - !> Initialize transpose tool in z - subroutine fourier3d_ztranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,kp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%zdir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%zdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%zdir='y' - end if - - ! Allocate global partitions - allocate( this%nx_z(this%cfg%npz)) - allocate( this%ny_z(this%cfg%npz)) - allocate( this%nz_z(this%cfg%npz)) - allocate(this%imin_z(this%cfg%npz)) - allocate(this%imax_z(this%cfg%npz)) - allocate(this%jmin_z(this%cfg%npz)) - allocate(this%jmax_z(this%cfg%npz)) - allocate(this%kmin_z(this%cfg%npz)) - allocate(this%kmax_z(this%cfg%npz)) - - ! Partition - select case (trim(this%zdir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%nx/this%cfg%npz - r=mod(this%cfg%nx,this%cfg%npz) - if (kp.le.r) then - this%nx_z(kp) =q+1 - this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) - else - this%nx_z(kp) =q - this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q - end if - this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 - end do - this%ny_z=this%cfg%ny_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%ny/this%cfg%npz - r=mod(this%cfg%ny,this%cfg%npz) - if (kp.le.r) then - this%ny_z(kp) =q+1 - this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) - else - this%ny_z(kp) =q - this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q - end if - this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 - end do - this%nx_z=this%cfg%nx_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('z') - - ! No transpose required, use local partition - this%nx_z=this%cfg%nx_ - this%ny_z=this%cfg%ny_ - this%nz_z=this%cfg%nz_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - this%kmin_z=this%cfg%kmin_ - this%kmax_z=this%cfg%kmax_ - - end select - - ! Allocate storage - allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - - end subroutine fourier3d_ztranspose_init - - - !> Perform forward transpose in x - subroutine fourier3d_xtranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - At=A - case ('y') - ! Transpose x=>y - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do - end do - end do - case ('z') - ! Transpose x=>z - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do - end do - end do - end select - - end subroutine fourier3d_xtranspose_forward - - - !> Perform forward transpose in y - subroutine fourier3d_ytranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose y=>x - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do - end do - end do - case ('y') - ! No transpose required - At=A - case ('z') - ! Transpose y=>z - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) - end do - end do + this%nz_x=this%cfg%nz_ + this%kmin_x=this%cfg%kmin_ + this%kmax_x=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ + allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%cfg%npx + q=this%cfg%nz/this%cfg%npx + r=mod(this%cfg%nz,this%cfg%npx) + if (ip.le.r) then + this%nz_x(ip) =q+1 + this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) + else + this%nz_x(ip) =q + this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q + end if + this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 + end do + this%ny_x=this%cfg%ny_ + this%jmin_x=this%cfg%jmin_ + this%jmax_x=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) + allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + end select + + ! Allocate storage + allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) + + end subroutine fourier3d_xtranspose_init + + + !> Initialize transpose tool in y + subroutine fourier3d_ytranspose_init(this) + use mpi_f08 + implicit none + class(fourier3d), intent(inout) :: this + integer :: ierr,jp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%ydir='y' + else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%ydir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%ydir='x' + end if + + ! Allocate global partitions + allocate( this%nx_y(this%cfg%npy)) + allocate( this%ny_y(this%cfg%npy)) + allocate( this%nz_y(this%cfg%npy)) + allocate(this%imin_y(this%cfg%npy)) + allocate(this%imax_y(this%cfg%npy)) + allocate(this%jmin_y(this%cfg%npy)) + allocate(this%jmax_y(this%cfg%npy)) + allocate(this%kmin_y(this%cfg%npy)) + allocate(this%kmax_y(this%cfg%npy)) + + ! Partition + select case (trim(this%ydir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nx/this%cfg%npy + r=mod(this%cfg%nx,this%cfg%npy) + if (jp.le.r) then + this%nx_y(jp) =q+1 + this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) + else + this%nx_y(jp) =q + this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q + end if + this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 + end do + this%nz_y=this%cfg%nz_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ + allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + case ('y') + + ! No transpose required, use local partition + this%nx_y=this%cfg%nx_ + this%ny_y=this%cfg%ny_ + this%nz_y=this%cfg%nz_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + this%jmin_y=this%cfg%jmin_ + this%jmax_y=this%cfg%jmax_ + this%kmin_y=this%cfg%kmin_ + this%kmax_y=this%cfg%kmax_ + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%cfg%npy + q=this%cfg%nz/this%cfg%npy + r=mod(this%cfg%nz,this%cfg%npy) + if (jp.le.r) then + this%nz_y(jp) =q+1 + this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) + else + this%nz_y(jp) =q + this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q + end if + this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 + end do + this%nx_y=this%cfg%nx_ + this%imin_y=this%cfg%imin_ + this%imax_y=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + end select + + ! Allocate storage + allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) + + end subroutine fourier3d_ytranspose_init + + + !> Initialize transpose tool in z + subroutine fourier3d_ztranspose_init(this) + use mpi_f08 + implicit none + class(fourier3d), intent(inout) :: this + integer :: ierr,kp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then + this%zdir='z' + else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then + this%zdir='x' + else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then + this%zdir='y' + end if + + ! Allocate global partitions + allocate( this%nx_z(this%cfg%npz)) + allocate( this%ny_z(this%cfg%npz)) + allocate( this%nz_z(this%cfg%npz)) + allocate(this%imin_z(this%cfg%npz)) + allocate(this%imax_z(this%cfg%npz)) + allocate(this%jmin_z(this%cfg%npz)) + allocate(this%jmax_z(this%cfg%npz)) + allocate(this%kmin_z(this%cfg%npz)) + allocate(this%kmax_z(this%cfg%npz)) + + ! Partition + select case (trim(this%zdir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%nx/this%cfg%npz + r=mod(this%cfg%nx,this%cfg%npz) + if (kp.le.r) then + this%nx_z(kp) =q+1 + this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) + else + this%nx_z(kp) =q + this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q + end if + this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 + end do + this%ny_z=this%cfg%ny_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) + allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%cfg%npz + q=this%cfg%ny/this%cfg%npz + r=mod(this%cfg%ny,this%cfg%npz) + if (kp.le.r) then + this%ny_z(kp) =q+1 + this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) + else + this%ny_z(kp) =q + this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q + end if + this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 + end do + this%nx_z=this%cfg%nx_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + + ! Variables for AllToAll communication + this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('z') + + ! No transpose required, use local partition + this%nx_z=this%cfg%nx_ + this%ny_z=this%cfg%ny_ + this%nz_z=this%cfg%nz_ + this%imin_z=this%cfg%imin_ + this%imax_z=this%cfg%imax_ + this%jmin_z=this%cfg%jmin_ + this%jmax_z=this%cfg%jmax_ + this%kmin_z=this%cfg%kmin_ + this%kmax_z=this%cfg%kmax_ + + end select + + ! Allocate storage + allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) + + end subroutine fourier3d_ztranspose_init + + + !> Perform forward transpose in x + subroutine fourier3d_xtranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + At=A + case ('y') + ! Transpose x=>y + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) end do - end do - end select - - end subroutine fourier3d_ytranspose_forward - - - !> Perform forward transpose in z - subroutine fourier3d_ztranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose z=>x - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) - end do - end do + end do + end do + end do + case ('z') + ! Transpose x=>z + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_x(ip)+1 + ii=i-this%cfg%imin_+1 + this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) end do - end do - case ('y') - ! Transpose z=>y - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) - end do - end do + end do + end do + end do + end select + + end subroutine fourier3d_xtranspose_forward + + + !> Perform forward transpose in y + subroutine fourier3d_ytranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose y=>x + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) end do - end do - case ('z') - ! No transpose required - At=A - end select - - end subroutine fourier3d_ztranspose_forward - - - !> Perform backward transpose in x - subroutine fourier3d_xtranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - A=At - case ('y') - ! Transpose y=>x - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) - end do - end do + end do + end do + end do + case ('y') + ! No transpose required + At=A + case ('z') + ! Transpose y=>z + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%cfg%jmin_+1 + this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - jj=j-this%jmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) end do - end do - case ('z') - ! Transpose z=>x - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) - end do - end do + end do + end do + end do + end select + + end subroutine fourier3d_ytranspose_forward + + + !> Perform forward transpose in z + subroutine fourier3d_ztranspose_forward(this,A,At) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose z=>x + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - kk=k-this%kmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) end do - end do - end select - - end subroutine fourier3d_xtranspose_backward - - - !> Perform backward transpose in y - subroutine fourier3d_ytranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose x=>y - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) - end do - end do + end do + end do + end do + case ('y') + ! Transpose z=>y + do kp=1,this%cfg%npz + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%cfg%kmin_+1 + this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) end do - end do - case ('y') - ! No transpose required - A=At - case ('z') - ! Transpose z=>y - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) - end do - end do + end do + end do + end do + case ('z') + ! No transpose required + At=A + end select + + end subroutine fourier3d_ztranspose_forward + + + !> Perform backward transpose in x + subroutine fourier3d_xtranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + A=At + case ('y') + ! Transpose y=>x + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + jj=j-this%jmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) end do - end do - end select - - end subroutine fourier3d_ytranspose_backward - - - !> Perform backward transpose in z - subroutine fourier3d_ztranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose x=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) - end do - end do + end do + end do + end do + case ('z') + ! Transpose z=>x + do ip=1,this%cfg%npx + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%cfg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) + do ip=1,this%cfg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) + kk=k-this%kmin_x(ip)+1 + ii=i-this%imin_x(this%cfg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) end do - end do - case ('y') - ! Transpose y=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) - end do - end do + end do + end do + end do + end select + + end subroutine fourier3d_xtranspose_backward + + + !> Perform backward transpose in y + subroutine fourier3d_ytranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose x=>y + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + ii=i-this%imin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) end do - end do - case ('z') - ! No transpose required - A=At - end select - - end subroutine fourier3d_ztranspose_backward - - - !> Transpose A and perform Fourier transform - subroutine fourier3d_fourier_transform(this,A) - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) - integer :: i,j,k - include 'fftw3.f03' - - if (this%cfg%nx.gt.1) then - ! Transpose in X - call this%fourier3d_xtranspose_forward(A,this%xtrans) - ! Forward transform - X - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x=this%xtrans(:,j,k) - call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k)=this%out_x + end do + end do + end do + case ('y') + ! No transpose required + A=At + case ('z') + ! Transpose z=>y + do jp=1,this%cfg%npy + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(this%cfg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) end do - end do - ! Transpose back - call this%fourier3d_xtranspose_backward(this%xtrans,A) - end if - - if (this%cfg%ny.gt.1) then - ! Transpose in Y - call this%fourier3d_ytranspose_forward(A,this%ytrans) - ! Forward transform - Y - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y=this%ytrans(i,:,k) - call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k)=this%out_y + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) + do jp=1,this%cfg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) + do i=this%cfg%imin_,this%cfg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%jmin_y(this%cfg%jproc)+1 + A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) end do - end do - ! Transpose back - call this%fourier3d_ytranspose_backward(this%ytrans,A) - end if - - if (this%cfg%nz.gt.1) then - ! Transpose in Z - call this%fourier3d_ztranspose_forward(A,this%ztrans) - ! Forward transform - Z - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + end do + end do + end do + end select + + end subroutine fourier3d_ytranspose_backward + + + !> Perform backward transpose in z + subroutine fourier3d_ztranspose_backward(this,At,A) + use mpi_f08 + use parallel, only: MPI_REAL_WP + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose x=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z=this%ztrans(i,j,:) - call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:)=this%out_z - end do - end do - ! Transpose back - call this%fourier3d_ztranspose_backward(this%ztrans,A) - end if - - ! Oddball - if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP - - end subroutine fourier3d_fourier_transform - - - !> FFT -> real and transpose back - subroutine fourier3d_inverse_transform(this,A) - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) - integer :: i,j,k - include 'fftw3.f03' - - if (this%cfg%nx.gt.1) then - ! Transpose in X - call this%fourier3d_xtranspose_forward(A,this%xtrans) - ! Inverse transform - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x=this%xtrans(:,j,k) - call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k)=this%out_x/this%cfg%nx + ii=i-this%imin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) end do - end do - ! Transpose back - call this%fourier3d_xtranspose_backward(this%xtrans,A) - end if - - if (this%cfg%ny.gt.1) then - ! Transpose in Y - call this%fourier3d_ytranspose_forward(A,this%ytrans) - ! Inverse transform - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y=this%ytrans(i,:,k) - call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k)=this%out_y/this%cfg%ny + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) end do - end do - ! Transpose back - call this%fourier3d_ytranspose_backward(this%ytrans,A) - end if - - if (this%cfg%nz.gt.1) then - ! Transpose in Z - call this%fourier3d_ztranspose_forward(A,this%ztrans) - ! Inverse transform - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z=this%ztrans(i,j,:) - call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:)=this%out_z/this%cfg%nz + end do + end do + end do + case ('y') + ! Transpose y=>z + do kp=1,this%cfg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%cfg%imin_,this%cfg%imax_ + jj=j-this%jmin_z(this%cfg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) end do - end do - ! Transpose back - call this%fourier3d_ztranspose_backward(this%ztrans,A) - end if - -end subroutine fourier3d_inverse_transform - - -!> Setup solver - done everytime the operator changes - subroutine fourier3d_setup(this) - use messager, only: die - use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - real(WP), dimension(1:this%nst) :: ref_opr - logical :: circulant - integer :: i,j,k,n,ierr - - ! If the solver has already been setup, destroy it first - if (this%setup_done) call this%destroy() - - ! Check circulent operator - if (this%cfg%amRoot) ref_opr=this%opr(:,this%cfg%imin,this%cfg%jmin,this%cfg%kmin) - call MPI_BCAST(ref_opr,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) - circulant=.true. - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) + do kp=1,this%cfg%npz + do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) + do j=this%jmin_z(kp),this%jmax_z(kp) do i=this%cfg%imin_,this%cfg%imax_ - if (any(abs(this%opr(:,i,j,k)-ref_opr).gt.6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4)) circulant=.false. + jj=j-this%jmin_z(kp)+1 + kk=k-this%kmin_z(this%cfg%kproc)+1 + A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) end do - end do + end do + end do + end do + case ('z') + ! No transpose required + A=At + end select + + end subroutine fourier3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine fourier3d_fourier_transform(this,A) + use messager, only: die + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Forward transform - X + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x + end do + end do + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Forward transform - Y + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y + end do + end do + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Forward transform - Z + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + + ! Oddball + if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP + + end subroutine fourier3d_fourier_transform + + + !> FFT -> real and transpose back + subroutine fourier3d_inverse_transform(this,A) + use messager, only: die + implicit none + class(fourier3d), intent(inout) :: this + complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%cfg%nx.gt.1) then + ! Transpose in X + call this%fourier3d_xtranspose_forward(A,this%xtrans) + ! Inverse transform + do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) + do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x/this%cfg%nx + end do end do - if (.not.circulant) call die('[fourier3d setup] operator must be uniform in space') - - ! Build the operator - this%factored_operator=0.0_WP - do n=1,this%nst - i=modulo(this%stc(n,1)-this%cfg%imin+1,this%cfg%nx)+this%cfg%imin - j=modulo(this%stc(n,2)-this%cfg%jmin+1,this%cfg%ny)+this%cfg%jmin - k=modulo(this%stc(n,3)-this%cfg%kmin+1,this%cfg%nz)+this%cfg%kmin - if (this%cfg%imin_.le.i.and.i.le.this%cfg%imax_.and.& - & this%cfg%jmin_.le.j.and.j.le.this%cfg%jmax_.and.& - & this%cfg%kmin_.le.k.and.k.le.this%cfg%kmax_) this%factored_operator(i,j,k)=this%factored_operator(i,j,k)+real(ref_opr(n),WP) + ! Transpose back + call this%fourier3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%cfg%ny.gt.1) then + ! Transpose in Y + call this%fourier3d_ytranspose_forward(A,this%ytrans) + ! Inverse transform + do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) + do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y/this%cfg%ny + end do end do - - ! Take transform of operator - call this%fourier3d_fourier_transform(this%factored_operator) - - ! Make zero wavenumber not zero - ! Setting this to one has the nice side effect of returning a solution with the same integral - if (this%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=1.0_C_DOUBLE - - ! Make sure other wavenumbers are not close to zero - i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_WP)) - call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) - if (j.gt.0) then - print*,j - call die('[fourier3d setup] elements of transformed operator near zero') - end if - - ! Divide now instead of later - this%factored_operator=1.0_WP/this%factored_operator - - ! Check for division issues - i=count(isnan(abs(this%factored_operator))) - call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) - if (j.gt.0) call die('[fourier3d setup] elements of transformed operator are NaN') - - ! Set setup-flag to true - this%setup_done=.true. - - end subroutine fourier3d_setup - - - !> Solve the linear system iteratively - subroutine fourier3d_solve(this) - use messager, only: die - use param, only: verbose - implicit none - class(fourier3d), intent(inout) :: this - integer :: i,j,k,ierr - - ! Check that setup was done - if (.not.this%setup_done) call die('[fourier3d solve] Solver has not been setup.') - - ! Copy to unstrided array - this%transformed_rhs=this%rhs(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) - - ! Forward transform - call this%fourier3d_fourier_transform(this%transformed_rhs) - - ! Divide - this%transformed_rhs=this%transformed_rhs*this%factored_operator - - ! Backward transform - call this%fourier3d_inverse_transform(this%transformed_rhs) - - ! Copy to strided output - this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs - - ! Sync the solution vector - call this%cfg%sync(this%sol) - - ! If verbose run, log and or print info - if (verbose.gt.0) call this%log - if (verbose.gt.1) call this%print_short - - end subroutine fourier3d_solve - - - !> Destroy solver - done everytime the operator changes - subroutine fourier3d_destroy(this) - use messager, only: die - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr - include 'fftw3.f03' - - ! Destroy our plans - call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x) - call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y) - call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z) - - ! Set setup-flag to false - this%setup_done=.false. - - end subroutine fourier3d_destroy - - - !> Log fourier3d info - subroutine fourier3d_log(this) - use string, only: str_long - use messager, only: log - implicit none - class(fourier3d), intent(in) :: this - character(len=str_long) :: message - if (this%cfg%amRoot) then - write(message,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name); call log(message) - end if - end subroutine fourier3d_log - - - !> Print fourier3d info to the screen - subroutine fourier3d_print(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(fourier3d), intent(in) :: this - if (this%cfg%amRoot) then - write(output_unit,'("fourier3d solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) - end if - end subroutine fourier3d_print - - - !> Short print of fourier3d info to the screen - subroutine fourier3d_print_short(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(fourier3d), intent(in) :: this - if (this%cfg%amRoot) write(output_unit,'("fourier3d solver [",a16,"] for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - end subroutine fourier3d_print_short - - + ! Transpose back + call this%fourier3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%cfg%nz.gt.1) then + ! Transpose in Z + call this%fourier3d_ztranspose_forward(A,this%ztrans) + ! Inverse transform + do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) + do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z/this%cfg%nz + end do + end do + ! Transpose back + call this%fourier3d_ztranspose_backward(this%ztrans,A) + end if + + end subroutine fourier3d_inverse_transform + + + !> Destroy FFT object + subroutine fourier3d_destroy(this) + use messager, only: die + implicit none + type(fourier3d), intent(inout) :: this + include 'fftw3.f03' + + ! Destroy our plans + call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x); + call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y); + call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z); + + end subroutine fourier3d_destroy + + + !> Log fourier3d info + subroutine fourier3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(fourier3d), intent(in) :: this + character(len=str_long) :: message + + if (this%cfg%amRoot) then + write(message,'("fourier3d for config [",a,"]")') trim(this%cfg%name) + call log(message) + end if + + end subroutine fourier3d_log + + + !> Print fourier3d info to the screen + subroutine fourier3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fourier3d), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("fourier3d for config [",a,"]")') trim(this%cfg%name) + end if + + end subroutine fourier3d_print + + + !> Short print of fourier3d info to the screen + subroutine fourier3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fourier3d), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("fourier3d for config [",a16,"]")') trim(this%cfg%name) + end if + + end subroutine fourier3d_print_short + + end module fourier3d_class + diff --git a/src/solver/fouriersolver_class.f90 b/src/solver/fouriersolver_class.f90 new file mode 100644 index 000000000..906c60852 --- /dev/null +++ b/src/solver/fouriersolver_class.f90 @@ -0,0 +1,278 @@ +!> 3D FFT pressure solver concept is defined by extension of the linsol class +!> This solver is specifically intended to be a FFT-based pressure Poisson solver +!> for 3D periodic uniform computational domains decomposed in at most 2 directions +!> uses fourier3d for Fourier transform +module fouriersolver_class + use precision, only: WP + use config_class, only: config + use fourier3d_class, only: fourier3d + use string, only: str_short + use linsol_class, only: linsol + use, intrinsic :: iso_c_binding + implicit none + private + + + ! Expose type/constructor/methods + public :: fouriersolver + + + !> fouriersolver object definition + type, extends(linsol) :: fouriersolver + + ! FFT object + class(fourier3d), allocatable :: dft + + !> Unstrided arrays + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs + + contains + + procedure :: print_short=>fouriersolver_print_short !< One-line printing of solver status + procedure :: print=>fouriersolver_print !< Long-form printing of solver status + procedure :: log=>fouriersolver_log !< Long-form logging of solver status + procedure :: init=>fouriersolver_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>fouriersolver_setup !< Solver setup (every time the operator changes) + procedure :: solve=>fouriersolver_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>fouriersolver_destroy + + end type fouriersolver + + + !> Declare fouriersolver constructor + interface fouriersolver; procedure fouriersolver_from_args; end interface fouriersolver; + + +contains + + + !> Constructor for a fouriersolver object + function fouriersolver_from_args(cfg,name,nst) result(self) + use messager, only: die + implicit none + type(fouriersolver) :: self + class(config), target, intent(in) :: cfg + character(len=*), intent(in) :: name + integer, intent(in) :: nst + + ! Link the config and store the name + self%cfg=>cfg + self%name=trim(adjustl(name)) + + ! Set solution method - not used + self%method=0 + + ! Set up stencil size and map + self%nst=nst + allocate(self%stc(1:self%nst,1:3)) + self%stc=0 + + ! Allocate operator, rhs, and sol arrays + allocate(self%opr(self%nst,self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%opr=0.0_WP + allocate(self%rhs( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%rhs=0.0_WP + allocate(self%sol( self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%sol=0.0_WP + + ! Zero out some info + self%it=1 + self%aerr=0.0_WP + self%rerr=0.0_WP + + ! Allocate unstrided arrays + allocate(self%factored_operator(self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + allocate(self%transformed_rhs (self%cfg%imin_:self%cfg%imax_,self%cfg%jmin_:self%cfg%jmax_,self%cfg%kmin_:self%cfg%kmax_)) + + ! Setup is not done + self%setup_done=.false. + + end function fouriersolver_from_args + + + !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change + !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver + !> Only the stencil needs to be defined at this point + subroutine fouriersolver_init(this) + use messager, only: die + implicit none + class(fouriersolver), intent(inout) :: this + integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 + integer, dimension(3) :: periodicity,offset + include 'fftw3.f03' + + ! From the provided stencil, generate an inverse map + stx1=minval(this%stc(:,1)); stx2=maxval(this%stc(:,1)); + sty1=minval(this%stc(:,2)); sty2=maxval(this%stc(:,2)); + stz1=minval(this%stc(:,3)); stz2=maxval(this%stc(:,3)); + allocate(this%stmap(stx1:stx2,sty1:sty2,stz1:stz2)); this%stmap=0 + do st=1,this%nst + this%stmap(this%stc(st,1),this%stc(st,2),this%stc(st,3))=st + end do + + ! Initialize DFT + this%dft=fourier3d(this%cfg) + + end subroutine fouriersolver_init + + + !> Setup solver - done everytime the operator changes + subroutine fouriersolver_setup(this) + use messager, only: die + use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM + use parallel, only: MPI_REAL_WP + implicit none + class(fouriersolver), intent(inout) :: this + real(WP), dimension(1:this%nst) :: ref_opr + integer :: i,j,k,n,ierr + + ! Check operator is circulant + checkcirc: block + logical :: circulant + real(WP) :: circtol + if (this%cfg%amRoot) ref_opr=this%opr(:,this%cfg%imin,this%cfg%jmin,this%cfg%kmin) + call MPI_BCAST(ref_opr,this%nst,MPI_REAL_WP,0,this%cfg%comm,ierr) + circulant=.true. + circtol = 6.0_WP*epsilon(1.0_WP)/this%cfg%min_meshsize**4 + do k=this%cfg%kmin_,this%cfg%kmax_ + do j=this%cfg%jmin_,this%cfg%jmax_ + do i=this%cfg%imin_,this%cfg%imax_ + if (any(abs(this%opr(:,i,j,k)-ref_opr).gt.circtol)) circulant=.false. + end do + end do + end do + if (.not.circulant) call die('[fouriersolver setup] operator must be uniform in space') + end block checkcirc + + ! Build the operator + this%factored_operator=0.0_WP + do n=1,this%nst + i=modulo(this%stc(n,1)-this%cfg%imin+1,this%cfg%nx)+this%cfg%imin + j=modulo(this%stc(n,2)-this%cfg%jmin+1,this%cfg%ny)+this%cfg%jmin + k=modulo(this%stc(n,3)-this%cfg%kmin+1,this%cfg%nz)+this%cfg%kmin + if (this%cfg%imin_.le.i.and.i.le.this%cfg%imax_.and. & + & this%cfg%jmin_.le.j.and.j.le.this%cfg%jmax_.and. & + & this%cfg%kmin_.le.k.and.k.le.this%cfg%kmax_) & + this%factored_operator(i,j,k)=this%factored_operator(i,j,k)+ref_opr(n) + end do + + ! Take transform of operator + call this%dft%fourier3d_fourier_transform(this%factored_operator) + + ! Make zero wavenumber not zero + ! Setting this to one has the nice side effect of returning a solution with the same integral + if (this%dft%oddball) this%factored_operator(this%cfg%imin_,this%cfg%jmin_,& + this%cfg%kmin_)=1.0_C_DOUBLE + + ! Make sure other wavenumbers are not close to zero + i=count(abs(this%factored_operator).lt.1000_WP*epsilon(1.0_WP)) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) then + write(*,*) j + call die('[fouriersolver setup] elements of transformed operator near zero') + end if + + ! Divide now instead of later + this%factored_operator=1.0_WP/this%factored_operator + + ! Check for division issues + i=count(isnan(abs(this%factored_operator))) + call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) + if (j.gt.0) call die('[fouriersolver setup] elements of transformed operator are NaN') + + ! Set setup-flag to true + this%setup_done=.true. + + end subroutine fouriersolver_setup + + + !> Solve the linear system iteratively + subroutine fouriersolver_solve(this) + use messager, only: die + use param, only: verbose + implicit none + class(fouriersolver), intent(inout) :: this + integer :: i,j,k,ierr + + ! Check that setup was done + if (.not.this%setup_done) call die('[fouriersolver solve] Solver has not & + &been setup.') + + ! Copy to unstrided array + this%transformed_rhs=this%rhs(this%cfg%imin_:this%cfg%imax_, & + this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) + + ! Forward transform + call this%dft%fourier3d_fourier_transform(this%transformed_rhs) + + ! Divide + this%transformed_rhs=this%transformed_rhs*this%factored_operator + + ! Backward transform + call this%dft%fourier3d_inverse_transform(this%transformed_rhs) + + ! Copy to strided output + this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_, & + this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs + + ! Sync the solution vector + call this%cfg%sync(this%sol) + + ! If verbose run, log and or print info + if (verbose.gt.0) call this%log + if (verbose.gt.1) call this%print_short + + end subroutine fouriersolver_solve + + + !> Log fouriersolver info + subroutine fouriersolver_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(fouriersolver), intent(in) :: this + character(len=str_long) :: message + + if (this%cfg%amRoot) then + write(message,'("fouriersolver solver [",a,"] for config [",a,"]")') & + trim(this%name), trim(this%cfg%name) + call log(message) + end if + + end subroutine fouriersolver_log + + + !> Print fouriersolver info to the screen + subroutine fouriersolver_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fouriersolver), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("fouriersolver solver [",a,"] for config [",a,"]")') & + trim(this%name), trim(this%cfg%name) + end if + + end subroutine fouriersolver_print + + + !> Short print of fouriersolver info to the screen + subroutine fouriersolver_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fouriersolver), intent(in) :: this + + if (this%cfg%amRoot) write(output_unit,'("fouriersolver solver [",a16,"] & + &for config [",a16,"]")') trim(this%name),trim(this%cfg%name) + + end subroutine fouriersolver_print_short + + subroutine fouriersolver_destroy(this) + implicit none + class(fouriersolver), intent(inout) :: this + + deallocate(this%stc,this%opr,this%rhs,this%sol,this%factored_operator, & + this%transformed_rhs,this%stmap) + + end subroutine fouriersolver_destroy + +end module fouriersolver_class + diff --git a/src/solver/linsol_class.f90 b/src/solver/linsol_class.f90 index c3bef687b..69d66de74 100644 --- a/src/solver/linsol_class.f90 +++ b/src/solver/linsol_class.f90 @@ -6,47 +6,47 @@ module linsol_class use string, only: str_medium implicit none private - - + + ! Expose type/constructor/methods public :: linsol - - + + !> linsol object definition type, abstract :: linsol - + ! A linear solver works for a config type(config), pointer :: cfg !< Config for linsol - + ! An linsol has a name character(len=str_medium) :: name !< Name of solver - + ! Specific method to use integer :: method !< Solution method (we assume all solvers will have some sort of options) - + ! An linsol has a stencil size integer :: nst !< Stencil size in 3D integer, dimension(:,:), allocatable :: stc !< Stencil map in 3D (from stencil entry to i/j/k shift) integer, dimension(:,:,:), allocatable :: stmap !< Inverse stencil map in 3D (from i/j/k shift to stencil entry) - + ! An linsol stores the linear operator and rhs real(WP), dimension(:,:,:,:), allocatable :: opr !< Linear operator real(WP), dimension(:,:,:), allocatable :: rhs !< RHS real(WP), dimension(:,:,:), allocatable :: sol !< Solution - + ! Is the solver setup? logical :: setup_done !< Check whether the solver has been setup - + ! Convergence criteria integer :: maxit !< Maximum number of iterations allowed real(WP) :: rcvg !< Desired relative convergence criterion real(WP) :: acvg !< Desired absolue convergence criterion - + ! Current convergence info integer :: it !< Current number of iterations real(WP) :: rerr !< Current relative error real(WP) :: aerr !< Current absolute error - + contains procedure(in_noarg_interface ), deferred :: print_short !< One-line printing of solver status procedure(in_noarg_interface ), deferred :: print !< Long-form printing of solver status @@ -56,8 +56,8 @@ module linsol_class procedure(inout_noarg_interface), deferred :: solve !< Execute solver (assumes new RHS and initial guess at every call) procedure(inout_noarg_interface), deferred :: destroy !< Solver destruction (every time the operator changes) end type linsol - - + + !> Interface abstract interface subroutine in_noarg_interface(this) @@ -69,6 +69,6 @@ subroutine inout_noarg_interface(this) class(linsol), intent(inout) :: this end subroutine inout_noarg_interface end interface - - + + end module linsol_class From 9a4638620aacb2f804f8d9d882d36c32795a03f0 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Wed, 1 Mar 2023 00:39:57 -0500 Subject: [PATCH 151/152] refactored fft functions to make them shorter, removed compiler warnings --- examples/hit/GNUmakefile | 4 +- examples/hit/src/simulation.f90 | 32 +- examples/ib_pipe/GNUmakefile | 3 +- examples/ib_pipe/src/simulation.f90 | 34 +- examples/riser/src/simulation.f90 | 38 +- src/solver/Make.package | 2 +- src/solver/fft3d_class.f90 | 1105 ++++++++++++++++ ...ersolver_class.f90 => fftsolver_class.f90} | 129 +- src/solver/fourier3d_class.f90 | 1107 ----------------- 9 files changed, 1224 insertions(+), 1230 deletions(-) create mode 100644 src/solver/fft3d_class.f90 rename src/solver/{fouriersolver_class.f90 => fftsolver_class.f90} (65%) delete mode 100644 src/solver/fourier3d_class.f90 diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile index f5f8dfd1c..ab67aa10e 100644 --- a/examples/hit/GNUmakefile +++ b/examples/hit/GNUmakefile @@ -5,7 +5,6 @@ NGA_HOME ?= ../.. PRECISION = DOUBLE USE_MPI = TRUE USE_FFTW = TRUE -USE_P3DFFT= TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE PROFILE = FALSE @@ -32,7 +31,7 @@ VPATH_LOCATIONS += $(Ulocs) include $(NGA_HOME)/tools/GNUMake/Make.defs # Include NGA base code -Bdirs := core constant_density data solver config grid libraries +Bdirs := core constant_density solver config grid libraries particles data Bpack += $(foreach dir, $(Bdirs), $(NGA_HOME)/src/$(dir)/Make.package) include $(Bpack) @@ -48,3 +47,4 @@ all: $(executable) # NGA compilation rules include $(NGA_HOME)/tools/GNUMake/Make.rules + diff --git a/examples/hit/src/simulation.f90 b/examples/hit/src/simulation.f90 index ca379b2c8..bb8f17021 100644 --- a/examples/hit/src/simulation.f90 +++ b/examples/hit/src/simulation.f90 @@ -1,23 +1,23 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg - use fouriersolver_class, only: fouriersolver - use incomp_class, only: incomp - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use monitor_class, only: monitor - use datafile_class, only: datafile - use string, only: str_medium + use precision, only: WP + use geometry, only: cfg + use fftsolver_class, only: fftsolver + use incomp_class, only: incomp + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use monitor_class, only: monitor + use datafile_class, only: datafile + use string, only: str_medium implicit none private !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker - type(fouriersolver), public :: ps - type(incomp), public :: fs - type(timetracker), public :: time + type(fftsolver), public :: ps + type(incomp), public :: fs + type(timetracker), public :: time !> Ensight postprocessing type(partmesh) :: pmesh @@ -193,7 +193,7 @@ subroutine simulation_init ! Assign constant density call param_read('Density',fs%rho) ! Prepare and configure pressure solver - ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) + ps=fftsolver(cfg=cfg,name='Pressure',nst=7) ! Setup the solver call fs%setup(pressure_solver=ps) end block create_and_initialize_flow_solver @@ -202,7 +202,6 @@ subroutine simulation_init initialize_velocity: block use random, only: random_normal use mpi_f08, only: MPI_ALLREDUCE,MPI_SUM - use parallel, only: MPI_REAL_WP use mathtools,only: Pi integer :: i,j,k ! Read in forcing, grid, and initial velocity field parameters @@ -372,7 +371,6 @@ end subroutine simulation_init subroutine simulation_run use parallel, only: parallel_time implicit none - integer :: ii ! Perform time integration do while (.not.time%done()) diff --git a/examples/ib_pipe/GNUmakefile b/examples/ib_pipe/GNUmakefile index bdb62cb2b..14c300608 100644 --- a/examples/ib_pipe/GNUmakefile +++ b/examples/ib_pipe/GNUmakefile @@ -7,10 +7,9 @@ USE_MPI = TRUE USE_HYPRE = TRUE USE_LAPACK= TRUE USE_FFTW = TRUE -USE_P3DFFT= TRUE USE_IRL = FALSE PROFILE = FALSE -DEBUG = FALSE +DEBUG = TRUE COMP = gnu EXEBASE = nga diff --git a/examples/ib_pipe/src/simulation.f90 b/examples/ib_pipe/src/simulation.f90 index fcdf28a86..526deab15 100644 --- a/examples/ib_pipe/src/simulation.f90 +++ b/examples/ib_pipe/src/simulation.f90 @@ -1,25 +1,25 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use precision, only: WP - use geometry, only: cfg,D,get_VF - use hypre_str_class, only: hypre_str - use fouriersolver_class, only: fouriersolver - use incomp_class, only: incomp - use sgsmodel_class, only: sgsmodel - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use event_class, only: event - use monitor_class, only: monitor + use precision, only: WP + use geometry, only: cfg,D,get_VF + use hypre_str_class, only: hypre_str + use fftsolver_class, only: fftsolver + use incomp_class, only: incomp + use sgsmodel_class, only: sgsmodel + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use event_class, only: event + use monitor_class, only: monitor implicit none private !> Get an an incompressible solver, pressure solver, and corresponding time tracker - type(incomp), public :: fs - !type(hypre_str), public :: ps - type(fouriersolver), public :: ps - type(hypre_str), public :: vs - type(sgsmodel), public :: sgs - type(timetracker), public :: time + type(incomp), public :: fs + !type(hypre_str), public :: ps + type(fftsolver), public :: ps + type(hypre_str), public :: vs + type(sgsmodel), public :: sgs + type(timetracker), public :: time !> Ensight postprocessing type(ensight) :: ens_out @@ -103,7 +103,7 @@ subroutine simulation_init call param_read('Density',fs%rho) call param_read('Dynamic viscosity',visc); fs%visc=visc ! Configure pressure solver - ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) + ps=fftsolver(cfg=cfg,name='Pressure',nst=7) !ps=hypre_str(cfg=cfg,name='Pressure',method=pcg_pfmg,nst=7) !ps%maxlevel=14 !call param_read('Pressure iteration',ps%maxit) diff --git a/examples/riser/src/simulation.f90 b/examples/riser/src/simulation.f90 index 2b7175fff..69f5be862 100644 --- a/examples/riser/src/simulation.f90 +++ b/examples/riser/src/simulation.f90 @@ -1,27 +1,27 @@ !> Various definitions and tools for running an NGA2 simulation module simulation - use string, only: str_medium - use precision, only: WP - use geometry, only: cfg,D,get_VF - use lowmach_class, only: lowmach - use fouriersolver_class, only: fouriersolver - use hypre_str_class, only: hypre_str - use lpt_class, only: lpt - use timetracker_class, only: timetracker - use ensight_class, only: ensight - use partmesh_class, only: partmesh - use event_class, only: event - use datafile_class, only: datafile - use monitor_class, only: monitor + use string, only: str_medium + use precision, only: WP + use geometry, only: cfg,D,get_VF + use lowmach_class, only: lowmach + use fftsolver_class, only: fftsolver + use hypre_str_class, only: hypre_str + use lpt_class, only: lpt + use timetracker_class, only: timetracker + use ensight_class, only: ensight + use partmesh_class, only: partmesh + use event_class, only: event + use datafile_class, only: datafile + use monitor_class, only: monitor implicit none private !> Get an LPT solver, a lowmach solver, and corresponding time tracker - type(lowmach), public :: fs - type(fouriersolver), public :: ps - type(hypre_str), public :: vs - type(lpt), public :: lp - type(timetracker), public :: time + type(lowmach), public :: fs + type(fftsolver), public :: ps + type(hypre_str), public :: vs + type(lpt), public :: lp + type(timetracker), public :: time !> Provide a datafile and an event tracker for saving restarts type(event) :: save_evt @@ -228,7 +228,7 @@ subroutine simulation_init ! Assign acceleration of gravity call param_read('Gravity',fs%gravity) ! Configure pressure solver - ps=fouriersolver(cfg=cfg,name='Pressure',nst=7) + ps=fftsolver(cfg=cfg,name='Pressure',nst=7) ! Configure implicit velocity solver vs=hypre_str(cfg=cfg,name='Velocity',method=pcg_pfmg,nst=7) call param_read('Implicit iteration',vs%maxit) diff --git a/src/solver/Make.package b/src/solver/Make.package index a8ffdd616..e257be322 100644 --- a/src/solver/Make.package +++ b/src/solver/Make.package @@ -3,7 +3,7 @@ ifeq ($(USE_HYPRE),TRUE) f90EXE_sources += hypre_str_class.f90 hypre_uns_class.f90 ils_class.f90 endif ifeq ($(USE_FFTW),TRUE) - f90EXE_sources += fourier3d_class.f90 fouriersolver_class.f90 + f90EXE_sources += fft3d_class.f90 fftsolver_class.f90 endif INCLUDE_LOCATIONS += $(NGA_HOME)/src/solver diff --git a/src/solver/fft3d_class.f90 b/src/solver/fft3d_class.f90 new file mode 100644 index 000000000..9b586e492 --- /dev/null +++ b/src/solver/fft3d_class.f90 @@ -0,0 +1,1105 @@ +!> FFT for 3D periodic uniform computational domains decomposed in at most 2 +!> directions. Makes use of FFTW and in-house parallel transpose operations. +!> +!> The FFT-based pressure solver that uses this class internally may be found +!> in fftsolver_clas.f90 + +module fft3d_class + use precision, only: WP + use pgrid_class, only: pgrid + use string, only: str_short + use, intrinsic :: iso_c_binding + implicit none + private + + + ! Expose type/constructor/methods + public :: fft3d + + + !> fft3d object definition + type :: fft3d + + ! pgrid + class(pgrid), pointer :: pg + + ! FFT's oddball + logical :: oddball + + ! Data storage for FFTW plans + complex(WP), dimension(:), allocatable :: in_x,out_x + complex(WP), dimension(:), allocatable :: in_y,out_y + complex(WP), dimension(:), allocatable :: in_z,out_z + + ! FFTW plans + type(C_PTR) :: fplan_x,bplan_x + type(C_PTR) :: fplan_y,bplan_y + type(C_PTR) :: fplan_z,bplan_z + + !> Unstrided arrays + complex(WP), dimension(:,:,:), allocatable :: factored_operator + complex(WP), dimension(:,:,:), allocatable :: transformed_rhs + + ! Storage for transposed data + complex(WP), dimension(:,:,:), allocatable :: xtrans, ytrans, ztrans + + ! Transpose partition - X + integer, dimension(:), allocatable :: imin_x,imax_x + integer, dimension(:), allocatable :: jmin_x,jmax_x + integer, dimension(:), allocatable :: kmin_x,kmax_x + integer, dimension(:), allocatable :: nx_x,ny_x,nz_x + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x + integer :: sendcount_x,recvcount_x + character :: xdir + + ! Transpose partition - Y + integer, dimension(:), allocatable :: imin_y,imax_y + integer, dimension(:), allocatable :: jmin_y,jmax_y + integer, dimension(:), allocatable :: kmin_y,kmax_y + integer, dimension(:), allocatable :: nx_y,ny_y,nz_y + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y + integer :: sendcount_y,recvcount_y + character :: ydir + + ! Transpose partition - Z + integer, dimension(:), allocatable :: imin_z,imax_z + integer, dimension(:), allocatable :: jmin_z,jmax_z + integer, dimension(:), allocatable :: kmin_z,kmax_z + integer, dimension(:), allocatable :: nx_z,ny_z,nz_z + complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z + integer :: sendcount_z,recvcount_z + character :: zdir + + contains + + procedure :: print_short=>fft3d_print_short !< One-line printing of solver status + procedure :: print=>fft3d_print !< Long-form printing of solver status + procedure :: log=>fft3d_log !< Long-form logging of solver status + final :: fft3d_destroy !< Deconstructor + + procedure :: forward_transform => fft3d_fourier_transform + procedure :: backward_transform => fft3d_inverse_transform + + procedure, private :: fft3d_xtranspose_init + procedure, private :: fft3d_ytranspose_init + procedure, private :: fft3d_ztranspose_init + + procedure, private :: fft3d_xtranspose_forward + procedure, private :: fft3d_ytranspose_forward + procedure, private :: fft3d_ztranspose_forward + + procedure, private :: fft3d_xtranspose_backward + procedure, private :: fft3d_ytranspose_backward + procedure, private :: fft3d_ztranspose_backward + + end type fft3d + + + !> Declare fft3d constructor + interface fft3d; procedure fft3d_from_args; end interface fft3d; + + +contains + + + !> Constructor for a fft3d object + !> (pgrid is a subclass of pgrid; a full cfg object can be passed here + !> without issue) + function fft3d_from_args(pg) result(self) + use messager, only: die + implicit none + type(fft3d) :: self + class(pgrid), target, intent(in) :: pg + include 'fftw3.f03' + + ! Link the config and store the name + self%pg=>pg + + ! Various checks to ensure we can use this solver + check_solver_is_useable: block + integer :: ndim,ndcp + ! Periodicity and uniformity of mesh + if (self%pg%nx.gt.1.and..not.(self%pg%xper.and.self%pg%uniform_x)) & + call die('[fft3d constructor] Need x-direction needs to be & + &periodic and uniform') + if (self%pg%ny.gt.1.and..not.(self%pg%yper.and.self%pg%uniform_y)) & + call die('[fft3d constructor] Need y-direction needs to be & + &periodic and uniform') + if (self%pg%nz.gt.1.and..not.(self%pg%zper.and.self%pg%uniform_z)) & + call die('[fft3d constructor] Need z-direction needs to be & + &periodic and uniform') + ! Ensure that we have at least one non-decomposed direction + ndim = count((/ self%pg%nx, self%pg%ny, self%pg%nz /) .gt. 1) + ndcp = count((/ self%pg%npx, self%pg%npy, self%pg%npz /) .gt. 1) + if (ndcp.ge.ndim) call die('[fft3d constructor] Need at least one & + &NON-decomposed direction') + end block check_solver_is_useable + + ! Initialize transpose and FFTW plans in x + if (self%pg%nx.gt.1) then + call self%fft3d_xtranspose_init() + allocate(self%in_x(self%pg%nx),self%out_x(self%pg%nx)) + self%fplan_x=fftw_plan_dft_1d(self%pg%nx,self%in_x,self%out_x,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_x=fftw_plan_dft_1d(self%pg%nx,self%in_x,self%out_x,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in y + if (self%pg%ny.gt.1) then + call self%fft3d_ytranspose_init() + allocate(self%in_y(self%pg%ny),self%out_y(self%pg%ny)) + self%fplan_y=fftw_plan_dft_1d(self%pg%ny,self%in_y,self%out_y,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_y=fftw_plan_dft_1d(self%pg%ny,self%in_y,self%out_y,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Initialize transpose and FFTW plans in z + if (self%pg%nz.gt.1) then + call self%fft3d_ztranspose_init() + allocate(self%in_z(self%pg%nz),self%out_z(self%pg%nz)) + self%fplan_z=fftw_plan_dft_1d(self%pg%nz,self%in_z,self%out_z,FFTW_FORWARD,FFTW_MEASURE) + self%bplan_z=fftw_plan_dft_1d(self%pg%nz,self%in_z,self%out_z,FFTW_BACKWARD,FFTW_MEASURE) + end if + + ! Find who owns the oddball + self%oddball=all((/ self%pg%iproc, self%pg%jproc, self%pg%kproc /) .eq. 1) + + end function fft3d_from_args + + + !> Initialize transpose tool in x + subroutine fft3d_xtranspose_init(this) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + integer :: ierr,ip,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%pg%npx.eq.1.and.this%pg%nx.gt.1) then + this%xdir='x' + else if (this%pg%npy.eq.1.and.this%pg%ny.gt.1) then + this%xdir='y' + else if (this%pg%npz.eq.1.and.this%pg%nz.gt.1) then + this%xdir='z' + end if + + ! Allocate global partitions + allocate( this%nx_x(this%pg%npx)) + allocate( this%ny_x(this%pg%npx)) + allocate( this%nz_x(this%pg%npx)) + allocate(this%imin_x(this%pg%npx)) + allocate(this%imax_x(this%pg%npx)) + allocate(this%jmin_x(this%pg%npx)) + allocate(this%jmax_x(this%pg%npx)) + allocate(this%kmin_x(this%pg%npx)) + allocate(this%kmax_x(this%pg%npx)) + + ! Partition + select case (trim(this%xdir)) + case ('x') + + ! No transpose required, use local partition + this%nx_x=this%pg%nx_ + this%ny_x=this%pg%ny_ + this%nz_x=this%pg%nz_ + this%imin_x=this%pg%imin_ + this%imax_x=this%pg%imax_ + this%jmin_x=this%pg%jmin_ + this%jmax_x=this%pg%jmax_ + this%kmin_x=this%pg%kmin_ + this%kmax_x=this%pg%kmax_ + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%pg%xcomm,ierr) + call MPI_AllGather(this%pg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%pg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%pg%npx + q=this%pg%ny/this%pg%npx + r=mod(this%pg%ny,this%pg%npx) + if (ip.le.r) then + this%ny_x(ip) =q+1 + this%jmin_x(ip)=this%pg%jmin+(ip-1)*(q+1) + else + this%ny_x(ip) =q + this%jmin_x(ip)=this%pg%jmin+r*(q+1)+(ip-r-1)*q + end if + this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 + end do + this%nz_x=this%pg%nz_ + this%kmin_x=this%pg%kmin_ + this%kmax_x=this%pg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%pg%nz_ + this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%pg%nz_ + allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%pg%kmin_:this%pg%kmax_,this%pg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%pg%kmin_:this%pg%kmax_,this%pg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%pg%xcomm,ierr) + call MPI_AllGather(this%pg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%pg%xcomm,ierr) + this%nx_x=this%imax_x-this%imin_x+1 + + ! Partition new local indices + do ip=1,this%pg%npx + q=this%pg%nz/this%pg%npx + r=mod(this%pg%nz,this%pg%npx) + if (ip.le.r) then + this%nz_x(ip) =q+1 + this%kmin_x(ip)=this%pg%kmin+(ip-1)*(q+1) + else + this%nz_x(ip) =q + this%kmin_x(ip)=this%pg%kmin+r*(q+1)+(ip-r-1)*q + end if + this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 + end do + this%ny_x=this%pg%ny_ + this%jmin_x=this%pg%jmin_ + this%jmax_x=this%pg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_x=maxval(this%nx_x)*this%pg%ny_*maxval(this%nz_x) + this%recvcount_x=maxval(this%nx_x)*this%pg%ny_*maxval(this%nz_x) + allocate(this%sendbuf_x(maxval(this%nx_x),this%pg%jmin_:this%pg%jmax_,maxval(this%nz_x),this%pg%npx)) + allocate(this%recvbuf_x(maxval(this%nx_x),this%pg%jmin_:this%pg%jmax_,maxval(this%nz_x),this%pg%npx)) + + ! Zero out buffers + this%sendbuf_x=0.0_WP + this%recvbuf_x=0.0_WP + + end select + + ! Allocate storage + allocate(this%xtrans(this%pg%imin:this%pg%imax,this%jmin_x(this%pg%iproc):this%jmax_x(this%pg%iproc),this%kmin_x(this%pg%iproc):this%kmax_x(this%pg%iproc))) + + end subroutine fft3d_xtranspose_init + + + !> Initialize transpose tool in y + subroutine fft3d_ytranspose_init(this) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + integer :: ierr,jp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%pg%npy.eq.1.and.this%pg%ny.gt.1) then + this%ydir='y' + else if (this%pg%npz.eq.1.and.this%pg%nz.gt.1) then + this%ydir='z' + else if (this%pg%npx.eq.1.and.this%pg%nx.gt.1) then + this%ydir='x' + end if + + ! Allocate global partitions + allocate( this%nx_y(this%pg%npy)) + allocate( this%ny_y(this%pg%npy)) + allocate( this%nz_y(this%pg%npy)) + allocate(this%imin_y(this%pg%npy)) + allocate(this%imax_y(this%pg%npy)) + allocate(this%jmin_y(this%pg%npy)) + allocate(this%jmax_y(this%pg%npy)) + allocate(this%kmin_y(this%pg%npy)) + allocate(this%kmax_y(this%pg%npy)) + + ! Partition + select case (trim(this%ydir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%pg%ycomm,ierr) + call MPI_AllGather(this%pg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%pg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%pg%npy + q=this%pg%nx/this%pg%npy + r=mod(this%pg%nx,this%pg%npy) + if (jp.le.r) then + this%nx_y(jp) =q+1 + this%imin_y(jp)=this%pg%imin+(jp-1)*(q+1) + else + this%nx_y(jp) =q + this%imin_y(jp)=this%pg%imin+r*(q+1)+(jp-r-1)*q + end if + this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 + end do + this%nz_y=this%pg%nz_ + this%kmin_y=this%pg%kmin_ + this%kmax_y=this%pg%kmax_ + + ! Variables for AllToAll communication + this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%pg%nz_ + this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%pg%nz_ + allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%pg%kmin_:this%pg%kmax_,this%pg%npy)) + allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%pg%kmin_:this%pg%kmax_,this%pg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + case ('y') + + ! No transpose required, use local partition + this%nx_y=this%pg%nx_ + this%ny_y=this%pg%ny_ + this%nz_y=this%pg%nz_ + this%imin_y=this%pg%imin_ + this%imax_y=this%pg%imax_ + this%jmin_y=this%pg%jmin_ + this%jmax_y=this%pg%jmax_ + this%kmin_y=this%pg%kmin_ + this%kmax_y=this%pg%kmax_ + + case ('z') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%pg%ycomm,ierr) + call MPI_AllGather(this%pg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%pg%ycomm,ierr) + this%ny_y=this%jmax_y-this%jmin_y+1 + + ! Partition new local indices + do jp=1,this%pg%npy + q=this%pg%nz/this%pg%npy + r=mod(this%pg%nz,this%pg%npy) + if (jp.le.r) then + this%nz_y(jp) =q+1 + this%kmin_y(jp)=this%pg%kmin+(jp-1)*(q+1) + else + this%nz_y(jp) =q + this%kmin_y(jp)=this%pg%kmin+r*(q+1)+(jp-r-1)*q + end if + this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 + end do + this%nx_y=this%pg%nx_ + this%imin_y=this%pg%imin_ + this%imax_y=this%pg%imax_ + + ! Variables for AllToAll communication + this%sendcount_y=this%pg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + this%recvcount_y=this%pg%nx_*maxval(this%ny_y)*maxval(this%nz_y) + allocate(this%sendbuf_y(this%pg%imin_:this%pg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%pg%npy)) + allocate(this%recvbuf_y(this%pg%imin_:this%pg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%pg%npy)) + + ! Zero out buffers + this%sendbuf_y=0.0_WP + this%recvbuf_y=0.0_WP + + end select + + ! Allocate storage + allocate(this%ytrans(this%imin_y(this%pg%jproc):this%imax_y(this%pg%jproc),this%pg%jmin:this%pg%jmax,this%kmin_y(this%pg%jproc):this%kmax_y(this%pg%jproc))) + + end subroutine fft3d_ytranspose_init + + + !> Initialize transpose tool in z + subroutine fft3d_ztranspose_init(this) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + integer :: ierr,kp,q,r + + ! Determine non-decomposed direction to use for transpose + if (this%pg%npz.eq.1.and.this%pg%nz.gt.1) then + this%zdir='z' + else if (this%pg%npx.eq.1.and.this%pg%nx.gt.1) then + this%zdir='x' + else if (this%pg%npy.eq.1.and.this%pg%ny.gt.1) then + this%zdir='y' + end if + + ! Allocate global partitions + allocate( this%nx_z(this%pg%npz)) + allocate( this%ny_z(this%pg%npz)) + allocate( this%nz_z(this%pg%npz)) + allocate(this%imin_z(this%pg%npz)) + allocate(this%imax_z(this%pg%npz)) + allocate(this%jmin_z(this%pg%npz)) + allocate(this%jmax_z(this%pg%npz)) + allocate(this%kmin_z(this%pg%npz)) + allocate(this%kmax_z(this%pg%npz)) + + ! Partition + select case (trim(this%zdir)) + case ('x') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%pg%zcomm,ierr) + call MPI_AllGather(this%pg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%pg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%pg%npz + q=this%pg%nx/this%pg%npz + r=mod(this%pg%nx,this%pg%npz) + if (kp.le.r) then + this%nx_z(kp) =q+1 + this%imin_z(kp)=this%pg%imin+(kp-1)*(q+1) + else + this%nx_z(kp) =q + this%imin_z(kp)=this%pg%imin+r*(q+1)+(kp-r-1)*q + end if + this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 + end do + this%ny_z=this%pg%ny_ + this%jmin_z=this%pg%jmin_ + this%jmax_z=this%pg%jmax_ + + ! Variables for AllToAll communication + this%sendcount_z=maxval(this%nx_z)*this%pg%ny_*maxval(this%nz_z) + this%recvcount_z=maxval(this%nx_z)*this%pg%ny_*maxval(this%nz_z) + allocate(this%sendbuf_z(maxval(this%nx_z),this%pg%jmin_:this%pg%jmax_,maxval(this%nz_z),this%pg%npz)) + allocate(this%recvbuf_z(maxval(this%nx_z),this%pg%jmin_:this%pg%jmax_,maxval(this%nz_z),this%pg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('y') + + ! Store old local indices from each processor + call MPI_AllGather(this%pg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%pg%zcomm,ierr) + call MPI_AllGather(this%pg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%pg%zcomm,ierr) + this%nz_z=this%kmax_z-this%kmin_z+1 + + ! Partition new local indices + do kp=1,this%pg%npz + q=this%pg%ny/this%pg%npz + r=mod(this%pg%ny,this%pg%npz) + if (kp.le.r) then + this%ny_z(kp) =q+1 + this%jmin_z(kp)=this%pg%jmin+(kp-1)*(q+1) + else + this%ny_z(kp) =q + this%jmin_z(kp)=this%pg%jmin+r*(q+1)+(kp-r-1)*q + end if + this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 + end do + this%nx_z=this%pg%nx_ + this%imin_z=this%pg%imin_ + this%imax_z=this%pg%imax_ + + ! Variables for AllToAll communication + this%sendcount_z=this%pg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + this%recvcount_z=this%pg%nx_*maxval(this%ny_z)*maxval(this%nz_z) + allocate(this%sendbuf_z(this%pg%imin_:this%pg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%pg%npz)) + allocate(this%recvbuf_z(this%pg%imin_:this%pg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%pg%npz)) + + ! Zero out buffers + this%sendbuf_z=0.0_WP + this%recvbuf_z=0.0_WP + + case ('z') + + ! No transpose required, use local partition + this%nx_z=this%pg%nx_ + this%ny_z=this%pg%ny_ + this%nz_z=this%pg%nz_ + this%imin_z=this%pg%imin_ + this%imax_z=this%pg%imax_ + this%jmin_z=this%pg%jmin_ + this%jmax_z=this%pg%jmax_ + this%kmin_z=this%pg%kmin_ + this%kmax_z=this%pg%kmax_ + + end select + + ! Allocate storage + allocate(this%ztrans(this%imin_z(this%pg%kproc):this%imax_z(this%pg%kproc),this%jmin_z(this%pg%kproc):this%jmax_z(this%pg%kproc),this%pg%kmin:this%pg%kmax)) + + end subroutine fft3d_ztranspose_init + + + !> Perform forward transpose in x + subroutine fft3d_xtranspose_forward(this,A,At) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(in) :: A + complex(WP), dimension(this%pg%imin :,this%jmin_x(this%pg%iproc):,this%kmin_x(this%pg%iproc):), intent(out) :: At + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + At=A + case ('y') + ! Transpose x=>y + do ip=1,this%pg%npx + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%pg%imin_,this%pg%imax_ + jj=j-this%jmin_x(ip)+1 + ii=i-this%pg%imin_+1 + this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%pg%xcomm,ierr) + do ip=1,this%pg%npx + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_x(this%pg%iproc),this%jmax_x(this%pg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%pg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose x=>z + do ip=1,this%pg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%pg%imin_,this%pg%imax_ + kk=k-this%kmin_x(ip)+1 + ii=i-this%pg%imin_+1 + this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%pg%xcomm,ierr) + do ip=1,this%pg%npx + do k=this%kmin_x(this%pg%iproc),this%kmax_x(this%pg%iproc) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%pg%iproc)+1 + ii=i-this%imin_x(ip)+1 + At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine fft3d_xtranspose_forward + + + !> Perform forward transpose in y + subroutine fft3d_ytranspose_forward(this,A,At) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_y(this%pg%jproc):,this%pg%jmin:,this%kmin_y(this%pg%jproc):), intent(out) :: At + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose y=>x + do jp=1,this%pg%npy + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%pg%jmin_+1 + this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%pg%ycomm,ierr) + do jp=1,this%pg%npy + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%pg%jproc),this%imax_y(this%pg%jproc) + ii=i-this%imin_y(this%pg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + At=A + case ('z') + ! Transpose y=>z + do jp=1,this%pg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%pg%imin_,this%pg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%pg%jmin_+1 + this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%pg%ycomm,ierr) + do jp=1,this%pg%npy + do k=this%kmin_y(this%pg%jproc),this%kmax_y(this%pg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%pg%imin_,this%pg%imax_ + kk=k-this%kmin_y(this%pg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine fft3d_ytranspose_forward + + + !> Perform forward transpose in z + subroutine fft3d_ztranspose_forward(this,A,At) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(in) :: A + complex(WP), dimension(this%imin_z(this%pg%kproc):,this%jmin_z(this%pg%kproc):,this%pg%kmin:), intent(out) :: At + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose z=>x + do kp=1,this%pg%npz + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%pg%kmin_+1 + this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%pg%zcomm,ierr) + do kp=1,this%pg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_z(this%pg%kproc),this%imax_z(this%pg%kproc) + ii=i-this%imin_z(this%pg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose z=>y + do kp=1,this%pg%npz + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%pg%imin_,this%pg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%pg%kmin_+1 + this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%pg%zcomm,ierr) + do kp=1,this%pg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%pg%kproc),this%jmax_z(this%pg%kproc) + do i=this%pg%imin_,this%pg%imax_ + jj=j-this%jmin_z(this%pg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + At=A + end select + + end subroutine fft3d_ztranspose_forward + + + !> Perform backward transpose in x + subroutine fft3d_xtranspose_backward(this,At,A) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin :,this%jmin_x(this%pg%iproc):,this%kmin_x(this%pg%iproc):), intent(in) :: At + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(out) :: A + integer :: i,j,k,ip,ii,jj,kk,ierr + + select case (trim(this%xdir)) + case ('x') + ! No transpose required + A=At + case ('y') + ! Transpose y=>x + do ip=1,this%pg%npx + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_x(this%pg%iproc),this%jmax_x(this%pg%iproc) + do i=this%imin_x(ip),this%imax_x(ip) + jj=j-this%jmin_x(this%pg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%pg%xcomm,ierr) + do ip=1,this%pg%npx + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_x(ip),this%jmax_x(ip) + do i=this%imin_x(this%pg%iproc),this%imax_x(this%pg%iproc) + jj=j-this%jmin_x(ip)+1 + ii=i-this%imin_x(this%pg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) + end do + end do + end do + end do + case ('z') + ! Transpose z=>x + do ip=1,this%pg%npx + do k=this%kmin_x(this%pg%iproc),this%kmax_x(this%pg%iproc) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_x(ip),this%imax_x(ip) + kk=k-this%kmin_x(this%pg%iproc)+1 + ii=i-this%imin_x(ip)+1 + this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%pg%xcomm,ierr) + do ip=1,this%pg%npx + do k=this%kmin_x(ip),this%kmax_x(ip) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_x(this%pg%iproc),this%imax_x(this%pg%iproc) + kk=k-this%kmin_x(ip)+1 + ii=i-this%imin_x(this%pg%iproc)+1 + A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) + end do + end do + end do + end do + end select + + end subroutine fft3d_xtranspose_backward + + + !> Perform backward transpose in y + subroutine fft3d_ytranspose_backward(this,At,A) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%imin_y(this%pg%jproc):,this%pg%jmin:,this%kmin_y(this%pg%jproc):), intent(in) :: At + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(out) :: A + integer :: i,j,k,jp,ii,jj,kk,ierr + + select case (trim(this%ydir)) + case ('x') + ! Transpose x=>y + do jp=1,this%pg%npy + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%imin_y(this%pg%jproc),this%imax_y(this%pg%jproc) + ii=i-this%imin_y(this%pg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%pg%ycomm,ierr) + do jp=1,this%pg%npy + do k=this%pg%kmin_,this%pg%kmax_ + do j=this%jmin_y(this%pg%jproc),this%jmax_y(this%pg%jproc) + do i=this%imin_y(jp),this%imax_y(jp) + ii=i-this%imin_y(jp)+1 + jj=j-this%jmin_y(this%pg%jproc)+1 + A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) + end do + end do + end do + end do + case ('y') + ! No transpose required + A=At + case ('z') + ! Transpose z=>y + do jp=1,this%pg%npy + do k=this%kmin_y(this%pg%jproc),this%kmax_y(this%pg%jproc) + do j=this%jmin_y(jp),this%jmax_y(jp) + do i=this%pg%imin_,this%pg%imax_ + kk=k-this%kmin_y(this%pg%jproc)+1 + jj=j-this%jmin_y(jp)+1 + this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%pg%ycomm,ierr) + do jp=1,this%pg%npy + do k=this%kmin_y(jp),this%kmax_y(jp) + do j=this%jmin_y(this%pg%jproc),this%jmax_y(this%pg%jproc) + do i=this%pg%imin_,this%pg%imax_ + kk=k-this%kmin_y(jp)+1 + jj=j-this%jmin_y(this%pg%jproc)+1 + A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) + end do + end do + end do + end do + end select + + end subroutine fft3d_ytranspose_backward + + + !> Perform backward transpose in z + subroutine fft3d_ztranspose_backward(this,At,A) + use mpi_f08 + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%imin_z(this%pg%kproc):,this%jmin_z(this%pg%kproc):,this%pg%kmin:), intent(in) :: At + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(out) :: A + integer :: i,j,k,kp,ii,jj,kk,ierr + + select case (trim(this%zdir)) + case ('x') + ! Transpose x=>z + do kp=1,this%pg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_z(this%pg%kproc),this%imax_z(this%pg%kproc) + ii=i-this%imin_z(this%pg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%pg%zcomm,ierr) + do kp=1,this%pg%npz + do k=this%kmin_z(this%pg%kproc),this%kmax_z(this%pg%kproc) + do j=this%pg%jmin_,this%pg%jmax_ + do i=this%imin_z(kp),this%imax_z(kp) + ii=i-this%imin_z(kp)+1 + kk=k-this%kmin_z(this%pg%kproc)+1 + A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) + end do + end do + end do + end do + case ('y') + ! Transpose y=>z + do kp=1,this%pg%npz + do k=this%kmin_z(kp),this%kmax_z(kp) + do j=this%jmin_z(this%pg%kproc),this%jmax_z(this%pg%kproc) + do i=this%pg%imin_,this%pg%imax_ + jj=j-this%jmin_z(this%pg%kproc)+1 + kk=k-this%kmin_z(kp)+1 + this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) + end do + end do + end do + end do + call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%pg%zcomm,ierr) + do kp=1,this%pg%npz + do k=this%kmin_z(this%pg%kproc),this%kmax_z(this%pg%kproc) + do j=this%jmin_z(kp),this%jmax_z(kp) + do i=this%pg%imin_,this%pg%imax_ + jj=j-this%jmin_z(kp)+1 + kk=k-this%kmin_z(this%pg%kproc)+1 + A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) + end do + end do + end do + end do + case ('z') + ! No transpose required + A=At + end select + + end subroutine fft3d_ztranspose_backward + + + !> Transpose A and perform Fourier transform + subroutine fft3d_fourier_transform(this,A) + use messager, only: die + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%pg%nx.gt.1) then + ! Transpose in X + call this%fft3d_xtranspose_forward(A,this%xtrans) + ! Forward transform - X + do k=this%kmin_x(this%pg%iproc),this%kmax_x(this%pg%iproc) + do j=this%jmin_x(this%pg%iproc),this%jmax_x(this%pg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x + end do + end do + ! Transpose back + call this%fft3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%pg%ny.gt.1) then + ! Transpose in Y + call this%fft3d_ytranspose_forward(A,this%ytrans) + ! Forward transform - Y + do k=this%kmin_y(this%pg%jproc),this%kmax_y(this%pg%jproc) + do i=this%imin_y(this%pg%jproc),this%imax_y(this%pg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y + end do + end do + ! Transpose back + call this%fft3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%pg%nz.gt.1) then + ! Transpose in Z + call this%fft3d_ztranspose_forward(A,this%ztrans) + ! Forward transform - Z + do j=this%jmin_z(this%pg%kproc),this%jmax_z(this%pg%kproc) + do i=this%imin_z(this%pg%kproc),this%imax_z(this%pg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z + end do + end do + ! Transpose back + call this%fft3d_ztranspose_backward(this%ztrans,A) + end if + + ! Oddball + if (this%oddball) A(this%pg%imin_,this%pg%jmin_,this%pg%kmin_)=0.0_WP + + end subroutine fft3d_fourier_transform + + + !> FFT -> real and transpose back + subroutine fft3d_inverse_transform(this,A) + use messager, only: die + implicit none + class(fft3d), intent(inout) :: this + complex(WP), dimension(this%pg%imin_:,this%pg%jmin_:,this%pg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) + integer :: i,j,k + include 'fftw3.f03' + + if (this%pg%nx.gt.1) then + ! Transpose in X + call this%fft3d_xtranspose_forward(A,this%xtrans) + ! Inverse transform + do k=this%kmin_x(this%pg%iproc),this%kmax_x(this%pg%iproc) + do j=this%jmin_x(this%pg%iproc),this%jmax_x(this%pg%iproc) + this%in_x=this%xtrans(:,j,k) + call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) + this%xtrans(:,j,k)=this%out_x/this%pg%nx + end do + end do + ! Transpose back + call this%fft3d_xtranspose_backward(this%xtrans,A) + end if + + if (this%pg%ny.gt.1) then + ! Transpose in Y + call this%fft3d_ytranspose_forward(A,this%ytrans) + ! Inverse transform + do k=this%kmin_y(this%pg%jproc),this%kmax_y(this%pg%jproc) + do i=this%imin_y(this%pg%jproc),this%imax_y(this%pg%jproc) + this%in_y=this%ytrans(i,:,k) + call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) + this%ytrans(i,:,k)=this%out_y/this%pg%ny + end do + end do + ! Transpose back + call this%fft3d_ytranspose_backward(this%ytrans,A) + end if + + if (this%pg%nz.gt.1) then + ! Transpose in Z + call this%fft3d_ztranspose_forward(A,this%ztrans) + ! Inverse transform + do j=this%jmin_z(this%pg%kproc),this%jmax_z(this%pg%kproc) + do i=this%imin_z(this%pg%kproc),this%imax_z(this%pg%kproc) + this%in_z=this%ztrans(i,j,:) + call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) + this%ztrans(i,j,:)=this%out_z/this%pg%nz + end do + end do + ! Transpose back + call this%fft3d_ztranspose_backward(this%ztrans,A) + end if + + end subroutine fft3d_inverse_transform + + + !> Destroy FFT object + subroutine fft3d_destroy(this) + use messager, only: die + implicit none + type(fft3d), intent(inout) :: this + include 'fftw3.f03' + + ! Destroy our plans + call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x); + call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y); + call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z); + + end subroutine fft3d_destroy + + + !> Log fft3d info + subroutine fft3d_log(this) + use string, only: str_long + use messager, only: log + implicit none + class(fft3d), intent(in) :: this + character(len=str_long) :: message + + if (this%pg%amRoot) then + write(message,'("fft3d for config [",a,"]")') trim(this%pg%name) + call log(message) + end if + + end subroutine fft3d_log + + + !> Print fft3d info to the screen + subroutine fft3d_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fft3d), intent(in) :: this + + if (this%pg%amRoot) then + write(output_unit,'("fft3d for config [",a,"]")') trim(this%pg%name) + end if + + end subroutine fft3d_print + + + !> Short print of fft3d info to the screen + subroutine fft3d_print_short(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(fft3d), intent(in) :: this + + if (this%pg%amRoot) then + write(output_unit,'("fft3d for config [",a16,"]")') trim(this%pg%name) + end if + + end subroutine fft3d_print_short + + +end module fft3d_class + diff --git a/src/solver/fouriersolver_class.f90 b/src/solver/fftsolver_class.f90 similarity index 65% rename from src/solver/fouriersolver_class.f90 rename to src/solver/fftsolver_class.f90 index 906c60852..b77d47b36 100644 --- a/src/solver/fouriersolver_class.f90 +++ b/src/solver/fftsolver_class.f90 @@ -1,27 +1,28 @@ !> 3D FFT pressure solver concept is defined by extension of the linsol class !> This solver is specifically intended to be a FFT-based pressure Poisson solver !> for 3D periodic uniform computational domains decomposed in at most 2 directions -!> uses fourier3d for Fourier transform -module fouriersolver_class - use precision, only: WP - use config_class, only: config - use fourier3d_class, only: fourier3d - use string, only: str_short - use linsol_class, only: linsol +!> uses fft3d for Fourier transform + +module fftsolver_class + use precision, only: WP + use config_class, only: config + use fft3d_class, only: fft3d + use string, only: str_short + use linsol_class, only: linsol use, intrinsic :: iso_c_binding implicit none private ! Expose type/constructor/methods - public :: fouriersolver + public :: fftsolver - !> fouriersolver object definition - type, extends(linsol) :: fouriersolver + !> fftsolver object definition + type, extends(linsol) :: fftsolver ! FFT object - class(fourier3d), allocatable :: dft + class(fft3d), allocatable :: dft !> Unstrided arrays complex(WP), dimension(:,:,:), allocatable :: factored_operator @@ -29,29 +30,29 @@ module fouriersolver_class contains - procedure :: print_short=>fouriersolver_print_short !< One-line printing of solver status - procedure :: print=>fouriersolver_print !< Long-form printing of solver status - procedure :: log=>fouriersolver_log !< Long-form logging of solver status - procedure :: init=>fouriersolver_init !< Grid and stencil initialization - done once for the grid and stencil - procedure :: setup=>fouriersolver_setup !< Solver setup (every time the operator changes) - procedure :: solve=>fouriersolver_solve !< Execute solver (assumes new RHS and initial guess at every call) - procedure :: destroy=>fouriersolver_destroy + procedure :: print_short=>fftsolver_print_short !< One-line printing of solver status + procedure :: print=>fftsolver_print !< Long-form printing of solver status + procedure :: log=>fftsolver_log !< Long-form logging of solver status + procedure :: init=>fftsolver_init !< Grid and stencil initialization - done once for the grid and stencil + procedure :: setup=>fftsolver_setup !< Solver setup (every time the operator changes) + procedure :: solve=>fftsolver_solve !< Execute solver (assumes new RHS and initial guess at every call) + procedure :: destroy=>fftsolver_destroy - end type fouriersolver + end type fftsolver - !> Declare fouriersolver constructor - interface fouriersolver; procedure fouriersolver_from_args; end interface fouriersolver; + !> Declare fftsolver constructor + interface fftsolver; procedure fftsolver_from_args; end interface fftsolver; contains - !> Constructor for a fouriersolver object - function fouriersolver_from_args(cfg,name,nst) result(self) + !> Constructor for a fftsolver object + function fftsolver_from_args(cfg,name,nst) result(self) use messager, only: die implicit none - type(fouriersolver) :: self + type(fftsolver) :: self class(config), target, intent(in) :: cfg character(len=*), intent(in) :: name integer, intent(in) :: nst @@ -85,18 +86,17 @@ function fouriersolver_from_args(cfg,name,nst) result(self) ! Setup is not done self%setup_done=.false. - end function fouriersolver_from_args + end function fftsolver_from_args !> Initialize grid and stencil - done at start-up only as long as the stencil or cfg does not change !> When calling, zero values of this%opr(1,:,:,:) indicate cells that do not participate in the solver !> Only the stencil needs to be defined at this point - subroutine fouriersolver_init(this) + subroutine fftsolver_init(this) use messager, only: die implicit none - class(fouriersolver), intent(inout) :: this - integer :: ierr,st,stx1,stx2,sty1,sty2,stz1,stz2 - integer, dimension(3) :: periodicity,offset + class(fftsolver), intent(inout) :: this + integer :: st,stx1,stx2,sty1,sty2,stz1,stz2 include 'fftw3.f03' ! From the provided stencil, generate an inverse map @@ -109,18 +109,18 @@ subroutine fouriersolver_init(this) end do ! Initialize DFT - this%dft=fourier3d(this%cfg) + this%dft=fft3d(this%cfg) - end subroutine fouriersolver_init + end subroutine fftsolver_init !> Setup solver - done everytime the operator changes - subroutine fouriersolver_setup(this) + subroutine fftsolver_setup(this) use messager, only: die use mpi_f08, only: MPI_BCAST,MPI_ALLREDUCE,MPI_INTEGER,MPI_SUM use parallel, only: MPI_REAL_WP implicit none - class(fouriersolver), intent(inout) :: this + class(fftsolver), intent(inout) :: this real(WP), dimension(1:this%nst) :: ref_opr integer :: i,j,k,n,ierr @@ -139,7 +139,7 @@ subroutine fouriersolver_setup(this) end do end do end do - if (.not.circulant) call die('[fouriersolver setup] operator must be uniform in space') + if (.not.circulant) call die('[fftsolver setup] operator must be uniform in space') end block checkcirc ! Build the operator @@ -155,7 +155,7 @@ subroutine fouriersolver_setup(this) end do ! Take transform of operator - call this%dft%fourier3d_fourier_transform(this%factored_operator) + call this%dft%forward_transform(this%factored_operator) ! Make zero wavenumber not zero ! Setting this to one has the nice side effect of returning a solution with the same integral @@ -167,7 +167,7 @@ subroutine fouriersolver_setup(this) call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) if (j.gt.0) then write(*,*) j - call die('[fouriersolver setup] elements of transformed operator near zero') + call die('[fftsolver setup] elements of transformed operator near zero') end if ! Divide now instead of later @@ -176,24 +176,23 @@ subroutine fouriersolver_setup(this) ! Check for division issues i=count(isnan(abs(this%factored_operator))) call MPI_ALLREDUCE(i,j,1,MPI_INTEGER,MPI_SUM,this%cfg%comm,ierr) - if (j.gt.0) call die('[fouriersolver setup] elements of transformed operator are NaN') + if (j.gt.0) call die('[fftsolver setup] elements of transformed operator are NaN') ! Set setup-flag to true this%setup_done=.true. - end subroutine fouriersolver_setup + end subroutine fftsolver_setup !> Solve the linear system iteratively - subroutine fouriersolver_solve(this) + subroutine fftsolver_solve(this) use messager, only: die use param, only: verbose implicit none - class(fouriersolver), intent(inout) :: this - integer :: i,j,k,ierr + class(fftsolver), intent(inout) :: this ! Check that setup was done - if (.not.this%setup_done) call die('[fouriersolver solve] Solver has not & + if (.not.this%setup_done) call die('[fftsolver solve] Solver has not & &been setup.') ! Copy to unstrided array @@ -201,17 +200,17 @@ subroutine fouriersolver_solve(this) this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_) ! Forward transform - call this%dft%fourier3d_fourier_transform(this%transformed_rhs) + call this%dft%forward_transform(this%transformed_rhs) ! Divide this%transformed_rhs=this%transformed_rhs*this%factored_operator ! Backward transform - call this%dft%fourier3d_inverse_transform(this%transformed_rhs) + call this%dft%backward_transform(this%transformed_rhs) ! Copy to strided output this%sol(this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_, & - this%cfg%kmin_:this%cfg%kmax_)=this%transformed_rhs + this%cfg%kmin_:this%cfg%kmax_)=realpart(this%transformed_rhs) ! Sync the solution vector call this%cfg%sync(this%sol) @@ -220,59 +219,59 @@ subroutine fouriersolver_solve(this) if (verbose.gt.0) call this%log if (verbose.gt.1) call this%print_short - end subroutine fouriersolver_solve + end subroutine fftsolver_solve - !> Log fouriersolver info - subroutine fouriersolver_log(this) + !> Log fftsolver info + subroutine fftsolver_log(this) use string, only: str_long use messager, only: log implicit none - class(fouriersolver), intent(in) :: this + class(fftsolver), intent(in) :: this character(len=str_long) :: message if (this%cfg%amRoot) then - write(message,'("fouriersolver solver [",a,"] for config [",a,"]")') & + write(message,'("fftsolver solver [",a,"] for config [",a,"]")') & trim(this%name), trim(this%cfg%name) call log(message) end if - end subroutine fouriersolver_log + end subroutine fftsolver_log - !> Print fouriersolver info to the screen - subroutine fouriersolver_print(this) + !> Print fftsolver info to the screen + subroutine fftsolver_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(fouriersolver), intent(in) :: this + class(fftsolver), intent(in) :: this if (this%cfg%amRoot) then - write(output_unit,'("fouriersolver solver [",a,"] for config [",a,"]")') & + write(output_unit,'("fftsolver solver [",a,"] for config [",a,"]")') & trim(this%name), trim(this%cfg%name) end if - end subroutine fouriersolver_print + end subroutine fftsolver_print - !> Short print of fouriersolver info to the screen - subroutine fouriersolver_print_short(this) + !> Short print of fftsolver info to the screen + subroutine fftsolver_print_short(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none - class(fouriersolver), intent(in) :: this + class(fftsolver), intent(in) :: this - if (this%cfg%amRoot) write(output_unit,'("fouriersolver solver [",a16,"] & + if (this%cfg%amRoot) write(output_unit,'("fftsolver solver [",a16,"] & &for config [",a16,"]")') trim(this%name),trim(this%cfg%name) - end subroutine fouriersolver_print_short + end subroutine fftsolver_print_short - subroutine fouriersolver_destroy(this) + subroutine fftsolver_destroy(this) implicit none - class(fouriersolver), intent(inout) :: this + class(fftsolver), intent(inout) :: this deallocate(this%stc,this%opr,this%rhs,this%sol,this%factored_operator, & this%transformed_rhs,this%stmap) - end subroutine fouriersolver_destroy + end subroutine fftsolver_destroy -end module fouriersolver_class +end module fftsolver_class diff --git a/src/solver/fourier3d_class.f90 b/src/solver/fourier3d_class.f90 deleted file mode 100644 index 7d5dfc8a1..000000000 --- a/src/solver/fourier3d_class.f90 +++ /dev/null @@ -1,1107 +0,0 @@ -!> FFT for 3D periodic uniform computational domains decomposed in at most 2 -!> directions. Makes use of FFTW and in-house parallel transpose operations. -module fourier3d_class - use precision, only: WP - use config_class, only: config - use string, only: str_short - use, intrinsic :: iso_c_binding - implicit none - private - - - ! Expose type/constructor/methods - public :: fourier3d - - - !> fourier3d object definition - type :: fourier3d - - ! cfg - class(config), pointer :: cfg - - ! FFT's oddball - logical :: oddball - - ! Data storage for FFTW plans - complex(WP), dimension(:), allocatable :: in_x,out_x - complex(WP), dimension(:), allocatable :: in_y,out_y - complex(WP), dimension(:), allocatable :: in_z,out_z - - ! FFTW plans - type(C_PTR) :: fplan_x,bplan_x - type(C_PTR) :: fplan_y,bplan_y - type(C_PTR) :: fplan_z,bplan_z - - !> Unstrided arrays - complex(WP), dimension(:,:,:), allocatable :: factored_operator - complex(WP), dimension(:,:,:), allocatable :: transformed_rhs - - ! Storage for transposed data - complex(WP), dimension(:,:,:), allocatable :: xtrans, ytrans, ztrans - - ! Transpose partition - X - integer, dimension(:), allocatable :: imin_x,imax_x - integer, dimension(:), allocatable :: jmin_x,jmax_x - integer, dimension(:), allocatable :: kmin_x,kmax_x - integer, dimension(:), allocatable :: nx_x,ny_x,nz_x - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_x,recvbuf_x - integer :: sendcount_x,recvcount_x - character :: xdir - - ! Transpose partition - Y - integer, dimension(:), allocatable :: imin_y,imax_y - integer, dimension(:), allocatable :: jmin_y,jmax_y - integer, dimension(:), allocatable :: kmin_y,kmax_y - integer, dimension(:), allocatable :: nx_y,ny_y,nz_y - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_y,recvbuf_y - integer :: sendcount_y,recvcount_y - character :: ydir - - ! Transpose partition - Z - integer, dimension(:), allocatable :: imin_z,imax_z - integer, dimension(:), allocatable :: jmin_z,jmax_z - integer, dimension(:), allocatable :: kmin_z,kmax_z - integer, dimension(:), allocatable :: nx_z,ny_z,nz_z - complex(WP), dimension(:,:,:,:), allocatable :: sendbuf_z,recvbuf_z - integer :: sendcount_z,recvcount_z - character :: zdir - - contains - - procedure :: print_short=>fourier3d_print_short !< One-line printing of solver status - procedure :: print=>fourier3d_print !< Long-form printing of solver status - procedure :: log=>fourier3d_log !< Long-form logging of solver status - final :: fourier3d_destroy !< Deconstructor - - procedure :: fourier3d_fourier_transform - procedure :: fourier3d_inverse_transform - - procedure, private :: fourier3d_xtranspose_init - procedure, private :: fourier3d_ytranspose_init - procedure, private :: fourier3d_ztranspose_init - - procedure, private :: fourier3d_xtranspose_forward - procedure, private :: fourier3d_ytranspose_forward - procedure, private :: fourier3d_ztranspose_forward - - procedure, private :: fourier3d_xtranspose_backward - procedure, private :: fourier3d_ytranspose_backward - procedure, private :: fourier3d_ztranspose_backward - - end type fourier3d - - - !> Declare fourier3d constructor - interface fourier3d; procedure fourier3d_from_args; end interface fourier3d; - - -contains - - - !> Constructor for a fourier3d object - function fourier3d_from_args(cfg) result(self) - use messager, only: die - implicit none - type(fourier3d) :: self - class(config), target, intent(in) :: cfg - integer :: ierr - integer, dimension(3) :: periodicity,offset - include 'fftw3.f03' - - ! Link the config and store the name - self%cfg=>cfg - - ! Various checks to ensure we can use this solver - check_solver_is_useable: block - integer :: ndim,ndcp - ! Periodicity and uniformity of mesh - if (self%cfg%nx.gt.1.and..not.(self%cfg%xper.and.self%cfg%uniform_x)) & - call die('[fourier3d constructor] Need x-direction needs to be & - &periodic and uniform') - if (self%cfg%ny.gt.1.and..not.(self%cfg%yper.and.self%cfg%uniform_y)) & - call die('[fourier3d constructor] Need y-direction needs to be & - &periodic and uniform') - if (self%cfg%nz.gt.1.and..not.(self%cfg%zper.and.self%cfg%uniform_z)) & - call die('[fourier3d constructor] Need z-direction needs to be & - &periodic and uniform') - ! Ensure that we have at least one non-decomposed direction - ndim = count((/ self%cfg%nx, self%cfg%ny, self%cfg%nz /) .gt. 1) - ndcp = count((/ self%cfg%npx, self%cfg%npy, self%cfg%npz /) .gt. 1) - if (ndcp.ge.ndim) call die('[fourier3d constructor] Need at least one & - &NON-decomposed direction') - end block check_solver_is_useable - - ! Initialize transpose and FFTW plans in x - if (self%cfg%nx.gt.1) then - call self%fourier3d_xtranspose_init() - allocate(self%in_x(self%cfg%nx),self%out_x(self%cfg%nx)) - self%fplan_x=fftw_plan_dft_1d(self%cfg%nx,self%in_x,self%out_x,FFTW_FORWARD,FFTW_MEASURE) - self%bplan_x=fftw_plan_dft_1d(self%cfg%nx,self%in_x,self%out_x,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in y - if (self%cfg%ny.gt.1) then - call self%fourier3d_ytranspose_init() - allocate(self%in_y(self%cfg%ny),self%out_y(self%cfg%ny)) - self%fplan_y=fftw_plan_dft_1d(self%cfg%ny,self%in_y,self%out_y,FFTW_FORWARD,FFTW_MEASURE) - self%bplan_y=fftw_plan_dft_1d(self%cfg%ny,self%in_y,self%out_y,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Initialize transpose and FFTW plans in z - if (self%cfg%nz.gt.1) then - call self%fourier3d_ztranspose_init() - allocate(self%in_z(self%cfg%nz),self%out_z(self%cfg%nz)) - self%fplan_z=fftw_plan_dft_1d(self%cfg%nz,self%in_z,self%out_z,FFTW_FORWARD,FFTW_MEASURE) - self%bplan_z=fftw_plan_dft_1d(self%cfg%nz,self%in_z,self%out_z,FFTW_BACKWARD,FFTW_MEASURE) - end if - - ! Find who owns the oddball - self%oddball=all((/ self%cfg%iproc, self%cfg%jproc, self%cfg%kproc /) .eq. 1) - - end function fourier3d_from_args - - - !> Initialize transpose tool in x - subroutine fourier3d_xtranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,ip,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%xdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%xdir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%xdir='z' - end if - - ! Allocate global partitions - allocate( this%nx_x(this%cfg%npx)) - allocate( this%ny_x(this%cfg%npx)) - allocate( this%nz_x(this%cfg%npx)) - allocate(this%imin_x(this%cfg%npx)) - allocate(this%imax_x(this%cfg%npx)) - allocate(this%jmin_x(this%cfg%npx)) - allocate(this%jmax_x(this%cfg%npx)) - allocate(this%kmin_x(this%cfg%npx)) - allocate(this%kmax_x(this%cfg%npx)) - - ! Partition - select case (trim(this%xdir)) - case ('x') - - ! No transpose required, use local partition - this%nx_x=this%cfg%nx_ - this%ny_x=this%cfg%ny_ - this%nz_x=this%cfg%nz_ - this%imin_x=this%cfg%imin_ - this%imax_x=this%cfg%imax_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%ny/this%cfg%npx - r=mod(this%cfg%ny,this%cfg%npx) - if (ip.le.r) then - this%ny_x(ip) =q+1 - this%jmin_x(ip)=this%cfg%jmin+(ip-1)*(q+1) - else - this%ny_x(ip) =q - this%jmin_x(ip)=this%cfg%jmin+r*(q+1)+(ip-r-1)*q - end if - this%jmax_x(ip)=this%jmin_x(ip)+this%ny_x(ip)-1 - end do - this%nz_x=this%cfg%nz_ - this%kmin_x=this%cfg%kmin_ - this%kmax_x=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - this%recvcount_x=maxval(this%nx_x)*maxval(this%ny_x)*this%cfg%nz_ - allocate(this%sendbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),maxval(this%ny_x),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%imin_,1,MPI_INTEGER,this%imin_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - call MPI_AllGather(this%cfg%imax_,1,MPI_INTEGER,this%imax_x,1,MPI_INTEGER,this%cfg%xcomm,ierr) - this%nx_x=this%imax_x-this%imin_x+1 - - ! Partition new local indices - do ip=1,this%cfg%npx - q=this%cfg%nz/this%cfg%npx - r=mod(this%cfg%nz,this%cfg%npx) - if (ip.le.r) then - this%nz_x(ip) =q+1 - this%kmin_x(ip)=this%cfg%kmin+(ip-1)*(q+1) - else - this%nz_x(ip) =q - this%kmin_x(ip)=this%cfg%kmin+r*(q+1)+(ip-r-1)*q - end if - this%kmax_x(ip)=this%kmin_x(ip)+this%nz_x(ip)-1 - end do - this%ny_x=this%cfg%ny_ - this%jmin_x=this%cfg%jmin_ - this%jmax_x=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - this%recvcount_x=maxval(this%nx_x)*this%cfg%ny_*maxval(this%nz_x) - allocate(this%sendbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - allocate(this%recvbuf_x(maxval(this%nx_x),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_x),this%cfg%npx)) - - ! Zero out buffers - this%sendbuf_x=0.0_WP - this%recvbuf_x=0.0_WP - - end select - - ! Allocate storage - allocate(this%xtrans(this%cfg%imin:this%cfg%imax,this%jmin_x(this%cfg%iproc):this%jmax_x(this%cfg%iproc),this%kmin_x(this%cfg%iproc):this%kmax_x(this%cfg%iproc))) - - end subroutine fourier3d_xtranspose_init - - - !> Initialize transpose tool in y - subroutine fourier3d_ytranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,jp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%ydir='y' - else if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%ydir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%ydir='x' - end if - - ! Allocate global partitions - allocate( this%nx_y(this%cfg%npy)) - allocate( this%ny_y(this%cfg%npy)) - allocate( this%nz_y(this%cfg%npy)) - allocate(this%imin_y(this%cfg%npy)) - allocate(this%imax_y(this%cfg%npy)) - allocate(this%jmin_y(this%cfg%npy)) - allocate(this%jmax_y(this%cfg%npy)) - allocate(this%kmin_y(this%cfg%npy)) - allocate(this%kmax_y(this%cfg%npy)) - - ! Partition - select case (trim(this%ydir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nx/this%cfg%npy - r=mod(this%cfg%nx,this%cfg%npy) - if (jp.le.r) then - this%nx_y(jp) =q+1 - this%imin_y(jp)=this%cfg%imin+(jp-1)*(q+1) - else - this%nx_y(jp) =q - this%imin_y(jp)=this%cfg%imin+r*(q+1)+(jp-r-1)*q - end if - this%imax_y(jp)=this%imin_y(jp)+this%nx_y(jp)-1 - end do - this%nz_y=this%cfg%nz_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - ! Variables for AllToAll communication - this%sendcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - this%recvcount_y=maxval(this%nx_y)*maxval(this%ny_y)*this%cfg%nz_ - allocate(this%sendbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - allocate(this%recvbuf_y(maxval(this%nx_y),maxval(this%ny_y),this%cfg%kmin_:this%cfg%kmax_,this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - case ('y') - - ! No transpose required, use local partition - this%nx_y=this%cfg%nx_ - this%ny_y=this%cfg%ny_ - this%nz_y=this%cfg%nz_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - this%jmin_y=this%cfg%jmin_ - this%jmax_y=this%cfg%jmax_ - this%kmin_y=this%cfg%kmin_ - this%kmax_y=this%cfg%kmax_ - - case ('z') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%jmin_,1,MPI_INTEGER,this%jmin_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - call MPI_AllGather(this%cfg%jmax_,1,MPI_INTEGER,this%jmax_y,1,MPI_INTEGER,this%cfg%ycomm,ierr) - this%ny_y=this%jmax_y-this%jmin_y+1 - - ! Partition new local indices - do jp=1,this%cfg%npy - q=this%cfg%nz/this%cfg%npy - r=mod(this%cfg%nz,this%cfg%npy) - if (jp.le.r) then - this%nz_y(jp) =q+1 - this%kmin_y(jp)=this%cfg%kmin+(jp-1)*(q+1) - else - this%nz_y(jp) =q - this%kmin_y(jp)=this%cfg%kmin+r*(q+1)+(jp-r-1)*q - end if - this%kmax_y(jp)=this%kmin_y(jp)+this%nz_y(jp)-1 - end do - this%nx_y=this%cfg%nx_ - this%imin_y=this%cfg%imin_ - this%imax_y=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - this%recvcount_y=this%cfg%nx_*maxval(this%ny_y)*maxval(this%nz_y) - allocate(this%sendbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - allocate(this%recvbuf_y(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_y),maxval(this%nz_y),this%cfg%npy)) - - ! Zero out buffers - this%sendbuf_y=0.0_WP - this%recvbuf_y=0.0_WP - - end select - - ! Allocate storage - allocate(this%ytrans(this%imin_y(this%cfg%jproc):this%imax_y(this%cfg%jproc),this%cfg%jmin:this%cfg%jmax,this%kmin_y(this%cfg%jproc):this%kmax_y(this%cfg%jproc))) - - end subroutine fourier3d_ytranspose_init - - - !> Initialize transpose tool in z - subroutine fourier3d_ztranspose_init(this) - use mpi_f08 - implicit none - class(fourier3d), intent(inout) :: this - integer :: ierr,kp,q,r - - ! Determine non-decomposed direction to use for transpose - if (this%cfg%npz.eq.1.and.this%cfg%nz.gt.1) then - this%zdir='z' - else if (this%cfg%npx.eq.1.and.this%cfg%nx.gt.1) then - this%zdir='x' - else if (this%cfg%npy.eq.1.and.this%cfg%ny.gt.1) then - this%zdir='y' - end if - - ! Allocate global partitions - allocate( this%nx_z(this%cfg%npz)) - allocate( this%ny_z(this%cfg%npz)) - allocate( this%nz_z(this%cfg%npz)) - allocate(this%imin_z(this%cfg%npz)) - allocate(this%imax_z(this%cfg%npz)) - allocate(this%jmin_z(this%cfg%npz)) - allocate(this%jmax_z(this%cfg%npz)) - allocate(this%kmin_z(this%cfg%npz)) - allocate(this%kmax_z(this%cfg%npz)) - - ! Partition - select case (trim(this%zdir)) - case ('x') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%nx/this%cfg%npz - r=mod(this%cfg%nx,this%cfg%npz) - if (kp.le.r) then - this%nx_z(kp) =q+1 - this%imin_z(kp)=this%cfg%imin+(kp-1)*(q+1) - else - this%nx_z(kp) =q - this%imin_z(kp)=this%cfg%imin+r*(q+1)+(kp-r-1)*q - end if - this%imax_z(kp)=this%imin_z(kp)+this%nx_z(kp)-1 - end do - this%ny_z=this%cfg%ny_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - - ! Variables for AllToAll communication - this%sendcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - this%recvcount_z=maxval(this%nx_z)*this%cfg%ny_*maxval(this%nz_z) - allocate(this%sendbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(maxval(this%nx_z),this%cfg%jmin_:this%cfg%jmax_,maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('y') - - ! Store old local indices from each processor - call MPI_AllGather(this%cfg%kmin_,1,MPI_INTEGER,this%kmin_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - call MPI_AllGather(this%cfg%kmax_,1,MPI_INTEGER,this%kmax_z,1,MPI_INTEGER,this%cfg%zcomm,ierr) - this%nz_z=this%kmax_z-this%kmin_z+1 - - ! Partition new local indices - do kp=1,this%cfg%npz - q=this%cfg%ny/this%cfg%npz - r=mod(this%cfg%ny,this%cfg%npz) - if (kp.le.r) then - this%ny_z(kp) =q+1 - this%jmin_z(kp)=this%cfg%jmin+(kp-1)*(q+1) - else - this%ny_z(kp) =q - this%jmin_z(kp)=this%cfg%jmin+r*(q+1)+(kp-r-1)*q - end if - this%jmax_z(kp)=this%jmin_z(kp)+this%ny_z(kp)-1 - end do - this%nx_z=this%cfg%nx_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - - ! Variables for AllToAll communication - this%sendcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - this%recvcount_z=this%cfg%nx_*maxval(this%ny_z)*maxval(this%nz_z) - allocate(this%sendbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - allocate(this%recvbuf_z(this%cfg%imin_:this%cfg%imax_,maxval(this%ny_z),maxval(this%nz_z),this%cfg%npz)) - - ! Zero out buffers - this%sendbuf_z=0.0_WP - this%recvbuf_z=0.0_WP - - case ('z') - - ! No transpose required, use local partition - this%nx_z=this%cfg%nx_ - this%ny_z=this%cfg%ny_ - this%nz_z=this%cfg%nz_ - this%imin_z=this%cfg%imin_ - this%imax_z=this%cfg%imax_ - this%jmin_z=this%cfg%jmin_ - this%jmax_z=this%cfg%jmax_ - this%kmin_z=this%cfg%kmin_ - this%kmax_z=this%cfg%kmax_ - - end select - - ! Allocate storage - allocate(this%ztrans(this%imin_z(this%cfg%kproc):this%imax_z(this%cfg%kproc),this%jmin_z(this%cfg%kproc):this%jmax_z(this%cfg%kproc),this%cfg%kmin:this%cfg%kmax)) - - end subroutine fourier3d_ztranspose_init - - - !> Perform forward transpose in x - subroutine fourier3d_xtranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(out) :: At - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - At=A - case ('y') - ! Transpose x=>y - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,jj,k,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do - end do - end do - case ('z') - ! Transpose x=>z - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_x(ip)+1 - ii=i-this%cfg%imin_+1 - this%sendbuf_x(ii,j,kk,ip)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - At(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do - end do - end do - end select - - end subroutine fourier3d_xtranspose_forward - - - !> Perform forward transpose in y - subroutine fourier3d_ytranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(out) :: At - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose y=>x - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(ii,jj,k,jp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do - end do - end do - case ('y') - ! No transpose required - At=A - case ('z') - ! Transpose y=>z - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%cfg%jmin_+1 - this%sendbuf_y(i,jj,kk,jp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - At(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do - end do - end do - end select - - end subroutine fourier3d_ytranspose_forward - - - !> Perform forward transpose in z - subroutine fourier3d_ztranspose_forward(this,A,At) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(in) :: A - complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(out) :: At - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose z=>x - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(ii,j,kk,kp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do - end do - end do - case ('y') - ! Transpose z=>y - do kp=1,this%cfg%npz - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%cfg%kmin_+1 - this%sendbuf_z(i,jj,kk,kp)=A(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - At(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do - end do - end do - case ('z') - ! No transpose required - At=A - end select - - end subroutine fourier3d_ztranspose_forward - - - !> Perform backward transpose in x - subroutine fourier3d_xtranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin :,this%jmin_x(this%cfg%iproc):,this%kmin_x(this%cfg%iproc):), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,ip,ii,jj,kk,ierr - - select case (trim(this%xdir)) - case ('x') - ! No transpose required - A=At - case ('y') - ! Transpose y=>x - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - do i=this%imin_x(ip),this%imax_x(ip) - jj=j-this%jmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,jj,k,ip)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_x(ip),this%jmax_x(ip) - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - jj=j-this%jmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,jj,k,ip) - end do - end do - end do - end do - case ('z') - ! Transpose z=>x - do ip=1,this%cfg%npx - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(ip),this%imax_x(ip) - kk=k-this%kmin_x(this%cfg%iproc)+1 - ii=i-this%imin_x(ip)+1 - this%sendbuf_x(ii,j,kk,ip)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_x,this%sendcount_x,MPI_DOUBLE_COMPLEX,this%recvbuf_x,this%recvcount_x,MPI_DOUBLE_COMPLEX,this%cfg%xcomm,ierr) - do ip=1,this%cfg%npx - do k=this%kmin_x(ip),this%kmax_x(ip) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_x(this%cfg%iproc),this%imax_x(this%cfg%iproc) - kk=k-this%kmin_x(ip)+1 - ii=i-this%imin_x(this%cfg%iproc)+1 - A(i,j,k)=this%recvbuf_x(ii,j,kk,ip) - end do - end do - end do - end do - end select - - end subroutine fourier3d_xtranspose_backward - - - !> Perform backward transpose in y - subroutine fourier3d_ytranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%imin_y(this%cfg%jproc):,this%cfg%jmin:,this%kmin_y(this%cfg%jproc):), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,jp,ii,jj,kk,ierr - - select case (trim(this%ydir)) - case ('x') - ! Transpose x=>y - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - ii=i-this%imin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(ii,jj,k,jp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%cfg%kmin_,this%cfg%kmax_ - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%imin_y(jp),this%imax_y(jp) - ii=i-this%imin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(ii,jj,k,jp) - end do - end do - end do - end do - case ('y') - ! No transpose required - A=At - case ('z') - ! Transpose z=>y - do jp=1,this%cfg%npy - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do j=this%jmin_y(jp),this%jmax_y(jp) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(this%cfg%jproc)+1 - jj=j-this%jmin_y(jp)+1 - this%sendbuf_y(i,jj,kk,jp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_y,this%sendcount_y,MPI_DOUBLE_COMPLEX,this%recvbuf_y,this%recvcount_y,MPI_DOUBLE_COMPLEX,this%cfg%ycomm,ierr) - do jp=1,this%cfg%npy - do k=this%kmin_y(jp),this%kmax_y(jp) - do j=this%jmin_y(this%cfg%jproc),this%jmax_y(this%cfg%jproc) - do i=this%cfg%imin_,this%cfg%imax_ - kk=k-this%kmin_y(jp)+1 - jj=j-this%jmin_y(this%cfg%jproc)+1 - A(i,j,k)=this%recvbuf_y(i,jj,kk,jp) - end do - end do - end do - end do - end select - - end subroutine fourier3d_ytranspose_backward - - - !> Perform backward transpose in z - subroutine fourier3d_ztranspose_backward(this,At,A) - use mpi_f08 - use parallel, only: MPI_REAL_WP - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%imin_z(this%cfg%kproc):,this%jmin_z(this%cfg%kproc):,this%cfg%kmin:), intent(in) :: At - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(out) :: A - integer :: i,j,k,kp,ii,jj,kk,ierr - - select case (trim(this%zdir)) - case ('x') - ! Transpose x=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - ii=i-this%imin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(ii,j,kk,kp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%cfg%jmin_,this%cfg%jmax_ - do i=this%imin_z(kp),this%imax_z(kp) - ii=i-this%imin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(ii,j,kk,kp) - end do - end do - end do - end do - case ('y') - ! Transpose y=>z - do kp=1,this%cfg%npz - do k=this%kmin_z(kp),this%kmax_z(kp) - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(this%cfg%kproc)+1 - kk=k-this%kmin_z(kp)+1 - this%sendbuf_z(i,jj,kk,kp)=At(i,j,k) - end do - end do - end do - end do - call MPI_AllToAll(this%sendbuf_z,this%sendcount_z,MPI_DOUBLE_COMPLEX,this%recvbuf_z,this%recvcount_z,MPI_DOUBLE_COMPLEX,this%cfg%zcomm,ierr) - do kp=1,this%cfg%npz - do k=this%kmin_z(this%cfg%kproc),this%kmax_z(this%cfg%kproc) - do j=this%jmin_z(kp),this%jmax_z(kp) - do i=this%cfg%imin_,this%cfg%imax_ - jj=j-this%jmin_z(kp)+1 - kk=k-this%kmin_z(this%cfg%kproc)+1 - A(i,j,k)=this%recvbuf_z(i,jj,kk,kp) - end do - end do - end do - end do - case ('z') - ! No transpose required - A=At - end select - - end subroutine fourier3d_ztranspose_backward - - - !> Transpose A and perform Fourier transform - subroutine fourier3d_fourier_transform(this,A) - use messager, only: die - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) - integer :: i,j,k - include 'fftw3.f03' - - if (this%cfg%nx.gt.1) then - ! Transpose in X - call this%fourier3d_xtranspose_forward(A,this%xtrans) - ! Forward transform - X - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x=this%xtrans(:,j,k) - call fftw_execute_dft(this%fplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k)=this%out_x - end do - end do - ! Transpose back - call this%fourier3d_xtranspose_backward(this%xtrans,A) - end if - - if (this%cfg%ny.gt.1) then - ! Transpose in Y - call this%fourier3d_ytranspose_forward(A,this%ytrans) - ! Forward transform - Y - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y=this%ytrans(i,:,k) - call fftw_execute_dft(this%fplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k)=this%out_y - end do - end do - ! Transpose back - call this%fourier3d_ytranspose_backward(this%ytrans,A) - end if - - if (this%cfg%nz.gt.1) then - ! Transpose in Z - call this%fourier3d_ztranspose_forward(A,this%ztrans) - ! Forward transform - Z - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z=this%ztrans(i,j,:) - call fftw_execute_dft(this%fplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:)=this%out_z - end do - end do - ! Transpose back - call this%fourier3d_ztranspose_backward(this%ztrans,A) - end if - - ! Oddball - if (this%oddball) A(this%cfg%imin_,this%cfg%jmin_,this%cfg%kmin_)=0.0_WP - - end subroutine fourier3d_fourier_transform - - - !> FFT -> real and transpose back - subroutine fourier3d_inverse_transform(this,A) - use messager, only: die - implicit none - class(fourier3d), intent(inout) :: this - complex(WP), dimension(this%cfg%imin_:,this%cfg%jmin_:,this%cfg%kmin_:), intent(inout) :: A !< Needs to be (imin_:imax_,jmin_:jmax_,kmin_:kmax_) - integer :: i,j,k - include 'fftw3.f03' - - if (this%cfg%nx.gt.1) then - ! Transpose in X - call this%fourier3d_xtranspose_forward(A,this%xtrans) - ! Inverse transform - do k=this%kmin_x(this%cfg%iproc),this%kmax_x(this%cfg%iproc) - do j=this%jmin_x(this%cfg%iproc),this%jmax_x(this%cfg%iproc) - this%in_x=this%xtrans(:,j,k) - call fftw_execute_dft(this%bplan_x,this%in_x,this%out_x) - this%xtrans(:,j,k)=this%out_x/this%cfg%nx - end do - end do - ! Transpose back - call this%fourier3d_xtranspose_backward(this%xtrans,A) - end if - - if (this%cfg%ny.gt.1) then - ! Transpose in Y - call this%fourier3d_ytranspose_forward(A,this%ytrans) - ! Inverse transform - do k=this%kmin_y(this%cfg%jproc),this%kmax_y(this%cfg%jproc) - do i=this%imin_y(this%cfg%jproc),this%imax_y(this%cfg%jproc) - this%in_y=this%ytrans(i,:,k) - call fftw_execute_dft(this%bplan_y,this%in_y,this%out_y) - this%ytrans(i,:,k)=this%out_y/this%cfg%ny - end do - end do - ! Transpose back - call this%fourier3d_ytranspose_backward(this%ytrans,A) - end if - - if (this%cfg%nz.gt.1) then - ! Transpose in Z - call this%fourier3d_ztranspose_forward(A,this%ztrans) - ! Inverse transform - do j=this%jmin_z(this%cfg%kproc),this%jmax_z(this%cfg%kproc) - do i=this%imin_z(this%cfg%kproc),this%imax_z(this%cfg%kproc) - this%in_z=this%ztrans(i,j,:) - call fftw_execute_dft(this%bplan_z,this%in_z,this%out_z) - this%ztrans(i,j,:)=this%out_z/this%cfg%nz - end do - end do - ! Transpose back - call this%fourier3d_ztranspose_backward(this%ztrans,A) - end if - - end subroutine fourier3d_inverse_transform - - - !> Destroy FFT object - subroutine fourier3d_destroy(this) - use messager, only: die - implicit none - type(fourier3d), intent(inout) :: this - include 'fftw3.f03' - - ! Destroy our plans - call fftw_destroy_plan(this%fplan_x); call fftw_destroy_plan(this%bplan_x); - call fftw_destroy_plan(this%fplan_y); call fftw_destroy_plan(this%bplan_y); - call fftw_destroy_plan(this%fplan_z); call fftw_destroy_plan(this%bplan_z); - - end subroutine fourier3d_destroy - - - !> Log fourier3d info - subroutine fourier3d_log(this) - use string, only: str_long - use messager, only: log - implicit none - class(fourier3d), intent(in) :: this - character(len=str_long) :: message - - if (this%cfg%amRoot) then - write(message,'("fourier3d for config [",a,"]")') trim(this%cfg%name) - call log(message) - end if - - end subroutine fourier3d_log - - - !> Print fourier3d info to the screen - subroutine fourier3d_print(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(fourier3d), intent(in) :: this - - if (this%cfg%amRoot) then - write(output_unit,'("fourier3d for config [",a,"]")') trim(this%cfg%name) - end if - - end subroutine fourier3d_print - - - !> Short print of fourier3d info to the screen - subroutine fourier3d_print_short(this) - use, intrinsic :: iso_fortran_env, only: output_unit - implicit none - class(fourier3d), intent(in) :: this - - if (this%cfg%amRoot) then - write(output_unit,'("fourier3d for config [",a16,"]")') trim(this%cfg%name) - end if - - end subroutine fourier3d_print_short - - -end module fourier3d_class - From b5a5a5c9effa66a3fd2646067547f08694011384 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Wed, 1 Mar 2023 00:54:10 -0500 Subject: [PATCH 152/152] Fixed several compiler warnings, most of which related to previously committed hard tabs, unused variables, or implicit typecasting. lpt_class.f90 was left as is, as most compiler warnings in this file relate to the evolving nature of that class. --- src/config/ibconfig_class.f90 | 38 +-- src/constant_density/incomp_class.f90 | 444 +++++++++++++------------- src/constant_density/scalar_class.f90 | 265 ++++++++------- src/grid/pgrid_class.f90 | 382 +++++++++++----------- src/solver/bbmg_class.f90 | 160 +++++----- 5 files changed, 642 insertions(+), 647 deletions(-) diff --git a/src/config/ibconfig_class.f90 b/src/config/ibconfig_class.f90 index 57142c021..1b5958517 100644 --- a/src/config/ibconfig_class.f90 +++ b/src/config/ibconfig_class.f90 @@ -5,35 +5,35 @@ module ibconfig_class use config_class, only: config implicit none private - + ! Expose type/constructor/methods public :: ibconfig - + ! List of known available methods for calculating VF from G integer, parameter, public :: bigot=1 integer, parameter, public :: sharp=2 - + !> Config object definition as an extension of config type, extends(config) :: ibconfig - + real(WP), dimension(:,:,:), allocatable :: Gib !< Level set function, negative in fluid and positive in solid real(WP), dimension(:,:,:,:), allocatable :: Nib !< IB normal vector, oriented into the solid - + contains procedure :: calculate_normal !< Calculate robustly the normal vector from G field procedure :: calculate_vf !< Calculate fluid volume fraction end type ibconfig - - + + !> Declare single-grid ibconfig constructor interface ibconfig procedure construct_from_sgrid end interface ibconfig - - + + contains - - + + !> Single-grid config constructor from a serial grid function construct_from_sgrid(grp,decomp,grid) result(self) use sgrid_class, only: sgrid @@ -50,8 +50,8 @@ function construct_from_sgrid(grp,decomp,grid) result(self) allocate(self%Gib( self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)); self%Gib=-1.0_WP allocate(self%Nib(1:3,self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)); self%Nib=+0.0_WP end function construct_from_sgrid - - + + !> Specialized normal vector calculation from G !> Well suited to handle G discontinuities subroutine calculate_normal(this) @@ -118,8 +118,8 @@ subroutine calculate_normal(this) end if end if end subroutine calculate_normal - - + + !> Calculation of VF from G subroutine calculate_vf(this,method,allow_zero_vf) use messager, only: die @@ -127,7 +127,7 @@ subroutine calculate_vf(this,method,allow_zero_vf) class(ibconfig), intent(inout) :: this integer, intent(in) :: method logical, intent(in), optional :: allow_zero_vf - + ! Select the method select case (method) case(bigot) @@ -157,7 +157,7 @@ subroutine calculate_vf(this,method,allow_zero_vf) do k=this%kmino_,this%kmaxo_ do j=this%jmino_,this%jmaxo_ do i=this%imino_,this%imaxo_ - n=0 + n=0 do sk=0,1 do sj=0,1 do si=0,1 @@ -177,12 +177,12 @@ subroutine calculate_vf(this,method,allow_zero_vf) case default call die('[ibconfig calculate_vf] Unknown method to calculate VF') end select - + ! Check if VF=0 is allowed if (present(allow_zero_vf)) then if (.not.allow_zero_vf) this%VF=max(this%VF,epsilon(1.0_WP)) end if - + ! Update total fluid volume call this%calc_fluid_vol() diff --git a/src/constant_density/incomp_class.f90 b/src/constant_density/incomp_class.f90 index 7f180ffa2..7db754ccb 100644 --- a/src/constant_density/incomp_class.f90 +++ b/src/constant_density/incomp_class.f90 @@ -10,17 +10,17 @@ module incomp_class use iterator_class, only: iterator implicit none private - + ! Expose type/constructor/methods public :: incomp,bcond - + ! List of known available bcond types for this solver integer, parameter, public :: wall=1 !< Dirichlet at zero condition integer, parameter, public :: dirichlet=2 !< Dirichlet condition integer, parameter, public :: neumann=3 !< Zero normal gradient integer, parameter, public :: convective=4 !< Convective outflow condition integer, parameter, public :: clipped_neumann=5 !< Clipped Neumann condition (outflow only) - + !> Boundary conditions for the incompressible solver type :: bcond type(bcond), pointer :: next !< Linked list of bconds @@ -32,47 +32,47 @@ module incomp_class real(WP) :: rdir !< Bcond direction (real variable) logical :: canCorrect !< Can this bcond be corrected for global conservation? end type bcond - + !> Incompressible solver object definition type :: incomp - + ! This is our config class(config), pointer :: cfg !< This is the config the solver is build for - + ! This is the name of the solver character(len=str_medium) :: name='UNNAMED_INCOMP' !< Solver name (default=UNNAMED_INCOMP) - + ! Constant property fluid real(WP) :: rho !< This is our constant fluid density real(WP), dimension(:,:,:), allocatable :: visc !< These is our constant+SGS dynamic viscosity - + ! Boundary condition list integer :: nbc !< Number of bcond for our solver real(WP), dimension(:), allocatable :: mfr !< MFR through each bcond real(WP), dimension(:), allocatable :: area !< Area for each bcond real(WP) :: correctable_area !< Area of bcond that can be corrected type(bcond), pointer :: first_bc !< List of bcond for our solver - + ! Flow variables real(WP), dimension(:,:,:), allocatable :: U !< U velocity array real(WP), dimension(:,:,:), allocatable :: V !< V velocity array real(WP), dimension(:,:,:), allocatable :: W !< W velocity array real(WP), dimension(:,:,:), allocatable :: P !< Pressure array - + ! Old flow variables real(WP), dimension(:,:,:), allocatable :: Uold !< Uold velocity array real(WP), dimension(:,:,:), allocatable :: Vold !< Vold velocity array real(WP), dimension(:,:,:), allocatable :: Wold !< Wold velocity array - + ! Flow divergence real(WP), dimension(:,:,:), allocatable :: div !< Divergence array - + ! Pressure solver class(linsol), pointer :: psolv !< Iterative linear solver object for the pressure Poisson equation - + ! Implicit velocity solver class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the NS residual - + ! Metrics real(WP), dimension(:,:,:,:,:), allocatable :: itp_xy,itp_yz,itp_xz !< Interpolation for viscosity real(WP), dimension(:,:,:,:), allocatable :: itpr_x,itpr_y,itpr_z !< Interpolation for density @@ -86,20 +86,20 @@ module incomp_class real(WP), dimension(:,:,:,:), allocatable :: grdu_x,grdu_y,grdu_z !< Velocity gradient for U real(WP), dimension(:,:,:,:), allocatable :: grdv_x,grdv_y,grdv_z !< Velocity gradient for V real(WP), dimension(:,:,:,:), allocatable :: grdw_x,grdw_y,grdw_z !< Velocity gradient for W - + ! Masking info for metric modification integer, dimension(:,:,:), allocatable :: mask !< Integer array used for modifying P metrics integer, dimension(:,:,:), allocatable :: umask !< Integer array used for modifying U metrics integer, dimension(:,:,:), allocatable :: vmask !< Integer array used for modifying V metrics integer, dimension(:,:,:), allocatable :: wmask !< Integer array used for modifying W metrics - + ! CFL numbers real(WP) :: CFLc_x,CFLc_y,CFLc_z !< Convective CFL numbers real(WP) :: CFLv_x,CFLv_y,CFLv_z !< Viscous CFL numbers - + ! Monitoring quantities real(WP) :: Umax,Vmax,Wmax,Pmax,divmax !< Maximum velocity, pressure, divergence - + contains procedure :: print=>incomp_print !< Output solver to the screen procedure :: setup !< Finish configuring the flow solver @@ -122,16 +122,16 @@ module incomp_class procedure :: shift_p !< Shift pressure to have zero average procedure :: solve_implicit !< Solve for the velocity residuals implicitly end type incomp - - + + !> Declare incompressible solver constructor interface incomp procedure constructor end interface incomp - + contains - - + + !> Default constructor for incompressible flow solver function constructor(cfg,name) result(self) implicit none @@ -139,37 +139,37 @@ function constructor(cfg,name) result(self) class(config), target, intent(in) :: cfg character(len=*), optional :: name integer :: i,j,k - + ! Set the name for the solver if (present(name)) self%name=trim(adjustl(name)) - + ! Point to pgrid object self%cfg=>cfg - + ! Nullify bcond list self%nbc=0 self%first_bc=>NULL() - + ! Allocate flow variables allocate(self%U(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%U=0.0_WP allocate(self%V(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%V=0.0_WP allocate(self%W(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%W=0.0_WP allocate(self%P(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%P=0.0_WP - + ! Allocate flow divergence allocate(self%div(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%div=0.0_WP - + ! Allocate fluid viscosity allocate(self%visc(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%visc=0.0_WP - + ! Allocate old flow variables allocate(self%Uold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Uold=0.0_WP allocate(self%Vold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Vold=0.0_WP allocate(self%Wold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%Wold=0.0_WP - + ! Prepare default metrics call self%init_metrics() - + ! Prepare P-cell masks allocate(self%mask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%mask=0 if (.not.self%cfg%xper) then @@ -192,7 +192,7 @@ function constructor(cfg,name) result(self) end do end do call self%cfg%sync(self%mask) - + ! Prepare face mask for U allocate(self%umask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%umask=0 if (.not.self%cfg%xper) then @@ -208,7 +208,7 @@ function constructor(cfg,name) result(self) end do call self%cfg%sync(self%umask) if (.not.self%cfg%xper.and.self%cfg%iproc.eq.1) self%umask(self%cfg%imino,:,:)=self%umask(self%cfg%imino+1,:,:) - + ! Prepare face mask for V allocate(self%vmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%vmask=0 if (.not.self%cfg%yper) then @@ -224,7 +224,7 @@ function constructor(cfg,name) result(self) end do call self%cfg%sync(self%vmask) if (.not.self%cfg%yper.and.self%cfg%jproc.eq.1) self%vmask(:,self%cfg%jmino,:)=self%vmask(:,self%cfg%jmino+1,:) - + ! Prepare face mask for W allocate(self%wmask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%wmask=0 if (.not.self%cfg%zper) then @@ -240,17 +240,17 @@ function constructor(cfg,name) result(self) end do call self%cfg%sync(self%wmask) if (.not.self%cfg%zper.and.self%cfg%kproc.eq.1) self%wmask(:,:,self%cfg%kmino)=self%wmask(:,:,self%cfg%kmino+1) - + end function constructor - - + + !> Metric initialization with no awareness of walls nor bcond subroutine init_metrics(this) implicit none class(incomp), intent(inout) :: this integer :: i,j,k,st1,st2 real(WP), dimension(-1:0) :: itpx,itpy,itpz - + ! Allocate finite difference density (or other things) interpolation coefficients allocate(this%itpr_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered allocate(this%itpr_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered @@ -289,7 +289,7 @@ subroutine init_metrics(this) end do end do end do - + ! Allocate finite difference velocity interpolation coefficients allocate(this%itpu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered allocate(this%itpv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered @@ -337,7 +337,7 @@ subroutine init_metrics(this) end do end do end do - + ! Allocate finite volume divergence operators allocate(this%divp_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered allocate(this%divp_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered @@ -358,13 +358,13 @@ subroutine init_metrics(this) this%divp_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,zm] this%divp_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,zm] this%divp_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,ym,z ] - + this%divu_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] this%divu_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] - + this%divv_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,y ,zm] this%divv_z(:,i,j,k)=this%cfg%dzi(k)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] - + this%divw_x(:,i,j,k)=this%cfg%dxi(i)*[-1.0_WP,+1.0_WP] !< FV divergence from [x ,ym,z ] this%divw_y(:,i,j,k)=this%cfg%dyi(j)*[-1.0_WP,+1.0_WP] !< FV divergence from [xm,y ,z ] end do @@ -394,7 +394,7 @@ subroutine init_metrics(this) end do end do end do - + ! Allocate finite difference velocity gradient operators allocate(this%grdu_x( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered allocate(this%grdv_y( 0:+1,this%cfg%imino_ :this%cfg%imaxo_,this%cfg%jmino_ :this%cfg%jmaxo_,this%cfg%kmino_ :this%cfg%kmaxo_)) !< Cell-centered @@ -442,17 +442,17 @@ subroutine init_metrics(this) end do end do end do - + end subroutine init_metrics - - + + !> Metric adjustment accounting for bconds and walls subroutine adjust_metrics(this) implicit none class(incomp), intent(inout) :: this integer :: i,j,k,st1,st2 real(WP) :: delta,mysum - + ! Sync up u/v/wmasks call this%cfg%sync(this%umask) call this%cfg%sync(this%vmask) @@ -460,7 +460,7 @@ subroutine adjust_metrics(this) if (.not.this%cfg%xper.and.this%cfg%iproc.eq.1) this%umask(this%cfg%imino,:,:)=this%umask(this%cfg%imino+1,:,:) if (.not.this%cfg%yper.and.this%cfg%jproc.eq.1) this%vmask(:,this%cfg%jmino,:)=this%vmask(:,this%cfg%jmino+1,:) if (.not.this%cfg%zper.and.this%cfg%kproc.eq.1) this%wmask(:,:,this%cfg%kmino)=this%wmask(:,:,this%cfg%kmino+1) - + ! I am assuming here that we do not really need to zero out wall cells ! as they could be used for Dirichlet (then the density needs to be available! could be problematic if we do not have an explicit BC for scalars, e.g. for a Couette flow) ! or outflow condition (then the density needs to be available but it should be directly calculated) @@ -481,7 +481,7 @@ subroutine adjust_metrics(this) ! end do ! end do !end do - + ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -492,7 +492,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust viscosity interpolation coefficients to cell edge in the presence of walls (only walls) do k=this%cfg%kmino_+1,this%cfg%kmaxo_ do j=this%cfg%jmino_+1,this%cfg%jmaxo_ @@ -512,7 +512,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Loop over the domain and adjust divergence for P cell do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -525,7 +525,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Loop over the domain and apply masked conditions to U metrics do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -538,7 +538,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Loop over the domain and apply masked conditions to V metrics do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_+1,this%cfg%jmaxo_ @@ -551,7 +551,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Loop over the domain and apply masked conditions to W metrics do k=this%cfg%kmino_+1,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -564,7 +564,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust gradient coefficients to cell edge in x do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -594,7 +594,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust gradient coefficients to cell edge in y do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_+1,this%cfg%jmaxo_ @@ -624,7 +624,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust gradient coefficients to cell edge in z do k=this%cfg%kmino_+1,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -654,7 +654,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust interpolation coefficients to cell centers in the presence of walls (only walls!) do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -665,7 +665,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust interpolation coefficients to cell edge in x do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -679,7 +679,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust interpolation coefficients to cell edge in y do k=this%cfg%kmino_ ,this%cfg%kmaxo_ do j=this%cfg%jmino_+1,this%cfg%jmaxo_ @@ -693,7 +693,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust interpolation coefficients to cell edge in z do k=this%cfg%kmino_+1,this%cfg%kmaxo_ do j=this%cfg%jmino_ ,this%cfg%jmaxo_ @@ -707,7 +707,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust metrics to account for lower dimensionality if (this%cfg%nx.eq.1) then this%divp_x=0.0_WP @@ -736,10 +736,10 @@ subroutine adjust_metrics(this) this%grdv_z=0.0_WP this%grdw_z=0.0_WP end if - + end subroutine adjust_metrics - - + + !> Finish setting up the flow solver now that bconds have been defined subroutine setup(this,pressure_solver,implicit_solver) implicit none @@ -747,13 +747,13 @@ subroutine setup(this,pressure_solver,implicit_solver) class(linsol), target, intent(in) :: pressure_solver !< A pressure solver is required class(linsol), target, intent(in), optional :: implicit_solver !< An implicit solver can be provided integer :: i,j,k - + ! Adjust metrics based on bcflag array call this%adjust_metrics() - + ! Point to pressure solver linsol object this%psolv=>pressure_solver - + ! Set 7-pt stencil map for the pressure solver this%psolv%stc(1,:)=[ 0, 0, 0] this%psolv%stc(2,:)=[+1, 0, 0] @@ -762,7 +762,7 @@ subroutine setup(this,pressure_solver,implicit_solver) this%psolv%stc(5,:)=[ 0,-1, 0] this%psolv%stc(6,:)=[ 0, 0,+1] this%psolv%stc(7,:)=[ 0, 0,-1] - + ! Setup the scaled Laplacian operator from incomp metrics: lap(*)=-vol*div(grad(*)) do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ @@ -785,17 +785,17 @@ subroutine setup(this,pressure_solver,implicit_solver) end do end do end do - + ! Initialize the pressure Poisson solver call this%psolv%init() call this%psolv%setup() - + ! Prepare implicit solver if it had been provided if (present(implicit_solver)) then - + ! Point to implicit solver linsol object this%implicit=>implicit_solver - + ! Set 7-pt stencil map for the velocity solver this%implicit%stc(1,:)=[ 0, 0, 0] this%implicit%stc(2,:)=[+1, 0, 0] @@ -804,18 +804,18 @@ subroutine setup(this,pressure_solver,implicit_solver) this%implicit%stc(5,:)=[ 0,-1, 0] this%implicit%stc(6,:)=[ 0, 0,+1] this%implicit%stc(7,:)=[ 0, 0,-1] - + ! Set the diagonal to 1 to make sure all cells participate in solver this%implicit%opr(1,:,:,:)=1.0_WP - + ! Initialize the implicit velocity solver call this%implicit%init() - + end if - + end subroutine setup - - + + !> Add a boundary condition subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) use string, only: lowercase @@ -831,7 +831,7 @@ subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) logical, intent(in) :: canCorrect type(bcond), pointer :: new_bc integer :: i,j,k,n - + ! Prepare new bcond allocate(new_bc) new_bc%name=trim(adjustl(name)) @@ -851,14 +851,14 @@ subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) end select new_bc%rdir=real(new_bc%dir,WP) new_bc%canCorrect=canCorrect - + ! Insert it up front new_bc%next=>this%first_bc this%first_bc=>new_bc - + ! Increment bcond counter this%nbc=this%nbc+1 - + ! Now adjust the metrics accordingly select case (new_bc%type) case (dirichlet) !< Dirichlet is set one face (i.e., velocit component) at the time @@ -879,17 +879,17 @@ subroutine add_bcond(this,name,type,locator,face,dir,canCorrect) this%wmask(i,j,k)=2 end do end select - + case (neumann) !< Neumann has to be at existing wall or at domain boundary! case (clipped_neumann) case (convective) case default call die('[incomp apply_bcond] Unknown bcond type') end select - + end subroutine add_bcond - - + + !> Get a boundary condition subroutine get_bcond(this,name,my_bc) use messager, only: die @@ -904,8 +904,8 @@ subroutine get_bcond(this,name,my_bc) end do search if (.not.associated(my_bc)) call die('[incomp get_bcond] Boundary condition was not found') end subroutine get_bcond - - + + !> Enforce boundary condition subroutine apply_bcond(this,t,dt) use messager, only: die @@ -914,7 +914,7 @@ subroutine apply_bcond(this,t,dt) real(WP), intent(in) :: t,dt integer :: i,j,k,n,stag type(bcond), pointer :: my_bc - + ! ! First enfore zero velocity at walls ! do k=this%cfg%kmin_,this%cfg%kmax_ ! do j=this%cfg%jmin_,this%cfg%jmax_ @@ -929,22 +929,22 @@ subroutine apply_bcond(this,t,dt) ! call this%cfg%sync(this%U) ! call this%cfg%sync(this%V) ! call this%cfg%sync(this%W) - + ! Traverse bcond list my_bc=>this%first_bc do while (associated(my_bc)) - + ! Only processes inside the bcond work here if (my_bc%itr%amIn) then - + ! Select appropriate action based on the bcond type select case (my_bc%type) - + case (dirichlet) !< Apply Dirichlet conditions - + ! This is done by the user directly ! Unclear whether we want to do this within the solver... - + case (neumann,clipped_neumann) !< Apply Neumann condition to all 3 components ! Handle index shift due to staggering stag=min(my_bc%dir,0) @@ -995,28 +995,28 @@ subroutine apply_bcond(this,t,dt) end do end select end if - + case (convective) ! Not implemented yet! - + case default call die('[incomp apply_bcond] Unknown bcond type') end select - + end if - + ! Sync full fields after each bcond - this should be optimized call this%cfg%sync(this%U) call this%cfg%sync(this%V) call this%cfg%sync(this%W) - + ! Move on to the next bcond my_bc=>my_bc%next - + end do - + end subroutine apply_bcond - - + + !> Calculate the explicit momentum time derivative based on U/V/W/P subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) implicit none @@ -1026,12 +1026,12 @@ subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: drhoWdt !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,ii,jj,kk real(WP), dimension(:,:,:), allocatable :: FX,FY,FZ - + ! Allocate flux arrays allocate(FX(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(FY(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(FZ(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - + ! Flux of rhoU do kk=this%cfg%kmin_,this%cfg%kmax_+1 do jj=this%cfg%jmin_,this%cfg%jmax_+1 @@ -1065,7 +1065,7 @@ subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) end do ! Sync it call this%cfg%sync(drhoUdt) - + ! Flux of rhoV do kk=this%cfg%kmin_,this%cfg%kmax_+1 do jj=this%cfg%jmin_,this%cfg%jmax_+1 @@ -1099,7 +1099,7 @@ subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) end do ! Sync it call this%cfg%sync(drhoVdt) - + ! Flux of rhoW do kk=this%cfg%kmin_,this%cfg%kmax_+1 do jj=this%cfg%jmin_,this%cfg%jmax_+1 @@ -1133,13 +1133,13 @@ subroutine get_dmomdt(this,drhoUdt,drhoVdt,drhoWdt) end do ! Sync it call this%cfg%sync(drhoWdt) - + ! Deallocate flux arrays deallocate(FX,FY,FZ) - + end subroutine get_dmomdt - - + + !> Calculate the velocity divergence based on U/V/W subroutine get_div(this) implicit none @@ -1157,8 +1157,8 @@ subroutine get_div(this) ! Sync it call this%cfg%sync(this%div) end subroutine get_div - - + + !> Calculate the pressure gradient based on P subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) implicit none @@ -1182,8 +1182,8 @@ subroutine get_pgrad(this,P,Pgradx,Pgrady,Pgradz) call this%cfg%sync(Pgrady) call this%cfg%sync(Pgradz) end subroutine get_pgrad - - + + !> Calculate the interpolated velocity, including overlap and ghosts subroutine interp_vel(this,Ui,Vi,Wi) implicit none @@ -1223,8 +1223,8 @@ subroutine interp_vel(this,Ui,Vi,Wi) call this%cfg%sync(Vi) call this%cfg%sync(Wi) end subroutine interp_vel - - + + !> Calculate the deviatoric part of the strain rate tensor from U/V/W !> 1: du/dx-div/3 !> 2: dv/dy-div/3 @@ -1240,12 +1240,12 @@ subroutine get_strainrate(this,SR) real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy real(WP) :: div integer :: i,j,k - + ! Check SR's first dimension - if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - + if (size(SR,dim=1).ne.6) call die('[incomp get_strainrate] SR should be of size (1:6,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + ! Compute dudx, dvdy, and dwdz first - do k=this%cfg%kmin_,this%cfg%kmax_ + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ SR(1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) @@ -1258,17 +1258,17 @@ subroutine get_strainrate(this,SR) end do end do end do - + ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 + do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) @@ -1280,9 +1280,9 @@ subroutine get_strainrate(this,SR) end do end do end do - + ! Interpolate off-diagonal components of the velocity gradient to the cell center and store strain rate - do k=this%cfg%kmin_,this%cfg%kmax_ + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ SR(4,i,j,k)=0.125_WP*(sum(dudy(i:i+1,j:j+1,k ))+sum(dvdx(i:i+1,j:j+1,k ))) @@ -1291,9 +1291,9 @@ subroutine get_strainrate(this,SR) end do end do end do - + ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then + if (.not.this%cfg%xper) then if (this%cfg%iproc.eq.1) SR(:,this%cfg%imin-1,:,:)=SR(:,this%cfg%imin,:,:) if (this%cfg%iproc.eq.this%cfg%npx) SR(:,this%cfg%imax+1,:,:)=SR(:,this%cfg%imax,:,:) end if @@ -1305,25 +1305,25 @@ subroutine get_strainrate(this,SR) if (this%cfg%kproc.eq.1) SR(:,:,:,this%cfg%kmin-1)=SR(:,:,:,this%cfg%kmin) if (this%cfg%kproc.eq.this%cfg%npz) SR(:,:,:,this%cfg%kmax+1)=SR(:,:,:,this%cfg%kmax) end if - + ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ + do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ do i=this%cfg%imino_,this%cfg%imaxo_ if (this%mask(i,j,k).eq.1) SR(:,i,j,k)=0.0_WP end do end do end do - + ! Sync it - call this%cfg%sync(SR) - + call this%cfg%sync(SR) + ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + end subroutine get_strainrate - + !> Calculate the velocity gradient tensor from U/V/W !> Note that gradu(i,j)=duj/dxi subroutine get_gradu(this,gradu) @@ -1333,12 +1333,12 @@ subroutine get_gradu(this,gradu) real(WP), dimension(1:,1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: gradu !< Needs to be (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - + ! Check gradu's first two dimensions - if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') - + if (size(gradu,dim=1).ne.3.or.size(gradu,dim=2).ne.3) call die('[incomp get_gradu] gradu should be of size (1:3,1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') + ! Compute dudx, dvdy, and dwdz first - do k=this%cfg%kmin_,this%cfg%kmax_ + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ gradu(1,1,i,j,k)=sum(this%grdu_x(:,i,j,k)*this%U(i:i+1,j,k)) @@ -1347,17 +1347,17 @@ subroutine get_gradu(this,gradu) end do end do end do - + ! Allocate velocity gradient components - allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) + allocate(dudy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dudz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dvdz(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dwdx(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) allocate(dwdy(this%cfg%imino_:this%cfg%imaxo_,this%cfg%jmino_:this%cfg%jmaxo_,this%cfg%kmino_:this%cfg%kmaxo_)) - + ! Calculate components of the velocity gradient at their natural locations with an extra cell for interpolation - do k=this%cfg%kmin_,this%cfg%kmax_+1 + do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 do i=this%cfg%imin_,this%cfg%imax_+1 dudy(i,j,k)=sum(this%grdu_y(:,i,j,k)*this%U(i,j-1:j,k)) @@ -1369,9 +1369,9 @@ subroutine get_gradu(this,gradu) end do end do end do - + ! Interpolate off-diagonal components of the velocity gradient to the cell center - do k=this%cfg%kmin_,this%cfg%kmax_ + do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ do i=this%cfg%imin_,this%cfg%imax_ gradu(2,1,i,j,k)=0.25_WP*sum(dudy(i:i+1,j:j+1,k)) @@ -1383,9 +1383,9 @@ subroutine get_gradu(this,gradu) end do end do end do - + ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then + if (.not.this%cfg%xper) then if (this%cfg%iproc.eq.1) gradu(:,:,this%cfg%imin-1,:,:)=gradu(:,:,this%cfg%imin,:,:) if (this%cfg%iproc.eq.this%cfg%npx) gradu(:,:,this%cfg%imax+1,:,:)=gradu(:,:,this%cfg%imax,:,:) end if @@ -1397,25 +1397,25 @@ subroutine get_gradu(this,gradu) if (this%cfg%kproc.eq.1) gradu(:,:,:,:,this%cfg%kmin-1)=gradu(:,:,:,:,this%cfg%kmin) if (this%cfg%kproc.eq.this%cfg%npz) gradu(:,:,:,:,this%cfg%kmax+1)=gradu(:,:,:,:,this%cfg%kmax) end if - + ! Ensure zero in walls - do k=this%cfg%kmino_,this%cfg%kmaxo_ + do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ do i=this%cfg%imino_,this%cfg%imaxo_ if (this%mask(i,j,k).eq.1) gradu(:,:,i,j,k)=0.0_WP end do end do end do - + ! Sync it - call this%cfg%sync(gradu) - + call this%cfg%sync(gradu) + ! Deallocate velocity gradient storage - deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) - + deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) + end subroutine get_gradu - - + + !> Calculate vorticity vector subroutine get_vorticity(this,vort) use messager, only: die @@ -1424,7 +1424,7 @@ subroutine get_vorticity(this,vort) real(WP), dimension(1:,this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(out) :: vort !< Needs to be (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k real(WP), dimension(:,:,:), allocatable :: dudy,dudz,dvdx,dvdz,dwdx,dwdy - + ! Check vort's first two dimensions if (size(vort,dim=1).ne.3) call die('[incomp get_vorticity] vort should be of size (1:3,imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_)') @@ -1460,9 +1460,9 @@ subroutine get_vorticity(this,vort) end do end do end do - + ! Apply a Neumann condition in non-periodic directions - if (.not.this%cfg%xper) then + if (.not.this%cfg%xper) then if (this%cfg%iproc.eq.1) vort(:,this%cfg%imin-1,:,:)=vort(:,this%cfg%imin,:,:) if (this%cfg%iproc.eq.this%cfg%npx) vort(:,this%cfg%imax+1,:,:)=vort(:,this%cfg%imax,:,:) end if @@ -1474,7 +1474,7 @@ subroutine get_vorticity(this,vort) if (this%cfg%kproc.eq.1) vort(:,:,:,this%cfg%kmin-1)=vort(:,:,:,this%cfg%kmin) if (this%cfg%kproc.eq.this%cfg%npz) vort(:,:,:,this%cfg%kmax+1)=vort(:,:,:,this%cfg%kmax) end if - + ! Ensure zero in walls do k=this%cfg%kmino_,this%cfg%kmaxo_ do j=this%cfg%jmino_,this%cfg%jmaxo_ @@ -1491,8 +1491,8 @@ subroutine get_vorticity(this,vort) deallocate(dudy,dudz,dvdx,dvdz,dwdx,dwdy) end subroutine get_vorticity - - + + !> Calculate the CFL subroutine get_cfl(this,dt,cflc,cfl) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX @@ -1504,7 +1504,7 @@ subroutine get_cfl(this,dt,cflc,cfl) real(WP), optional :: cfl integer :: i,j,k,ierr real(WP) :: my_CFLc_x,my_CFLc_y,my_CFLc_z,my_CFLv_x,my_CFLv_y,my_CFLv_z - + ! Set the CFLs to zero my_CFLc_x=0.0_WP; my_CFLc_y=0.0_WP; my_CFLc_z=0.0_WP my_CFLv_x=0.0_WP; my_CFLv_y=0.0_WP; my_CFLv_z=0.0_WP @@ -1522,7 +1522,7 @@ subroutine get_cfl(this,dt,cflc,cfl) end do my_CFLc_x=my_CFLc_x*dt; my_CFLc_y=my_CFLc_y*dt; my_CFLc_z=my_CFLc_z*dt my_CFLv_x=my_CFLv_x*dt; my_CFLv_y=my_CFLv_y*dt; my_CFLv_z=my_CFLv_z*dt - + ! Get the parallel max call MPI_ALLREDUCE(my_CFLc_x,this%CFLc_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_CFLc_y,this%CFLc_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) @@ -1530,16 +1530,16 @@ subroutine get_cfl(this,dt,cflc,cfl) call MPI_ALLREDUCE(my_CFLv_x,this%CFLv_x,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_CFLv_y,this%CFLv_y,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_CFLv_z,this%CFLv_z,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - + ! Return the maximum convective CFL cflc=max(this%CFLc_x,this%CFLc_y,this%CFLc_z) - + ! If asked for, also return the maximum overall CFL if (present(CFL)) cfl=max(this%CFLc_x,this%CFLc_y,this%CFLc_z,this%CFLv_x,this%CFLv_y,this%CFLv_z) - + end subroutine get_cfl - - + + !> Calculate the max of our fields subroutine get_max(this) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX @@ -1548,7 +1548,7 @@ subroutine get_max(this) class(incomp), intent(inout) :: this integer :: i,j,k,ierr real(WP) :: my_Umax,my_Vmax,my_Wmax,my_Pmax,my_divmax - + ! Set all to zero my_Umax=0.0_WP; my_Vmax=0.0_WP; my_Wmax=0.0_WP; my_Pmax=0.0_WP; my_divmax=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1562,17 +1562,17 @@ subroutine get_max(this) end do end do end do - + ! Get the parallel max call MPI_ALLREDUCE(my_Umax ,this%Umax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_Vmax ,this%Vmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_Wmax ,this%Wmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_Pmax ,this%Pmax ,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_divmax,this%divmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) - + end subroutine get_max - - + + !> Compute MFR through all bcs subroutine get_mfr(this) use mpi_f08, only: MPI_SUM,MPI_ALLREDUCE @@ -1583,7 +1583,7 @@ subroutine get_mfr(this) type(bcond), pointer :: my_bc real(WP), dimension(:), allocatable :: my_mfr,my_area real(WP), dimension(:), allocatable :: canCorrect - + ! Ensure this%mfr is of proper size if (.not.allocated(this%mfr)) then allocate(this%mfr(this%nbc)) @@ -1592,7 +1592,7 @@ subroutine get_mfr(this) deallocate(this%mfr); allocate(this%mfr(this%nbc)) end if end if - + ! Ensure this%area is of proper size if (.not.allocated(this%area)) then allocate(this%area(this%nbc)) @@ -1601,16 +1601,16 @@ subroutine get_mfr(this) deallocate(this%area); allocate(this%area(this%nbc)) end if end if - + ! Allocate temp array for communication allocate(my_mfr(this%nbc)) allocate(my_area(this%nbc)) allocate(canCorrect(this%nbc)) - + ! Traverse bcond list and integrate local outgoing MFR my_bc=>this%first_bc; ibc=1 do while (associated(my_bc)) - + ! Set zero local MFR and area my_mfr(ibc)=0.0_WP my_area(ibc)=0.0_WP @@ -1619,10 +1619,10 @@ subroutine get_mfr(this) else canCorrect(ibc)=0.0_WP end if - + ! Only processes inside the bcond have a non-zero MFR if (my_bc%itr%amIn) then - + ! Implement based on bcond face and dir, loop over interior only select case (my_bc%face) case ('x') @@ -1644,27 +1644,27 @@ subroutine get_mfr(this) my_area(ibc)=my_area(ibc)+this%cfg%dx(i)*this%cfg%dy(j) end do end select - + end if - + ! Move on to the next bcond my_bc=>my_bc%next; ibc=ibc+1 - + end do - + ! Sum up all values call MPI_ALLREDUCE(my_mfr ,this%mfr ,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) call MPI_ALLREDUCE(my_area,this%area,this%nbc,MPI_REAL_WP,MPI_SUM,this%cfg%comm,ierr) - + ! Compute the correctable area this%correctable_area=sum(this%area*canCorrect) - + ! Deallocate temp array deallocate(my_mfr,my_area,canCorrect) - + end subroutine get_mfr - - + + !> Correct MFR through correctable bconds subroutine correct_mfr(this) use mpi_f08, only: MPI_SUM @@ -1673,20 +1673,20 @@ subroutine correct_mfr(this) real(WP) :: mfr_error,vel_correction integer :: i,j,k,n type(bcond), pointer :: my_bc - + ! Evaluate MFR mismatch and velocity correction call this%get_mfr() mfr_error=sum(this%mfr) if (abs(mfr_error).lt.10.0_WP*epsilon(1.0_WP).or.abs(this%correctable_area).lt.10.0_WP*epsilon(1.0_WP)) return vel_correction=-mfr_error/(this%rho*this%correctable_area) - + ! Traverse bcond list and correct bcond MFR my_bc=>this%first_bc do while (associated(my_bc)) - + ! Only processes inside correctable bcond need to work if (my_bc%itr%amIn.and.my_bc%canCorrect) then - + ! Implement based on bcond direction, loop over all cell select case (my_bc%face) case ('x') @@ -1705,17 +1705,17 @@ subroutine correct_mfr(this) this%W(i,j,k)=this%W(i,j,k)+my_bc%rdir*vel_correction end do end select - + end if - + ! Move on to the next bcond my_bc=>my_bc%next - + end do - + end subroutine correct_mfr - - + + !> Shift pressure to ensure zero average subroutine shift_p(this,pressure) implicit none @@ -1723,10 +1723,10 @@ subroutine shift_p(this,pressure) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: pressure !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP) :: pressure_tot integer :: i,j,k - + ! Compute volume-averaged pressure call this%cfg%integrate(A=pressure,integral=pressure_tot); pressure_tot=pressure_tot/this%cfg%fluid_vol - + ! Shift the pressure do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ @@ -1736,10 +1736,10 @@ subroutine shift_p(this,pressure) end do end do call this%cfg%sync(pressure) - + end subroutine shift_p - - + + !> Solve for implicit velocity residual subroutine solve_implicit(this,dt,resU,resV,resW) use ils_class, only: amg @@ -1751,7 +1751,7 @@ subroutine solve_implicit(this,dt,resU,resV,resW) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(inout) :: resW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k real(WP) :: rhoUp,rhoUm,rhoVp,rhoVm,rhoWp,rhoWm - + ! Solve implicit U problem this%implicit%opr(1,:,:,:)=this%rho; this%implicit%opr(2:,:,:,:)=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1801,7 +1801,7 @@ subroutine solve_implicit(this,dt,resU,resV,resW) this%implicit%sol=0.0_WP call this%implicit%solve() resU=this%implicit%sol - + ! Solve implicit V problem this%implicit%opr(1,:,:,:)=this%rho; this%implicit%opr(2:,:,:,:)=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1851,7 +1851,7 @@ subroutine solve_implicit(this,dt,resU,resV,resW) this%implicit%sol=0.0_WP call this%implicit%solve() resV=this%implicit%sol - + ! Solve implicit W problem this%implicit%opr(1,:,:,:)=this%rho; this%implicit%opr(2:,:,:,:)=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ @@ -1901,28 +1901,28 @@ subroutine solve_implicit(this,dt,resU,resV,resW) this%implicit%sol=0.0_WP call this%implicit%solve() resW=this%implicit%sol - + ! Sync up all residuals call this%cfg%sync(resU) call this%cfg%sync(resV) call this%cfg%sync(resW) - + end subroutine solve_implicit - - + + !> Print out info for incompressible flow solver subroutine incomp_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none class(incomp), intent(in) :: this - + ! Output if (this%cfg%amRoot) then write(output_unit,'("Incompressible solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) write(output_unit,'(" > density = ",es12.5)') this%rho end if - + end subroutine incomp_print - - + + end module incomp_class diff --git a/src/constant_density/scalar_class.f90 b/src/constant_density/scalar_class.f90 index 19252f220..eac38a267 100644 --- a/src/constant_density/scalar_class.f90 +++ b/src/constant_density/scalar_class.f90 @@ -9,20 +9,20 @@ module scalar_class use iterator_class, only: iterator implicit none private - + ! Expose type/constructor/methods public :: scalar,bcond - + ! List of known available bcond for this solver integer, parameter, public :: dirichlet=2 !< Dirichlet condition integer, parameter, public :: neumann=3 !< Zero normal gradient - + ! List of available advection schemes for scalar transport integer, parameter, public :: upwind=0 !< First order upwind scheme integer, parameter, public :: quick=1 !< Quick scheme integer, parameter, public :: bquick=2 !< BQuick scheme - - + + !> Boundary conditions for the incompressible solver type :: bcond type(bcond), pointer :: next !< Linked list of bconds @@ -31,37 +31,37 @@ module scalar_class integer :: dir !< Bcond direction (1 to 6) type(iterator) :: itr !< This is the iterator for the bcond end type bcond - + !> Bcond shift value integer, dimension(3,6), parameter :: shift=reshape([+1,0,0,-1,0,0,0,+1,0,0,-1,0,0,0,+1,0,0,-1],shape(shift)) - + !> Constant density scalar solver object definition type :: scalar - + ! This is our config class(config), pointer :: cfg !< This is the config the solver is build for - + ! This is the name of the solver character(len=str_medium) :: name='UNNAMED_SCALAR' !< Solver name (default=UNNAMED_SCALAR) - + ! Constant property fluid, but diffusivity is still a field due to LES modeling real(WP) :: rho !< This is our constant fluid density real(WP), dimension(:,:,:), allocatable :: diff !< These is our constant+SGS dynamic diffusivity for the scalar - + ! Boundary condition list integer :: nbc !< Number of bcond for our solver type(bcond), pointer :: first_bc !< List of bcond for our solver - + ! Scalar variable real(WP), dimension(:,:,:), allocatable :: SC !< SC array - + ! Old scalar variable real(WP), dimension(:,:,:), allocatable :: SCold !< SCold array - + ! Implicit scalar solver class(linsol), pointer :: implicit !< Iterative linear solver object for an implicit prediction of the scalar residual integer, dimension(:,:,:), allocatable :: stmap !< Inverse map from stencil shift to index location - + ! Metrics integer :: scheme !< Advection scheme for scalar integer :: nst !< Scheme order (and elemental stencil size) @@ -72,17 +72,17 @@ module scalar_class real(WP), dimension(:,:,:,:), allocatable :: div_x ,div_y ,div_z !< Divergence for SC real(WP), dimension(:,:,:,:), allocatable :: grd_x ,grd_y ,grd_z !< Scalar gradient for SC real(WP), dimension(:,:,:,:), allocatable :: itp_x ,itp_y ,itp_z !< Second order interpolation for SC diffusivity - + ! Bquick requires additional storage - real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup + real(WP), dimension(:,:,:,:), allocatable :: bitp_xp,bitp_yp,bitp_zp !< Plus interpolation for SC - backup real(WP), dimension(:,:,:,:), allocatable :: bitp_xm,bitp_ym,bitp_zm !< Minus interpolation for SC - backup ! Masking info for metric modification integer, dimension(:,:,:), allocatable :: mask !< Integer array used for modifying SC metrics - + ! Monitoring quantities real(WP) :: SCmax,SCmin,SCint !< Maximum and minimum, integral scalar - + contains procedure :: print=>scalar_print !< Output solver to the screen procedure :: setup !< Finish configuring the scalar solver @@ -98,16 +98,16 @@ module scalar_class procedure :: get_int !< Calculate integral field values procedure :: solve_implicit !< Solve for the scalar residuals implicitly end type scalar - - + + !> Declare scalar solver constructor interface scalar procedure constructor end interface scalar - + contains - - + + !> Default constructor for scalar solver function constructor(cfg,scheme,name) result(self) use messager, only: die @@ -117,30 +117,30 @@ function constructor(cfg,scheme,name) result(self) integer, intent(in) :: scheme character(len=*), optional :: name integer :: i,j,k - + ! Set the name for the solver if (present(name)) self%name=trim(adjustl(name)) - + ! Point to pgrid object self%cfg=>cfg - + ! Nullify bcond list self%nbc=0 self%first_bc=>NULL() - + ! Allocate variables allocate(self%SC (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%SC =0.0_WP allocate(self%SCold(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%SCold=0.0_WP allocate(self%diff (self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%diff =0.0_WP - + ! Prepare advection scheme self%scheme=scheme select case (self%scheme) case (upwind) ! Check current overlap - if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + if (self%cfg%no.lt.1) call die('[scalar constructor] Scalar transport scheme requires larger overlap') ! Set interpolation stencil sizes - self%nst=1 + self%nst=1 self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (quick) @@ -152,18 +152,18 @@ function constructor(cfg,scheme,name) result(self) self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case (bquick) ! Check current overlap - if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') - ! Set interpolation stencil sizes - self%nst=3 - self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 - self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 + if (self%cfg%no.lt.2) call die('[scalar constructor] Scalar transport scheme requires larger overlap') + ! Set interpolation stencil sizes + self%nst=3 + self%stp1=-(self%nst+1)/2; self%stp2=self%nst+self%stp1-1 + self%stm1=-(self%nst-1)/2; self%stm2=self%nst+self%stm1-1 case default call die('[scalar constructor] Unknown scalar transport scheme selected') end select - + ! Prepare default metrics call self%init_metrics() - + ! Prepare mask for SC allocate(self%mask(self%cfg%imino_:self%cfg%imaxo_,self%cfg%jmino_:self%cfg%jmaxo_,self%cfg%kmino_:self%cfg%kmaxo_)); self%mask=0 if (.not.self%cfg%xper) then @@ -186,17 +186,17 @@ function constructor(cfg,scheme,name) result(self) end do end do call self%cfg%sync(self%mask) - + end function constructor - - + + !> Metric initialization with no awareness of walls nor bcond subroutine init_metrics(this) use mathtools, only: fv_itp_build implicit none class(scalar), intent(inout) :: this integer :: i,j,k - + ! Allocate finite difference diffusivity interpolation coefficients allocate(this%itp_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered allocate(this%itp_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered @@ -211,7 +211,7 @@ subroutine init_metrics(this) end do end do end do - + ! Allocate finite difference scalar interpolation coefficients allocate(this%itp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered allocate(this%itp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered @@ -242,7 +242,7 @@ subroutine init_metrics(this) end do end do end select - + ! Allocate finite volume divergence operators allocate(this%div_x(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered allocate(this%div_y(0:+1,this%cfg%imin_:this%cfg%imax_,this%cfg%jmin_:this%cfg%jmax_,this%cfg%kmin_:this%cfg%kmax_)) !< Cell-centered @@ -257,7 +257,7 @@ subroutine init_metrics(this) end do end do end do - + ! Allocate finite difference velocity gradient operators allocate(this%grd_x(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< X-face-centered allocate(this%grd_y(-1:0,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)) !< Y-face-centered @@ -272,19 +272,19 @@ subroutine init_metrics(this) end do end do end do - + end subroutine init_metrics - - + + !> Metric adjustment accounting for bconds and walls - zero out div at bcond and walls subroutine adjust_metrics(this) implicit none class(scalar), intent(inout) :: this integer :: i,j,k - + ! Sync up masks call this%cfg%sync(this%mask) - + ! Adjust interpolation coefficients to cell faces do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -301,7 +301,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust scalar interpolation to reflect Dirichlet boundaries do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -336,7 +336,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Loop over the domain and apply masked conditions to SC divergence do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ @@ -349,7 +349,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust gradient coefficients to cell faces for walls (assume Neumann at wall) do k=this%cfg%kmin_,this%cfg%kmax_+1 do j=this%cfg%jmin_,this%cfg%jmax_+1 @@ -360,7 +360,7 @@ subroutine adjust_metrics(this) end do end do end do - + ! Adjust metrics to account for lower dimensionality if (this%cfg%nx.eq.1) then this%div_x=0.0_WP @@ -374,22 +374,22 @@ subroutine adjust_metrics(this) this%div_z=0.0_WP this%grd_z=0.0_WP end if - + end subroutine adjust_metrics - - + + !> Finish setting up the scalar solver now that bconds have been defined subroutine setup(this,implicit_solver) implicit none class(scalar), intent(inout) :: this class(linsol), target, intent(in), optional :: implicit_solver integer :: count,st - + ! Adjust metrics based on mask array call this%adjust_metrics() - + ! Bquick needs to remember the quick coefficients - select case (this%scheme) + select case (this%scheme) case (bquick) allocate(this%bitp_xp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xp=this%itp_xp allocate(this%bitp_xm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_xm=this%itp_xm @@ -398,13 +398,13 @@ subroutine setup(this,implicit_solver) allocate(this%bitp_zp(this%stp1:this%stp2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zp=this%itp_zp allocate(this%bitp_zm(this%stm1:this%stm2,this%cfg%imin_:this%cfg%imax_+1,this%cfg%jmin_:this%cfg%jmax_+1,this%cfg%kmin_:this%cfg%kmax_+1)); this%bitp_zm=this%itp_zm end select - + ! Prepare implicit solver if it had been provided if (present(implicit_solver)) then - + ! Point to implicit solver linsol object this%implicit=>implicit_solver - + ! Set dynamic stencil map for the scalar solver count=1; this%implicit%stc(count,:)=[0,0,0] do st=1,abs(this%stp1) @@ -415,18 +415,18 @@ subroutine setup(this,implicit_solver) count=count+1; this%implicit%stc(count,:)=[0,0,+st] count=count+1; this%implicit%stc(count,:)=[0,0,-st] end do - + ! Set the diagonal to 1 to make sure all cells participate in solver this%implicit%opr(1,:,:,:)=1.0_WP - + ! Initialize the implicit velocity solver call this%implicit%init() - + end if - + end subroutine setup - - + + !> Add a boundary condition subroutine add_bcond(this,name,type,locator,dir) use string, only: lowercase @@ -440,7 +440,7 @@ subroutine add_bcond(this,name,type,locator,dir) character(len=2), optional :: dir type(bcond), pointer :: new_bc integer :: i,j,k,n - + ! Prepare new bcond allocate(new_bc) new_bc%name=trim(adjustl(name)) @@ -460,14 +460,14 @@ subroutine add_bcond(this,name,type,locator,dir) new_bc%dir=0 end if new_bc%itr=iterator(this%cfg,new_bc%name,locator,'c') - + ! Insert it up front new_bc%next=>this%first_bc this%first_bc=>new_bc - + ! Increment bcond counter this%nbc=this%nbc+1 - + ! Now adjust the metrics accordingly select case (new_bc%type) case (dirichlet) @@ -480,10 +480,10 @@ subroutine add_bcond(this,name,type,locator,dir) case default call die('[scalar apply_bcond] Unknown bcond type') end select - + end subroutine add_bcond - - + + !> Get a boundary condition subroutine get_bcond(this,name,my_bc) use messager, only: die @@ -498,59 +498,58 @@ subroutine get_bcond(this,name,my_bc) end do search if (.not.associated(my_bc)) call die('[scalar get_bcond] Boundary condition was not found') end subroutine get_bcond - - + + !> Enforce boundary condition subroutine apply_bcond(this,t,dt) use messager, only: die use mpi_f08, only: MPI_MAX - use parallel, only: MPI_REAL_WP implicit none class(scalar), intent(inout) :: this real(WP), intent(in) :: t,dt integer :: i,j,k,n type(bcond), pointer :: my_bc - + ! Traverse bcond list my_bc=>this%first_bc do while (associated(my_bc)) - + ! Only processes inside the bcond work here if (my_bc%itr%amIn) then - + ! Select appropriate action based on the bcond type select case (my_bc%type) - + case (dirichlet) ! Apply Dirichlet conditions - + ! This is done by the user directly ! Unclear whether we want to do this within the solver... - + case (neumann) ! Apply Neumann condition - + ! Implement based on bcond direction do n=1,my_bc%itr%n_ i=my_bc%itr%map(1,n); j=my_bc%itr%map(2,n); k=my_bc%itr%map(3,n) this%SC(i,j,k)=this%SC(i-shift(1,my_bc%dir),j-shift(2,my_bc%dir),k-shift(3,my_bc%dir)) end do - + case default call die('[scalar apply_bcond] Unknown bcond type') end select - + end if - + ! Sync full fields after each bcond - this should be optimized call this%cfg%sync(this%SC) - + ! Move on to the next bcond my_bc=>my_bc%next - + end do - + end subroutine apply_bcond - - + + !> Calculate the explicit rhoSC time derivative based on rhoU/rhoV/rhoW subroutine get_drhoSCdt(this,drhoSCdt,rhoU,rhoV,rhoW) implicit none @@ -599,8 +598,8 @@ subroutine get_drhoSCdt(this,drhoSCdt,rhoU,rhoV,rhoW) ! Sync residual call this%cfg%sync(drhoSCdt) end subroutine get_drhoSCdt - - + + !> Calculate the min and max of our SC field subroutine get_max(this) use mpi_f08, only: MPI_ALLREDUCE,MPI_MAX,MPI_MIN @@ -612,16 +611,16 @@ subroutine get_max(this) my_SCmax=maxval(this%SC); call MPI_ALLREDUCE(my_SCmax,this%SCmax,1,MPI_REAL_WP,MPI_MAX,this%cfg%comm,ierr) my_SCmin=minval(this%SC); call MPI_ALLREDUCE(my_SCmin,this%SCmin,1,MPI_REAL_WP,MPI_MIN,this%cfg%comm,ierr) end subroutine get_max - - + + !> Calculate the integral of our SC field subroutine get_int(this) implicit none class(scalar), intent(inout) :: this call this%cfg%integrate(this%SC,integral=this%SCint) end subroutine get_int - - + + !> Solve for implicit scalar residual subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) implicit none @@ -632,7 +631,7 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rhoV !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) real(WP), dimension(this%cfg%imino_:,this%cfg%jmino_:,this%cfg%kmino_:), intent(in) :: rhoW !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) integer :: i,j,k,sti,std - + ! Prepare convective operator this%implicit%opr(1,:,:,:)=this%rho; this%implicit%opr(2:,:,:,:)=0.0_WP do k=this%cfg%kmin_,this%cfg%kmax_ @@ -656,7 +655,7 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) end do end do end do - + ! Prepare diffusive operator do k=this%cfg%kmin_,this%cfg%kmax_ do j=this%cfg%jmin_,this%cfg%jmax_ @@ -676,36 +675,36 @@ subroutine solve_implicit(this,dt,resSC,rhoU,rhoV,rhoW) end do end do end do - + ! Solve the linear system call this%implicit%setup() this%implicit%rhs=resSC this%implicit%sol=0.0_WP call this%implicit%solve() resSC=this%implicit%sol - + ! Sync up residual call this%cfg%sync(resSC) - + end subroutine solve_implicit - - + + !> Metric resetting for adaptive discretization like bquick subroutine metric_reset(this) - implicit none - class(scalar), intent(inout) :: this - select case (this%scheme) - case (bquick) - this%itp_xp=this%bitp_xp - this%itp_xm=this%bitp_xm - this%itp_yp=this%bitp_yp - this%itp_ym=this%bitp_ym - this%itp_zp=this%bitp_zp - this%itp_zm=this%bitp_zm - end select + implicit none + class(scalar), intent(inout) :: this + select case (this%scheme) + case (bquick) + this%itp_xp=this%bitp_xp + this%itp_xm=this%bitp_xm + this%itp_yp=this%bitp_yp + this%itp_ym=this%bitp_ym + this%itp_zp=this%bitp_zp + this%itp_zm=this%bitp_zm + end select end subroutine metric_reset - - + + !> Adjust adaptive metrics like bquick subroutine metric_adjust(this,SC,SCmin,SCmax) implicit none @@ -727,7 +726,7 @@ subroutine metric_adjust(this,SC,SCmin,SCmax) !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if + end if end do end do end do @@ -738,32 +737,32 @@ subroutine metric_adjust(this,SC,SCmin,SCmax) do i=this%cfg%imin_,this%cfg%imax_+1 if (SC(i,j,k).gt.SCmax) then !this%itp_xp(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] - end if + !this%itp_xm(i:i+1,j,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_yp(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_ym(i,j:j+1,k)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zp(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + !this%itp_zm(i,j,k:k+1)=[0.0_WP,1.0_WP,0.0_WP] + end if end do end do end do end if end select end subroutine metric_adjust - - + + !> Print out info for scalar solver subroutine scalar_print(this) use, intrinsic :: iso_fortran_env, only: output_unit implicit none class(scalar), intent(in) :: this - + ! Output if (this%cfg%amRoot) then write(output_unit,'("Constant density scalar solver [",a,"] for config [",a,"]")') trim(this%name),trim(this%cfg%name) end if - + end subroutine scalar_print - - + + end module scalar_class diff --git a/src/grid/pgrid_class.f90 b/src/grid/pgrid_class.f90 index 37bb8008c..7635bebaa 100644 --- a/src/grid/pgrid_class.f90 +++ b/src/grid/pgrid_class.f90 @@ -7,13 +7,13 @@ module pgrid_class use mpi_f08 implicit none private - + ! Expose type/constructor/methods public :: pgrid - + !> Partitioned grid type type, extends(sgrid) :: pgrid - + ! Parallelization information type(MPI_Group) :: group !< Group of processors working on the pgrid type(MPI_Comm) :: comm =MPI_COMM_NULL !< Communicator for our group @@ -41,7 +41,7 @@ module pgrid_class integer :: xyrank=MPI_UNDEFINED !< 2D rank for xycomm integer :: yzrank=MPI_UNDEFINED !< 2D rank for yzcomm integer :: zxrank=MPI_UNDEFINED !< 2D rank for zxcomm - + ! Local grid size integer :: nx_=0 !< Local grid size in x integer :: ny_=0 !< Local grid size in y @@ -64,12 +64,12 @@ module pgrid_class integer :: jmaxo_=0 !< Domain-decomposed index upper bound in y with overlap integer :: kmino_=0 !< Domain-decomposed index lower bound in z with overlap integer :: kmaxo_=0 !< Domain-decomposed index upper bound in z with overlap - + ! Index to processor coordinate map integer, dimension(:), allocatable :: xcoord !< Conversion from grid index to processor coordinate in x integer, dimension(:), allocatable :: ycoord !< Conversion from grid index to processor coordinate in y integer, dimension(:), allocatable :: zcoord !< Conversion from grid index to processor coordinate in z - + !> Communication buffers real(WP), dimension(:,:,:), allocatable, private :: syncbuf_x1, syncbuf_x2 real(WP), dimension(:,:,:), allocatable, private :: syncbuf_y1, syncbuf_y2 @@ -77,7 +77,7 @@ module pgrid_class integer , dimension(:,:,:), allocatable, private :: isyncbuf_x1,isyncbuf_x2 integer , dimension(:,:,:), allocatable, private :: isyncbuf_y1,isyncbuf_y2 integer , dimension(:,:,:), allocatable, private :: isyncbuf_z1,isyncbuf_z2 - + contains procedure, private :: init_mpi=>pgrid_init_mpi !< Prepare the MPI environment for the pgrid procedure, private :: domain_decomp=>pgrid_domain_decomp !< Perform the domain decomposition @@ -96,17 +96,17 @@ module pgrid_class procedure :: get_ijk_global !< Function that returns closest mesh indices to a provided position - global over full pgrid procedure :: get_ijk_from_lexico,get_lexico_from_ijk !< Functions that convert a lexicographic index to (i,j,k) and vice-versa end type pgrid - - + + !> Declare partitioned grid constructor interface pgrid procedure construct_pgrid_from_sgrid procedure construct_pgrid_from_file end interface pgrid - + contains - - + + !> Partitioned grid constructor from file function construct_pgrid_from_file(no,file,grp,decomp) result(self) use string, only: lowercase @@ -126,10 +126,10 @@ function construct_pgrid_from_file(no,file,grp,decomp) result(self) real(WP), dimension(:), allocatable :: y real(WP), dimension(:), allocatable :: z logical :: xper,yper,zper - + ! Initialize MPI environment self%group=grp; call self%init_mpi - + ! Root process can now read in the grid if (self%amRoot) then self%sgrid=sgrid(no,file) @@ -142,7 +142,7 @@ function construct_pgrid_from_file(no,file,grp,decomp) result(self) ny=self%ny nz=self%nz end if - + ! Broadcast it to our group call MPI_BCAST(simu_name,len(simu_name),MPI_CHARACTER,0,self%comm,ierr) call MPI_BCAST(coord ,1 ,MPI_INTEGER ,0,self%comm,ierr) @@ -152,7 +152,7 @@ function construct_pgrid_from_file(no,file,grp,decomp) result(self) call MPI_BCAST(nx ,1 ,MPI_INTEGER ,0,self%comm,ierr) call MPI_BCAST(ny ,1 ,MPI_INTEGER ,0,self%comm,ierr) call MPI_BCAST(nz ,1 ,MPI_INTEGER ,0,self%comm,ierr) - + ! Allocate x/y/z, fill it, and bc allocate(x(1:nx+1),y(1:ny+1),z(1:nz+1)) if (self%amRoot) then @@ -163,28 +163,28 @@ function construct_pgrid_from_file(no,file,grp,decomp) result(self) call MPI_BCAST(x,nx+1,MPI_REAL_WP,0,self%comm,ierr) call MPI_BCAST(y,ny+1,MPI_REAL_WP,0,self%comm,ierr) call MPI_BCAST(z,nz+1,MPI_REAL_WP,0,self%comm,ierr) - + ! Finish creating the sgrid if (.not.self%amRoot) self%sgrid=sgrid(coord,no,x,y,z,xper,yper,zper,trim(adjustl(simu_name))) - + ! Deallocate deallocate(x,y,z) - + ! Check and store decomposition if (product(decomp).ne.self%nproc) call die('[pgrid constructor] Parallel decomposition is improper') self%npx=decomp(1); self%npy=decomp(2); self%npz=decomp(3) - + ! Perform actual domain decomposition of grid call self%domain_decomp() - + ! If verbose run, log and or print grid if (verbose.gt.0) call self%log if (verbose.gt.1) call self%print if (verbose.gt.2) call self%allprint - + end function construct_pgrid_from_file - - + + !> Partitioned grid constructor from sgrid function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) use string, only: lowercase @@ -195,28 +195,28 @@ function construct_pgrid_from_sgrid(grid,grp,decomp) result(self) type(sgrid), intent(in) :: grid !< Base grid type(MPI_Group), intent(in) :: grp !< MPI group integer, dimension(3), intent(in) :: decomp !< Requested domain decomposition - + ! Initialize MPI environment self%group=grp; call self%init_mpi - + ! Copy base grid data self%sgrid=grid - + ! Check and store decomposition if (product(decomp).ne.self%nproc) call die('[pgrid constructor] Parallel decomposition is improper') self%npx=decomp(1); self%npy=decomp(2); self%npz=decomp(3) - + ! Perform actual domain decomposition of grid call self%domain_decomp() - + ! If verbose run, log and or print grid if (verbose.gt.0) call self%log if (verbose.gt.1) call self%print if (verbose.gt.2) call self%allprint - + end function construct_pgrid_from_sgrid - - + + !> Prepares the MPI environment for the pgrid subroutine pgrid_init_mpi(self) use parallel, only: comm @@ -236,8 +236,8 @@ subroutine pgrid_init_mpi(self) ! Create intracommunicator for the group call MPI_COMM_CREATE_GROUP(comm,self%group,0,self%comm,ierr) end subroutine pgrid_init_mpi - - + + !> Prepares the domain decomposition of the pgrid subroutine pgrid_domain_decomp(self) use messager, only: die @@ -251,14 +251,14 @@ subroutine pgrid_domain_decomp(self) logical, dimension(3) :: dir integer, dimension(3) :: coords integer, dimension(3) :: gsizes,lsizes,lstart - + ! Give cartesian layout to intracommunicator call MPI_CART_CREATE(self%comm,ndims,[self%npx,self%npy,self%npz],[self%xper,self%yper,self%zper],reorder,tmp_comm,ierr); self%comm=tmp_comm call MPI_COMM_RANK (self%comm,self%rank,ierr) call MPI_CART_COORDS(self%comm,self%rank,ndims,coords,ierr) self%iproc=coords(1)+1; self%jproc=coords(2)+1; self%kproc=coords(3)+1 self%amRoot=(self%rank.eq.0) - + ! Create 1D communicators dir=[.true.,.false.,.false.] call MPI_CART_SUB(self%comm,dir,self%xcomm,ierr) @@ -269,7 +269,7 @@ subroutine pgrid_domain_decomp(self) dir=[.false.,.false.,.true.] call MPI_CART_SUB(self%comm,dir,self%zcomm,ierr) call MPI_COMM_RANK(self%zcomm,self%zrank,ierr) - + ! Create 2D communicators dir=[.true.,.true.,.false.] call MPI_CART_SUB(self%comm,dir,self%xycomm,ierr) @@ -280,7 +280,7 @@ subroutine pgrid_domain_decomp(self) dir=[.true.,.false.,.true.] call MPI_CART_SUB(self%comm,dir,self%zxcomm,ierr) call MPI_COMM_RANK(self%zxcomm,self%zxrank,ierr) - + ! Perform decomposition in x q=self%nx/self%npx; r=mod(self%nx,self%npx) self%imin_ =self%imin+ coords(1) *q+min(coords(1) ,r) @@ -289,7 +289,7 @@ subroutine pgrid_domain_decomp(self) self%nxo_ =self%nx_+2*self%no self%imino_=self%imin_-self%no self%imaxo_=self%imax_+self%no - + ! Perform decomposition in y q=self%ny/self%npy; r=mod(self%ny,self%npy) self%jmin_ =self%jmin+ coords(2) *q+min(coords(2) ,r) @@ -298,7 +298,7 @@ subroutine pgrid_domain_decomp(self) self%nyo_ =self%ny_+2*self%no self%jmino_=self%jmin_-self%no self%jmaxo_=self%jmax_+self%no - + ! Perform decomposition in z q=self%nz/self%npz; r=mod(self%nz,self%npz) self%kmin_ =self%kmin+ coords(3) *q+min(coords(3) ,r) @@ -307,7 +307,7 @@ subroutine pgrid_domain_decomp(self) self%nzo_ =self%nz_+2*self%no self%kmino_=self%kmin_-self%no self%kmaxo_=self%kmax_+self%no - + ! We also need to prepare communication buffers allocate(self%syncbuf_x1(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) allocate(self%syncbuf_x2(self%no,self%jmino_:self%jmaxo_,self%kmino_:self%kmaxo_)) @@ -321,7 +321,7 @@ subroutine pgrid_domain_decomp(self) allocate(self%isyncbuf_y2(self%imino_:self%imaxo_,self%no,self%kmino_:self%kmaxo_)) allocate(self%isyncbuf_z1(self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%no)) allocate(self%isyncbuf_z2(self%imino_:self%imaxo_,self%jmino_:self%jmaxo_,self%no)) - + ! We need to define a proper MPI-I/O view gsizes=[self%nx ,self%ny ,self%nz ] lsizes=[self%nx_,self%ny_,self%nz_] @@ -332,7 +332,7 @@ subroutine pgrid_domain_decomp(self) call MPI_TYPE_COMMIT(self%SPview,ierr) call MPI_TYPE_CREATE_SUBARRAY(3,gsizes,lsizes,lstart,MPI_ORDER_FORTRAN,MPI_INTEGER,self%Iview,ierr) call MPI_TYPE_COMMIT(self%Iview,ierr) - + ! Finally, create x/y/zcoord array for rapid finding of processor cartesian coordinates allocate(self%xcoord(self%imino:self%imaxo)); self%xcoord=0 allocate(self%ycoord(self%jmino:self%jmaxo)); self%ycoord=0 @@ -358,10 +358,10 @@ subroutine pgrid_domain_decomp(self) end do end do end block find_coords - + end subroutine pgrid_domain_decomp - - + + !> Print out partitioned grid info to screen !> This is a slow and blocking routine for debugging only! subroutine pgrid_allprint(this) @@ -383,8 +383,8 @@ subroutine pgrid_allprint(this) end if end do end subroutine pgrid_allprint - - + + !> Cheap print of partitioned grid info to screen subroutine pgrid_print(this) use, intrinsic :: iso_fortran_env, only: output_unit @@ -406,8 +406,8 @@ subroutine pgrid_print(this) write(output_unit,'(" > volume = ",es12.5)') this%vol_total end if end subroutine pgrid_print - - + + !> Cheap print of partitioned grid info to log subroutine pgrid_log(this) use messager, only: log @@ -431,8 +431,8 @@ subroutine pgrid_log(this) write(message,'(" > volume = ",es12.5)') this%vol_total; call log(message) end if end subroutine pgrid_log - - + + !> Synchronization of overlap cells - uses full no !> This routine assumes that the default overlap size is used !> It allows the use of pre-allocated buffers for speed @@ -443,7 +443,7 @@ subroutine pgrid_rsync(this,A) real(WP), dimension(this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Direct copy if 2D @@ -466,7 +466,7 @@ subroutine pgrid_rsync(this,A) call MPI_SENDRECV(this%syncbuf_x1,isize,MPI_REAL_WP,idst,0,this%syncbuf_x2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(this%imino_:this%imin_-1,:,:)=this%syncbuf_x2 end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Direct copy if 2D @@ -489,7 +489,7 @@ subroutine pgrid_rsync(this,A) call MPI_SENDRECV(this%syncbuf_y1,isize,MPI_REAL_WP,idst,0,this%syncbuf_y2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,this%jmino_:this%jmin_-1,:)=this%syncbuf_y2 end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Direct copy if 2D @@ -512,10 +512,10 @@ subroutine pgrid_rsync(this,A) call MPI_SENDRECV(this%syncbuf_z1,isize,MPI_REAL_WP,idst,0,this%syncbuf_z2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,:,this%kmino_:this%kmin_-1)=this%syncbuf_z2 end if - + end subroutine pgrid_rsync - - + + !> Synchronization of overlap cells - uses full no !> This routine assumes that the default overlap size is used !> It allows the use of pre-allocated buffers for speed @@ -525,7 +525,7 @@ subroutine pgrid_isync(this,A) integer, dimension(this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Direct copy if 2D @@ -548,7 +548,7 @@ subroutine pgrid_isync(this,A) call MPI_SENDRECV(this%isyncbuf_x1,isize,MPI_INTEGER,idst,0,this%isyncbuf_x2,isize,MPI_INTEGER,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(this%imino_:this%imin_-1,:,:)=this%isyncbuf_x2 end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Direct copy if 2D @@ -571,7 +571,7 @@ subroutine pgrid_isync(this,A) call MPI_SENDRECV(this%isyncbuf_y1,isize,MPI_INTEGER,idst,0,this%isyncbuf_y2,isize,MPI_INTEGER,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,this%jmino_:this%jmin_-1,:)=this%isyncbuf_y2 end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Direct copy if 2D @@ -594,10 +594,10 @@ subroutine pgrid_isync(this,A) call MPI_SENDRECV(this%isyncbuf_z1,isize,MPI_INTEGER,idst,0,this%isyncbuf_z2,isize,MPI_INTEGER,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,:,this%kmino_:this%kmin_-1)=this%isyncbuf_z2 end if - + end subroutine pgrid_isync - - + + !> Synchronization of overlap cells !> This version is capable of handling any overlap size subroutine pgrid_rsync_no(this,A,no) @@ -609,7 +609,7 @@ subroutine pgrid_rsync_no(this,A,no) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k real(WP), dimension(:,:,:), allocatable :: buf1,buf2 - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Direct copy if 2D @@ -636,7 +636,7 @@ subroutine pgrid_rsync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Direct copy if 2D @@ -663,7 +663,7 @@ subroutine pgrid_rsync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Direct copy if 2D @@ -690,10 +690,10 @@ subroutine pgrid_rsync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + end subroutine pgrid_rsync_no - - + + !> Synchronization of overlap cells !> This version is capable of handling an array of the shape (:,i,j,k) subroutine pgrid_rsync_array(this,A) @@ -704,10 +704,10 @@ subroutine pgrid_rsync_array(this,A) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k,dim real(WP), dimension(:,:,:,:), allocatable :: buf1,buf2 - + ! Get first dimension dim=size(A,DIM=1) - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Direct copy if 2D @@ -734,7 +734,7 @@ subroutine pgrid_rsync_array(this,A) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Direct copy if 2D @@ -761,7 +761,7 @@ subroutine pgrid_rsync_array(this,A) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Direct copy if 2D @@ -788,109 +788,109 @@ subroutine pgrid_rsync_array(this,A) ! Deallocate deallocate(buf1,buf2) end if - + end subroutine pgrid_rsync_array !> Synchronization of overlap cells !> This version is capable of handling a tensor of the shape (:,:,i,j,k) subroutine pgrid_rsync_tensor(this,A) - use parallel, only: MPI_REAL_WP - implicit none - class(pgrid), intent(in) :: this - real(WP), dimension(1:,1:,this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (:,:,imin_-no:imax_+no,jmin_-no:jmax_+no,kmin_-no:kmax_+no) - type(MPI_Status) :: status - integer :: isrc,idst,ierr,isize,i,j,k,dim1,dim2 - real(WP), dimension(:,:,:,:,:), allocatable :: buf1,buf2 - - ! Get first two dimensions - dim1=size(A,DIM=1) - dim2=size(A,DIM=2) - - ! Work in x - is it 2D or 3D? - if (this%nx.eq.1) then - ! Direct copy if 2D - do i=this%imax_+1,this%imaxo_ - A(:,:,i,:,:)=A(:,:,this%imin_,:,:) - end do - do i=this%imino_,this%imin_-1 - A(:,:,i,:,:)=A(:,:,this%imin_,:,:) - end do - else - isize=dim1*dim2*(this%no)*(this%nyo_)*(this%nzo_) - allocate(buf1(dim1,dim2,this%no,this%nyo_,this%nzo_)) - allocate(buf2(dim1,dim2,this%no,this%nyo_,this%nzo_)) - ! Send left buffer to left neighbour - call MPI_CART_SHIFT(this%comm,0,-1,isrc,idst,ierr) - buf1=A(:,:,this%imin_:this%imin_+this%no-1,:,:) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imax_+1:this%imaxo_,:,:)=buf2 - ! Send right buffer to right neighbour - call MPI_CART_SHIFT(this%comm,0,+1,isrc,idst,ierr) - buf1=A(:,:,this%imax_-this%no+1:this%imax_,:,:) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imino_:this%imin_-1,:,:)=buf2 - ! Deallocate - deallocate(buf1,buf2) - end if - - ! Work in y - is it 2D or 3D? - if (this%ny.eq.1) then - ! Direct copy if 2D - do j=this%jmax_+1,this%jmaxo_ - A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) - end do - do j=this%jmino_,this%jmin_-1 - A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) - end do - else - isize=dim1*dim2*(this%nxo_)*(this%no)*(this%nzo_) - allocate(buf1(dim1,dim2,this%nxo_,this%no,this%nzo_)) - allocate(buf2(dim1,dim2,this%nxo_,this%no,this%nzo_)) - ! Send left buffer to left neighbour - call MPI_CART_SHIFT(this%comm,1,-1,isrc,idst,ierr) - buf1=A(:,:,:,this%jmin_:this%jmin_+this%no-1,:) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmax_+1:this%jmaxo_,:)=buf2 - ! Send right buffer to right neighbour - call MPI_CART_SHIFT(this%comm,1,+1,isrc,idst,ierr) - buf1=A(:,:,:,this%jmax_-this%no+1:this%jmax_,:) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmino_:this%jmin_-1,:)=buf2 - ! Deallocate - deallocate(buf1,buf2) - end if - - ! Work in z - is it 2D or 3D? - if (this%nz.eq.1) then - ! Direct copy if 2D - do k=this%kmax_+1,this%kmaxo_ - A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) - end do - do k=this%kmino_,this%kmin_-1 - A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) - end do - else - isize=dim1*dim2*(this%nxo_)*(this%nyo_)*(this%no) - allocate(buf1(dim1,dim2,this%nxo_,this%nyo_,this%no)) - allocate(buf2(dim1,dim2,this%nxo_,this%nyo_,this%no)) - ! Send left buffer to left neighbour - call MPI_CART_SHIFT(this%comm,2,-1,isrc,idst,ierr) - buf1=A(:,:,:,:,this%kmin_:this%kmin_+this%no-1) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmax_+1:this%kmaxo_)=buf2 - ! Send right buffer to right neighbour - call MPI_CART_SHIFT(this%comm,2,+1,isrc,idst,ierr) - buf1=A(:,:,:,:,this%kmax_-this%no+1:this%kmax_) - call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) - if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmino_:this%kmin_-1)=buf2 - ! Deallocate - deallocate(buf1,buf2) - end if - + use parallel, only: MPI_REAL_WP + implicit none + class(pgrid), intent(in) :: this + real(WP), dimension(1:,1:,this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (:,:,imin_-no:imax_+no,jmin_-no:jmax_+no,kmin_-no:kmax_+no) + type(MPI_Status) :: status + integer :: isrc,idst,ierr,isize,i,j,k,dim1,dim2 + real(WP), dimension(:,:,:,:,:), allocatable :: buf1,buf2 + + ! Get first two dimensions + dim1=size(A,DIM=1) + dim2=size(A,DIM=2) + + ! Work in x - is it 2D or 3D? + if (this%nx.eq.1) then + ! Direct copy if 2D + do i=this%imax_+1,this%imaxo_ + A(:,:,i,:,:)=A(:,:,this%imin_,:,:) + end do + do i=this%imino_,this%imin_-1 + A(:,:,i,:,:)=A(:,:,this%imin_,:,:) + end do + else + isize=dim1*dim2*(this%no)*(this%nyo_)*(this%nzo_) + allocate(buf1(dim1,dim2,this%no,this%nyo_,this%nzo_)) + allocate(buf2(dim1,dim2,this%no,this%nyo_,this%nzo_)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,0,-1,isrc,idst,ierr) + buf1=A(:,:,this%imin_:this%imin_+this%no-1,:,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imax_+1:this%imaxo_,:,:)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,0,+1,isrc,idst,ierr) + buf1=A(:,:,this%imax_-this%no+1:this%imax_,:,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,this%imino_:this%imin_-1,:,:)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + + ! Work in y - is it 2D or 3D? + if (this%ny.eq.1) then + ! Direct copy if 2D + do j=this%jmax_+1,this%jmaxo_ + A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) + end do + do j=this%jmino_,this%jmin_-1 + A(:,:,:,j,:)=A(:,:,:,this%jmin_,:) + end do + else + isize=dim1*dim2*(this%nxo_)*(this%no)*(this%nzo_) + allocate(buf1(dim1,dim2,this%nxo_,this%no,this%nzo_)) + allocate(buf2(dim1,dim2,this%nxo_,this%no,this%nzo_)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,1,-1,isrc,idst,ierr) + buf1=A(:,:,:,this%jmin_:this%jmin_+this%no-1,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmax_+1:this%jmaxo_,:)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,1,+1,isrc,idst,ierr) + buf1=A(:,:,:,this%jmax_-this%no+1:this%jmax_,:) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,this%jmino_:this%jmin_-1,:)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + + ! Work in z - is it 2D or 3D? + if (this%nz.eq.1) then + ! Direct copy if 2D + do k=this%kmax_+1,this%kmaxo_ + A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) + end do + do k=this%kmino_,this%kmin_-1 + A(:,:,:,:,k)=A(:,:,:,:,this%kmin_) + end do + else + isize=dim1*dim2*(this%nxo_)*(this%nyo_)*(this%no) + allocate(buf1(dim1,dim2,this%nxo_,this%nyo_,this%no)) + allocate(buf2(dim1,dim2,this%nxo_,this%nyo_,this%no)) + ! Send left buffer to left neighbour + call MPI_CART_SHIFT(this%comm,2,-1,isrc,idst,ierr) + buf1=A(:,:,:,:,this%kmin_:this%kmin_+this%no-1) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmax_+1:this%kmaxo_)=buf2 + ! Send right buffer to right neighbour + call MPI_CART_SHIFT(this%comm,2,+1,isrc,idst,ierr) + buf1=A(:,:,:,:,this%kmax_-this%no+1:this%kmax_) + call MPI_SENDRECV(buf1,isize,MPI_REAL_WP,idst,0,buf2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) + if (isrc.ne.MPI_PROC_NULL) A(:,:,:,:,this%kmino_:this%kmin_-1)=buf2 + ! Deallocate + deallocate(buf1,buf2) + end if + end subroutine pgrid_rsync_tensor - - + + !> Synchronization of overlap cells for integer !> This version is capable of handling any overlap size subroutine pgrid_isync_no(this,A,no) @@ -901,7 +901,7 @@ subroutine pgrid_isync_no(this,A,no) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k integer, dimension(:,:,:), allocatable :: buf1,buf2 - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Direct copy if 2D @@ -928,7 +928,7 @@ subroutine pgrid_isync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Direct copy if 2D @@ -955,7 +955,7 @@ subroutine pgrid_isync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Direct copy if 2D @@ -982,10 +982,10 @@ subroutine pgrid_isync_no(this,A,no) ! Deallocate deallocate(buf1,buf2) end if - + end subroutine pgrid_isync_no - - + + !> Synchronization by summation of overlap cells - uses full no !> This routine assumes that the default overlap size is used !> It allows the use of pre-allocated buffers for speed @@ -996,7 +996,7 @@ subroutine pgrid_rsyncsum(this,A) real(WP), dimension(this%imino_:,this%jmino_:,this%kmino_:), intent(inout) :: A !< Needs to be (imino_:imaxo_,jmino_:jmaxo_,kmino_:kmaxo_) type(MPI_Status) :: status integer :: isrc,idst,ierr,isize,i,j,k - + ! Work in x - is it 2D or 3D? if (this%nx.eq.1) then ! Sum along x @@ -1019,7 +1019,7 @@ subroutine pgrid_rsyncsum(this,A) call MPI_SENDRECV(this%syncbuf_x1,isize,MPI_REAL_WP,idst,0,this%syncbuf_x2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(this%imin_:this%imin_+this%no-1,:,:)=A(this%imin_:this%imin_+this%no-1,:,:)+this%syncbuf_x2 end if - + ! Work in y - is it 2D or 3D? if (this%ny.eq.1) then ! Sum along x @@ -1042,7 +1042,7 @@ subroutine pgrid_rsyncsum(this,A) call MPI_SENDRECV(this%syncbuf_y1,isize,MPI_REAL_WP,idst,0,this%syncbuf_y2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,this%jmin_:this%jmin_+this%no-1,:)=A(:,this%jmin_:this%jmin_+this%no-1,:)+this%syncbuf_y2 end if - + ! Work in z - is it 2D or 3D? if (this%nz.eq.1) then ! Sum along z @@ -1065,13 +1065,13 @@ subroutine pgrid_rsyncsum(this,A) call MPI_SENDRECV(this%syncbuf_z1,isize,MPI_REAL_WP,idst,0,this%syncbuf_z2,isize,MPI_REAL_WP,isrc,0,this%comm,status,ierr) if (isrc.ne.MPI_PROC_NULL) A(:,:,this%kmin_:this%kmin_+this%no-1)=A(:,:,this%kmin_:this%kmin_+this%no-1)+this%syncbuf_z2 end if - + ! Follow by a sync step call this%pgrid_rsync(A) end subroutine pgrid_rsyncsum - + !> Returns the closest local indices "ind" to the provided position "pos" with initial guess "ind_guess" function get_ijk_local(this,pos,ind_guess) result(ind) implicit none @@ -1092,8 +1092,8 @@ function get_ijk_local(this,pos,ind_guess) result(ind) do while (pos(3).gt.this%z(ind(3)+1).and.ind(3).lt.this%kmaxo_); ind(3)=ind(3)+1; end do do while (pos(3).lt.this%z(ind(3) ).and.ind(3).gt.this%kmino_); ind(3)=ind(3)-1; end do end function get_ijk_local - - + + !> Returns the closest global indices "ind" to the provided position "pos" with initial guess "ind_guess" function get_ijk_global(this,pos,ind_guess) result(ind) implicit none @@ -1114,8 +1114,8 @@ function get_ijk_global(this,pos,ind_guess) result(ind) do while (pos(3).gt.this%z(ind(3)+1).and.ind(3).lt.this%kmaxo); ind(3)=ind(3)+1; end do do while (pos(3).lt.this%z(ind(3) ).and.ind(3).gt.this%kmino); ind(3)=ind(3)-1; end do end function get_ijk_global - - + + !> Returns the rank that contains provided indices function get_rank(this,ind) result(rank) implicit none @@ -1124,8 +1124,8 @@ function get_rank(this,ind) result(rank) integer :: rank,ierr call MPI_CART_RANK(this%comm,[this%xcoord(ind(1)),this%ycoord(ind(2)),this%zcoord(ind(3))],rank,ierr) end function get_rank - - + + !> Function that returns an (i,j,k) index from a lexicographic index pure function get_ijk_from_lexico(this,lexico) result(ijk) implicit none @@ -1137,8 +1137,8 @@ pure function get_ijk_from_lexico(this,lexico) result(ijk) ijk(1)= lexico-this%nxo_*this%nyo_*ijk(3)-this%nxo_*ijk(2) ijk=ijk+[this%imino_,this%jmino_,this%kmino_] end function get_ijk_from_lexico - - + + !> Function that returns a lexicographic index from an (i,j,k) index pure function get_lexico_from_ijk(this,ijk) result(lexico) implicit none @@ -1147,6 +1147,6 @@ pure function get_lexico_from_ijk(this,ijk) result(lexico) integer :: lexico lexico=(ijk(1)-this%imino_)+(ijk(2)-this%jmino_)*this%nxo_+(ijk(3)-this%kmino_)*this%nxo_*this%nyo_ end function get_lexico_from_ijk - - + + end module pgrid_class diff --git a/src/solver/bbmg_class.f90 b/src/solver/bbmg_class.f90 index ea237df8b..dda1a7b6f 100644 --- a/src/solver/bbmg_class.f90 +++ b/src/solver/bbmg_class.f90 @@ -8,36 +8,36 @@ module bbmg_class use mpi_f08 implicit none private - + ! Expose type/constructor/methods public :: bbmg - + ! Level data object definition type :: lvl_data - + ! Global sizes integer :: ncell,ncello integer :: nx,imin,imax,nxo,imino,imaxo integer :: ny,jmin,jmax,nyo,jmino,jmaxo integer :: nz,kmin,kmax,nzo,kmino,kmaxo - + ! Local sizes integer :: ncell_,ncello_ integer :: nx_,imin_,imax_,nxo_,imino_,imaxo_ integer :: ny_,jmin_,jmax_,nyo_,jmino_,jmaxo_ integer :: nz_,kmin_,kmax_,nzo_,kmino_,kmaxo_ - + ! Operators real(WP), dimension(:,:,:,:,:,:), allocatable :: c2f real(WP), dimension(:,:,:,:,:,:), allocatable :: f2c real(WP), dimension(:,:,:,:,:,:), allocatable :: opr real(WP), dimension(:,:,:,:,:,:), allocatable :: oprc2f - + ! Vectors real(WP), dimension(:,:,:), allocatable :: v real(WP), dimension(:,:,:), allocatable :: f real(WP), dimension(:,:,:), allocatable :: r - + ! Parallel information logical, dimension(:), allocatable :: send_xm,send_xp logical, dimension(:), allocatable :: send_ym,send_yp @@ -48,16 +48,16 @@ module bbmg_class integer :: recv_xm,recv_xp integer :: recv_ym,recv_yp integer :: recv_zm,recv_zp - + end type lvl_data - - + + !> BBMG object definition type :: bbmg - + ! A BBMG has a name character(len=str_medium) :: name !< Name of solver - + ! Parallel information type(MPI_Comm) :: comm !< Grid communicator logical :: amRoot !< Root process for messaging @@ -66,27 +66,27 @@ module bbmg_class integer :: irank !< Rank info integer :: iproc,jproc,kproc !< Processor coordinates integer, dimension(:,:,:), allocatable :: rank !< Cartesian rank information - + ! General grid information integer :: no !< Size of the grid overlap logical :: xper,yper,zper !< Periodicity info for the problem - + ! General operator information integer :: nstx !< Number of diagonal in x integer :: nsty !< Number of diagonal in y integer :: nstz !< Number of diagonal in z - + ! Direct solver data integer :: np !< Direct problem size integer , dimension(:), allocatable :: piv !< Pivoting data real(WP), dimension(:), allocatable :: myrhs,rhs !< Local and assembled RHS real(WP), dimension(:,:), allocatable :: myOP,OP !< Local and assembled operator - + ! Solver information real(WP) :: my_res0 !< Initial L_infty norm of the residual real(WP) :: my_res !< Current L_infty norm of the residual integer :: my_ite !< Current number of iterations - + ! Configurable solver parameters real(WP) :: max_res !< Maximum residual - the solver will attempt to converge below that value integer :: max_ite !< Maximum number of iterations - the solver will not got past that value @@ -96,61 +96,61 @@ module bbmg_class integer :: ncell_coarsest=0 !< Coarsest problem size allowed logical :: use_direct_solve=.false. !< Use direct solve at the coarsest level (default is false) logical :: use_krylov=.true. !< Use BBMG as a preconditioner to a CG (default is true) - + ! Level data management integer :: nlvl !< Number of multigrid levels created - by default all will be used. This can be reduced by the user. type(lvl_data), dimension(:), allocatable :: lvl !< Entire data at each level - + ! Krylov solver data real(WP), dimension(:,:,:), allocatable :: res,pp,zz,Ap,sol !< Krylov solver work vectors real(WP) :: alpha,beta,rho1,rho2 !< Krylov solver coefficients - + contains - + procedure :: update !< Operator update (every time the operator changes) procedure :: solve !< Solve the linear system procedure :: mgsolve !< Solve the linear system with multigrid procedure :: cgsolve !< Solve the linear system with CG procedure :: initialize !< Initialize the solver - + procedure :: recompute_prolongation !< Recompute the prolongation at a given level procedure :: recompute_restriction !< Recompute the restriction at a given level procedure :: recompute_operator !< Recompute the operator at a given level procedure :: recompute_direct !< Recompute the direct problem at the final level - + procedure :: get_residual !< Compute the residual at a given level procedure :: c2f !< Prolongate from a level to the next finer level procedure :: f2c !< Restrict from a level to the next coarser level procedure :: relax !< Relax the problem at a given level procedure :: direct_solve !< Solve directly the problem at the final level procedure :: cycle !< Perform a multigrid cycle - + generic :: sync=>vsync,msync !< Synchronization at boundaries procedure, private :: vsync !< Synchronize boundaries for a vector at a given level procedure, private :: msync !< Synchronize boundaries for a matrix at a given level - + procedure :: pmodx,pmody,pmodz !< Parity calculation that accounts for periodicity - + end type bbmg - - + + !> Declare bbmg constructor interface bbmg procedure bbmg_from_pgrid end interface bbmg - - + + contains - - + + !> Division of an integer by 2 pure integer function div(ind) implicit none integer, intent(in) :: ind div=ind/2+mod(ind,2) end function div - - + + !> Parity of point i shifted by n to ensure 1<=i<=n pure integer function pmodx(this,i,n) class(bbmg), intent(in) :: this @@ -179,8 +179,8 @@ pure integer function pmodz(this,i,n) pmodz=1-mod(i,2) end if end function pmodz - - + + !> Constructor for a BBMG object - this sets the grid and storage function bbmg_from_pgrid(pg,name,nst) result(self) use messager, only: die @@ -190,7 +190,7 @@ function bbmg_from_pgrid(pg,name,nst) result(self) class(pgrid), intent(in) :: pg character(len=*), intent(in) :: name integer, dimension(3), intent(in) :: nst - + ! Process the operator size initialize_overlap: block integer :: maxst @@ -201,7 +201,7 @@ function bbmg_from_pgrid(pg,name,nst) result(self) maxst=max(self%nstx,self%nsty,self%nstz) self%no=(maxst-1)/2 end block initialize_overlap - + ! First build the hierarchy of grids initialize_grid: block integer :: i,n1,n2,n3,nlvl_x,nlvl_y,nlvl_z @@ -340,7 +340,7 @@ function bbmg_from_pgrid(pg,name,nst) result(self) end if end do lvl_loop end block initialize_grid - + ! Now prepare operator storage initialize_operator: block integer :: n @@ -367,7 +367,7 @@ function bbmg_from_pgrid(pg,name,nst) result(self) allocate(self%lvl(n)%r(self%lvl(n)%imino_:self%lvl(n)%imaxo_,self%lvl(n)%jmino_:self%lvl(n)%jmaxo_,self%lvl(n)%kmino_:self%lvl(n)%kmaxo_)); self%lvl(n)%r=0.0_WP end do end block initialize_operator - + ! Now prepare communication data initialize_comm: block integer :: ip,jp,kp,n,ierr @@ -567,19 +567,17 @@ function bbmg_from_pgrid(pg,name,nst) result(self) ! Deallocate work arrays deallocate(buf,mino_,min_,max_,maxo_,ncello_rank) end block initialize_comm - + end function bbmg_from_pgrid - - + + !> Initialize the solver subroutine initialize(this) use messager, only: die - use param, only: verbose - use parallel, only: MPI_REAL_WP implicit none class(bbmg), intent(inout) :: this integer :: i - + ! Recompute the coarsest level lvl_loop: do i=1,this%nlvl if (this%lvl(i)%ncell.le.this%ncell_coarsest) then @@ -587,7 +585,7 @@ subroutine initialize(this) exit lvl_loop end if end do lvl_loop - + ! Initialize the CG if needed if (this%use_krylov) then allocate(this%sol(this%lvl(1)%imino_:this%lvl(1)%imaxo_,this%lvl(1)%jmino_:this%lvl(1)%jmaxo_,this%lvl(1)%kmino_:this%lvl(1)%kmaxo_)); this%sol=0.0_WP @@ -596,10 +594,10 @@ subroutine initialize(this) allocate(this%pp (this%lvl(1)%imino_:this%lvl(1)%imaxo_,this%lvl(1)%jmino_:this%lvl(1)%jmaxo_,this%lvl(1)%kmino_:this%lvl(1)%kmaxo_)); this%pp =0.0_WP allocate(this%zz (this%lvl(1)%imino_:this%lvl(1)%imaxo_,this%lvl(1)%jmino_:this%lvl(1)%jmaxo_,this%lvl(1)%kmino_:this%lvl(1)%kmaxo_)); this%zz =0.0_WP end if - + end subroutine initialize - - + + !> Solve the linear system subroutine solve(this) use parallel, only: MPI_REAL_WP @@ -637,12 +635,11 @@ subroutine solve(this) call this%mgsolve() end if end subroutine solve - - + + !> Solve the linear system iteratively with CG subroutine cgsolve(this) use messager, only: die - use param, only: verbose use parallel, only: MPI_REAL_WP implicit none class(bbmg), intent(inout) :: this @@ -701,12 +698,11 @@ subroutine cgsolve(this) ! Put the solution back this%lvl(1)%v=this%sol end subroutine cgsolve - - + + !> Solve the linear system iteratively with multigrid subroutine mgsolve(this) use messager, only: die - use param, only: verbose use parallel, only: MPI_REAL_WP implicit none class(bbmg), intent(inout) :: this @@ -726,8 +722,8 @@ subroutine mgsolve(this) if (this%my_res.le.this%max_res) exit cycle_loop end do cycle_loop end subroutine mgsolve - - + + !> Perform a multigrid cycle recursive subroutine cycle(this,n) use messager, only: die @@ -774,7 +770,7 @@ recursive subroutine cycle(this,n) dir=-dir end do end subroutine cycle - + !> Application of the prolongation subroutine c2f(this,Ac,nc,Af,nf) use messager, only: die @@ -799,8 +795,8 @@ subroutine c2f(this,Ac,nc,Af,nf) ! Synchronize vector call this%sync(Af,nf) end subroutine c2f - - + + !> Application of the restriction subroutine f2c(this,Af,nf,Ac,nc) use messager, only: die @@ -825,8 +821,8 @@ subroutine f2c(this,Af,nf,Ac,nc) ! Synchronize vector call this%sync(Ac,nc) end subroutine f2c - - + + !> Get the residual subroutine get_residual(this,n) implicit none @@ -842,8 +838,8 @@ subroutine get_residual(this,n) end do call this%sync(this%lvl(n)%r,n) end subroutine get_residual - - + + !> Relax the problem with an 8 color Gauss-Seidel subroutine relax(this,A,B,n,dir) use messager, only: die @@ -885,8 +881,8 @@ subroutine relax(this,A,B,n,dir) call this%sync(A,n) end do end subroutine relax - - + + !> Solve directly the problem at the final level subroutine direct_solve(this) use parallel, only: MPI_REAL_WP @@ -925,8 +921,8 @@ subroutine direct_solve(this) ! Synchronize solution call this%sync(this%lvl(this%nlvl)%v,this%nlvl) end subroutine direct_solve - - + + !> Update of the operators across all levels !> This routine assumes that the level(1) opr has been populated in the interior subroutine update(this) @@ -960,8 +956,8 @@ subroutine update(this) ! Recompute direct problem call this%recompute_direct end subroutine update - - + + !> Recompute prolongation subroutine recompute_prolongation(this,n) implicit none @@ -1195,8 +1191,8 @@ subroutine recompute_prolongation(this,n) ! Synchronize prolongation call this%sync(this%lvl(n)%c2f,n) end subroutine recompute_prolongation - - + + !> Recompute restriction subroutine recompute_restriction(this,n) implicit none @@ -1229,8 +1225,8 @@ subroutine recompute_restriction(this,n) ! Synchronize restriction call this%sync(this%lvl(n)%f2c,n) end subroutine recompute_restriction - - + + !> Recompute operator subroutine recompute_operator(this,n) implicit none @@ -1301,8 +1297,8 @@ subroutine recompute_operator(this,n) ! Synchronize operator call this%sync(this%lvl(n)%opr,n) end subroutine recompute_operator - - + + ! Recompute direct problem subroutine recompute_direct(this) use parallel, only: MPI_REAL_WP @@ -1383,7 +1379,7 @@ subroutine recompute_direct(this) ! Gather operator call MPI_allreduce(this%myOP,this%OP,this%np*this%np,MPI_REAL_WP,MPI_SUM,this%comm,ierr) end subroutine recompute_direct - + !> Synchronization of overlap cells for a vector subroutine vsync(this,A,n) use parallel, only: MPI_REAL_WP @@ -1552,8 +1548,8 @@ subroutine vsync(this,A,n) ! Deallocate deallocate(buf1,buf2,request) end subroutine vsync - - + + !> Synchronization of overlap cells for a matrix subroutine msync(this,A,n) use parallel, only: MPI_REAL_WP @@ -1722,6 +1718,6 @@ subroutine msync(this,A,n) ! Deallocate deallocate(buf1,buf2,request) end subroutine msync - - + + end module bbmg_class