bmw_parallel_context.f

Go to the documentation of this file.

!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
      MODULE bmw_parallel_context
      USE mpi_inc
      USE profiler
 
      IMPLICIT NONE
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) bmw parallel context base class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE bmw_parallel_context_class
         INTEGER :: offset
         INTEGER :: stride
 
         INTEGER :: num_threads
 
#if defined (mpi_opt)
         INTEGER :: comm = mpi_comm_null
#endif
      END TYPE
 
!*******************************************************************************
!  INTERFACE BLOCKS
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE bmw_parallel_context_reduce
         MODULE PROCEDURE bmw_parallel_context_reduce1,                        &
     &                    bmw_parallel_context_reduce2,                        &
     &                    bmw_parallel_context_reduce3,                        &
     &                    bmw_parallel_context_reduce4
      END INTERFACE
 
      CONTAINS
 
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_parallel_context_construct(                                 &
#if defined (MPI_OPT)
     &                                        comm                             &
#endif
     &                                       )
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), POINTER ::                            &
     &   bmw_parallel_context_construct
#if defined (MPI_OPT)
      INTEGER, INTENT(in)                        :: comm
#endif
 
!  local variables
#if defined (MPI_OPT)
      LOGICAL                                    :: isinit
      INTEGER                                    :: status
#endif
      REAL (rprec)                               :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(bmw_parallel_context_construct)
 
#if defined (MPI_OPT)
      CALL mpi_initialized(isinit, status)
 
      IF (.not.isinit) THEN
         CALL mpi_init(status)
      END IF
 
      bmw_parallel_context_construct%comm = comm
      CALL mpi_comm_rank(bmw_parallel_context_construct%comm,                  &
     &                   bmw_parallel_context_construct%offset,                &
     &                   status)
      CALL mpi_comm_size(bmw_parallel_context_construct%comm,                  &
     &                   bmw_parallel_context_construct%stride,                &
     &                   status)
 
#else
      bmw_parallel_context_construct%offset = 0
      bmw_parallel_context_construct%stride = 1
#endif
 
!  Configure the number of threads to use.
      bmw_parallel_context_construct%num_threads = 1
 
      CALL profiler_set_stop_time('bmw_parallel_context_construct',            &
     &                            start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_destruct(this                            &
#if defined(MPI_OPT)
     &                                         ,finalize                       &
#endif
     &                                        )
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), POINTER :: this
#if defined (MPI_OPT)
      LOGICAL, INTENT(in)                        :: finalize
 
!  local variables
      INTEGER                                    :: status
#endif
 
!  Start of executable code
      DEALLOCATE(this)
 
#if defined (MPI_OPT)
      IF (finalize) THEN
         CALL mpi_finalize(status)
      END IF
#endif
 
      END SUBROUTINE
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_abort(status)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER, INTENT(in) :: status
 
!  Start of executable code
#if defined (MPI_OPT)
      CALL mpi_abort(mpi_comm_world, status, status)
#else
      CALL exit(status)
#endif
 
      END SUBROUTINE
 
!*******************************************************************************
!  SETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_set_threads(this, num_threads)
!$    USE omp_lib
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(inout) :: this
      INTEGER, INTENT(in)                              :: num_threads
 
!  local variables
      REAL (rprec)                                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  Configure the number of threads to use.
      this%num_threads = num_threads
 
!$    IF (this%num_threads .gt. 0) THEN
!$       CALL OMP_SET_NUM_THREADS(this%num_threads)
!$    END IF
!$OMP PARALLEL
!$    this%num_threads = OMP_GET_MAX_THREADS()
!$OMP END PARALLEL
 
      CALL profiler_set_stop_time('bmw_parallel_context_set_threads',          &
     &                            start_time)
 
      END SUBROUTINE
 
!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_report(this, io_unit)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(inout) :: this
      INTEGER, INTENT(in)                              :: io_unit
 
!  local variables
      REAL (rprec)                                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      IF (this%offset .eq. 0) THEN
#if defined(MPI_OPT)
         WRITE (io_unit,1000) this%stride
#endif
         WRITE (io_unit,1001) this%num_threads
      END IF
 
      CALL profiler_set_stop_time('bmw_parallel_context_report',               &
     &                            start_time)
 
1000  FORMAT('Using ',i4,' processes.')
#if defined (MPI_OPT)
1001  FORMAT('Using ',i4,' threads per process.')
#else
1001  FORMAT('Using ',i4,' threads.')
#endif
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_reduce1(this, buffer)
      USE stel_kinds, ONLY: rprec
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(in) :: this
      REAL (rprec), DIMENSION(:), INTENT(inout)     :: buffer
 
!  local variables
      REAL (rprec)                                  :: start_time
      INTEGER                                       :: status
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
#if defined (MPI_OPT)
      CALL mpi_allreduce(mpi_in_place, buffer, SIZE(buffer), mpi_real8,        &
     &                   mpi_sum, this%comm, status)
