store_faces Subroutine

public subroutine store_faces()

Uses

  • proc~~store_faces~~UsesGraph proc~store_faces store_faces module~mod_forest mod_forest proc~store_faces->module~mod_forest module~mod_global_parameters mod_global_parameters proc~store_faces->module~mod_global_parameters 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

To achive consistency and thus conservation of divergence, when refining a block we take into account the faces of the already fine neighbours, if any. This routine stores them.

Arguments

None

Called by

proc~~store_faces~~CalledByGraph proc~store_faces store_faces proc~amr_coarsen_refine amr_coarsen_refine proc~amr_coarsen_refine->proc~store_faces 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 store_faces
    use mod_forest, only: refine
    use mod_global_parameters
    integer :: igrid, iigrid, idims, iside, ineighbor, ipe_neighbor
    integer :: nx1,nx2,nx3, i1,i2,i3, ic1,ic2,ic3, inc1,inc2,inc3

    if (npe>1) then
      nsend_fc=0
      nrecv_fc=0
    end if

    ! Size of the block face
    nx1=ixMhi1-ixMlo1+1;nx2=ixMhi2-ixMlo2+1;nx3=ixMhi3-ixMlo3+1;

    do iigrid=1,igridstail; igrid=igrids(iigrid);
      ! Check whether it is necessary to store any block face, i.e.
      ! if any coarser neighbour is going to be refined
     do iside=1,2
        i1=kr(1,1)*(2*iside-3);i2=kr(2,1)*(2*iside-3);i3=kr(3,1)*(2*iside-3);
        if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
        if (neighbor_type(i1,i2,i3,igrid)==neighbor_coarse) then
          ineighbor   =neighbor(1,i1,i2,i3,igrid)
          ipe_neighbor=neighbor(2,i1,i2,i3,igrid)
          if (refine(ineighbor,ipe_neighbor)) then
            allocate(pface(iside,1,igrid)%face(1,1:nx2,1:nx3))
            !! Store the faces
            if (iside==1) then !! left side
              pface(iside,1,igrid)%face(1,1:nx2,1:nx3)=ps(igrid)%ws(ixMlo1-1,&
                 ixMlo2:ixMhi2,ixMlo3:ixMhi3,1)
            else !! right side
              pface(iside,1,igrid)%face(1,1:nx2,1:nx3)=ps(igrid)%ws(ixMhi1,&
                 ixMlo2:ixMhi2,ixMlo3:ixMhi3,1)
            end if
            if (ipe_neighbor/=mype) nsend_fc(1)=nsend_fc(1)+1
          end if
        end if
      end do
     do iside=1,2
        i1=kr(1,2)*(2*iside-3);i2=kr(2,2)*(2*iside-3);i3=kr(3,2)*(2*iside-3);
        if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
        if (neighbor_type(i1,i2,i3,igrid)==neighbor_coarse) then
          ineighbor   =neighbor(1,i1,i2,i3,igrid)
          ipe_neighbor=neighbor(2,i1,i2,i3,igrid)
          if (refine(ineighbor,ipe_neighbor)) then
            allocate(pface(iside,2,igrid)%face(1:nx1,1,1:nx3))
            !! Store the faces
            if (iside==1) then !! left side
              pface(iside,2,igrid)%face(1:nx1,1,&
                 1:nx3)=ps(igrid)%ws(ixMlo1:ixMhi1,ixMlo2-1,ixMlo3:ixMhi3,2)
            else !! right side
              pface(iside,2,igrid)%face(1:nx1,1,&
                 1:nx3)=ps(igrid)%ws(ixMlo1:ixMhi1,ixMhi2,ixMlo3:ixMhi3,2)
            end if
            if (ipe_neighbor/=mype) nsend_fc(2)=nsend_fc(2)+1
          end if
        end if
      end do
     do iside=1,2
        i1=kr(1,3)*(2*iside-3);i2=kr(2,3)*(2*iside-3);i3=kr(3,3)*(2*iside-3);
        if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
        if (neighbor_type(i1,i2,i3,igrid)==neighbor_coarse) then
          ineighbor   =neighbor(1,i1,i2,i3,igrid)
          ipe_neighbor=neighbor(2,i1,i2,i3,igrid)
          if (refine(ineighbor,ipe_neighbor)) then
            allocate(pface(iside,3,igrid)%face(1:nx1,1:nx2,1))
            !! Store the faces
            if (iside==1) then !! left side
              pface(iside,3,igrid)%face(1:nx1,1:nx2,&
                 1)=ps(igrid)%ws(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMlo3-1,3)
            else !! right side
              pface(iside,3,igrid)%face(1:nx1,1:nx2,&
                 1)=ps(igrid)%ws(ixMlo1:ixMhi1,ixMlo2:ixMhi2,ixMhi3,3)
            end if
            if (ipe_neighbor/=mype) nsend_fc(3)=nsend_fc(3)+1
          end if
        end if
      end do

      ! If a grid is going to be refined,
      ! remember what are its neighbours.
      if (refine(igrid,mype)) then
        ! Initialize neighbour array
        fine_neighbors(:,:,:,:,igrid)%igrid=-1
        fine_neighbors(:,:,:,:,igrid)%ipe=-1
        do idims=1,ndim
          do iside=1,2
            i1=kr(1,idims)*(2*iside-3);i2=kr(2,idims)*(2*iside-3)
            i3=kr(3,idims)*(2*iside-3);
            if (neighbor_pole(i1,i2,i3,igrid)/=0) cycle
            if (neighbor_type(i1,i2,i3,igrid)==neighbor_fine) then
             do ic3=1+int((1+i3)/2),2-int((1-i3)/2)
                inc3=ic3+i3
             do ic2=1+int((1+i2)/2),2-int((1-i2)/2)
                inc2=ic2+i2
             do ic1=1+int((1+i1)/2),2-int((1-i1)/2)
                inc1=ic1+i1
                ineighbor=neighbor_child(1,inc1,inc2,inc3,igrid)
                ipe_neighbor=neighbor_child(2,inc1,inc2,inc3,igrid)

                fine_neighbors(ic1,ic2,ic3,idims,igrid)%igrid= ineighbor
                fine_neighbors(ic1,ic2,ic3,idims,igrid)%ipe=ipe_neighbor

                if (ipe_neighbor/=mype) nrecv_fc(idims)=nrecv_fc(idims)+1
             end do
             end do
             end do
            end if
          end do
        end do
      end if

    end do

  end subroutine store_faces