mod_coarsen.t

Go to the documentation of this file.

module mod_coarsen
 
  implicit none
  private
 
  public :: coarsen_grid 
 
contains
 
  
  !> coarsen one grid to its coarser representative
  subroutine coarsen_grid(sFi,ixFiG^L,ixFi^L,sCo,ixCoG^L,ixCo^L)
    use mod_global_parameters
    use mod_physics
  
    type(state), intent(inout)      :: sfi, sco
    integer, intent(in) :: ixfig^l, ixfi^l, ixcog^l, ixco^l
  
    integer :: ixco^d, ixfi^d, iw
    double precision :: cofiratio
    double precision :: b_energy_change(ixcog^s)
  
    associate(wfi=>sfi%w(ixfig^s,1:nw), wco=>sco%w(ixcog^s,1:nw))
    staggered: associate(wfis=>sfi%ws,wcos=>sco%ws)
    ! coarsen by 2 in every direction - conservatively
  
    if(coarsenprimitive) call phys_to_primitive(ixfig^l,ixfi^l,wfi,sfi%x)
  
    if(slab_uniform) then
      cofiratio=one/dble(2**ndim)
      do iw=1,nw
         {do ixco^db = ixco^lim^db
            ixfi^db=2*(ixco^db-ixcomin^db)+ixfimin^db\}
            wco(ixco^d,iw)=sum(wfi(ixfi^d:ixfi^d+1,iw))*cofiratio
         {end do\}
      end do
    else
      do iw=1,nw
        {do ixco^db = ixco^lim^db
           ixfi^db=2*(ixco^db-ixcomin^db)+ixfimin^db\}
           wco(ixco^d,iw)= &
               sum(sfi%dvolume(ixfi^d:ixfi^d+1)*wfi(ixfi^d:ixfi^d+1,iw)) &
              /sco%dvolume(ixco^d)
        {end do\}
      end do
    end if
  
    if(stagger_grid) then
      do iw=1,nws
        ! Start one layer before
        {do ixco^db = ixcomin^db-kr(^db,iw),ixcomax^db
           ixfi^db=2*(ixco^db-ixcomin^db+kr(^db,iw))+ixfimin^db-kr(^db,iw)\}
           ! This if statement catches the axis where surface is zero:
           if (sco%surfaceC(ixco^d,iw)>1.0d-9*sco%dvolume(ixco^d)) then ! Normal case
             wcos(ixco^d,iw)=sum(sfi%surfaceC(ixfi^d:ixfi^d+1-kr(iw,^d),iw)*wfis(ixfi^d:ixfi^d+1-kr(iw,^d),iw)) &
                  /sco%surfaceC(ixco^d,iw)
           else ! On axis
             wcos(ixco^d,iw)=zero
           end if
        {end do\}
      end do
      if(phys_total_energy.and. .not.coarsenprimitive) then
        b_energy_change(ixco^s)=0.5d0*sum(wco(ixco^s,iw_mag(:))**2,dim=ndim+1)
      end if
      ! average to fill cell-centred values
      call phys_face_to_center(ixco^l,sco)
      if(phys_total_energy.and. .not.coarsenprimitive) then
        wco(ixco^s,iw_e)=wco(ixco^s,iw_e)-b_energy_change(ixco^s)+&
           0.5d0*sum(wco(ixco^s,iw_mag(:))**2,dim=ndim+1)
      end if
    end if
  
    if(coarsenprimitive) then
      call phys_to_conserved(ixfig^l,ixfi^l,wfi,sfi%x)
      call phys_to_conserved(ixcog^l,ixco^l,wco,sco%x)
    end if
    end associate staggered
    end associate
  end subroutine coarsen_grid
 
end module mod_coarsen