PRACE NPT

      Module mpi_module

! ---------------------------------------------------------------------

! --- This module contains information for communication and data 

!     distribution.

! ---------------------------------------------------------------------

      Include               'mpif.h'

      Integer            :: me, nodes

      Integer, Parameter :: maxnod = 2048

      Integer            :: offset(0:maxnod-1), sizes(0:maxnod-1)

      Integer            :: glb, gub, lb

      Integer            :: comm, ierr, ityp, rtyp

! ---------------------------------------------------------------------

      Contains

      Subroutine bsaddr

! ----------------------------------------------------------------------

! --- Routine 'bsaddr' calculates the offsets that occur when local

!     data must be copied into a global one that combines all local

!     data. As the sizes of the local arrays need not be the same,

!     offsets cannot be generated with local knowledge only.

!

! --- Input:  - Integer nodes              (via Module mpi_module)

!             - Integer sizes(0:maxnod-1)  (via Module mpi_module)

! --- Output: - Integer offset(0:maxnod-1) (via Module mpi_module)

! ----------------------------------------------------------------------

      Implicit   None

      Integer :: i

! ----------------------------------------------------------------------

      offset(0) = 0

      Do i = 1, nodes - 1

         offset(i) = offset(i-1) + sizes(i-1)

      End Do

      glb = offset(me)

      lb  = glb + 1

      If ( me < nodes - 1 ) Then

         gub = offset(me+1)

      Else

         gub = offset(me) + sizes(me)

      End If

! ----------------------------------------------------------------------

      End Subroutine bsaddr

      Subroutine mpibye

! ----------------------------------------------------------------------

      Call MPI_Finalize( ierr )

! ----------------------------------------------------------------------

      End Subroutine mpibye

      Subroutine csetup

! ----------------------------------------------------------------------

! --- 'csetup' initializes the communication for MPI programs.

!

! --- Output parameters (in mpi_module):

!     Integer: me    --- Local node number (0 <= me <= nodes-1).

!     Integer: nodes --- Number of nodes as found in the MPI system.

! --- Initialize MPI also, initialize this processor and the set of

!     processors for this job. (In case of problems, report and stop).

! ----------------------------------------------------------------------

      Call Mpi_Init( ierr )

      If ( ierr /= Mpi_Success ) Then

         Print *, 'Could not initialize MPI, ierr = ', ierr

         Stop 'Csetup stage 1'

      End If

      Call Mpi_Comm_Rank( Mpi_Comm_World, me, ierr )

      If ( ierr /= Mpi_Success ) Then

         Print *, 'Could not find my process id, ierr = ', ierr

         Stop 'Csetup stage 2'

      End If

      Call Mpi_Comm_Size( Mpi_Comm_World, nodes, ierr )

      If ( ierr /= Mpi_Success ) Then

         Print *, 'Could not determine no. of nodes, ierr = ', ierr

         Stop 'Csetup stage 3'

      End If

! ----------------------------------------------------------------------

! --- Be sure that all processors start together.

      Call Mpi_Barrier( Mpi_Comm_World, ierr )

! ----------------------------------------------------------------------

      End Subroutine csetup

      Subroutine evdist( n )

! ---------------------------------------------------------------------

! --- Routine 'evdist' distributes 'n' elements as evenly as possible

!     over 'nodes' processors. The actual number of elements per

!     processor are returned in array 'sizes'.

! ---------------------------------------------------------------------

! --- Input:  - Integer n

!             - Integer nodes             (via Module mpi_module).

! --- Output: - Integer sizes(0:maxnod-1) (via Module mpi_module).

! ---------------------------------------------------------------------

      Implicit   None

      Integer :: n

      Integer :: i, non, nrest, rest

! ---------------------------------------------------------------------

! --- Set number of rows.

      non   = n/nodes

      rest  = Mod( n, nodes )

      nrest = nodes - rest - 1

      Do i = 0, nodes - 1

         sizes(i) = non

         If ( i > nrest ) sizes(i) = non + 1

      End Do

! ---------------------------------------------------------------------

      End Subroutine evdist

      Subroutine mpistart

! ---------------------------------------------------------------------

      Call csetup

      Call setnames

! ---------------------------------------------------------------------

      End Subroutine mpistart

      Integer Function part( n )

! ---------------------------------------------------------------------

! --- Routine 'part' partitions 'n' elements as evenly as possible

!     over 'nodes' processors.

! ---------------------------------------------------------------------

! --- Input:  - Integer n

!             - Integer nodes

! ---------------------------------------------------------------------

      Implicit   None

      Integer :: n

      Integer :: i, non, nrest, rest

! ---------------------------------------------------------------------

      non   = n/nodes

      rest  = Mod( n, nodes )

      nrest = nodes - rest - 1

      part  = non

      If ( me > nrest ) part = part + 1

! ---------------------------------------------------------------------

      End Function part

      Subroutine setnames

! ---------------------------------------------------------------------

      comm = MPI_Comm_World

      ityp = MPI_Integer8

      rtyp = MPI_Real8

! ---------------------------------------------------------------------

      End Subroutine

      End Module mpi_module