mg_prolong_sparse Subroutine

public subroutine mg_prolong_sparse(mg, p_id, dix, nc, iv, fine)

Prolong from a parent to a child with index offset dix

Arguments

Type IntentOptional Attributes Name
type(mg_t), intent(inout) :: mg
integer, intent(in) :: p_id

Id of parent

integer, intent(in) :: dix(3)

Offset of child in parent grid

integer, intent(in) :: nc

Child grid size

integer, intent(in) :: iv

Prolong from this variable

real(kind=dp), intent(out) :: fine(nc,nc,nc)

Prolonged values


Source Code

  subroutine mg_prolong_sparse(mg, p_id, dix, nc, iv, fine)
    type(mg_t), intent(inout) :: mg
    integer, intent(in)       :: p_id
    !< Id of parent
    integer, intent(in)       :: dix(3)
    !< Offset of child in parent grid
    integer, intent(in)       :: nc
    !< Child grid size
    integer, intent(in)       :: iv
    !< Prolong from this variable
    real(dp), intent(out)     :: fine(nc, nc, nc)
    !< Prolonged values

    integer  :: i, j, k, hnc
    integer  :: ic, jc, kc
    real(dp) :: f0, flx, fhx, fly, fhy, flz, fhz

    hnc = nc/2

    associate (crs => mg%boxes(p_id)%cc)
      do k = 1, hnc
         kc = k + dix(3)
         do j = 1, hnc
            jc = j + dix(2)
            do i = 1, hnc
               ic = i + dix(1)

               f0  = 0.25_dp * crs(ic, jc, kc, iv)
               flx = 0.25_dp * crs(ic-1, jc, kc, iv)
               fhx = 0.25_dp * crs(ic+1, jc, kc, iv)
               fly = 0.25_dp * crs(ic, jc-1, kc, iv)
               fhy = 0.25_dp * crs(ic, jc+1, kc, iv)
               flz = 0.25_dp * crs(ic, jc, kc-1, iv)
               fhz = 0.25_dp * crs(ic, jc, kc+1, iv)

               fine(2*i-1, 2*j-1, 2*k-1) = f0 + flx + fly + flz
               fine(2*i, 2*j-1, 2*k-1)   = f0 + fhx + fly + flz
               fine(2*i-1, 2*j, 2*k-1)   = f0 + flx + fhy + flz
               fine(2*i, 2*j, 2*k-1)     = f0 + fhx + fhy + flz
               fine(2*i-1, 2*j-1, 2*k)   = f0 + flx + fly + fhz
               fine(2*i, 2*j-1, 2*k)     = f0 + fhx + fly + fhz
               fine(2*i-1, 2*j, 2*k)     = f0 + flx + fhy + fhz
               fine(2*i, 2*j, 2*k)       = f0 + fhx + fhy + fhz
            end do
         end do
      end do
    end associate
  end subroutine mg_prolong_sparse