coarsen.t

Go to the documentation of this file.

!> 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