comm_lib.t

Go to the documentation of this file.

!> \file
!> @todo Convert this file to a module

!> Initialize the MPI environment
!> @todo Check for errors in return code
subroutine comm_start
  use mod_global_parameters

  integer(kind=MPI_ADDRESS_KIND) :: lb
  integer(kind=MPI_ADDRESS_KIND) :: size

  ! Initialize MPI
  call mpi_init(ierrmpi)

  ! Each process stores its rank, which ranges from 0 to N-1, where N is the
  ! number of processes.
  call mpi_comm_rank(mpi_comm_world,mype,ierrmpi)

  ! Store the number of processes
  call mpi_comm_size(mpi_comm_world,npe,ierrmpi)

  ! Use the default communicator, which contains all the processes
  icomm = mpi_comm_world

  ! Get size of double/integer
  call mpi_type_get_extent(mpi_real,lb,size,ierrmpi)
  if (size /= size_real) call mpistop("Incompatible real size")
  call mpi_type_get_extent(mpi_double_precision,lb,size,ierrmpi)
  if (size /= size_double) call mpistop("Incompatible double size")
  call mpi_type_get_extent(mpi_integer,lb,size,ierrmpi)
  if (size /= size_int) call mpistop("Incompatible integer size")
  call mpi_type_get_extent(mpi_logical,lb,size,ierrmpi)
  if (size /= size_logical) call mpistop("Incompatible logical size")

end subroutine comm_start

!> Finalize (or shutdown) the MPI environment
subroutine comm_finalize
  use mod_global_parameters

  call mpi_barrier(mpi_comm_world,ierrmpi)
  call mpi_finalize(ierrmpi)

end subroutine comm_finalize

