coarsen_grid_siblings Subroutine

private subroutine coarsen_grid_siblings(igrid, ipe, child_igrid, child_ipe, active)

Uses

  • proc~~coarsen_grid_siblings~~UsesGraph proc~coarsen_grid_siblings coarsen_grid_siblings mod_amr_solution_node mod_amr_solution_node proc~coarsen_grid_siblings->mod_amr_solution_node module~mod_coarsen mod_coarsen proc~coarsen_grid_siblings->module~mod_coarsen module~mod_comm_lib mod_comm_lib proc~coarsen_grid_siblings->module~mod_comm_lib module~mod_global_parameters mod_global_parameters proc~coarsen_grid_siblings->module~mod_global_parameters module~mod_initialize_amr mod_initialize_amr proc~coarsen_grid_siblings->module~mod_initialize_amr module~mod_coarsen->module~mod_global_parameters mod_physics mod_physics module~mod_coarsen->mod_physics 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

coarsen sibling blocks into one block

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: igrid
integer, intent(in) :: ipe
integer, intent(in), dimension(2,2,2) :: child_igrid
integer, intent(in), dimension(2,2,2) :: child_ipe
logical, intent(in) :: active

Calls

proc~~coarsen_grid_siblings~~CallsGraph proc~coarsen_grid_siblings coarsen_grid_siblings alloc_node alloc_node proc~coarsen_grid_siblings->alloc_node proc~coarsen_grid coarsen_grid proc~coarsen_grid_siblings->proc~coarsen_grid proc~initial_condition initial_condition proc~coarsen_grid_siblings->proc~initial_condition proc~mpi_irecv_wrapper mpi_irecv_wrapper proc~coarsen_grid_siblings->proc~mpi_irecv_wrapper proc~mpi_isend_wrapper mpi_isend_wrapper proc~coarsen_grid_siblings->proc~mpi_isend_wrapper proc~mpistop mpistop proc~coarsen_grid_siblings->proc~mpistop proc~initial_condition->proc~mpistop proc~sync_positions_host sync_positions_host proc~initial_condition->proc~sync_positions_host mpi_irecv mpi_irecv proc~mpi_irecv_wrapper->mpi_irecv mpi_isend mpi_isend proc~mpi_isend_wrapper->mpi_isend mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

proc~~coarsen_grid_siblings~~CalledByGraph proc~coarsen_grid_siblings coarsen_grid_siblings proc~amr_coarsen_refine amr_coarsen_refine proc~amr_coarsen_refine->proc~coarsen_grid_siblings proc~resettree resettree proc~resettree->proc~amr_coarsen_refine proc~resettree_convert resettree_convert proc~resettree_convert->proc~amr_coarsen_refine proc~settree settree proc~settree->proc~amr_coarsen_refine proc~main main proc~main->proc~resettree_convert proc~main->proc~settree proc~timeintegration timeintegration proc~main->proc~timeintegration proc~timeintegration->proc~resettree program~agile agile program~agile->proc~main

