module mspmd

USE mkinds
USE mgrid

#ifdef MPI
USE mpi
 
IMPLICIT NONE

integer,public,save        :: npes
integer,public,save        :: pid
integer                    :: ierr
integer,allocatable        :: nxs(:),i0(:),il(:)
integer,allocatable        :: nys(:),jf(:),jl(:)
integer                    :: jfp,jlp,ifp,ilp
integer                    :: status(MPI_STATUS_SIZE)
integer                    :: tag

PUBLIC :: spmd_bcast_array

INTERFACE spmd_bcast_array
     MODULE PROCEDURE bcast_iarray
     MODULE PROCEDURE bcast_rarray
END INTERFACE spmd_bcast_array

contains

subroutine start_spmd()

CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,pid, ierr)
end subroutine start_spmd

subroutine spmd_distribute()
implicit none
integer :: pe,iis,iil,i,jjs,jjl,nye,jstart

logical :: file_exists

allocate(nxs(0:npes-1))
allocate(i0(0:npes-1))
allocate(il(0:npes-1))
allocate(nys(0:npes-1))
allocate(jf(0:npes-1))
allocate(jl(0:npes-1))

nye=ny
jstart=0

INQUIRE(FILE='tsis.patch', EXIST=file_exists)
if(file_exists) then
open(unit=10,file='tsis.patch',status="unknown")
if(pid==0) write(*,*) "Reading tsis.patch "
read(10,*) nye,jstart
!do i=0,npes-1
!read(10,*) pe, iis,iil,jjs,jjl
!nxs(i)=(iil-iis)+1
!nys(i)=(jjl-jjs)+1
!i0(i)=iis
!il(i)=iil
!jf(i)=jjs
!jl(i)=jjl
!enddo
close(10)

!ifp=i0(pid)
!ilp=il(pid)
!jfp=jf(pid)
!jlp=jl(pid)

endif 
ifp=1
ilp=nx
!jfp=nye*pid/npes + 1 !+ 290
!jlp=nye*(pid+1)/npes !+ 290


do i=0,npes-1
nxs(i)=nx
nys(i)=(jlp-jfp)+1

!jjs=ny*i/npes + 1 !+ 290
!jjl=ny*(i+1)/npes !+ 290

jjs=nye*i/npes + 1 + jstart
jjl=nye*(i+1)/npes + jstart
nys(i)=(jjl-jjs)+1
i0(i)=1
il(i)=nx
jf(i)=jjs
jl(i)=jjl
if(pid==i) then
        ifp=i0(pid)
        ilp=il(pid)
        jfp=jf(pid)
        jlp=jl(pid)
!print *, pid, i0(i),il(i),jf(i),jl(i)
endif
enddo
!endif
end subroutine spmd_distribute

subroutine spmd_wait()
implicit none
CALL MPI_Barrier(MPI_COMM_WORLD,ierr)
end subroutine

subroutine spmd_collect(array)
implicit none
real (r4), dimension(:,:), intent(inout) :: array
integer :: i,s,e

tag=123456
! gather all analyzed values to one processor

IF(pid==0) THEN
do i=1,npes-1
          call MPI_RECV(array(i0(i):il(i),jf(i):jl(i)),nxs(i)*nys(i),MPI_REAL,i,tag,MPI_COMM_WORLD,status,ierr)
ENDDO
ELSE
        call MPI_send(array(ifp:ilp,jfp:jlp),nxs(pid)*nys(pid),MPI_REAL,0,tag,MPI_COMM_WORLD,ierr)
ENDIF

end subroutine

subroutine bcast_rarray(array, root_pe)
!  Broadcasts a real 2d array from one processor (root_pe)
!  to all other processors. 

integer (i4), intent(in) :: root_pe               ! processor number to broadcast from
real (r4), dimension(:,:), intent(inout) :: array       ! array to be broadcast
integer (i4) :: nelements,ierr                    ! size and  local MPI error flag