#endif
 
      CALL profiler_set_stop_time('bmw_parallel_context_reduce1',              &
     &                            start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_reduce2(this, buffer)
      USE stel_kinds, ONLY: rprec
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(in) :: this
      REAL (rprec), DIMENSION(:,:), INTENT(inout)   :: buffer
 
!  local variables
      REAL (rprec)                                  :: start_time
      INTEGER                                       :: status
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
#if defined (MPI_OPT)
      CALL mpi_allreduce(mpi_in_place, buffer, SIZE(buffer), mpi_real8,        &
     &                   mpi_sum, this%comm, status)
#endif
 
      CALL profiler_set_stop_time('bmw_parallel_context_reduce2',              &
     &                            start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_reduce3(this, buffer)
      USE stel_kinds, ONLY: rprec
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(in) :: this
      REAL (rprec), DIMENSION(:,:,:), INTENT(inout) :: buffer
 
!  local variables
      REAL (rprec)                                  :: start_time
      INTEGER                                       :: status
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
#if defined (MPI_OPT)
      CALL mpi_allreduce(mpi_in_place, buffer, SIZE(buffer), mpi_real8,        &
     &                   mpi_sum, this%comm, status)
#endif
 
      CALL profiler_set_stop_time('bmw_parallel_context_reduce3',              &
     &                            start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_parallel_context_reduce4(this, buffer)
      USE stel_kinds, ONLY: rprec
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_parallel_context_class), INTENT(in)   :: this
      REAL (rprec), DIMENSION(:,:,:,:), INTENT(inout) :: buffer
 
!  local variables
      REAL (rprec)                                    :: start_time
      INTEGER                                         :: status
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
#if defined (MPI_OPT)
      CALL mpi_allreduce(mpi_in_place, buffer, SIZE(buffer), mpi_real8,        &
     &                   mpi_sum, this%comm, status)
#endif
 
      CALL profiler_set_stop_time('bmw_parallel_context_reduce4',              &
     &                            start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION bmw_parallel_context_start(this, total)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_parallel_context_start
      TYPE (bmw_parallel_context_class), INTENT(in) :: this
      INTEGER, INTENT(in)                           :: total
 
!  local variables
      INTEGER                                       :: n_per_process
      INTEGER                                       :: n_left
 
!  Start of executable code
!  Need to divide the problem space evenly by the number of processes.
      n_per_process = total/this%stride
 
!  The number of items may not evenly divide by the number of processes.
      n_left = mod(total, this%stride)
 
      bmw_parallel_context_start = 1 + this%offset*n_per_process
 
!  Acound for the remaining elements in the first n_left processes.
      IF (this%offset .lt. n_left) THEN
         bmw_parallel_context_start = bmw_parallel_context_start               &
     &                              + this%offset
      ELSE
         bmw_parallel_context_start = bmw_parallel_context_start               &
     &                              + n_left
      END IF
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION bmw_parallel_context_end(this, total)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_parallel_context_end
      TYPE (bmw_parallel_context_class), INTENT(in) :: this
      INTEGER, INTENT(in)                           :: total
 
!  local variables
      INTEGER                                       :: n_per_process
      INTEGER                                       :: n_left
 
!  Start of executable code
!  Need to divide the problem space evenly by the number of processes.
      n_per_process = total/this%stride
 
!  The number of items may not evenly divide by the number of processes.
      n_left = mod(total, this%stride)
 
      bmw_parallel_context_end = (this%offset + 1)*n_per_process
 
!  Acound for the remaining elements in the first n_left processes.
      IF (this%offset .lt. n_left) THEN
         bmw_parallel_context_end = bmw_parallel_context_end               &
     &                              + this%offset + 1
      ELSE
         bmw_parallel_context_end = bmw_parallel_context_end               &
     &                              + n_left
      END IF
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION bmw_parallel_context_i(index, num_i)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_parallel_context_i
      INTEGER, INTENT(in)                           :: index
      INTEGER, INTENT(in)                           :: num_i
 
!  Start of executable code
      bmw_parallel_context_i = mod(index - 1, num_i) + 1
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION bmw_parallel_context_j(index, num_i, num_j)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_parallel_context_j
      INTEGER, INTENT(in)                           :: index
      INTEGER, INTENT(in)                           :: num_i
      INTEGER, INTENT(in)                           :: num_j
 
!  Start of executable code
      bmw_parallel_context_j = mod((index - 1)/num_i, num_j) + 1
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION bmw_parallel_context_k(index, num_i, num_j)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_parallel_context_k
      INTEGER, INTENT(in)                           :: index
      INTEGER, INTENT(in)                           :: num_i
      INTEGER, INTENT(in)                           :: num_j
 
!  Start of executable code
      bmw_parallel_context_k = (index - 1)/(num_j*num_i) + 1
 
      END FUNCTION
 
      END MODULE