set_openacc_device Subroutine

subroutine set_openacc_device()

Uses

  • proc~~set_openacc_device~~UsesGraph proc~set_openacc_device set_openacc_device mpi mpi proc~set_openacc_device->mpi openacc openacc proc~set_openacc_device->openacc

Arguments

None

Calls

proc~~set_openacc_device~~CallsGraph proc~set_openacc_device set_openacc_device acc_get_num_devices acc_get_num_devices proc~set_openacc_device->acc_get_num_devices acc_set_device_num acc_set_device_num proc~set_openacc_device->acc_set_device_num mpi_comm_rank mpi_comm_rank proc~set_openacc_device->mpi_comm_rank mpi_comm_split_type mpi_comm_split_type proc~set_openacc_device->mpi_comm_split_type

Called by

proc~~set_openacc_device~~CalledByGraph proc~set_openacc_device set_openacc_device program~agile agile program~agile->proc~set_openacc_device

Source Code

  subroutine set_openacc_device
    use mpi
    use openacc
    integer :: local_rank, comm_shared, my_device, num_devices, ierror
    integer(acc_device_kind) :: dev_type

    call MPI_COMM_SPLIT_TYPE(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, comm_shared, ierror)
    call MPI_COMM_RANK(comm_shared, local_rank, ierror)

    dev_type = ACC_DEVICE_DEFAULT
    num_devices = acc_get_num_devices(dev_type)

    if (num_devices < 1) error stop "No devices available on host"

    my_device = mod(local_rank, num_devices)
    call acc_set_device_num(my_device, dev_type)

  end subroutine set_openacc_device