nelements = size(array)
call MPI_BCAST(array, nelements, MPI_REAL, root_pe, MPI_COMM_WORLD, ierr)
call MPI_BARRIER(MPI_COMM_WORLD, ierr)

end subroutine bcast_rarray

subroutine bcast_iarray(array, root_pe)
!  Broadcasts an integer array 
!  from one processor (root_pe) 
!  to all other processors. 

integer (i4), intent(in) :: root_pe  ! processor number to broadcast from

!INPUT/OUTPUT PARAMETERS:

integer (i4), dimension(:,:), intent(inout) :: array       ! array to be broadcast
integer (i4) :: nelements,ierr ! array size and local MPI error flag

nelements = size(array)
call MPI_BCAST(array, nelements, MPI_INTEGER, root_pe, MPI_COMM_WORLD, ierr)
call MPI_BARRIER(MPI_COMM_WORLD, ierr)

end subroutine bcast_iarray


subroutine spmd_ireduce(my_total,total,root_pe)
integer (i4), intent(in) :: root_pe, my_total
integer (i4) :: error_flag,ierr,total
call MPI_Reduce(my_total, total, 1, MPI_INTEGER,MPI_SUM, root_pe, MPI_COMM_WORLD, ierr )
end subroutine

subroutine stop_spmd
implicit none
integer :: ierr

CALL mpi_finalize(ierr)

end subroutine stop_spmd

#else

IMPLICIT NONE

integer,public,save        :: npes
integer,public,save        :: pid
integer                    :: ierr
integer,allocatable        :: nxs(:),i0(:),il(:)
integer,allocatable        :: nys(:),jf(:),jl(:)
integer                    :: jfp,jlp,ifp,ilp
integer                    :: status
integer                    :: tag



PUBLIC :: spmd_bcast_array
INTERFACE spmd_bcast_array
     MODULE PROCEDURE bcast_iarray
     MODULE PROCEDURE bcast_rarray
END INTERFACE spmd_bcast_array


contains

subroutine start_spmd()
npes=1
pid=0
end subroutine start_spmd

subroutine spmd_distribute()
implicit none
integer :: iis,ill,i
ifp=1
ilp=nx
jfp=ny*pid/npes + 1
jlp=ny*(pid+1)/npes

allocate(nxs(0:npes-1))
allocate(i0(0:npes-1))
allocate(il(0:npes-1))
allocate(nys(0:npes-1))
allocate(jf(0:npes-1))
allocate(jl(0:npes-1))

do i=0,npes-1
iis=ny*i/npes + 1
ill=ny*(i+1)/npes
nys(i)=(ill-iis)+1
nxs(i)=(ilp-ifp)+1
jf(i)=iis
jl(i)=ill
i0(i)=ifp
il(i)=ilp
enddo
end subroutine spmd_distribute

subroutine spmd_wait()
return
end subroutine

subroutine bcast_rarray(array, root_pe)
integer (i4), intent(in) :: root_pe               ! processor number to broadcast from
real (r4), dimension(:,:), intent(inout) :: array       ! array to be broadcast
return
end subroutine bcast_rarray

subroutine bcast_iarray(array, root_pe)
integer (i4), intent(in) :: root_pe 
integer (i4), dimension(:,:), intent(inout) :: array       ! array to be broadcast
end subroutine

subroutine spmd_collect(array)
implicit none
real (r4), dimension(:,:), intent(inout) :: array
return
end subroutine

subroutine spmd_ireduce(my_total,total,root_pe)
integer (i4), intent(in) :: root_pe, my_total
integer (i4) :: error_flag,ierr,total
!call MPI_Reduce(my_total, total, 1, MPI_INTEGER,MPI_SUM, root_pe, MPI_COMM_WORLD, ierr )
return
end subroutine

subroutine stop_spmd
implicit none
return
end subroutine stop_spmd

#endif
end module mspmd