!> Create and store the MPI types that will be used for parallel communication
subroutine init_comm_types
  use mod_global_parameters

  integer, dimension(ndim+1) :: sizes, subsizes, start
  integer :: i^D, ic^D, nx^D, nxCo^D, nxG^D, idir

  nx^d=ixmhi^d-ixmlo^d+1;
  nxg^d=ixghi^d-ixglo^d+1;
  nxco^d=nx^d/2;

  ^d&sizes(^d)=ixghi^d;
  sizes(ndim+1)=nw
  ^d&subsizes(^d)=nxg^d;
  subsizes(ndim+1)=nw
  ^d&start(^d)=ixglo^d-1;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block,ierrmpi)
  call mpi_type_commit(type_block,ierrmpi)
  size_block={nxg^d*}*nw*size_double

  ^d&sizes(^d)=ixghi^d/2+nghostcells;
  sizes(ndim+1)=nw
  ^d&subsizes(^d)=nxco^d;
  subsizes(ndim+1)=nw
  ^d&start(^d)=ixmlo^d-1;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_coarse_block,ierrmpi)
  call mpi_type_commit(type_coarse_block,ierrmpi)

  if(stagger_grid) then
    ^d&sizes(^d)=ixghi^d+1;
    sizes(ndim+1)=nws
    ^d&subsizes(^d)=nx^d+1;
    subsizes(ndim+1)=nws
    ^d&start(^d)=ixmlo^d-1;
    start(ndim+1)=0
    call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                  mpi_order_fortran,mpi_double_precision, &
                                  type_block_io_stg,ierrmpi)
    call mpi_type_commit(type_block_io_stg,ierrmpi)
    size_block_io_stg={(nx^d+1)*}*nws*size_double

    ^d&sizes(^d)=ixghi^d/2+nghostcells+1;
    sizes(ndim+1)=nws
   {do ic^db=1,2\}
      do idir=1,ndim
        ^d&subsizes(^d)=nxco^d+kr(ic^d,1)*kr(idir,^d);
        subsizes(ndim+1)=1
        ^d&start(^d)=ixmlo^d-kr(ic^d,1)*kr(idir,^d);
        start(ndim+1)=idir-1

        call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                      mpi_order_fortran,mpi_double_precision, &
                                      type_coarse_block_stg(idir,ic^d),ierrmpi)
        call mpi_type_commit(type_coarse_block_stg(idir,ic^d),ierrmpi)
      end do
   {end do\}

    ^d&sizes(^d)=ixghi^d+1;
    sizes(ndim+1)=nws
   {do ic^db=1,2\}
      do idir=1,^nd
        ^d&subsizes(^d)=nxco^d+kr(ic^d,1)*kr(idir,^d);
        subsizes(ndim+1)=1
        ^d&start(^d)=ixmlo^d-kr(ic^d,1)*kr(idir,^d)+(ic^d-1)*nxco^d;
        start(ndim+1)=idir-1
        call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                      mpi_order_fortran,mpi_double_precision, &
                                      type_sub_block_stg(idir,ic^d),ierrmpi)
        call mpi_type_commit(type_sub_block_stg(idir,ic^d),ierrmpi)
      end do
   {end do\}
  end if

  ^d&sizes(^d)=ixghi^d;
  sizes(ndim+1)=nw
  {do ic^db=1,2\}
     ^d&subsizes(^d)=nxco^d;
     subsizes(ndim+1)=nw
     ^d&start(^d)=ixmlo^d-1+(ic^d-1)*nxco^d;
     start(ndim+1)=0
     call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                   mpi_order_fortran,mpi_double_precision, &
                                   type_sub_block(ic^d),ierrmpi)
     call mpi_type_commit(type_sub_block(ic^d),ierrmpi)
  {end do\}

  ^d&sizes(^d)=ixghi^d;
  sizes(ndim+1)=nw
  ^d&subsizes(^d)=nx^d;
  subsizes(ndim+1)=nw
  ^d&start(^d)=ixmlo^d-1;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block_io,ierrmpi)
  call mpi_type_commit(type_block_io,ierrmpi)
  size_block_io={nx^d*}*nw*size_double

  ^d&sizes(^d)=ixmhi^d-ixmlo^d+1;
  sizes(ndim+1)=^nd
  ^d&subsizes(^d)=sizes(^d);
  subsizes(ndim+1)=^nd
  ^d&start(^d)=0;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block_xcc_io,ierrmpi)
  call mpi_type_commit(type_block_xcc_io,ierrmpi)

  ^d&sizes(^d)=ixmhi^d-ixmlo^d+2;
  sizes(ndim+1)=^nd
  ^d&subsizes(^d)=sizes(^d);
  subsizes(ndim+1)=^nd
  ^d&start(^d)=0;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block_xc_io,ierrmpi)
  call mpi_type_commit(type_block_xc_io,ierrmpi)

  ^d&sizes(^d)=ixmhi^d-ixmlo^d+1;
  sizes(ndim+1)=nw+nwauxio
  ^d&subsizes(^d)=sizes(^d);
  subsizes(ndim+1)=nw+nwauxio
  ^d&start(^d)=0;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block_wcc_io,ierrmpi)
  call mpi_type_commit(type_block_wcc_io,ierrmpi)

  ^d&sizes(^d)=ixmhi^d-ixmlo^d+2;
  sizes(ndim+1)=nw+nwauxio
  ^d&subsizes(^d)=sizes(^d);
  subsizes(ndim+1)=nw+nwauxio
  ^d&start(^d)=0;
  start(ndim+1)=0
  call mpi_type_create_subarray(ndim+1,sizes,subsizes,start, &
                                mpi_order_fortran,mpi_double_precision, &
                                type_block_wc_io,ierrmpi)
  call mpi_type_commit(type_block_wc_io,ierrmpi)

end subroutine init_comm_types

!> Exit MPI-AMRVAC with an error message
subroutine mpistop(message)
  use mod_global_parameters

  character(len=*), intent(in) :: message !< The error message
  integer                      :: ierrcode

  write(*, *) "ERROR for processor", mype, ":"
  write(*, *) trim(message)

  call mpi_abort(icomm, ierrcode, ierrmpi)

end subroutine mpistop