From f808d59eae2123cdc69d400a4f8de2eacb1cd722 Mon Sep 17 00:00:00 2001 From: Jesse Capecelatro <> Date: Mon, 7 Nov 2022 12:59:02 +0100 Subject: [PATCH 001/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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/136] 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 f626d042f57a831191d8f51d9053ce5ed369092c Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 29 Dec 2022 16:25:35 -0500 Subject: [PATCH 040/136] added error message for bad write; exposed additional method --- src/data/ensight_class.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index 70ff33cce..e74eb4f14 100644 --- a/src/data/ensight_class.f90 +++ b/src/data/ensight_class.f90 @@ -11,7 +11,7 @@ module ensight_class private ! Expose type/constructor/methods - public :: ensight + public :: ensight, add_rscalar ! List types type :: scl !< Scalar field @@ -272,6 +272,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 +318,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 From 32189872adfa09d782c871a59cba810a1ffad2b3 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 29 Dec 2022 16:26:30 -0500 Subject: [PATCH 041/136] exposed additional method until issue can be debugged --- src/libraries/monitor_class.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libraries/monitor_class.f90 b/src/libraries/monitor_class.f90 index 3c2799394..b1d8cce5c 100644 --- a/src/libraries/monitor_class.f90 +++ b/src/libraries/monitor_class.f90 @@ -8,7 +8,7 @@ module monitor_class ! Expose constructor for monitor object - public :: monitor + public :: monitor, add_column_real !> Preset some length and formats for the columns From 90577ffb3827e8c7973750e3e98be7fae852878f Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 29 Dec 2022 16:27:58 -0500 Subject: [PATCH 042/136] 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 953e7de20486e78632b8bf04b08c6bc70f2c8c18 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 29 Dec 2022 16:28:16 -0500 Subject: [PATCH 043/136] first draft of muscl solver --- examples/advection/GNUmakefile | 50 ++ examples/advection/README | 1 + examples/advection/input | 19 + examples/advection/src/Make.package | 2 + examples/advection/src/geometry.f90 | 59 ++ examples/advection/src/simulation.f90 | 339 ++++++++ examples/detonation/GNUmakefile | 50 ++ examples/detonation/README | 1 + examples/detonation/input | 16 + examples/detonation/src/Make.package | 2 + examples/detonation/src/geometry.f90 | 59 ++ examples/detonation/src/simulation.f90 | 261 ++++++ src/hyperbolic/Make.package | 4 + src/hyperbolic/advection.f90 | 144 ++++ src/hyperbolic/euler.f90 | 332 ++++++++ src/hyperbolic/muscl_class.f90 | 1056 ++++++++++++++++++++++++ 16 files changed, 2395 insertions(+) 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 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 src/hyperbolic/Make.package create mode 100644 src/hyperbolic/advection.f90 create mode 100644 src/hyperbolic/euler.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..ea13477ea --- /dev/null +++ b/examples/advection/README @@ -0,0 +1 @@ +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..ca8948964 --- /dev/null +++ b/examples/advection/input @@ -0,0 +1,19 @@ +# Parallelization +Partition : 2 1 1 + +# Mesh definition +Lx : 1.0 +nx : 64 + +# Initialization +Shapes : c + +# Direction +Advection direction : 1 1 0 + +# Time integration +Max cfl number : 0.98 + +# 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..205953952 --- /dev/null +++ b/examples/advection/src/geometry.f90 @@ -0,0 +1,59 @@ +!> 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 + real(WP) :: Lx + real(WP), dimension(:), allocatable :: x + ! Read in grid definition + call param_read('Lx',Lx) + call param_read('nx',nx) + allocate(x(nx+1)) + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + ! General serial grid object + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.true., & + & yper=.true., zper=.true., name='Periodic Cube') + 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..6143f6409 --- /dev/null +++ b/examples/advection/src/simulation.f90 @@ -0,0 +1,339 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl, SUPERBEE + 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, numparams + character, dimension(:), allocatable :: fields + + ! num params is 3 here; this will have to be changed for other systems + numparams = 3 + + ! check domain + check_cfg: block + + if (cfg%xL .ne. cfg%yL .or. cfg%xL .ne. cfg%zL) call die("domain must be square") + if (.not. (cfg%xper .and. cfg%yper .and. cfg%zper)) call die("domain must be periodic") + + end block check_cfg + + ! 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 ensight_class, only: add_rscalar + use string, only: str_short + integer :: i + character(len=4) :: istr + real(WP), dimension(:,:,:), pointer :: scl_ptr + + ! 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 + scl_ptr => fs%Uc(i,:,:,:) + write(istr,'(I2.2)') i + !WTF? + !call ens_out%add_scalar('U'//istr, scl_ptr) + call add_rscalar(ens_out, 'U'//istr, scl_ptr) + end do + + do i = 1, numparams + scl_ptr => fs%params(i,:,:,:) + write(istr,'(I2.2)') i + !WTF? + !call ens_out%add_scalar('p'//istr, scl_ptr) + call add_rscalar(ens_out, 'p'//istr, scl_ptr) + end do + + ! 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 monitor_class, only: add_column_real + 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 + ! WTF? + !call mfile%add_column(real_ptr, fields(i:i)//'min') + !call mfile%add_column(real_ptr, fields(i:i)//'max') + fieldname(1:1) = fields(i) + fieldname(2:4) = 'min' + real_ptr => fs%Umin(i) + call add_column_real(mfile, real_ptr, fieldname) + fieldname(1:1) = fields(i) + fieldname(2:4) = 'max' + real_ptr => fs%Umax(i) + call add_column_real(mfile, 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 (unsplit) + !call fs%compute_dU(time%dt) + !fs%Uc = fs%Uc + fs%dU + + ! take step (Strang) + fs%dU(:, :, :, :) = 0.0_WP + call fs%compute_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + call fs%compute_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + call fs%compute_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! apply boundary conditions + !call fs%apply_bcond(time%t, time%dt) + + ! 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 b/examples/detonation/input new file mode 100644 index 000000000..545671604 --- /dev/null +++ b/examples/detonation/input @@ -0,0 +1,16 @@ +# Parallelization +Partition : 2 2 1 + +# Mesh definition +Lx : 1.0 +nx : 64 + +# Initialization +Initial diameter : 0.2 + +# 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..6b4d3cb66 --- /dev/null +++ b/examples/detonation/src/geometry.f90 @@ -0,0 +1,59 @@ +!> 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 + real(WP) :: Lx + real(WP), dimension(:), allocatable :: x + ! Read in grid definition + call param_read('Lx',Lx) + call param_read('nx',nx) + allocate(x(nx+1)) + ! Create simple rectilinear grid + do i=1,nx+1 + x(i)=real(i-1,WP)/real(nx,WP)*Lx + end do + ! General serial grid object + grid=sgrid(coord=cartesian, no=4, x=x, y=x, z=x, xper=.true., & + & yper=.true., zper=.true., name='Periodic Cube') + 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..e716940bf --- /dev/null +++ b/examples/detonation/src/simulation.f90 @@ -0,0 +1,261 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use muscl_class, only: muscl + 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 + + !> 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 + + !> 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) + + end block create_and_initialize_flow_solver + + ! prepare initial fields + initialize_fields: block + real(WP) :: r2, oR + real(WP), dimension(3) :: x, c + real(WP), dimension(5) :: insval, outval + integer :: i, j, k + + call param_read('Initial diameter', oR) + oR = 0.5_WP * oR + + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_L, insval) + call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_R, outval) + + 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 (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 ensight_class, only: add_rscalar + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: scl_ptr + + ! 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 + scl_ptr => phys_out(1,:,:,:) + call add_rscalar(ens_out, 'density', scl_ptr) + scl_ptr => phys_out(2,:,:,:) + call add_rscalar(ens_out, 'x_velocity', scl_ptr) + scl_ptr => phys_out(3,:,:,:) + call add_rscalar(ens_out, 'y_velocity', scl_ptr) + scl_ptr => phys_out(4,:,:,:) + call add_rscalar(ens_out, 'z_velocity', scl_ptr) + scl_ptr => phys_out(5,:,:,:) + call add_rscalar(ens_out, 'pressure', scl_ptr) + scl_ptr => fs%params(1,:,:,:) + call add_rscalar(ens_out, 'gamma', scl_ptr) + + ! 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 monitor_class, only: add_column_real + 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 add_column_real(mfile, real_ptr, 'density_min') + real_ptr => fs%Umax(1) + call add_column_real(mfile, real_ptr, 'density_max') + real_ptr => fs%Umin(2) + call add_column_real(mfile, real_ptr, 'momentum_x_min') + real_ptr => fs%Umax(2) + call add_column_real(mfile, real_ptr, 'momentum_x_max') + real_ptr => fs%Umin(3) + call add_column_real(mfile, real_ptr, 'momentum_y_min') + real_ptr => fs%Umax(3) + call add_column_real(mfile, real_ptr, 'momentum_y_max') + real_ptr => fs%Umin(4) + call add_column_real(mfile, real_ptr, 'momentum_z_min') + real_ptr => fs%Umax(4) + call add_column_real(mfile, real_ptr, 'momentum_z_max') + real_ptr => fs%Umin(5) + call add_column_real(mfile, real_ptr, 'totalenergy_min') + real_ptr => fs%Umax(5) + call add_column_real(mfile, real_ptr, 'totalenergy_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() + + 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%compute_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + call fs%compute_dU_y(time%dt) + fs%Uc = fs%Uc + fs%dU + fs%dU(:, :, :, :) = 0.0_WP + call fs%compute_dU_x(0.5 * time%dt) + fs%Uc = fs%Uc + fs%dU + + ! apply boundary conditions + !call fs%apply_bcond(time%t, time%dt) + + ! 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() + + 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/hyperbolic/Make.package b/src/hyperbolic/Make.package new file mode 100644 index 000000000..f6f9faf42 --- /dev/null +++ b/src/hyperbolic/Make.package @@ -0,0 +1,4 @@ +f90EXE_sources += muscl_class.f90 advection.f90 euler.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..7ba9ced96 --- /dev/null +++ b/src/hyperbolic/advection.f90 @@ -0,0 +1,144 @@ + +!> contains necessary functions for using the muscl class (or other general hyperbolic +!> solvers) to solve basic advection problems + +!> 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 muscl_class, only: muscl, constructor, eigenvals_ftype, rsolver_ftype, limiter_ftype + 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 + evals_y_ptr => advec_evals_y + evals_z_ptr => advec_evals_z + rsolv_x_ptr => advec_rsolv_x + rsolv_y_ptr => advec_rsolv_y + 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 + + end function make_advec_muscl + + pure subroutine advec_evals_x(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(:) + + do i = 1, size(Ul, 1) + rs(i,i+4) = 1.0_WP + end do + + end subroutine + + pure subroutine advec_rsolv_x(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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..5a8adc765 --- /dev/null +++ b/src/hyperbolic/euler.f90 @@ -0,0 +1,332 @@ + +!> contains necessary functions for using the muscl class (or other general +!> hyperbolic solvers) to solve the Euler equations for an ideal (gamma) gas + +!> Written by John Wakefield in December 2022 + +module hyperbolic_euler + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use muscl_class, only: muscl, VANLEER, eigenvals_ftype, rsolver_ftype, & + & limiter_ftype + 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 + + !> 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 + evals_y_ptr => euler_evals_y + evals_z_ptr => euler_evals_z + rsolv_x_ptr => euler_rsolv_x + rsolv_y_ptr => euler_rsolv_y + 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 + + end function make_euler_muscl + + !> 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_evals_x(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(N, params, U, evals) + implicit none + integer, intent(in) :: N + real(WP), dimension(:), 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(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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(N, pl, Ul, pr, Ur, rs) + integer, intent(in) :: N + real(WP), dimension(:), 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/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 new file mode 100644 index 000000000..ba13021db --- /dev/null +++ b/src/hyperbolic/muscl_class.f90 @@ -0,0 +1,1056 @@ +!> MUSCL-type solver class +!> Provides support for various BC, generic hyperbolic structures, and source +!> terms projected onto eigenstructures +!> +!> Originally written by John P Wakefield, December 2022 +!> +!> this file includes: +!> +!> - module block +!> - function interfaces +!> - bc type +!> - solver class def +!> - system class defs +!> - contains (with headers containing exactly these phrases) +!> - standard interface class functions +!> - muscl-specific class functions +!> - limiter definitions +!> +!> 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 + implicit none + private + + ! expose type/constructor/methods + public :: muscl, constructor, bcond + + ! expose interfaces + public :: eigenvals_ftype, rsolver_ftype, limiter_ftype + + ! 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 + + ! 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 interpolate + ! 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 + ! rs(:, 5:(N+4)) (linearized) eigenvectors + + interface + pure subroutine eigenvals_ftype(N, params, u, evals) + use precision, only: WP + implicit none + integer, intent(in) :: N + real(WP), dimension(:), intent(in) :: params + real(WP), dimension(N), intent(in) :: u + real(WP), dimension(N), intent(out) :: evals + end subroutine + pure subroutine rsolver_ftype(N, pl, ul, pr, ur, rs) + use precision, only: WP + implicit none + integer, intent(in) :: N + real(WP), dimension(:), intent(in) :: pl, pr + real(WP), dimension(N), intent(in) :: ul, ur + real(WP), dimension(:,:), intent(out) :: rs + 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 + + !> boundary conditions for the hyperbolic solver + type :: bcond + type(bcond), pointer :: next !< linked list of bconds + character(len=str_medium) :: name = 'UNNAMED_BCOND' !< bcond name (default UNNAMED_BCOND) + integer(1) :: 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(1) :: dir !< bcond direction (+1,-1,0 for interior) + end type bcond + + !> solver object definition + type :: muscl + + ! config / pgrid object + class(config), pointer :: cfg !< config / pgrid information + + ! name + character(len=str_medium) :: name = 'UNNAMED_MUSCL' !< solver name (default UNNAMED_MUSCL) + + ! 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 + !TODO all the reflecting bc stuff + logical, dimension(:), allocatable :: reflect_mask_x, reflect_mask_y, reflect_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 + 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, 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 + 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 :: compute_dU !< take step + procedure :: compute_dU_x, compute_dU_y, compute_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 + select case (lim) + case (UPWIND) + this%limiter => limiter_upwind + case (LAXWEND) + this%limiter => limiter_laxwend + case (BEAMWARM) + this%limiter => limiter_beamwarm + case (FROMM) + this%limiter => limiter_fromm + case (MINMOD) + this%limiter => limiter_minmod + case (SUPERBEE) + this%limiter => limiter_superbee + case (MC) + this%limiter => limiter_mc + case (VANLEER) + this%limiter => limiter_vanleer + case default + call die("could not find limiter") + end select + this%upratio_divzero_eps = upratio_divzero_eps + + ! 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. + + ! 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%have_Urange = .false. + + end function + + !> solver print function + subroutine muscl_print(this) + implicit none + class(muscl), intent(in) :: this + + !TODO + + + + end subroutine + + !> Add a boundary condition + subroutine add_bcond(this, name, type, locator, face, dir) + 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 + 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(1), intent(in) :: dir + type(bcond), pointer :: new_bc + integer :: i, j, k, n + integer(1) :: fi, wbc + + ! check input + select case (lowercase(face)) + case ('x'); case ('y'); case ('z'); + case default; call die('[muscl add_bcond] Unknown bcond face - expecting x, y, or z') + end select + if (abs(dir) .ne. 1 .and. dir .ne. 0) then + call die('[muscl add_bcond] Unknown bcond dir - expecting -1, +1, or 0') + end if + + ! prepare new bcond + allocate(new_bc) + new_bc%name = trim(adjustl(name)) + new_bc%type = type + new_bc%face = lowercase(face) + fi = int(ichar(new_bc%face) - ichar('x'), 1) + new_bc%itr = iterator(pg=this%cfg, name=new_bc%name, locator=locator, & + & face=new_bc%face) + new_bc%dir = dir + + ! 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(ior(type, 96_1), -4_1) + if (dir .eq. -1_1) then + select case (wbc) + case (1) + wbc = 2_1 + case (2) + wbc = 1_1 + case default + end select + end if + wbc = ishft(wbc, 2 * fi) + 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(bcond), 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 + !TODO + 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 + 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 + masked_type = ior(my_bc%type, 3_1) + select case (masked_type) + + case (0) !< do nothing + + case (2) !< interpolate + + + + case (3) !< reflect interpolate + + + + case (1) + call die('[muscl apply_bcond] Unknown bcond type') + case default + call die('[muscl apply_bcond] Unknown bcond type') + end select + + !<<<<<<<<< TODO example of how this might be done + !! 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 + + !>>>>>>>>>>>>>> end example + + 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 + use parallel, only: MPI_REAL_WP + implicit none + class(muscl), intent(inout) :: this + real(WP), dimension(this%N) :: task_Umin, task_Umax + integer :: i, j, k, ierr + + if (.not. this%have_Urange) then + + task_Umin = + huge(1.0_WP) + task_Umax = - 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_ + task_Umin = min(task_Umin, this%Uc(:,i,j,k)) + task_Umax = max(task_Umax, this%Uc(:,i,j,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") + + this%have_Urange = .true. + + end if + + end subroutine get_range + + !> get mass flow rate through boundaries at previous step + !TODO + + !> compute dU + ! this is an unsplit step---its use is generally a bad idea. A better + ! approach is to use the directional subroutines below in operator splitting; + ! e.g. Strang. Strang stepping should utilize Jack's timestepping class. + subroutine compute_dU(this, dt) + implicit none + class(muscl), intent(inout) :: this + real(WP), intent(in) :: dt + + this%dU(:, :, :, :) = 0.0_WP + + call this%compute_dU_x(dt) + + call this%compute_dU_y(dt) + + call this%compute_dU_z(dt) + + end subroutine compute_dU + + !> compute dU in x direction + subroutine compute_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, j, k, ierr + + call this%cfg%sync(this%Uc) + + N = this%N; P = this%P; M = size(this%Uc, 2); cfl = 0.0_WP; + + do k = this%cfg%kmin_,this%cfg%kmax_ + do j = this%cfg%jmin_,this%cfg%jmax_ + call wavestep_1d(N, P, M, this%limiter, this%upratio_divzero_eps, & + & this%rsolv_x, this%cfg%dx, this%wavebcs(:,j,k), dt, & + & this%params(:,:,j,k), this%Uc(:,:,j,k), this%dU(:,:,j,k), cfl) + end do + end do + + 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.; + + end subroutine compute_dU_x + + !> compute dU in y direction + subroutine compute_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, k, jmino_, jmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + 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) + bc1d = this%wavebcs(i,jmino_:jmaxo_,k) + 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.; + + end subroutine compute_dU_y + + !> compute dU in z direction + subroutine compute_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, kmino_, kmaxo_, ierr + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + integer(1), dimension(:), allocatable :: bc1d + + 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_) + 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.; + + end subroutine compute_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(N, params(:,1), U(:,1), params(:,2), U(:,2), ll) + call rsolver(N, params(:,2), U(:,2), params(:,3), U(:,3), lc) + call rsolver(N, params(:,3), U(:,3), params(:,4), U(:,4), rc) + + !TODO this is broken + !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(N, params(:,j+1), U(:,j+1), params(:,j+2), U(:,j+2), rr) + !TODO this is broken + !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 + + !TODO this is broken + + N = size(rs, 1) + + ! zero negative waves? + if (ior(bc, 1_1) .eq. 1_1) rs(:, 3:4) = max(rs(:, 3:4), 0.0_WP) + + ! zero positive waves? + if (ior(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%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%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%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 + + !! limiter definitions + + ! limiter functions + 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 + From 057fa6cd932bbac13031899b7599c799aa641d2d Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 29 Dec 2022 22:58:47 -0500 Subject: [PATCH 044/136] 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 045/136] 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 046/136] 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 047/136] 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 048/136] 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 049/136] 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 050/136] 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 051/136] 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 052/136] 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 053/136] 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 054/136] 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 055/136] 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 056/136] 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 057/136] 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 058/136] 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 059/136] 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 060/136] 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 061/136] 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 062/136] 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 063/136] 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 064/136] 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 065/136] 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 066/136] 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 067/136] 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 068/136] 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 069/136] 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 070/136] 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 071/136] 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 072/136] 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 073/136] 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 074/136] 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 1ea6e4dca8cbd069856bf5b01b2c03883961cbb2 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 19 Jan 2023 14:23:14 -0500 Subject: [PATCH 075/136] make localization interface public in iterator_class.f90 --- src/grid/iterator_class.f90 | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) 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 From d816cfc2ed26738d6e5fc9cddd81ce9d00c7e1fd Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 19 Jan 2023 14:40:25 -0500 Subject: [PATCH 076/136] fixed boundary conditions --- src/hyperbolic/muscl_class.f90 | 292 +++++++++++++++------------------ 1 file changed, 133 insertions(+), 159 deletions(-) diff --git a/src/hyperbolic/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 index ba13021db..1bf8d695c 100644 --- a/src/hyperbolic/muscl_class.f90 +++ b/src/hyperbolic/muscl_class.f90 @@ -45,13 +45,13 @@ module muscl_class ! 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 interpolate + ! 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 + 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 @@ -91,9 +91,8 @@ pure function limiter_ftype(r) result(phi) type(bcond), pointer :: next !< linked list of bconds character(len=str_medium) :: name = 'UNNAMED_BCOND' !< bcond name (default UNNAMED_BCOND) integer(1) :: 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(1) :: dir !< bcond direction (+1,-1,0 for interior) + type(iterator) :: itr !< this is the iterator for the bcond + integer(1) :: dir !< bcond direction 0-6 end type bcond !> solver object definition @@ -110,8 +109,7 @@ pure function limiter_ftype(r) result(phi) 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 - !TODO all the reflecting bc stuff - logical, dimension(:), allocatable :: reflect_mask_x, reflect_mask_y, reflect_mask_z + logical, dimension(:), allocatable :: vel_mask_x, vel_mask_y, vel_mask_z ! limiting procedure(limiter_ftype), pointer, nopass :: limiter !< limiter function @@ -119,6 +117,7 @@ pure function limiter_ftype(r) result(phi) ! boundary condition list integer :: nbc !< number of bcond for our solver + !TODO mft 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 @@ -146,6 +145,7 @@ pure function limiter_ftype(r) result(phi) ! 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 @@ -160,7 +160,6 @@ pure function limiter_ftype(r) result(phi) procedure :: get_min => get_range !< compatibility procedure :: get_max => get_range !< compatibility !procedure :: get_mfr !< mfr at ea bcond in last step - procedure :: compute_dU !< take step procedure :: compute_dU_x, compute_dU_y, compute_dU_z !< take step ! muscl specific @@ -259,62 +258,54 @@ function constructor(cfg, name, N, P, evals_x, evals_y, evals_z, rsolv_x, & this%have_CFL_z_estim = .false.; this%have_CFL_z_exact = .false.; ! initialize monitoring - allocate(this%Umin(N), this%Umax(N)) + 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 - !TODO - - + 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, face, dir) - use string, only: lowercase - use messager, only: die + 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 - 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(1), intent(in) :: dir + procedure(locator_gen_ftype) :: locator + character(len=2), intent(in) :: dir type(bcond), pointer :: new_bc integer :: i, j, k, n - integer(1) :: fi, wbc - - ! check input - select case (lowercase(face)) - case ('x'); case ('y'); case ('z'); - case default; call die('[muscl add_bcond] Unknown bcond face - expecting x, y, or z') - end select - if (abs(dir) .ne. 1 .and. dir .ne. 0) then - call die('[muscl add_bcond] Unknown bcond dir - expecting -1, +1, or 0') - end if + integer(1) :: wbc ! prepare new bcond allocate(new_bc) new_bc%name = trim(adjustl(name)) new_bc%type = type - new_bc%face = lowercase(face) - fi = int(ichar(new_bc%face) - ichar('x'), 1) - new_bc%itr = iterator(pg=this%cfg, name=new_bc%name, locator=locator, & - & face=new_bc%face) - new_bc%dir = dir + 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 @@ -322,19 +313,20 @@ end function locator this%nbc = this%nbc + 1 ! update wave zeroing array - wbc = ishft(ior(type, 96_1), -4_1) - if (dir .eq. -1_1) then + 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 (1) - wbc = 2_1 - case (2) - wbc = 1_1 - case default + 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 * fi) - 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) + 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 @@ -361,13 +353,14 @@ 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 - !TODO 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(bcond), pointer :: my_bc ! Traverse bcond list @@ -378,76 +371,51 @@ subroutine apply_bcond(this, t, dt) if (my_bc%itr%amIn) then ! Select appropriate action based on the bcond type - masked_type = ior(my_bc%type, 3_1) + masked_type = iand(my_bc%type, 3_1) select case (masked_type) - - case (0) !< do nothing - - case (2) !< interpolate - - - - case (3) !< reflect interpolate - - - - case (1) - call die('[muscl apply_bcond] Unknown bcond type') + case (0_1) !< do nothing + case (2_1) !< interpolate + 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) + 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 + !TODO + call die("not implemented") + case (1_1) + call die('[muscl apply_bcond] Unknown bcond type') case default - call die('[muscl apply_bcond] Unknown bcond type') + call die('[muscl apply_bcond] Unknown bcond type') end select - !<<<<<<<<< TODO example of how this might be done - !! 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 - - !>>>>>>>>>>>>>> end example - + ! 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 @@ -486,23 +454,26 @@ 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 + 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 + 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_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 @@ -513,6 +484,9 @@ subroutine get_range(this) 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. @@ -523,25 +497,6 @@ end subroutine get_range !> get mass flow rate through boundaries at previous step !TODO - !> compute dU - ! this is an unsplit step---its use is generally a bad idea. A better - ! approach is to use the directional subroutines below in operator splitting; - ! e.g. Strang. Strang stepping should utilize Jack's timestepping class. - subroutine compute_dU(this, dt) - implicit none - class(muscl), intent(inout) :: this - real(WP), intent(in) :: dt - - this%dU(:, :, :, :) = 0.0_WP - - call this%compute_dU_x(dt) - - call this%compute_dU_y(dt) - - call this%compute_dU_z(dt) - - end subroutine compute_dU - !> compute dU in x direction subroutine compute_dU_x(this, dt) use messager, only: die @@ -551,20 +506,29 @@ subroutine compute_dU_x(this, dt) class(muscl), intent(inout) :: this real(WP), intent(in) :: dt real(WP) :: cfl - integer :: N, P, M, j, k, ierr + 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; - do k = this%cfg%kmin_,this%cfg%kmax_ - do j = this%cfg%jmin_,this%cfg%jmax_ + 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, this%wavebcs(:,j,k), dt, & + & 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, & @@ -572,6 +536,7 @@ subroutine compute_dU_x(this, dt) 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 compute_dU_x @@ -584,10 +549,12 @@ subroutine compute_dU_y(this, dt) class(muscl), intent(inout) :: this real(WP), intent(in) :: dt real(WP) :: cfl - integer :: N, P, M, i, k, jmino_, jmaxo_, ierr + 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; @@ -602,12 +569,15 @@ subroutine compute_dU_y(this, dt) U1d = this%Uc(:,i,jmino_:jmaxo_,k) dU1d = this%dU(:,i,jmino_:jmaxo_,k) p1d = this%params(:,i,jmino_:jmaxo_,k) - bc1d = this%wavebcs(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) @@ -617,6 +587,7 @@ subroutine compute_dU_y(this, dt) 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 compute_dU_y @@ -629,10 +600,12 @@ subroutine compute_dU_z(this, dt) class(muscl), intent(inout) :: this real(WP), intent(in) :: dt real(WP) :: cfl - integer :: N, P, M, i, j, kmino_, kmaxo_, ierr + 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; @@ -648,11 +621,15 @@ subroutine compute_dU_z(this, dt) 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) @@ -662,6 +639,7 @@ subroutine compute_dU_z(this, dt) 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 compute_dU_z @@ -689,10 +667,9 @@ pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & call rsolver(N, params(:,2), U(:,2), params(:,3), U(:,3), lc) call rsolver(N, params(:,3), U(:,3), params(:,4), U(:,4), rc) - !TODO this is broken - !call handle_wavebc(wbcs(1), ll) - !call handle_wavebc(wbcs(2), lc) - !call handle_wavebc(wbcs(3), 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))) @@ -702,8 +679,7 @@ pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & do j = 3, M-2 call rsolver(N, params(:,j+1), U(:,j+1), params(:,j+2), U(:,j+2), rr) - !TODO this is broken - !call handle_wavebc(wbcs(j+1), 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)) @@ -723,15 +699,13 @@ pure subroutine handle_wavebc(bc, rs) real(WP), dimension(:,:), intent(inout) :: rs integer :: N - !TODO this is broken - N = size(rs, 1) ! zero negative waves? - if (ior(bc, 1_1) .eq. 1_1) rs(:, 3:4) = max(rs(:, 3:4), 0.0_WP) + if (iand(bc, 1_1) .eq. 1_1) rs(:, 3:4) = max(rs(:, 3:4), 0.0_WP) ! zero positive waves? - if (ior(bc, 2_1) .eq. 2_1) rs(:, 3:4) = min(rs(:, 3:4), 0.0_WP) + if (iand(bc, 2_1) .eq. 2_1) rs(:, 3:4) = min(rs(:, 3:4), 0.0_WP) end subroutine handle_wavebc From dfcdc78a5398c592a547f95b91a10f1e4d367daf Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 19 Jan 2023 16:06:18 -0500 Subject: [PATCH 077/136] advection and detonation test cases with and without periodic boundaries --- examples/advection/input | 13 ++- examples/advection/src/geometry.f90 | 53 +++++++--- examples/advection/src/simulation.f90 | 25 +++-- examples/detonation/input | 6 ++ examples/detonation/src/geometry.f90 | 55 +++++++--- examples/detonation/src/simulation.f90 | 139 +++++++++++++++++++++---- 6 files changed, 222 insertions(+), 69 deletions(-) diff --git a/examples/advection/input b/examples/advection/input index ca8948964..8a7370489 100644 --- a/examples/advection/input +++ b/examples/advection/input @@ -1,9 +1,14 @@ # Parallelization -Partition : 2 1 1 +Partition : 4 1 1 # Mesh definition -Lx : 1.0 -nx : 64 +Lx : 1.0 +nx : 128 +Ly : 1.0 +ny : 128 +Lz : 1.0 +nz : 1 +Periodic : true # Initialization Shapes : c @@ -12,7 +17,7 @@ Shapes : c Advection direction : 1 1 0 # Time integration -Max cfl number : 0.98 +Max cfl number : 0.5 # Ensight output Ensight output period : 0.01 diff --git a/examples/advection/src/geometry.f90 b/examples/advection/src/geometry.f90 index 205953952..2520b1f66 100644 --- a/examples/advection/src/geometry.f90 +++ b/examples/advection/src/geometry.f90 @@ -22,30 +22,51 @@ subroutine geometry_init ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian - integer :: i,nx - real(WP) :: Lx - real(WP), dimension(:), allocatable :: x - ! Read in grid definition - call param_read('Lx',Lx) - call param_read('nx',nx) - allocate(x(nx+1)) - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx + 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 - ! General serial grid object - grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.true., & - & yper=.true., zper=.true., name='Periodic Cube') + + ! 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 a config from that grid on our entire group create_cfg: block use parallel, only: group integer, dimension(3) :: partition - ! Read in partition + + ! read in partition call param_read('Partition', partition, short='p') - ! Create partitioned grid + + ! create partitioned grid cfg = config(grp=group, decomp=partition, grid=grid) + end block create_cfg ! Create masks for this config diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 index 6143f6409..657336d98 100644 --- a/examples/advection/src/simulation.f90 +++ b/examples/advection/src/simulation.f90 @@ -86,11 +86,20 @@ subroutine simulation_init() ! num params is 3 here; this will have to be changed for other systems numparams = 3 - ! check domain + ! remind user whether periodic check_cfg: block - if (cfg%xL .ne. cfg%yL .or. cfg%xL .ne. cfg%zL) call die("domain must be square") - if (.not. (cfg%xper .and. cfg%yper .and. cfg%zper)) call die("domain must be periodic") + if (cfg%amRoot) then + + if (.not. (cfg%xper .and. cfg%yper .and. cfg%zper)) then + write(*,*) "domain is not periodic" + end if + + if (cfg%xper .and. cfg%yper .and. cfg%zper) then + write(*,*) "periodic domain" + end if + + end if end block check_cfg @@ -291,24 +300,20 @@ subroutine simulation_run call time%adjust_dt() call time%increment() - ! take step (unsplit) - !call fs%compute_dU(time%dt) - !fs%Uc = fs%Uc + fs%dU - ! take step (Strang) fs%dU(:, :, :, :) = 0.0_WP + !call fs%apply_bcond(time%t, time%dt) call fs%compute_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%compute_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%compute_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU - ! apply boundary conditions - !call fs%apply_bcond(time%t, time%dt) - ! Output to ensight if (ens_evt%occurs()) call ens_out%write_data(time%t) diff --git a/examples/detonation/input b/examples/detonation/input index 545671604..f146e101b 100644 --- a/examples/detonation/input +++ b/examples/detonation/input @@ -4,9 +4,15 @@ 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 diff --git a/examples/detonation/src/geometry.f90 b/examples/detonation/src/geometry.f90 index 6b4d3cb66..c27998de1 100644 --- a/examples/detonation/src/geometry.f90 +++ b/examples/detonation/src/geometry.f90 @@ -22,30 +22,53 @@ subroutine geometry_init ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian - integer :: i,nx - real(WP) :: Lx - real(WP), dimension(:), allocatable :: x - ! Read in grid definition - call param_read('Lx',Lx) - call param_read('nx',nx) - allocate(x(nx+1)) - ! Create simple rectilinear grid - do i=1,nx+1 - x(i)=real(i-1,WP)/real(nx,WP)*Lx + 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 - ! General serial grid object - grid=sgrid(coord=cartesian, no=4, x=x, y=x, z=x, xper=.true., & - & yper=.true., zper=.true., name='Periodic Cube') + 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 a config from that grid on our entire group create_cfg: block use parallel, only: group integer, dimension(3) :: partition - ! Read in partition + + ! read in partition call param_read('Partition', partition, short='p') - ! Create partitioned grid + + ! create partitioned grid cfg = config(grp=group, decomp=partition, grid=grid) + end block create_cfg ! Create masks for this config diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index e716940bf..0e4affcff 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -2,7 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg - use muscl_class, only: muscl + 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 @@ -25,7 +25,7 @@ module simulation real(WP), dimension(:,:,:,:), pointer :: phys_out !> simulation monitor file - type(monitor) :: mfile, cflfile + type(monitor) :: mfile, cflfile, consfile !> simulation control functions public :: simulation_init, simulation_run, simulation_final @@ -49,6 +49,62 @@ subroutine update_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 @@ -72,28 +128,48 @@ subroutine simulation_init() ! 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 + real(WP) :: r2, oR, initxvel real(WP), dimension(3) :: x, c - real(WP), dimension(5) :: insval, outval + real(WP), dimension(5) :: insvalphys, outvalphys, insval, outval integer :: i, j, k call param_read('Initial diameter', oR) oR = 0.5_WP * oR - call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_L, insval) - call euler_tocons(DIATOMIC_GAMMA, SOD_PHYS_R, outval) + call param_read('Initial x velocity', initxvel, 'Initial x velocity', 0.0_WP) - c = 0.5 * (/ cfg%xL, cfg%yL, cfg%zL /) + 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) - do k = cfg%kmin_, cfg%kmax_ + c = 0.5_WP * (/ cfg%xL, cfg%yL, cfg%zL /) + + do k = cfg%kmino_, cfg%kmaxo_ x(3) = cfg%zm(k) - do j = cfg%jmin_, cfg%jmax_ + do j = cfg%jmino_, cfg%jmaxo_ x(2) = cfg%ym(j) - do i = cfg%imin_, cfg%imax_ + do i = cfg%imino_, cfg%imaxo_ x(1) = cfg%xm(i) r2 = sum((c - x)**2) if (r2 .lt. oR**2) then @@ -168,25 +244,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'density_min') + call add_column_real(mfile, real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'density_max') + call add_column_real(mfile, real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momentum_x_min') + call add_column_real(mfile, real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momentum_x_max') + call add_column_real(mfile, real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momentum_y_min') + call add_column_real(mfile, real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momentum_y_max') + call add_column_real(mfile, real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momentum_z_min') + call add_column_real(mfile, real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momentum_z_max') + call add_column_real(mfile, real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totalenergy_min') + call add_column_real(mfile, real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totalenergy_max') + call add_column_real(mfile, real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -198,6 +274,22 @@ subroutine simulation_init() 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 add_column_real(consfile, real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call add_column_real(consfile, real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call add_column_real(consfile, real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call add_column_real(consfile, real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%write() + end block create_monitor end subroutine simulation_init @@ -215,19 +307,19 @@ subroutine simulation_run call time%increment() ! take step (Strang) + !call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP call fs%compute_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%compute_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%compute_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU - ! apply boundary conditions - !call fs%apply_bcond(time%t, time%dt) - ! Output to ensight if (ens_evt%occurs()) then call update_phys_out() @@ -238,6 +330,7 @@ subroutine simulation_run call fs%get_range() call mfile%write() call cflfile%write() + call consfile%write() end do From c51814e24de38e268b2d320d21f1d6381a0053c2 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 19 Jan 2023 20:50:44 -0500 Subject: [PATCH 078/136] fixed periodic bcs --- src/hyperbolic/advection.f90 | 5 ++++ src/hyperbolic/euler.f90 | 5 ++++ src/hyperbolic/muscl_class.f90 | 52 ++++++++++++++++++++++++++++++---- 3 files changed, 56 insertions(+), 6 deletions(-) diff --git a/src/hyperbolic/advection.f90 b/src/hyperbolic/advection.f90 index 7ba9ced96..295054340 100644 --- a/src/hyperbolic/advection.f90 +++ b/src/hyperbolic/advection.f90 @@ -49,6 +49,11 @@ function make_advec_muscl(cfg, N, limiter, velocity) result(solver) 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(N, params, U, evals) diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 index 5a8adc765..ed80fce8a 100644 --- a/src/hyperbolic/euler.f90 +++ b/src/hyperbolic/euler.f90 @@ -66,6 +66,11 @@ function make_euler_muscl(cfg, limiter, gma) result(solver) ! 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 !> Convert to Physical Coordinates (velocity and pressure to momentum and energy) diff --git a/src/hyperbolic/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 index 1bf8d695c..69cd445cb 100644 --- a/src/hyperbolic/muscl_class.f90 +++ b/src/hyperbolic/muscl_class.f90 @@ -247,6 +247,9 @@ function constructor(cfg, name, N, P, evals_x, evals_y, evals_z, rsolv_x, & !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 @@ -375,18 +378,55 @@ subroutine apply_bcond(this, t, dt) select case (masked_type) case (0_1) !< do nothing case (2_1) !< interpolate - 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) + 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 - !TODO - call die("not implemented") + 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 From 60c0861b276bfdade545b1b691804ca27f77e85c Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 19 Jan 2023 20:56:37 -0500 Subject: [PATCH 079/136] updated test cases --- examples/advection/input | 2 +- examples/advection/src/simulation.f90 | 17 ------- examples/detonation/{input => input_openbcs} | 8 +++- examples/detonation/input_reflect | 26 +++++++++++ examples/detonation/src/geometry.f90 | 6 +-- examples/detonation/src/simulation.f90 | 48 ++++++++++++++------ 6 files changed, 68 insertions(+), 39 deletions(-) rename examples/detonation/{input => input_openbcs} (67%) create mode 100644 examples/detonation/input_reflect diff --git a/examples/advection/input b/examples/advection/input index 8a7370489..267b7e036 100644 --- a/examples/advection/input +++ b/examples/advection/input @@ -1,5 +1,5 @@ # Parallelization -Partition : 4 1 1 +Partition : 2 1 1 # Mesh definition Lx : 1.0 diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 index 657336d98..765ae256d 100644 --- a/examples/advection/src/simulation.f90 +++ b/examples/advection/src/simulation.f90 @@ -86,23 +86,6 @@ subroutine simulation_init() ! num params is 3 here; this will have to be changed for other systems numparams = 3 - ! remind user whether periodic - check_cfg: block - - if (cfg%amRoot) then - - if (.not. (cfg%xper .and. cfg%yper .and. cfg%zper)) then - write(*,*) "domain is not periodic" - end if - - if (cfg%xper .and. cfg%yper .and. cfg%zper) then - write(*,*) "periodic domain" - end if - - end if - - end block check_cfg - ! read shapes read_shapes: block character(len=str_medium) :: fieldbuffer diff --git a/examples/detonation/input b/examples/detonation/input_openbcs similarity index 67% rename from examples/detonation/input rename to examples/detonation/input_openbcs index f146e101b..9a7ce3168 100644 --- a/examples/detonation/input +++ b/examples/detonation/input_openbcs @@ -8,11 +8,15 @@ Ly : 1.0 ny : 64 Lz : 1.0 nz : 1 -Periodic : false + +# Reflect? +Reflect : false # Initialization Initial diameter : 0.2 -Initial x velocity : 0.5 +Initial x velocity : 0.4 +Initial x position : 0.5 +Initial pressure multiplier : 12.0 # Time integration Max cfl number : 0.98 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/geometry.f90 b/examples/detonation/src/geometry.f90 index c27998de1..637b9e1c0 100644 --- a/examples/detonation/src/geometry.f90 +++ b/examples/detonation/src/geometry.f90 @@ -22,7 +22,6 @@ subroutine geometry_init ! 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 @@ -34,7 +33,6 @@ subroutine geometry_init 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)) @@ -51,8 +49,8 @@ subroutine geometry_init end do ! generate serial grid object - grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=periodic, & - & yper=periodic, zper=periodic) + grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + & yper=.false., zper=.false.) deallocate(x, y, z) diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index 0e4affcff..02b220161 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -2,7 +2,7 @@ module simulation use precision, only: WP use geometry, only: cfg - use muscl_class, only: muscl, NO_WAVES + 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 @@ -10,6 +10,7 @@ module simulation use partmesh_class, only: partmesh use event_class, only: event use monitor_class, only: monitor + use string, only: str_medium implicit none private @@ -18,6 +19,7 @@ module simulation type(timetracker), public :: time !> Ensight postprocessing + character(len=str_medium) :: ens_out_name type(ensight) :: ens_out type(event) :: ens_evt @@ -40,7 +42,8 @@ subroutine update_phys_out() 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)) + 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 @@ -108,7 +111,6 @@ 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 @@ -122,8 +124,11 @@ subroutine simulation_init() end block initialize_timetracker - ! create a single-phase flow solver without bconds + ! 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) @@ -131,8 +136,15 @@ subroutine simulation_init() ! 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') + 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, & @@ -146,24 +158,28 @@ subroutine simulation_init() ! prepare initial fields initialize_fields: block - real(WP) :: r2, oR, initxvel + 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) - oR = 0.5_WP * 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) - call param_read('Initial x velocity', initxvel, 'Initial x velocity', 0.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 * (/ cfg%xL, cfg%yL, cfg%zL /) + c = 0.5_WP * (/ 2 * initxpos, cfg%yL, cfg%zL /) do k = cfg%kmino_, cfg%kmaxo_ x(3) = cfg%zm(k) @@ -192,11 +208,11 @@ subroutine simulation_init() real(WP), dimension(:,:,:), pointer :: scl_ptr ! create array to hold physical coordinates - allocate(phys_out(5,cfg%imino_:cfg%imaxo_,cfg%jmino_:cfg%jmaxo_, & + 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='SodSphereTest') + ens_out = ensight(cfg=cfg, name=ens_out_name) ! Create event for Ensight output ens_evt = event(time=time, name='Ensight output') @@ -215,6 +231,8 @@ subroutine simulation_init() call add_rscalar(ens_out, 'pressure', scl_ptr) scl_ptr => fs%params(1,:,:,:) call add_rscalar(ens_out, 'gamma', scl_ptr) + scl_ptr => phys_out(6,:,:,:) + call add_rscalar(ens_out, 'Ma', scl_ptr) ! Output to ensight if (ens_evt%occurs()) then @@ -307,15 +325,15 @@ subroutine simulation_run call time%increment() ! take step (Strang) - !call fs%apply_bcond(time%t, time%dt) + call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP call fs%compute_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU - !call fs%apply_bcond(time%t, time%dt) + call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP call fs%compute_dU_y(time%dt) fs%Uc = fs%Uc + fs%dU - !call fs%apply_bcond(time%t, time%dt) + call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP call fs%compute_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU From 83f05aa26639fbdc3648951c889537404a25c2f8 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Fri, 20 Jan 2023 22:34:21 -0500 Subject: [PATCH 080/136] added sod case --- examples/sod/GNUmakefile | 50 +++++ 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 | 339 ++++++++++++++++++++++++++++++++ 6 files changed, 513 insertions(+) create mode 100644 examples/sod/GNUmakefile 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 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/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..ca8cf5436 --- /dev/null +++ b/examples/sod/src/simulation.f90 @@ -0,0 +1,339 @@ +!> 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 + + !> Single-phase incompressible flow solver, pressure and implicit solvers, 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 ensight_class, only: add_rscalar + use string, only: str_short + real(WP), dimension(:,:,:), pointer :: scl_ptr + + ! 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 + scl_ptr => phys_out(1,:,:,:) + call add_rscalar(ens_out, 'density', scl_ptr) + scl_ptr => phys_out(2,:,:,:) + call add_rscalar(ens_out, 'x_velocity', scl_ptr) + scl_ptr => phys_out(3,:,:,:) + call add_rscalar(ens_out, 'y_velocity', scl_ptr) + scl_ptr => phys_out(4,:,:,:) + call add_rscalar(ens_out, 'z_velocity', scl_ptr) + scl_ptr => phys_out(5,:,:,:) + call add_rscalar(ens_out, 'pressure', scl_ptr) + scl_ptr => fs%params(1,:,:,:) + call add_rscalar(ens_out, 'gamma', scl_ptr) + scl_ptr => phys_out(6,:,:,:) + call add_rscalar(ens_out, 'Ma', scl_ptr) + + ! 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 monitor_class, only: add_column_real + 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 add_column_real(mfile, real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call add_column_real(mfile, real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call add_column_real(mfile, real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call add_column_real(mfile, real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call add_column_real(mfile, real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call add_column_real(mfile, real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call add_column_real(mfile, real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call add_column_real(mfile, real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call add_column_real(mfile, real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call add_column_real(mfile, 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 add_column_real(consfile, real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call add_column_real(consfile, real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call add_column_real(consfile, real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call add_column_real(consfile, real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call add_column_real(consfile, 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%compute_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%compute_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%compute_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 + From 04509fc85e5b8b9b068ed23c1f7f54ea7552b0b5 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Mon, 23 Jan 2023 15:26:29 -0500 Subject: [PATCH 081/136] fixed bad comment --- examples/detonation/src/simulation.f90 | 2 +- examples/sod/src/simulation.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index 02b220161..ccfa5d03f 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -14,7 +14,7 @@ module simulation implicit none private - !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + !> Flow solver and a time tracker type(muscl), public :: fs type(timetracker), public :: time diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 index ca8cf5436..90ae54668 100644 --- a/examples/sod/src/simulation.f90 +++ b/examples/sod/src/simulation.f90 @@ -14,7 +14,7 @@ module simulation implicit none private - !> Single-phase incompressible flow solver, pressure and implicit solvers, and a time tracker + !> Flow solver and a time tracker type(muscl), public :: fs type(timetracker), public :: time From c8761dbd7fadb1997d922de21faca3639248a599 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Tue, 24 Jan 2023 14:18:38 -0500 Subject: [PATCH 082/136] 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 083/136] 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 084/136] 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 085/136] 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 086/136] 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 087/136] 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 088/136] 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 089/136] 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 090/136] 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 091/136] 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 092/136] 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 093/136] 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 094/136] 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 095/136] 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 096/136] 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 097/136] 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 098/136] 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 099/136] 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 100/136] 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 101/136] 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 102/136] 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 103/136] 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 104/136] 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 105/136] 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 106/136] 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 107/136] 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 108/136] 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 109/136] 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 110/136] 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 111/136] 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 112/136] 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 113/136] 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 114/136] 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 115/136] 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 116/136] 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 117/136] 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 118/136] 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 119/136] 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 120/136] 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 121/136] 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 122/136] 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 123/136] 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 aae1e0b88baa1a709ef4bbf4b0273bf131fab2b3 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 10:59:42 -0500 Subject: [PATCH 124/136] moved several definitions to a hyperbolic_general.f90 module in preparation for future solvers that depend on them --- examples/detonation/src/simulation.f90 | 15 ++- examples/hit/input | 1 + examples/sod/src/simulation.f90 | 15 ++- src/data/ensight_class.f90 | 50 +++++----- src/hyperbolic/Make.package | 3 +- src/hyperbolic/advection.f90 | 36 +++---- src/hyperbolic/euler.f90 | 132 ++++++++++++++++++++----- src/hyperbolic/hyperbolic_general.f90 | 114 +++++++++++++++++++++ src/hyperbolic/muscl_class.f90 | 115 ++------------------- tools/GNUMake/Make.local | 3 +- 10 files changed, 293 insertions(+), 191 deletions(-) create mode 100644 src/hyperbolic/hyperbolic_general.f90 diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index ccfa5d03f..7ae2d5d60 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -203,7 +203,6 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block - use ensight_class, only: add_rscalar use string, only: str_short real(WP), dimension(:,:,:), pointer :: scl_ptr @@ -220,19 +219,19 @@ subroutine simulation_init() ! Add variables to output scl_ptr => phys_out(1,:,:,:) - call add_rscalar(ens_out, 'density', scl_ptr) + call ens_out%add_scalar('density', scl_ptr) scl_ptr => phys_out(2,:,:,:) - call add_rscalar(ens_out, 'x_velocity', scl_ptr) + call ens_out%add_scalar('x_velocity', scl_ptr) scl_ptr => phys_out(3,:,:,:) - call add_rscalar(ens_out, 'y_velocity', scl_ptr) + call ens_out%add_scalar('y_velocity', scl_ptr) scl_ptr => phys_out(4,:,:,:) - call add_rscalar(ens_out, 'z_velocity', scl_ptr) + call ens_out%add_scalar('z_velocity', scl_ptr) scl_ptr => phys_out(5,:,:,:) - call add_rscalar(ens_out, 'pressure', scl_ptr) + call ens_out%add_scalar('pressure', scl_ptr) scl_ptr => fs%params(1,:,:,:) - call add_rscalar(ens_out, 'gamma', scl_ptr) + call ens_out%add_scalar('gamma', scl_ptr) scl_ptr => phys_out(6,:,:,:) - call add_rscalar(ens_out, 'Ma', scl_ptr) + call ens_out%add_scalar('Ma', scl_ptr) ! Output to ensight if (ens_evt%occurs()) then diff --git a/examples/hit/input b/examples/hit/input index 0c376b4a8..01156a0ce 100644 --- a/examples/hit/input +++ b/examples/hit/input @@ -30,3 +30,4 @@ Implicit iteration : 100 # Ensight output Ensight output period : 0.01 + diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 index 90ae54668..12afd8f9c 100644 --- a/examples/sod/src/simulation.f90 +++ b/examples/sod/src/simulation.f90 @@ -170,7 +170,6 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block - use ensight_class, only: add_rscalar use string, only: str_short real(WP), dimension(:,:,:), pointer :: scl_ptr @@ -187,19 +186,19 @@ subroutine simulation_init() ! Add variables to output scl_ptr => phys_out(1,:,:,:) - call add_rscalar(ens_out, 'density', scl_ptr) + call ens_out%add_scalar('density', scl_ptr) scl_ptr => phys_out(2,:,:,:) - call add_rscalar(ens_out, 'x_velocity', scl_ptr) + call ens_out%add_scalar('x_velocity', scl_ptr) scl_ptr => phys_out(3,:,:,:) - call add_rscalar(ens_out, 'y_velocity', scl_ptr) + call ens_out%add_scalar('y_velocity', scl_ptr) scl_ptr => phys_out(4,:,:,:) - call add_rscalar(ens_out, 'z_velocity', scl_ptr) + call ens_out%add_scalar('z_velocity', scl_ptr) scl_ptr => phys_out(5,:,:,:) - call add_rscalar(ens_out, 'pressure', scl_ptr) + call ens_out%add_scalar('pressure', scl_ptr) scl_ptr => fs%params(1,:,:,:) - call add_rscalar(ens_out, 'gamma', scl_ptr) + call ens_out%add_scalar('gamma', scl_ptr) scl_ptr => phys_out(6,:,:,:) - call add_rscalar(ens_out, 'Ma', scl_ptr) + call ens_out%add_scalar('Ma', scl_ptr) ! Output to ensight if (ens_evt%occurs()) then diff --git a/src/data/ensight_class.f90 b/src/data/ensight_class.f90 index e74eb4f14..68ac0a1ca 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, add_rscalar - + 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 diff --git a/src/hyperbolic/Make.package b/src/hyperbolic/Make.package index f6f9faf42..73e3d8da8 100644 --- a/src/hyperbolic/Make.package +++ b/src/hyperbolic/Make.package @@ -1,4 +1,5 @@ -f90EXE_sources += muscl_class.f90 advection.f90 euler.f90 +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 index 295054340..c68992a09 100644 --- a/src/hyperbolic/advection.f90 +++ b/src/hyperbolic/advection.f90 @@ -56,10 +56,10 @@ function make_advec_muscl(cfg, N, limiter, velocity) result(solver) end function make_advec_muscl - pure subroutine advec_evals_x(N, params, U, evals) + pure subroutine advec_evals_x(P, N, params, U, evals) implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -70,10 +70,10 @@ pure subroutine advec_evals_x(N, params, U, evals) end subroutine advec_evals_x - pure subroutine advec_evals_y(N, params, U, evals) + pure subroutine advec_evals_y(P, N, params, U, evals) implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -84,10 +84,10 @@ pure subroutine advec_evals_y(N, params, U, evals) end subroutine advec_evals_y - pure subroutine advec_evals_z(N, params, U, evals) + pure subroutine advec_evals_z(P, N, params, U, evals) implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -115,9 +115,9 @@ pure subroutine advec_rsolv_simple(v, Ul, Ur, rs) end subroutine - pure subroutine advec_rsolv_x(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 @@ -125,9 +125,9 @@ pure subroutine advec_rsolv_x(N, pl, Ul, pr, Ur, rs) end subroutine advec_rsolv_x - pure subroutine advec_rsolv_y(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 @@ -135,9 +135,9 @@ pure subroutine advec_rsolv_y(N, pl, Ul, pr, Ur, rs) end subroutine advec_rsolv_y - pure subroutine advec_rsolv_z(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 index ed80fce8a..c39db6016 100644 --- a/src/hyperbolic/euler.f90 +++ b/src/hyperbolic/euler.f90 @@ -5,11 +5,12 @@ !> Written by John Wakefield in December 2022 module hyperbolic_euler - use precision, only: WP - use string, only: str_medium - use config_class, only: config - use muscl_class, only: muscl, VANLEER, eigenvals_ftype, rsolver_ftype, & - & limiter_ftype + 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 @@ -24,7 +25,7 @@ module hyperbolic_euler contains - !> factory + !> muscl factory function make_euler_muscl(cfg, limiter, gma) result(solver) implicit none type(muscl) :: solver @@ -73,6 +74,43 @@ function make_euler_muscl(cfg, limiter, gma) result(solver) 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 @@ -107,10 +145,56 @@ pure subroutine euler_tocons(gma, phys, cons) end subroutine - pure subroutine euler_evals_x(N, params, U, evals) + 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) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -118,10 +202,10 @@ pure subroutine euler_evals_x(N, params, U, evals) end subroutine euler_evals_x - pure subroutine euler_evals_y(N, params, U, evals) + pure subroutine euler_evals_y(P, N, params, U, evals) implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -132,10 +216,10 @@ pure subroutine euler_evals_y(N, params, U, evals) end subroutine euler_evals_y - pure subroutine euler_evals_z(N, params, U, evals) + pure subroutine euler_evals_z(P, N, params, U, evals) implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params + 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 @@ -163,9 +247,9 @@ pure subroutine euler_evals_1d(gma, U, lambda) end subroutine euler_evals_1d - pure subroutine euler_rsolv_x(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 @@ -173,9 +257,9 @@ pure subroutine euler_rsolv_x(N, pl, Ul, pr, Ur, rs) end subroutine euler_rsolv_x - pure subroutine euler_rsolv_y(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 @@ -190,9 +274,9 @@ pure subroutine euler_rsolv_y(N, pl, Ul, pr, Ur, rs) end subroutine euler_rsolv_y - pure subroutine euler_rsolv_z(N, pl, Ul, pr, Ur, rs) - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr + 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 diff --git a/src/hyperbolic/hyperbolic_general.f90 b/src/hyperbolic/hyperbolic_general.f90 new file mode 100644 index 000000000..47e1d1a17 --- /dev/null +++ b/src/hyperbolic/hyperbolic_general.f90 @@ -0,0 +1,114 @@ +!> module containing things like function type definitions, limiter +!> definitions, etc +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 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 index 69cd445cb..acc95c884 100644 --- a/src/hyperbolic/muscl_class.f90 +++ b/src/hyperbolic/muscl_class.f90 @@ -24,6 +24,7 @@ module muscl_class use string, only: str_medium use config_class, only: config use iterator_class, only: iterator + use hyperbolic implicit none private @@ -33,16 +34,6 @@ module muscl_class ! expose interfaces public :: eigenvals_ftype, rsolver_ftype, limiter_ftype - ! 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 - ! 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 @@ -61,31 +52,6 @@ module muscl_class ! rs(:, 4) (projected) source strengths ! rs(:, 5:(N+4)) (linearized) eigenvectors - interface - pure subroutine eigenvals_ftype(N, params, u, evals) - use precision, only: WP - implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: params - real(WP), dimension(N), intent(in) :: u - real(WP), dimension(N), intent(out) :: evals - end subroutine - pure subroutine rsolver_ftype(N, pl, ul, pr, ur, rs) - use precision, only: WP - implicit none - integer, intent(in) :: N - real(WP), dimension(:), intent(in) :: pl, pr - real(WP), dimension(N), intent(in) :: ul, ur - real(WP), dimension(:,:), intent(out) :: rs - 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 - !> boundary conditions for the hyperbolic solver type :: bcond type(bcond), pointer :: next !< linked list of bconds @@ -300,7 +266,7 @@ subroutine add_bcond(this, name, type, locator, dir) 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 ('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 @@ -336,7 +302,7 @@ subroutine add_bcond(this, name, type, locator, dir) end subroutine add_bcond !> get a boundary condition - subroutine get_bcond(this,name,my_bc) + subroutine get_bcond(this, name, my_bc) use messager, only: die implicit none class(muscl), intent(inout) :: this @@ -703,9 +669,9 @@ pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & real(WP), dimension(N) :: phil, phir integer :: j - call rsolver(N, params(:,1), U(:,1), params(:,2), U(:,2), ll) - call rsolver(N, params(:,2), U(:,2), params(:,3), U(:,3), lc) - call rsolver(N, params(:,3), U(:,3), params(:,4), U(:,4), rc) + 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) @@ -718,7 +684,7 @@ pure subroutine wavestep_1d(N, P, M, limfun, eps, rsolver, dxs, wbcs, dt, & call compute_limval(N, limfun, eps, ll, lc, rc, phil) do j = 3, M-2 - call rsolver(N, params(:,j+1), U(:,j+1), params(:,j+2), U(:,j+2), rr) + 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))) @@ -978,11 +944,11 @@ subroutine recalc_cfl(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_ - call this%evals_x(this%N, this%params(:,i,j,k), this%Uc(:,i,j,k), evals) + 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%N, this%params(:,i,j,k), this%Uc(:,i,j,k), 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%N, this%params(:,i,j,k), this%Uc(:,i,j,k), 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 @@ -1005,66 +971,5 @@ subroutine recalc_cfl(this) end subroutine recalc_cfl - !! limiter definitions - - ! limiter functions - 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 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 78c63e65516ebfdc3d0796274afb9b53c3198e2a Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 11:01:52 -0500 Subject: [PATCH 125/136] added reflection bc test --- examples/muscl_reflect_test/GNUmakefile | 50 +++ examples/muscl_reflect_test/README | 1 + 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 | 353 ++++++++++++++++++ 6 files changed, 510 insertions(+) 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 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..8718d3d32 --- /dev/null +++ b/examples/muscl_reflect_test/README @@ -0,0 +1 @@ +a spherical detonation based off the Sod problem 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..4a244a210 --- /dev/null +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -0,0 +1,353 @@ +!> 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 :: scl_ptr + + ! 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 + scl_ptr => phys_out(1,:,:,:) + call ens_out%add_scalar('density', scl_ptr) + scl_ptr => phys_out(2,:,:,:) + call ens_out%add_scalar('x_velocity', scl_ptr) + scl_ptr => phys_out(3,:,:,:) + call ens_out%add_scalar('y_velocity', scl_ptr) + scl_ptr => phys_out(4,:,:,:) + call ens_out%add_scalar('z_velocity', scl_ptr) + scl_ptr => phys_out(5,:,:,:) + call ens_out%add_scalar('pressure', scl_ptr) + scl_ptr => fs%params(1,:,:,:) + call ens_out%add_scalar('gamma', scl_ptr) + + ! 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 monitor_class, only: add_column_real + 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 add_column_real(mfile, real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call add_column_real(mfile, real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call add_column_real(mfile, real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call add_column_real(mfile, real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call add_column_real(mfile, real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call add_column_real(mfile, real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call add_column_real(mfile, real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call add_column_real(mfile, real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call add_column_real(mfile, real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call add_column_real(mfile, 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 add_column_real(consfile, real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call add_column_real(consfile, real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call add_column_real(consfile, real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call add_column_real(consfile, real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call add_column_real(consfile, 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%compute_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%compute_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%compute_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 + From 276204398f1027ba3f4ce5551aaa2d7bcb3b665f Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 11:59:35 -0500 Subject: [PATCH 126/136] extensive style cleanup in preparation of merging with upstream --- examples/advection/README | 3 +- examples/advection/src/simulation.f90 | 18 +-- examples/detonation/src/simulation.f90 | 6 +- examples/hit/GNUmakefile | 47 ------ examples/muscl_reflect_test/README | 3 +- .../muscl_reflect_test/src/simulation.f90 | 6 +- examples/sod/README | 6 + examples/sod/src/simulation.f90 | 6 +- src/hyperbolic/advection.f90 | 22 ++- src/hyperbolic/euler.f90 | 11 +- src/hyperbolic/hyperbolic_general.f90 | 57 +++++-- src/hyperbolic/muscl_class.f90 | 149 +++++++----------- 12 files changed, 137 insertions(+), 197 deletions(-) delete mode 100644 examples/hit/GNUmakefile create mode 100644 examples/sod/README diff --git a/examples/advection/README b/examples/advection/README index ea13477ea..fb7412417 100644 --- a/examples/advection/README +++ b/examples/advection/README @@ -1 +1,2 @@ -standard advection test case advecting different shapes over a periodic domain to evaluate accuracy and diffusion +standard advection test case advecting different shapes over a periodic domain +to evaluate accuracy and diffusion diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 index 765ae256d..d9b49e03a 100644 --- a/examples/advection/src/simulation.f90 +++ b/examples/advection/src/simulation.f90 @@ -2,7 +2,8 @@ module simulation use precision, only: WP use geometry, only: cfg - use muscl_class, only: muscl, SUPERBEE + 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 @@ -190,7 +191,6 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block - use ensight_class, only: add_rscalar use string, only: str_short integer :: i character(len=4) :: istr @@ -207,17 +207,13 @@ subroutine simulation_init() do i = 1, numfields scl_ptr => fs%Uc(i,:,:,:) write(istr,'(I2.2)') i - !WTF? - !call ens_out%add_scalar('U'//istr, scl_ptr) - call add_rscalar(ens_out, 'U'//istr, scl_ptr) + call ens_out%add_scalar('U'//istr, scl_ptr) end do do i = 1, numparams scl_ptr => fs%params(i,:,:,:) write(istr,'(I2.2)') i - !WTF? - !call ens_out%add_scalar('p'//istr, scl_ptr) - call add_rscalar(ens_out, 'p'//istr, scl_ptr) + call ens_out%add_scalar('p'//istr, scl_ptr) end do ! Output to ensight @@ -286,15 +282,15 @@ subroutine simulation_run ! take step (Strang) fs%dU(:, :, :, :) = 0.0_WP !call fs%apply_bcond(time%t, time%dt) - call fs%compute_dU_x(0.5 * 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%compute_dU_y(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%compute_dU_x(0.5 * time%dt) + call fs%calc_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU ! Output to ensight diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index 7ae2d5d60..6c33445cd 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -326,15 +326,15 @@ subroutine simulation_run ! take step (Strang) call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP - call fs%compute_dU_x(0.5 * time%dt) + 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%compute_dU_y(time%dt) + 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%compute_dU_x(0.5 * time%dt) + call fs%calc_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU ! Output to ensight diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile deleted file mode 100644 index 52dbd4c18..000000000 --- a/examples/hit/GNUmakefile +++ /dev/null @@ -1,47 +0,0 @@ -# NGA location if not yet defined -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 - -# 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 := 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/muscl_reflect_test/README b/examples/muscl_reflect_test/README index 8718d3d32..07c52460b 100644 --- a/examples/muscl_reflect_test/README +++ b/examples/muscl_reflect_test/README @@ -1 +1,2 @@ -a spherical detonation based off the Sod problem +The 'detonation' example, but with an initial velocity toward a reflecting +wall. diff --git a/examples/muscl_reflect_test/src/simulation.f90 b/examples/muscl_reflect_test/src/simulation.f90 index 4a244a210..52174cb50 100644 --- a/examples/muscl_reflect_test/src/simulation.f90 +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -308,15 +308,15 @@ subroutine simulation_run ! take step (Strang) !call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP - call fs%compute_dU_x(0.5 * time%dt) + 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%compute_dU_y(time%dt) + 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%compute_dU_x(0.5 * time%dt) + call fs%calc_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU ! Output to ensight 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/src/simulation.f90 b/examples/sod/src/simulation.f90 index 12afd8f9c..12251d5f6 100644 --- a/examples/sod/src/simulation.f90 +++ b/examples/sod/src/simulation.f90 @@ -293,15 +293,15 @@ subroutine simulation_run ! take step (Strang) call fs%apply_bcond(time%t, time%dt) fs%dU(:, :, :, :) = 0.0_WP - call fs%compute_dU_x(0.5 * time%dt) + 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%compute_dU_y(time%dt) + 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%compute_dU_x(0.5 * time%dt) + call fs%calc_dU_x(0.5 * time%dt) fs%Uc = fs%Uc + fs%dU ! Output to ensight diff --git a/src/hyperbolic/advection.f90 b/src/hyperbolic/advection.f90 index c68992a09..0848f1a90 100644 --- a/src/hyperbolic/advection.f90 +++ b/src/hyperbolic/advection.f90 @@ -2,13 +2,14 @@ !> contains necessary functions for using the muscl class (or other general hyperbolic !> solvers) to solve basic advection problems -!> written by John P Wakefield in December 2022 +!> 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 muscl_class, only: muscl, constructor, eigenvals_ftype, rsolver_ftype, limiter_ftype + 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 @@ -32,16 +33,13 @@ function make_advec_muscl(cfg, N, limiter, velocity) result(solver) name_actual = advec_muscl_name - evals_x_ptr => advec_evals_x - evals_y_ptr => advec_evals_y - evals_z_ptr => advec_evals_z - rsolv_x_ptr => advec_rsolv_x - rsolv_y_ptr => advec_rsolv_y - rsolv_z_ptr => advec_rsolv_z + 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, & + 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 @@ -109,9 +107,7 @@ pure subroutine advec_rsolv_simple(v, Ul, Ur, rs) rs(:,2) = max(v, 0.0_WP) rs(:,3) = Ur(:) - Ul(:) - do i = 1, size(Ul, 1) - rs(i,i+4) = 1.0_WP - end do + rs(1:size(Ul,1),5:(size(Ul,1)+4)) = 1.0_WP end subroutine diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 index c39db6016..b281eb923 100644 --- a/src/hyperbolic/euler.f90 +++ b/src/hyperbolic/euler.f90 @@ -2,7 +2,7 @@ !> contains necessary functions for using the muscl class (or other general !> hyperbolic solvers) to solve the Euler equations for an ideal (gamma) gas -!> Written by John Wakefield in December 2022 +!> Originally written by John P Wakefield in December 2022. module hyperbolic_euler use precision, only: WP @@ -52,12 +52,9 @@ function make_euler_muscl(cfg, limiter, gma) result(solver) name_actual = euler_muscl_name - evals_x_ptr => euler_evals_x - evals_y_ptr => euler_evals_y - evals_z_ptr => euler_evals_z - rsolv_x_ptr => euler_rsolv_x - rsolv_y_ptr => euler_rsolv_y - rsolv_z_ptr => euler_rsolv_z + 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, & diff --git a/src/hyperbolic/hyperbolic_general.f90 b/src/hyperbolic/hyperbolic_general.f90 index 47e1d1a17..da784a3de 100644 --- a/src/hyperbolic/hyperbolic_general.f90 +++ b/src/hyperbolic/hyperbolic_general.f90 @@ -1,11 +1,15 @@ -!> module containing things like function type definitions, limiter -!> definitions, etc + +!> 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 + !> limiter names integer(1), parameter, public :: UPWIND = 0_1 integer(1), parameter, public :: LAXWEND = 1_1 integer(1), parameter, public :: BEAMWARM = 2_1 @@ -15,8 +19,9 @@ module hyperbolic integer(1), parameter, public :: MC = 6_1 integer(1), parameter, public :: VANLEER = 7_1 - ! function types + !> function types interface + pure subroutine eigenvals_ftype(P, N, params, u, evals) use precision, only: WP implicit none @@ -25,6 +30,7 @@ pure subroutine eigenvals_ftype(P, N, params, u, evals) 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 @@ -33,6 +39,7 @@ pure subroutine rsolver_ftype(P, N, pl, ul, pr, ur, rs) 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 @@ -40,18 +47,51 @@ pure subroutine flux_ftype(P, N, params, u, f) 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 definitions + !! 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 @@ -59,7 +99,6 @@ pure function limiter_upwind(r) result(phi) phi = r phi = 0.0 end function - pure function limiter_laxwend(r) result(phi) implicit none real(WP), intent(in) :: r @@ -67,42 +106,36 @@ pure function limiter_laxwend(r) result(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 diff --git a/src/hyperbolic/muscl_class.f90 b/src/hyperbolic/muscl_class.f90 index acc95c884..7797c235a 100644 --- a/src/hyperbolic/muscl_class.f90 +++ b/src/hyperbolic/muscl_class.f90 @@ -1,20 +1,7 @@ !> MUSCL-type solver class -!> Provides support for various BC, generic hyperbolic structures, and source -!> terms projected onto eigenstructures +!> Provides support for various BC, generic hyperbolic structures !> -!> Originally written by John P Wakefield, December 2022 -!> -!> this file includes: -!> -!> - module block -!> - function interfaces -!> - bc type -!> - solver class def -!> - system class defs -!> - contains (with headers containing exactly these phrases) -!> - standard interface class functions -!> - muscl-specific class functions -!> - limiter definitions +!> Originally written by John P Wakefield in December 2022. !> !> When possible, helper functions immediately follow the class function that !> calls them. @@ -24,15 +11,12 @@ module muscl_class use string, only: str_medium use config_class, only: config use iterator_class, only: iterator - use hyperbolic + use hyperbolic, only: limiter_ftype, eigenvals_ftype, rsolver_ftype, get_limiter implicit none private ! expose type/constructor/methods - public :: muscl, constructor, bcond - - ! expose interfaces - public :: eigenvals_ftype, rsolver_ftype, limiter_ftype + public :: muscl, muscl_bc ! List of known available bcond types for this solver ! here 'right' means bcond direction +1 @@ -49,53 +33,49 @@ module muscl_class ! rs(:, 1) left-going eigenvalues ! rs(:, 2) right-going eigenvalues ! rs(:, 3) wave strengths - ! rs(:, 4) (projected) source 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 :: bcond - type(bcond), pointer :: next !< linked list of bconds - character(len=str_medium) :: name = 'UNNAMED_BCOND' !< 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 bcond + 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 + class(config), pointer :: cfg !< config / pgrid information ! name - character(len=str_medium) :: name = 'UNNAMED_MUSCL' !< solver name (default UNNAMED_MUSCL) + character(len=str_medium) :: name = 'MUSCL' !< solver name ! system information - integer :: N !< system dimension - integer :: P !< number of parameters + 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 + 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 - !TODO mft - 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 + 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 + 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(1), dimension(:,:,:), allocatable :: trans !< bitwise entropy violation check xyz !integer :: trans_total !logical :: have_trans_flags @@ -104,34 +84,34 @@ module muscl_class 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 + 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 + 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 :: compute_dU_x, compute_dU_y, compute_dU_z !< take step + 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 + !procedure :: check_transonic !< check for transonic waves + procedure :: recalc_cfl !< calculate maximum CFL end type muscl @@ -172,31 +152,11 @@ function constructor(cfg, name, N, P, evals_x, evals_y, evals_z, rsolv_x, & this%rsolv_x => rsolv_x; this%rsolv_y => rsolv_y; this%rsolv_z => rsolv_z; ! limiting - select case (lim) - case (UPWIND) - this%limiter => limiter_upwind - case (LAXWEND) - this%limiter => limiter_laxwend - case (BEAMWARM) - this%limiter => limiter_beamwarm - case (FROMM) - this%limiter => limiter_fromm - case (MINMOD) - this%limiter => limiter_minmod - case (SUPERBEE) - this%limiter => limiter_superbee - case (MC) - this%limiter => limiter_mc - case (VANLEER) - this%limiter => limiter_vanleer - case default - call die("could not find limiter") - end select + this%limiter => get_limiter(lim) this%upratio_divzero_eps = upratio_divzero_eps - ! boundary condition list - this%nbc = 0 - this%first_bc => NULL() + ! initialize boundary condition list + this%nbc = 0; this%first_bc => NULL(); ! get array sizes imino = this%cfg%imino_; imaxo = this%cfg%imaxo_; @@ -256,7 +216,7 @@ subroutine add_bcond(this, name, type, locator, dir) integer(1), intent(in) :: type procedure(locator_gen_ftype) :: locator character(len=2), intent(in) :: dir - type(bcond), pointer :: new_bc + type(muscl_bc), pointer :: new_bc integer :: i, j, k, n integer(1) :: wbc @@ -307,11 +267,11 @@ subroutine get_bcond(this, name, my_bc) implicit none class(muscl), intent(inout) :: this character(len=*), intent(in) :: name - type(bcond), pointer, intent(out) :: my_bc + 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 + if (trim(my_bc%name) .eq. trim(name)) return my_bc => my_bc%next end do @@ -330,7 +290,7 @@ subroutine apply_bcond(this, t, dt) integer(1) :: masked_type logical, dimension(this%N) :: vel_mask integer :: i, j, k, m, n, iref, jref, kref - type(bcond), pointer :: my_bc + type(muscl_bc), pointer :: my_bc ! Traverse bcond list my_bc => this%first_bc @@ -395,7 +355,7 @@ subroutine apply_bcond(this, t, dt) end do case (1_1) call die('[muscl apply_bcond] Unknown bcond type') - case default + case default call die('[muscl apply_bcond] Unknown bcond type') end select @@ -500,11 +460,8 @@ subroutine get_range(this) end subroutine get_range - !> get mass flow rate through boundaries at previous step - !TODO - !> compute dU in x direction - subroutine compute_dU_x(this, dt) + subroutine calc_dU_x(this, dt) use messager, only: die use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX use parallel, only: MPI_REAL_WP @@ -544,10 +501,10 @@ subroutine compute_dU_x(this, dt) this%have_CFL_x_estim = .true.; this%have_CFL_x_exact = .false.; this%have_Urange = .false. - end subroutine compute_dU_x + end subroutine calc_dU_x !> compute dU in y direction - subroutine compute_dU_y(this, dt) + subroutine calc_dU_y(this, dt) use messager, only: die use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX use parallel, only: MPI_REAL_WP @@ -595,10 +552,10 @@ subroutine compute_dU_y(this, dt) this%have_CFL_y_estim = .true.; this%have_CFL_y_exact = .false.; this%have_Urange = .false. - end subroutine compute_dU_y + end subroutine calc_dU_y !> compute dU in z direction - subroutine compute_dU_z(this, dt) + subroutine calc_dU_z(this, dt) use messager, only: die use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX use parallel, only: MPI_REAL_WP @@ -647,7 +604,7 @@ subroutine compute_dU_z(this, dt) this%have_CFL_z_estim = .true.; this%have_CFL_z_exact = .false.; this%have_Urange = .false. - end subroutine compute_dU_z + 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 From 1cef485b4b353ae1470a4de4c450112638b5f5ac Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 12:07:57 -0500 Subject: [PATCH 127/136] reverted to upstream makefile in HIT case --- examples/hit/GNUmakefile | 47 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 examples/hit/GNUmakefile diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile new file mode 100644 index 000000000..52dbd4c18 --- /dev/null +++ b/examples/hit/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +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 + +# 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 := 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 From a3bbdc51935708767c6a77d6e7dbf1d49960e24c Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 12:34:39 -0500 Subject: [PATCH 128/136] fixed issues with monitor files --- examples/advection/src/simulation.f90 | 34 ++++------- examples/detonation/src/simulation.f90 | 59 +++++++++---------- .../muscl_reflect_test/src/simulation.f90 | 55 ++++++++--------- examples/sod/src/simulation.f90 | 59 +++++++++---------- src/libraries/monitor_class.f90 | 2 +- 5 files changed, 95 insertions(+), 114 deletions(-) diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 index d9b49e03a..8354723c7 100644 --- a/examples/advection/src/simulation.f90 +++ b/examples/advection/src/simulation.f90 @@ -81,12 +81,9 @@ subroutine simulation_init() use messager, only: die implicit none - integer :: numfields, numparams + integer :: numfields character, dimension(:), allocatable :: fields - ! num params is 3 here; this will have to be changed for other systems - numparams = 3 - ! read shapes read_shapes: block character(len=str_medium) :: fieldbuffer @@ -194,7 +191,7 @@ subroutine simulation_init() use string, only: str_short integer :: i character(len=4) :: istr - real(WP), dimension(:,:,:), pointer :: scl_ptr + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 ! Create Ensight output from cfg ens_out=ensight(cfg=cfg, name='AdvectionTest') @@ -205,16 +202,15 @@ subroutine simulation_init() ! Add variables to output do i = 1, numfields - scl_ptr => fs%Uc(i,:,:,:) + ptr1 => fs%Uc(i,:,:,:) write(istr,'(I2.2)') i - call ens_out%add_scalar('U'//istr, scl_ptr) + call ens_out%add_scalar('U'//istr, ptr1) end do - do i = 1, numparams - scl_ptr => fs%params(i,:,:,:) - write(istr,'(I2.2)') i - call ens_out%add_scalar('p'//istr, scl_ptr) - 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) @@ -223,7 +219,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short character(len=str_short) :: fieldname integer :: i @@ -240,17 +235,12 @@ subroutine simulation_init() call mfile%add_column(time%dt, 'Timestep size') call mfile%add_column(time%cfl, 'Maximum CFL') do i = 1, numfields - ! WTF? - !call mfile%add_column(real_ptr, fields(i:i)//'min') - !call mfile%add_column(real_ptr, fields(i:i)//'max') - fieldname(1:1) = fields(i) - fieldname(2:4) = 'min' + write(fieldname,'("[",a,"]min")') fields(i) real_ptr => fs%Umin(i) - call add_column_real(mfile, real_ptr, fieldname) - fieldname(1:1) = fields(i) - fieldname(2:4) = 'max' + call mfile%add_column(real_ptr, fieldname) + write(fieldname,'("[",a,"]max")') fields(i) real_ptr => fs%Umax(i) - call add_column_real(mfile, real_ptr, fieldname) + call mfile%add_column(real_ptr, fieldname) end do call mfile%write() diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index 6c33445cd..e00dab230 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -204,7 +204,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -218,20 +218,18 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) - scl_ptr => phys_out(6,:,:,:) - call ens_out%add_scalar('Ma', scl_ptr) + 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 @@ -243,7 +241,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -261,25 +258,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -296,15 +293,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/examples/muscl_reflect_test/src/simulation.f90 b/examples/muscl_reflect_test/src/simulation.f90 index 52174cb50..e1c266b80 100644 --- a/examples/muscl_reflect_test/src/simulation.f90 +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -188,7 +188,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -202,18 +202,16 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) + 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 @@ -225,7 +223,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -243,25 +240,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -278,15 +275,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 index 12251d5f6..1778ef3fb 100644 --- a/examples/sod/src/simulation.f90 +++ b/examples/sod/src/simulation.f90 @@ -171,7 +171,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -185,20 +185,18 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) - scl_ptr => phys_out(6,:,:,:) - call ens_out%add_scalar('Ma', scl_ptr) + 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 @@ -210,7 +208,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -228,25 +225,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -263,15 +260,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/src/libraries/monitor_class.f90 b/src/libraries/monitor_class.f90 index b1d8cce5c..3c2799394 100644 --- a/src/libraries/monitor_class.f90 +++ b/src/libraries/monitor_class.f90 @@ -8,7 +8,7 @@ module monitor_class ! Expose constructor for monitor object - public :: monitor, add_column_real + public :: monitor !> Preset some length and formats for the columns From b52251546df386517436a13de23df9efa1eb0dae Mon Sep 17 00:00:00 2001 From: johnpwakefield Date: Thu, 9 Feb 2023 13:13:39 -0500 Subject: [PATCH 129/136] 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 130/136] 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 131/136] 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 d9dfdb9dc889f51886f91dcf2cb5de024f6fb69c Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 16:47:38 -0500 Subject: [PATCH 132/136] added rusanov scheme --- examples/sod_rusanov/GNUmakefile | 50 +++ examples/sod_rusanov/input_aligned | 21 + examples/sod_rusanov/input_skew | 21 + examples/sod_rusanov/src/Make.package | 2 + examples/sod_rusanov/src/geometry.f90 | 80 ++++ examples/sod_rusanov/src/simulation.f90 | 334 ++++++++++++++ src/hyperbolic/Make.package | 4 +- src/hyperbolic/advection.f90 | 82 +++- src/hyperbolic/euler.f90 | 72 ++- src/hyperbolic/rusanov_class.f90 | 561 ++++++++++++++++++++++++ 10 files changed, 1180 insertions(+), 47 deletions(-) create mode 100644 examples/sod_rusanov/GNUmakefile create mode 100644 examples/sod_rusanov/input_aligned create mode 100644 examples/sod_rusanov/input_skew create mode 100644 examples/sod_rusanov/src/Make.package create mode 100644 examples/sod_rusanov/src/geometry.f90 create mode 100644 examples/sod_rusanov/src/simulation.f90 create mode 100644 src/hyperbolic/rusanov_class.f90 diff --git a/examples/sod_rusanov/GNUmakefile b/examples/sod_rusanov/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/sod_rusanov/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_rusanov/input_aligned b/examples/sod_rusanov/input_aligned new file mode 100644 index 000000000..4ff2de33b --- /dev/null +++ b/examples/sod_rusanov/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_rusanov/input_skew b/examples/sod_rusanov/input_skew new file mode 100644 index 000000000..5974f5f37 --- /dev/null +++ b/examples/sod_rusanov/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_rusanov/src/Make.package b/examples/sod_rusanov/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/sod_rusanov/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/sod_rusanov/src/geometry.f90 b/examples/sod_rusanov/src/geometry.f90 new file mode 100644 index 000000000..dfe9a5b6e --- /dev/null +++ b/examples/sod_rusanov/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_rusanov/src/simulation.f90 b/examples/sod_rusanov/src/simulation.f90 new file mode 100644 index 000000000..48e312520 --- /dev/null +++ b/examples/sod_rusanov/src/simulation.f90 @@ -0,0 +1,334 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use rusanov_class, only: rusanov, EXTRAPOLATE + use hyperbolic_euler, only: make_euler_rusanov, 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(rusanov), 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_rusanov(cfg) + + ! set bcs + call fs%add_bcond(name='openxl' , type=EXTRAPOLATE, & + & locator=side_locator_x_l, dir='xl') + call fs%add_bcond(name='openxr' , type=EXTRAPOLATE, & + & locator=side_locator_x_r, dir='xr') + call fs%add_bcond(name='openyl' , type=EXTRAPOLATE, & + & locator=side_locator_y_l, dir='yl') + call fs%add_bcond(name='openyr' , type=EXTRAPOLATE, & + & 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 + + 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 monitor_class, only: add_column_real + 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 add_column_real(mfile, real_ptr, 'dens_min') + real_ptr => fs%Umax(1) + call add_column_real(mfile, real_ptr, 'dens_max') + real_ptr => fs%Umin(2) + call add_column_real(mfile, real_ptr, 'momx_min') + real_ptr => fs%Umax(2) + call add_column_real(mfile, real_ptr, 'momx_max') + real_ptr => fs%Umin(3) + call add_column_real(mfile, real_ptr, 'momy_min') + real_ptr => fs%Umax(3) + call add_column_real(mfile, real_ptr, 'momy_max') + real_ptr => fs%Umin(4) + call add_column_real(mfile, real_ptr, 'momz_min') + real_ptr => fs%Umax(4) + call add_column_real(mfile, real_ptr, 'momz_max') + real_ptr => fs%Umin(5) + call add_column_real(mfile, real_ptr, 'totE_min') + real_ptr => fs%Umax(5) + call add_column_real(mfile, 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 add_column_real(consfile, real_ptr, 'dens_int') + real_ptr => fs%Uint(2) + call add_column_real(consfile, real_ptr, 'momx_int') + real_ptr => fs%Uint(3) + call add_column_real(consfile, real_ptr, 'momy_int') + real_ptr => fs%Uint(4) + call add_column_real(consfile, real_ptr, 'momz_int') + real_ptr => fs%Uint(5) + call add_column_real(consfile, 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/hyperbolic/Make.package b/src/hyperbolic/Make.package index 73e3d8da8..379b832aa 100644 --- a/src/hyperbolic/Make.package +++ b/src/hyperbolic/Make.package @@ -1,5 +1,5 @@ -f90EXE_sources += hyperbolic_general.f90 muscl_class.f90 advection.f90 euler.f90 -# houssem2d.f90 rusanov_class.f90 +f90EXE_sources += hyperbolic_general.f90 muscl_class.f90 advection.f90 euler.f90 rusanov_class.f90 +# houssem2d.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 index 0848f1a90..59353540e 100644 --- a/src/hyperbolic/advection.f90 +++ b/src/hyperbolic/advection.f90 @@ -5,20 +5,22 @@ !> 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 + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use hyperbolic, only: eigenvals_ftype, rsolver_ftype, limiter_ftype, flux_ftype + use muscl_class, only: muscl + use rusanov_class, only: rusanov 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' + character(len=str_medium), parameter :: ADVEC_MUSCL_NAME = 'MUSCL_CONST_ADVEC' + character(len=str_medium), parameter :: ADVEC_RUS_NAME = 'RUSANOV_CONST_ADVEC' contains - !> factory + !> muscl factory function make_advec_muscl(cfg, N, limiter, velocity) result(solver) implicit none type(muscl) :: solver @@ -31,7 +33,7 @@ function make_advec_muscl(cfg, N, limiter, velocity) result(solver) procedure(rsolver_ftype), pointer :: rsolv_x_ptr, rsolv_y_ptr, rsolv_z_ptr integer :: i - name_actual = advec_muscl_name + 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; @@ -54,6 +56,37 @@ function make_advec_muscl(cfg, N, limiter, velocity) result(solver) end function make_advec_muscl + !> rusanov factory + function make_advec_rusanov(cfg, N, velocity) result(solver) + implicit none + type(rusanov) :: solver + class(config), target, intent(in) :: cfg + integer, intent(in) :: N + real(WP), dimension(3), intent(in) :: velocity + 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 + integer :: i + + evals_x_ptr => advec_evals_x; flux_x_ptr => advec_flux_x; + evals_y_ptr => advec_evals_y; flux_y_ptr => advec_flux_y; + evals_z_ptr => advec_evals_z; flux_z_ptr => advec_flux_z; + + ! build solver + solver = rusanov(cfg, ADVEC_RUS_NAME, N, 3, evals_x_ptr, evals_y_ptr, & + & evals_z_ptr, flux_x_ptr, flux_y_ptr, flux_z_ptr) + + ! put velocity in param array + 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_rusanov + pure subroutine advec_evals_x(P, N, params, U, evals) implicit none integer, intent(in) :: P, N @@ -96,6 +129,39 @@ pure subroutine advec_evals_z(P, N, params, U, evals) end subroutine advec_evals_z + pure subroutine advec_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 + + flux(:) = params(1) * U(:) + + end subroutine advec_flux_x + + pure subroutine advec_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 + + flux(:) = params(2) * U(:) + + end subroutine advec_flux_y + + pure subroutine advec_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 + + flux(:) = params(3) * U(:) + + end subroutine advec_flux_z + pure subroutine advec_rsolv_simple(v, Ul, Ur, rs) real(WP), intent(in) :: v real(WP), dimension(:), intent(in) :: Ul, Ur diff --git a/src/hyperbolic/euler.f90 b/src/hyperbolic/euler.f90 index b281eb923..7b76caa54 100644 --- a/src/hyperbolic/euler.f90 +++ b/src/hyperbolic/euler.f90 @@ -10,7 +10,7 @@ module hyperbolic_euler 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 + use rusanov_class, only: rusanov implicit none real(WP), parameter :: euler_muscl_cflsafety = 0.92_WP @@ -72,41 +72,38 @@ function make_euler_muscl(cfg, limiter, gma) result(solver) 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 + 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; flux_x_ptr => euler_flux_x; + evals_y_ptr => euler_evals_y; flux_y_ptr => euler_flux_y; + evals_z_ptr => euler_evals_z; 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) @@ -150,7 +147,8 @@ pure subroutine euler_flux_x(P, N, params, U, flux) 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)) + pressure = (params(1) - 1.0_WP) * (U(5) - 0.5_WP * (U(2)**2 + U(3)**2 + & + U(4)**2)/ U(1)) flux(1) = U(2) flux(2) = U(2)**2 / U(1) + pressure diff --git a/src/hyperbolic/rusanov_class.f90 b/src/hyperbolic/rusanov_class.f90 new file mode 100644 index 000000000..4431d7a28 --- /dev/null +++ b/src/hyperbolic/rusanov_class.f90 @@ -0,0 +1,561 @@ +!> Rusanov solver class +!> +!> This first-order Rusanov scheme is extremely diffusive, but foolproof (as +!> long as a flux function is known. +!> +!> Originally written by John P Wakefield, Feb 2023. +!> +!> +module rusanov_class + use precision, only: WP + use string, only: str_medium + use config_class, only: config + use iterator_class, only: iterator + use hyperbolic, only: eigenvals_ftype, flux_ftype + implicit none + private + + ! expose type/constructor/methods + public :: rusanov, rus_bc + + ! expose interfaces + public :: eigenvals_ftype, flux_ftype + + ! List of known available bcond types for this solver + integer(1), parameter, public :: EXTRAPOLATE = 1_1 !< 0th order extrapolation + integer(1), parameter, public :: REFLECT = 2_1 !< reflection by velmask + + !> boundary conditions for the hyperbolic solver + type :: rus_bc + type(rus_bc), pointer :: next !< linked list of bconds + character(len=str_medium) :: name = 'UNNAMED_BCOND' !< 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 rus_bc + + !> solver object definition + type :: rusanov + + ! config / pgrid object + class(config), pointer :: cfg !< config / pgrid information + + ! name + character(len=str_medium) :: name = 'UNNAMED_RUSANOV' !< 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(flux_ftype), pointer, nopass :: flux_x, flux_y, flux_z + logical, dimension(:), allocatable :: vel_mask_x, vel_mask_y, vel_mask_z + + ! boundary condition list + integer :: nbc !< number of bcond for our solver + type(rus_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/flux + + ! CFL numbers + real(WP) :: CFL_x, CFL_y, CFL_z !< global CFL numbers (over dt) + logical :: have_CFL_x, have_CFL_y, have_CFL_z + + ! 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 => rusanov_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 :: calc_dU_x, calc_dU_y, calc_dU_z !< take step + + end type rusanov + + !> declare constructors + interface rusanov; procedure rusanov_from_args; end interface + +contains + + !! standard interface class functions + + !> default constructor for rusanov-type flow solver + function rusanov_from_args(cfg, name, N, P, evals_x, evals_y, evals_z, & + flux_x, flux_y, flux_z) result(this) + use messager, only: die + implicit none + type(rusanov) :: 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(flux_ftype), pointer, intent(in) :: flux_x, flux_y, flux_z + integer :: imino, imaxo, jmino, jmaxo, kmino, kmaxo, minmino, maxmaxo + + ! check number of ghost cells + if (cfg%no .lt. 1) call die("must have at least one ghost cell") + + ! 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%flux_x => flux_x; this%flux_y => flux_y; this%flux_z => flux_z; + + ! 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 velocity masks + allocate(this%vel_mask_x(N), this%vel_mask_y(N), this%vel_mask_z(N)) + + ! initialize CFL computations + this%have_CFL_x = .false. + this%have_CFL_y = .false. + this%have_CFL_z = .false. + + ! initialize monitoring + allocate(this%Umin(N), this%Umax(N), this%Uint(N)) + this%have_Urange = .false. + + end function + + !> solver print function + subroutine rusanov_print(this) + use, intrinsic :: iso_fortran_env, only: output_unit + implicit none + class(rusanov), intent(in) :: this + + if (this%cfg%amRoot) then + write(output_unit,'("rusanov-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(rusanov), 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(rus_bc), pointer :: new_bc + + ! 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('[rusanov 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 + + end subroutine add_bcond + + !> get a boundary condition + subroutine get_bcond(this, name, my_bc) + use messager, only: die + implicit none + class(rusanov), intent(inout) :: this + character(len=*), intent(in) :: name + type(rus_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('[rusanov 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(rusanov), intent(inout) :: this + real(WP), intent(in) :: t, dt + logical, dimension(this%N) :: vel_mask + integer :: i, j, k, m, n, iref, jref, kref + type(rus_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 + select case (my_bc%type) + case (0_1) !< do nothing + case (1_1) !< extrapolate + 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 (2_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 default + call die('[rusanov 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) + use messager, only: die + use mpi_f08, only: MPI_ALLREDUCE, MPI_MAX + use parallel, only: MPI_REAL_WP + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + real(WP), intent(out) :: cfl + real(WP), dimension(this%N) :: evals + real(WP) :: task_CFL_x, task_CFL_y, task_CFL_z + logical :: have_CFL + integer :: i, j, k, ierrx, ierry, ierrz + + have_CFL = this%have_CFL_x .and. this%have_CFL_y .and. this%have_CFL_z + + if (.not. have_CFL) then + + 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 = .true. + this%have_CFL_y = .true. + this%have_CFL_z = .true. + + end if + + cfl = dt * max(this%CFL_x, this%CFL_y, this%CFL_z) + + 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(rusanov), 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) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: j, k + + call this%cfg%sync(this%Uc) + + do k = this%cfg%kmin_, this%cfg%kmax_ + do j = this%cfg%jmin_, this%cfg%jmax_ + call rusanov_1d(this%N, this%P, size(this%Uc, 2), this%flux_x, & + this%evals_x, this%cfg%dx, dt, this%params(:,:,j,k), & + this%Uc(:,:,j,k), this%dU(:,:,j,k)) + end do + end do + + call this%cfg%sync(this%dU) + + this%have_CFL_x = .false.; this%have_Urange = .false.; + + end subroutine calc_dU_x + + !> compute dU in y direction + subroutine calc_dU_y(this, dt) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: i, k, jmino_, jmaxo_ + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + + if (this%cfg%ny .lt. 2) return + + call this%cfg%sync(this%Uc) + + jmino_ = this%cfg%jmino_; jmaxo_ = this%cfg%jmaxo_; + + allocate(U1d(this%N,jmino_:jmaxo_), p1d(this%P,jmino_:jmaxo_), dU1d(this%N,jmino_:jmaxo_)) + + 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) + call rusanov_1d(this%N, this%P, size(U1d, 2), this%flux_y, & + this%evals_y, this%cfg%dy, dt, p1d, U1d, dU1d) + this%dU(:,i,jmino_:jmaxo_,k) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d) + + call this%cfg%sync(this%dU) + + this%have_CFL_y = .false.; this%have_Urange = .false.; + + end subroutine calc_dU_y + + !> compute dU in z direction + subroutine calc_dU_z(this, dt) + implicit none + class(rusanov), intent(inout) :: this + real(WP), intent(in) :: dt + integer :: i, j, kmino_, kmaxo_ + real(WP), dimension(:,:), allocatable :: U1d, dU1d, p1d + + if (this%cfg%nz .lt. 2) return + + call this%cfg%sync(this%Uc) + + kmino_ = this%cfg%kmino_; kmaxo_ = this%cfg%kmaxo_; + + allocate(U1d(this%N,kmino_:kmaxo_), p1d(this%P,kmino_:kmaxo_), dU1d(this%N,kmino_:kmaxo_)) + + 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_) + call rusanov_1d(this%N, this%P, size(U1d, 2), this%flux_z, & + this%evals_z, this%cfg%dz, dt, p1d, U1d, dU1d) + this%dU(:,i,j,kmino_:kmaxo_) = dU1d + end do + end do + + deallocate(U1d, dU1d, p1d) + + call this%cfg%sync(this%dU) + + this%have_CFL_z = .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 rusanov_1d(N, P, M, flux, evals, dxs, dt, params, U, dU) + implicit none + integer, intent(in) :: N, P, M + procedure(eigenvals_ftype), pointer, intent(in) :: evals + procedure(flux_ftype), pointer, intent(in) :: flux + real(WP), dimension(M), intent(in) :: dxs ! size M + 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), dimension(N) :: F, Fl, Fr, nudiff, laml, lamr + integer :: j + + dU(:,:) = 0.0_WP + + call flux(P, N, params(:,1), U(:,1), Fl) + call evals(P, N, params(:,1), U(:,1), laml) + laml(:) = abs(laml(:)) + + do j = 2, M + + call flux(P, N, params(:,j), U(:,j), Fr) + call evals(P, N, params(:,j), U(:,j), lamr) + lamr(:) = abs(lamr(:)) + + nudiff = (U(:,j) - U(:,j-1)) * max(maxval(laml), maxval(lamr)) + + ! not the right division by dx, but whatever + F = dt * 0.5_WP / (0.5_WP * (dxs(j-1) + dxs(j))) * (Fr + Fl - nudiff) + + dU(:,j-1) = dU(:,j-1) - F + dU(:,j ) = dU(:,j ) + F + + Fl(:) = Fr(:); laml(:) = lamr(:); + + end do + + end subroutine rusanov_1d + +end module rusanov_class + From 66dcb742a3e9bf310409fbd04cc58e94d33ea1ef Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 12:34:39 -0500 Subject: [PATCH 133/136] fixed issues with monitor files reverted to upstream makefile in HIT case fixed addcol issue --- examples/advection/src/simulation.f90 | 34 ++++------- examples/detonation/src/simulation.f90 | 59 +++++++++---------- examples/hit/GNUmakefile | 47 +++++++++++++++ .../muscl_reflect_test/src/simulation.f90 | 55 ++++++++--------- examples/sod/src/simulation.f90 | 59 +++++++++---------- examples/sod_rusanov/src/simulation.f90 | 31 +++++----- src/libraries/monitor_class.f90 | 2 +- 7 files changed, 157 insertions(+), 130 deletions(-) create mode 100644 examples/hit/GNUmakefile diff --git a/examples/advection/src/simulation.f90 b/examples/advection/src/simulation.f90 index d9b49e03a..8354723c7 100644 --- a/examples/advection/src/simulation.f90 +++ b/examples/advection/src/simulation.f90 @@ -81,12 +81,9 @@ subroutine simulation_init() use messager, only: die implicit none - integer :: numfields, numparams + integer :: numfields character, dimension(:), allocatable :: fields - ! num params is 3 here; this will have to be changed for other systems - numparams = 3 - ! read shapes read_shapes: block character(len=str_medium) :: fieldbuffer @@ -194,7 +191,7 @@ subroutine simulation_init() use string, only: str_short integer :: i character(len=4) :: istr - real(WP), dimension(:,:,:), pointer :: scl_ptr + real(WP), dimension(:,:,:), pointer :: ptr1, ptr2, ptr3 ! Create Ensight output from cfg ens_out=ensight(cfg=cfg, name='AdvectionTest') @@ -205,16 +202,15 @@ subroutine simulation_init() ! Add variables to output do i = 1, numfields - scl_ptr => fs%Uc(i,:,:,:) + ptr1 => fs%Uc(i,:,:,:) write(istr,'(I2.2)') i - call ens_out%add_scalar('U'//istr, scl_ptr) + call ens_out%add_scalar('U'//istr, ptr1) end do - do i = 1, numparams - scl_ptr => fs%params(i,:,:,:) - write(istr,'(I2.2)') i - call ens_out%add_scalar('p'//istr, scl_ptr) - 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) @@ -223,7 +219,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short character(len=str_short) :: fieldname integer :: i @@ -240,17 +235,12 @@ subroutine simulation_init() call mfile%add_column(time%dt, 'Timestep size') call mfile%add_column(time%cfl, 'Maximum CFL') do i = 1, numfields - ! WTF? - !call mfile%add_column(real_ptr, fields(i:i)//'min') - !call mfile%add_column(real_ptr, fields(i:i)//'max') - fieldname(1:1) = fields(i) - fieldname(2:4) = 'min' + write(fieldname,'("[",a,"]min")') fields(i) real_ptr => fs%Umin(i) - call add_column_real(mfile, real_ptr, fieldname) - fieldname(1:1) = fields(i) - fieldname(2:4) = 'max' + call mfile%add_column(real_ptr, fieldname) + write(fieldname,'("[",a,"]max")') fields(i) real_ptr => fs%Umax(i) - call add_column_real(mfile, real_ptr, fieldname) + call mfile%add_column(real_ptr, fieldname) end do call mfile%write() diff --git a/examples/detonation/src/simulation.f90 b/examples/detonation/src/simulation.f90 index 6c33445cd..e00dab230 100644 --- a/examples/detonation/src/simulation.f90 +++ b/examples/detonation/src/simulation.f90 @@ -204,7 +204,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -218,20 +218,18 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) - scl_ptr => phys_out(6,:,:,:) - call ens_out%add_scalar('Ma', scl_ptr) + 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 @@ -243,7 +241,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -261,25 +258,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -296,15 +293,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/examples/hit/GNUmakefile b/examples/hit/GNUmakefile new file mode 100644 index 000000000..52dbd4c18 --- /dev/null +++ b/examples/hit/GNUmakefile @@ -0,0 +1,47 @@ +# NGA location if not yet defined +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 + +# 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 := 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/muscl_reflect_test/src/simulation.f90 b/examples/muscl_reflect_test/src/simulation.f90 index 52174cb50..e1c266b80 100644 --- a/examples/muscl_reflect_test/src/simulation.f90 +++ b/examples/muscl_reflect_test/src/simulation.f90 @@ -188,7 +188,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -202,18 +202,16 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) + 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 @@ -225,7 +223,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -243,25 +240,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -278,15 +275,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/examples/sod/src/simulation.f90 b/examples/sod/src/simulation.f90 index 12251d5f6..1778ef3fb 100644 --- a/examples/sod/src/simulation.f90 +++ b/examples/sod/src/simulation.f90 @@ -171,7 +171,7 @@ subroutine simulation_init() ! Add Ensight output create_ensight: block use string, only: str_short - real(WP), dimension(:,:,:), pointer :: scl_ptr + 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_, & @@ -185,20 +185,18 @@ subroutine simulation_init() call param_read('Ensight output period', ens_evt%tper) ! Add variables to output - scl_ptr => phys_out(1,:,:,:) - call ens_out%add_scalar('density', scl_ptr) - scl_ptr => phys_out(2,:,:,:) - call ens_out%add_scalar('x_velocity', scl_ptr) - scl_ptr => phys_out(3,:,:,:) - call ens_out%add_scalar('y_velocity', scl_ptr) - scl_ptr => phys_out(4,:,:,:) - call ens_out%add_scalar('z_velocity', scl_ptr) - scl_ptr => phys_out(5,:,:,:) - call ens_out%add_scalar('pressure', scl_ptr) - scl_ptr => fs%params(1,:,:,:) - call ens_out%add_scalar('gamma', scl_ptr) - scl_ptr => phys_out(6,:,:,:) - call ens_out%add_scalar('Ma', scl_ptr) + 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 @@ -210,7 +208,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -228,25 +225,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -263,15 +260,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/examples/sod_rusanov/src/simulation.f90 b/examples/sod_rusanov/src/simulation.f90 index 48e312520..c0d58da33 100644 --- a/examples/sod_rusanov/src/simulation.f90 +++ b/examples/sod_rusanov/src/simulation.f90 @@ -206,7 +206,6 @@ subroutine simulation_init() ! Create a monitor file create_monitor: block - use monitor_class, only: add_column_real use string, only: str_short real(WP), pointer :: real_ptr @@ -224,25 +223,25 @@ subroutine simulation_init() !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 add_column_real(mfile, real_ptr, 'dens_min') + call mfile%add_column(real_ptr, 'dens_min') real_ptr => fs%Umax(1) - call add_column_real(mfile, real_ptr, 'dens_max') + call mfile%add_column(real_ptr, 'dens_max') real_ptr => fs%Umin(2) - call add_column_real(mfile, real_ptr, 'momx_min') + call mfile%add_column(real_ptr, 'momx_min') real_ptr => fs%Umax(2) - call add_column_real(mfile, real_ptr, 'momx_max') + call mfile%add_column(real_ptr, 'momx_max') real_ptr => fs%Umin(3) - call add_column_real(mfile, real_ptr, 'momy_min') + call mfile%add_column(real_ptr, 'momy_min') real_ptr => fs%Umax(3) - call add_column_real(mfile, real_ptr, 'momy_max') + call mfile%add_column(real_ptr, 'momy_max') real_ptr => fs%Umin(4) - call add_column_real(mfile, real_ptr, 'momz_min') + call mfile%add_column(real_ptr, 'momz_min') real_ptr => fs%Umax(4) - call add_column_real(mfile, real_ptr, 'momz_max') + call mfile%add_column(real_ptr, 'momz_max') real_ptr => fs%Umin(5) - call add_column_real(mfile, real_ptr, 'totE_min') + call mfile%add_column(real_ptr, 'totE_min') real_ptr => fs%Umax(5) - call add_column_real(mfile, real_ptr, 'totE_max') + call mfile%add_column(real_ptr, 'totE_max') call mfile%write() ! Create CFL monitor @@ -259,15 +258,15 @@ subroutine simulation_init() call consfile%add_column(time%n, 'Timestep number') call consfile%add_column(time%t, 'Time') real_ptr => fs%Uint(1) - call add_column_real(consfile, real_ptr, 'dens_int') + call consfile%add_column(real_ptr, 'dens_int') real_ptr => fs%Uint(2) - call add_column_real(consfile, real_ptr, 'momx_int') + call consfile%add_column(real_ptr, 'momx_int') real_ptr => fs%Uint(3) - call add_column_real(consfile, real_ptr, 'momy_int') + call consfile%add_column(real_ptr, 'momy_int') real_ptr => fs%Uint(4) - call add_column_real(consfile, real_ptr, 'momz_int') + call consfile%add_column(real_ptr, 'momz_int') real_ptr => fs%Uint(5) - call add_column_real(consfile, real_ptr, 'totE_int') + call consfile%add_column(real_ptr, 'totE_int') call consfile%write() end block create_monitor diff --git a/src/libraries/monitor_class.f90 b/src/libraries/monitor_class.f90 index b1d8cce5c..3c2799394 100644 --- a/src/libraries/monitor_class.f90 +++ b/src/libraries/monitor_class.f90 @@ -8,7 +8,7 @@ module monitor_class ! Expose constructor for monitor object - public :: monitor, add_column_real + public :: monitor !> Preset some length and formats for the columns From a1efa416fc42643631731e2c2e5405b80b5ad5cf Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 17:02:02 -0500 Subject: [PATCH 134/136] fixed number of ghost cells to one for Rusanov --- examples/sod_rusanov/src/geometry.f90 | 20 ++++++++++---------- src/hyperbolic/rusanov_class.f90 | 2 +- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/examples/sod_rusanov/src/geometry.f90 b/examples/sod_rusanov/src/geometry.f90 index dfe9a5b6e..6a93a5c54 100644 --- a/examples/sod_rusanov/src/geometry.f90 +++ b/examples/sod_rusanov/src/geometry.f90 @@ -4,21 +4,21 @@ 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 implicit none type(sgrid) :: grid - + ! Create a grid from input params create_grid: block use sgrid_class, only: cartesian @@ -49,13 +49,13 @@ subroutine geometry_init end do ! generate serial grid object - grid=sgrid(coord=cartesian, no=2, x=x, y=x, z=x, xper=.false., & + grid=sgrid(coord=cartesian, no=1, 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 @@ -68,13 +68,13 @@ subroutine geometry_init 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/src/hyperbolic/rusanov_class.f90 b/src/hyperbolic/rusanov_class.f90 index 4431d7a28..d10857d92 100644 --- a/src/hyperbolic/rusanov_class.f90 +++ b/src/hyperbolic/rusanov_class.f90 @@ -516,7 +516,7 @@ subroutine calc_dU_z(this, dt) end subroutine calc_dU_z - ! requires two ghost cells even if using the `upwind' limiter + ! requires one ghost cell ! left as an independent function, but called is by class pure subroutine rusanov_1d(N, P, M, flux, evals, dxs, dt, params, U, dU) implicit none From c0eb31d6f884e71f8007759c34e9310c82cf3861 Mon Sep 17 00:00:00 2001 From: John Wakefield Date: Thu, 9 Feb 2023 17:02:57 -0500 Subject: [PATCH 135/136] added Rusanov advection test case --- examples/advection_rusanov/GNUmakefile | 50 +++ examples/advection_rusanov/README | 2 + examples/advection_rusanov/input | 24 ++ examples/advection_rusanov/src/Make.package | 2 + examples/advection_rusanov/src/geometry.f90 | 80 +++++ examples/advection_rusanov/src/simulation.f90 | 310 ++++++++++++++++++ 6 files changed, 468 insertions(+) create mode 100644 examples/advection_rusanov/GNUmakefile create mode 100644 examples/advection_rusanov/README create mode 100644 examples/advection_rusanov/input create mode 100644 examples/advection_rusanov/src/Make.package create mode 100644 examples/advection_rusanov/src/geometry.f90 create mode 100644 examples/advection_rusanov/src/simulation.f90 diff --git a/examples/advection_rusanov/GNUmakefile b/examples/advection_rusanov/GNUmakefile new file mode 100644 index 000000000..691177ff0 --- /dev/null +++ b/examples/advection_rusanov/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_rusanov/README b/examples/advection_rusanov/README new file mode 100644 index 000000000..fb7412417 --- /dev/null +++ b/examples/advection_rusanov/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_rusanov/input b/examples/advection_rusanov/input new file mode 100644 index 000000000..267b7e036 --- /dev/null +++ b/examples/advection_rusanov/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_rusanov/src/Make.package b/examples/advection_rusanov/src/Make.package new file mode 100644 index 000000000..a7a927853 --- /dev/null +++ b/examples/advection_rusanov/src/Make.package @@ -0,0 +1,2 @@ +# List here the extra files here +f90EXE_sources += geometry.f90 simulation.f90 diff --git a/examples/advection_rusanov/src/geometry.f90 b/examples/advection_rusanov/src/geometry.f90 new file mode 100644 index 000000000..b38098e36 --- /dev/null +++ b/examples/advection_rusanov/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=1, 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_rusanov/src/simulation.f90 b/examples/advection_rusanov/src/simulation.f90 new file mode 100644 index 000000000..914359064 --- /dev/null +++ b/examples/advection_rusanov/src/simulation.f90 @@ -0,0 +1,310 @@ +!> Various definitions and tools for running an NGA2 simulation +module simulation + use precision, only: WP + use geometry, only: cfg + use rusanov_class, only: rusanov + use hyperbolic_advection, only: make_advec_rusanov + 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(rusanov), 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_rusanov(cfg, numfields, 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 + + 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 + From 70252d594749b1b68fa8b8e0672252c1f7712457 Mon Sep 17 00:00:00 2001 From: jessecaps Date: Thu, 9 Feb 2023 17:06:57 -0500 Subject: [PATCH 136/136] 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