collapse_subnode Subroutine

public subroutine collapse_subnode(igrid, jgrid, dir, normconv)

Uses

  • proc~~collapse_subnode~~UsesGraph proc~collapse_subnode collapse_subnode mod_physics mod_physics proc~collapse_subnode->mod_physics module~mod_calculate_xw mod_calculate_xw proc~collapse_subnode->module~mod_calculate_xw module~mod_global_parameters mod_global_parameters proc~collapse_subnode->module~mod_global_parameters module~mod_usr_methods mod_usr_methods proc~collapse_subnode->module~mod_usr_methods module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: igrid
integer, intent(in) :: jgrid
integer, intent(in) :: dir
double precision, intent(out), dimension(0:nw+nwauxio) :: normconv

Calls

proc~~collapse_subnode~~CallsGraph proc~collapse_subnode collapse_subnode proc~calc_grid calc_grid proc~collapse_subnode->proc~calc_grid proc~calc_x calc_x proc~collapse_subnode->proc~calc_x proc~mpistop mpistop proc~collapse_subnode->proc~mpistop proc~calc_grid->proc~mpistop phys_to_primitive phys_to_primitive proc~calc_grid->phys_to_primitive proc~to_cartesian to_cartesian proc~calc_grid->proc~to_cartesian mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

proc~~collapse_subnode~~CalledByGraph proc~collapse_subnode collapse_subnode proc~put_collapse put_collapse proc~put_collapse->proc~collapse_subnode proc~write_collapsed write_collapsed proc~write_collapsed->proc~put_collapse proc~saveamrfile saveamrfile proc~saveamrfile->proc~write_collapsed proc~timeintegration timeintegration proc~timeintegration->proc~saveamrfile proc~main main proc~main->proc~timeintegration program~agile agile program~agile->proc~main

Source Code

subroutine collapse_subnode(igrid,jgrid,dir,normconv)
  use mod_usr_methods, only: usr_aux_output
  use mod_global_parameters
  use mod_physics, only: phys_to_primitive
  use mod_calculate_xw

integer, intent(in) :: igrid, jgrid, dir
double precision,dimension(0:nw+nwauxio),intent(out)       :: normconv 
! .. local ..
integer                :: ix, iw
double precision       :: dx1,dx2,dx3
double precision, dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo3-1:ixMhi3,&
   ndim)       :: xC_TMP, xC
double precision, dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
   ndim)         :: xCC_TMP, xCC
double precision, dimension(ixMlo1-1:ixMhi1,ixMlo2-1:ixMhi2,ixMlo3-1:ixMhi3,&
   nw+nwauxio) :: wC_TMP
double precision, dimension(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
   nw+nwauxio)   :: wCC_TMP
integer                :: ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,&
    ixCCmin1,ixCCmin2,ixCCmin3,ixCCmax1,ixCCmax2,ixCCmax3
!-----------------------------------------------------------------------------
ps_sub(jgrid)%w=zero
dx1=rnode(rpdx1_,igrid);dx2=rnode(rpdx2_,igrid);dx3=rnode(rpdx3_,igrid);

call calc_x(igrid,xC,xCC)
call calc_grid(unitslice,igrid,xC,xCC,xC_TMP,xCC_TMP,wC_TMP,wCC_TMP,normconv,&
   ixCmin1,ixCmin2,ixCmin3,ixCmax1,ixCmax2,ixCmax3,ixCCmin1,ixCCmin2,ixCCmin3,&
   ixCCmax1,ixCCmax2,ixCCmax3,.true.)


select case (dir)
case (1)
  if(slab_uniform) then
    do ix=ixMlo1,ixMhi1
      ps_sub(jgrid)%w(ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
         1:nw+nwauxio) = ps_sub(jgrid)%w(ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
         1:nw+nwauxio) + wCC_TMP(ix,ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
         1:nw+nwauxio) * dx1
    end do
  else
    do iw=1,nw+nwauxio
      do ix=ixMlo1,ixMhi1
        ps_sub(jgrid)%w(ixMlo2:ixMhi2,ixMlo3:ixMhi3,&
           iw) = ps_sub(jgrid)%w(ixMlo2:ixMhi2,ixMlo3:ixMhi3,iw) + wCC_TMP(ix,&
           ixMlo2:ixMhi2,ixMlo3:ixMhi3,iw) * ps(igrid)%dx(ix,ixMlo2:ixMhi2,&
           ixMlo3:ixMhi3,1)
      end do
    end do
  end if
  ps_sub(jgrid)%x(ixMlo2:ixMhi2,ixMlo3:ixMhi3,1:ndim) = ps(igrid)%x(ixMlo1,&
     ixMlo2:ixMhi2,ixMlo3:ixMhi3,1:ndim)
case (2)
  if(slab_uniform) then
    do ix=ixMlo2,ixMhi2
       ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo3:ixMhi3,&
          1:nw+nwauxio) = ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo3:ixMhi3,&
          1:nw+nwauxio) + wCC_TMP(ixMlo1:ixMhi1,ix,ixMlo3:ixMhi3,&
          1:nw+nwauxio) * dx2
    end do
  else
    do iw=1,nw+nwauxio
      do ix=ixMlo2,ixMhi2
         ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo3:ixMhi3,&
            iw) = ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo3:ixMhi3,&
            iw) + wCC_TMP(ixMlo1:ixMhi1,ix,ixMlo3:ixMhi3,&
            iw) * ps(igrid)%dx(ixMlo1:ixMhi1,ix,ixMlo3:ixMhi3,2)
      end do
    end do
  endif
  ps_sub(jgrid)%x(ixMlo1:ixMhi1,ixMlo3:ixMhi3,&
     1:ndim) = ps(igrid)%x(ixMlo1:ixMhi1,ixMlo2,ixMlo3:ixMhi3,1:ndim) 
case (3)
  if(slab_uniform) then
    do ix=ixMlo3,ixMhi3
       ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo2:ixMhi2,&
          1:nw+nwauxio) = ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo2:ixMhi2,&
          1:nw+nwauxio) + wCC_TMP(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ix,&
          1:nw+nwauxio) * dx3
    end do
  else
    do iw=1,nw+nwauxio
      do ix=ixMlo3,ixMhi3
         ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo2:ixMhi2,&
            iw) = ps_sub(jgrid)%w(ixMlo1:ixMhi1,ixMlo2:ixMhi2,&
            iw) + wCC_TMP(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ix,&
            iw) * ps(igrid)%dx(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ix,3)
      end do
    end do
  endif
  ps_sub(jgrid)%x(ixMlo1:ixMhi1,ixMlo2:ixMhi2,&
     1:ndim) = ps(igrid)%x(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo3,1:ndim) 
case default
   print*, 'subnode, dir: ', dir
   call mpistop("slice direction not clear in collapse_subnode")
end select




end subroutine collapse_subnode