Source Code

  subroutine coarsen_grid_siblings(igrid,ipe,child_igrid,child_ipe,active)
    use mod_global_parameters
    use mod_coarsen, only: coarsen_grid
    use mod_initialize_amr, only: initial_condition
    use mod_amr_solution_node, only: alloc_node
    use mod_comm_lib, only: mpistop

    integer, intent(in) :: igrid, ipe
    integer, dimension(2,2,2), intent(in) :: child_igrid, child_ipe
    logical, intent(in) :: active

    integer :: igridFi, ipeFi, ixComin1,ixComin2,ixComin3,ixComax1,ixComax2,&
         ixComax3, ixCoGmin1,ixCoGmin2,ixCoGmin3,ixCoGmax1,ixCoGmax2,ixCoGmax3,&
         ixCoMmin1,ixCoMmin2,ixCoMmin3,ixCoMmax1,ixCoMmax2,ixCoMmax3, ic1,ic2,&
         ic3, idir
    integer :: ix1, ix2, ix3, iw

    if (ipe==mype) call alloc_node(igrid)

    ! New passive cell, coarsen from initial condition:
    if (.not. active) then
       if (ipe == mype) then
          ! initial_condition fetches this block's positions back itself
          call initial_condition(igrid)
          do ic3=1,2
             do ic2=1,2
                do ic1=1,2
                   igridFi=child_igrid(ic1,ic2,ic3)
                   ipeFi=child_ipe(ic1,ic2,ic3)
                   !if (ipeFi==mype) then
                   !   ! remove solution space of child
                   !   call dealloc_node(igridFi)
                   !end if
                end do
             end do
          end do
       end if
       return
    end if

    do ic3=1,2
       do ic2=1,2
          do ic1=1,2
             igridFi=child_igrid(ic1,ic2,ic3)
             ipeFi=child_ipe(ic1,ic2,ic3)

             if (ipeFi==mype) then
                dxlevel(1)=rnode(rpdx1_,igridFi);dxlevel(2)=rnode(rpdx2_,igridFi)
                dxlevel(3)=rnode(rpdx3_,igridFi);
                if (ipe==mype) then
                   ixComin1=ixMlo1+(ic1-1)*(ixMhi1-ixMlo1+1)/2
                   ixComin2=ixMlo2+(ic2-1)*(ixMhi2-ixMlo2+1)/2
                   ixComin3=ixMlo3+(ic3-1)*(ixMhi3-ixMlo3+1)/2;
                   ixComax1=ixMhi1+(ic1-2)*(ixMhi1-ixMlo1+1)/2
                   ixComax2=ixMhi2+(ic2-2)*(ixMhi2-ixMlo2+1)/2
                   ixComax3=ixMhi3+(ic3-2)*(ixMhi3-ixMlo3+1)/2;

                   call coarsen_grid(bg(1)%w(:,:,:,:,igridFi),ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,&
                        ixGhi3,ixMlo1,ixMlo2,ixMlo3,ixMhi1,ixMhi2,ixMhi3,&
                        bg(1)%w(:,:,:,:,igrid),&
                        ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,ixGhi3,ixComin1,ixComin2,&
                        ixComin3,ixComax1,ixComax2,ixComax3,bgeo,igridFi,bgeo,igrid)
                   ! remove solution space of child
                   !call dealloc_node(igridFi)
                else
                   ixCoGmin1=1;ixCoGmin2=1;ixCoGmin3=1;
                   ixCoGmax1=ixGhi1/2+nghostcells;ixCoGmax2=ixGhi2/2+nghostcells
                   ixCoGmax3=ixGhi3/2+nghostcells;
                   ixCoMmin1=ixCoGmin1+nghostcells;ixCoMmin2=ixCoGmin2+nghostcells
                   ixCoMmin3=ixCoGmin3+nghostcells;ixCoMmax1=ixCoGmax1-nghostcells
                   ixCoMmax2=ixCoGmax2-nghostcells;ixCoMmax3=ixCoGmax3-nghostcells;
                   call coarsen_grid(bg(1)%w(:,:,:,:,igridFi),ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,&
                        ixGhi3,ixMlo1,ixMlo2,ixMlo3,ixMhi1,ixMhi2,ixMhi3,&
                        bgc(1)%w(:,:,:,:,igridFi),&
                        ixCoGmin1,ixCoGmin2,ixCoGmin3,ixCoGmax1,ixCoGmax2,ixCoGmax3,&
                        ixCoMmin1,ixCoMmin2,ixCoMmin3,ixCoMmax1,ixCoMmax2,ixCoMmax3,&
                        bgeo,igridFi,bgeoc,igridFi)

                   ! Record the chunk; exchange_coarsened_blocks packs and
                   ! posts them all once the walk is over, one message per
                   ! peer.  The key is built from the receiving parent's block
                   ! index, igrid, which the receiver derives from its own.
                   isend=isend+1
                   n_cf_snd=n_cf_snd+1
                   if (n_cf_snd > max_buff) then
                      call mpistop('coarsen_grid_siblings: max_buff too small in send')
                   end if
                   cf_snd_igrid(n_cf_snd) = igridFi
                   cf_snd_dest(n_cf_snd)  = ipe
                   cf_snd_key(n_cf_snd)   = 8*(igrid-1) + (ic1-1) + 2*(ic2-1)&
                       + 4*(ic3-1)

                   ! The staggered branch below is NOT aggregated, and carries
                   ! two defects that are recorded rather than repaired because
                   ! nothing reaches it (stagger_grid is false throughout this
                   ! fork and fix_edges has no caller): the do idir loop stores
                   ! every request into the single slot sendrequest_stg(isend),
                   ! leaking ndim-1 handles that are never waited on; and
                   ! itag_stg multiplies igridFi by 3, 4 or 5 for ndir=3, so
                   ! (igridFi=4,idir=1) collides with (igridFi=3,idir=2).
                   if(stagger_grid) then
                      do idir=1,ndim
                         itag_stg=(npe+ipeFi+1)+igridFi*(ndir-1+idir)
                         call mpi_isend_wrapper(psc(igridFi)%ws,1,type_coarse_block_stg(idir,&
                              ic1,ic2,ic3),ipe,itag_stg, icomm,sendrequest_stg(isend),&
                              ierrmpi)
                      end do
                   end if
                end if
             else
                if (ipe==mype) then
                   irecv=irecv+1
                   n_cf_rcv=n_cf_rcv+1
                   if (n_cf_rcv > max_buff) then
                      call mpistop('coarsen_grid_siblings: max_buff too small in receive')
                   end if
                   cf_rcv_igrid(n_cf_rcv) = igrid
                   cf_rcv_src(n_cf_rcv)   = ipeFi
                   cf_rcv_ic(1,n_cf_rcv)  = ic1
                   cf_rcv_ic(2,n_cf_rcv)  = ic2
                   cf_rcv_ic(3,n_cf_rcv)  = ic3
                   ! the sender builds this same key from the block index it
                   ! was handed for this parent
                   cf_rcv_key(n_cf_rcv)   = 8*(igrid-1) + (ic1-1) + 2*(ic2-1)&
                       + 4*(ic3-1)
                   if(stagger_grid) then
                      do idir=1,ndim
                         itag_stg=(npe+ipeFi+1)+igridFi*(ndir-1+idir)
                         call mpi_irecv_wrapper(ps(igrid)%ws,1,type_sub_block_stg(idir,ic1,ic2,&
                              ic3),ipeFi,itag_stg, icomm,recvrequest_stg(irecv),ierrmpi)
                      end do
                   end if
                end if
             end if
          end do
       end do
    end do

  end subroutine coarsen_grid_siblings