From 29646c30c77141d4ca25da95a5b15cb289b17eb7 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 7 Feb 2012 12:30:03 +0000 Subject: [PATCH] psblas3-integer8: base/modules/psi_comm_buffers_mod.F90 base/modules/psi_p2p_mod.F90 base/modules/psi_reduce_mod.F90 Finalized comm_buffers for default integer types in 8_bytes mode. --- base/modules/psi_comm_buffers_mod.F90 | 48 ++++- base/modules/psi_p2p_mod.F90 | 191 +++++++++++++++++++ base/modules/psi_reduce_mod.F90 | 265 +++++++++++++++++++++++++- 3 files changed, 502 insertions(+), 2 deletions(-) diff --git a/base/modules/psi_comm_buffers_mod.F90 b/base/modules/psi_comm_buffers_mod.F90 index b0e68b9d..c51466dd 100644 --- a/base/modules/psi_comm_buffers_mod.F90 +++ b/base/modules/psi_comm_buffers_mod.F90 @@ -33,15 +33,17 @@ module psi_comm_buffers_mod integer(psb_mpik_), private, parameter:: psb_char_type = psb_logical_type + 1 integer(psb_mpik_), private, parameter:: psb_int8_type = psb_char_type + 1 integer(psb_mpik_), private, parameter:: psb_int2_type = psb_int8_type + 1 + integer(psb_mpik_), private, parameter:: psb_int4_type = psb_int2_type + 1 type psb_buffer_node integer(psb_mpik_) :: request integer(psb_mpik_) :: icontxt integer(psb_mpik_) :: buffer_type - integer(psb_ipk_), allocatable :: intbuf(:) + integer(psb_ipk_), allocatable :: intbuf(:) integer(psb_long_int_k_), allocatable :: int8buf(:) integer(2), allocatable :: int2buf(:) + integer(psb_mpik_), allocatable :: int4buf(:) real(psb_spk_), allocatable :: realbuf(:) real(psb_dpk_), allocatable :: doublebuf(:) complex(psb_spk_), allocatable :: complexbuf(:) @@ -62,6 +64,12 @@ module psi_comm_buffers_mod & psi_csnd, psi_zsnd,& & psi_lsnd, psi_hsnd end interface +#if defined(LONG_INTEGERS) + interface psi_snd + module procedure psi_i4snd + end interface +#endif + #if !defined(LONG_INTEGERS) interface psi_snd module procedure psi_i8snd @@ -266,6 +274,44 @@ contains end subroutine psi_isnd +#if defined(LONG_INTEGERS) + subroutine psi_i4snd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_) :: icontxt, tag, dest + integer(psb_mpik_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_mpik_) :: info + integer(psb_mpik_) :: minfo + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + node%buffer_type = psb_int4_type + call move_alloc(buffer,node%int4buf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_def_integer,& + & dest,tag,icontxt,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + + call psb_test_nodes(mesg_queue) + + end subroutine psi_i4snd +#endif + #if !defined(LONG_INTEGERS) subroutine psi_i8snd(icontxt,tag,dest,buffer,mesg_queue) #ifdef MPI_MOD diff --git a/base/modules/psi_p2p_mod.F90 b/base/modules/psi_p2p_mod.F90 index a74a8dee..e5c6db2b 100644 --- a/base/modules/psi_p2p_mod.F90 +++ b/base/modules/psi_p2p_mod.F90 @@ -24,6 +24,16 @@ module psi_p2p_mod end interface +#if defined(LONG_INTEGERS) + interface psb_snd + module procedure psb_i4snds, psb_i4sndv, psb_i4sndm + end interface + + interface psb_rcv + module procedure psb_i4rcvs, psb_i4rcvv, psb_i4rcvm + end interface +#endif + #if !defined(LONG_INTEGERS) interface psb_snd module procedure psb_i8snds, psb_i8sndv, psb_i8sndm @@ -77,6 +87,7 @@ module psi_p2p_mod integer(psb_mpik_), private, parameter:: psb_char_tag = psb_logical_tag + 1 integer(psb_mpik_), private, parameter:: psb_int8_tag = psb_char_tag + 1 integer(psb_mpik_), private, parameter:: psb_int2_tag = psb_int8_tag + 1 + integer(psb_mpik_), private, parameter:: psb_int4_tag = psb_int2_tag + 1 integer(psb_mpik_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag integer(psb_mpik_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag @@ -87,6 +98,7 @@ module psi_p2p_mod integer(psb_mpik_), parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag integer(psb_mpik_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag integer(psb_mpik_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag + integer(psb_mpik_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag contains @@ -645,6 +657,96 @@ contains #endif end subroutine psb_hsnds +#if defined(LONG_INTEGERS) + subroutine psb_i4snds(ictxt,dat,dst) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: dat + integer(psb_mpik_), intent(in) :: dst + integer(psb_mpik_), allocatable :: dat_(:) + integer(psb_mpik_) :: info +#if defined(SERIAL_MPI) + ! do nothing +#else + allocate(dat_(1), stat=info) + dat_(1) = dat + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_i4snds + + subroutine psb_i4sndv(ictxt,dat,dst) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: dat(:) + integer(psb_mpik_), intent(in) :: dst + integer(psb_mpik_), allocatable :: dat_(:) + integer(psb_mpik_) :: info + +#if defined(SERIAL_MPI) +#else + allocate(dat_(size(dat)), stat=info) + dat_(:) = dat(:) + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + + end subroutine psb_i4sndv + + subroutine psb_i4sndm(ictxt,dat,dst,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(in) :: dat(:,:) + integer(psb_mpik_), intent(in) :: dst + integer(psb_mpik_), intent(in), optional :: m + integer(psb_mpik_), allocatable :: dat_(:) + integer(psb_mpik_) :: info + integer(psb_mpik_) :: i,j,k,m_,n_ + +#if defined(SERIAL_MPI) +#else + if (present(m)) then + m_ = m + else + m_ = size(dat,1) + end if + n_ = size(dat,2) + allocate(dat_(m_*n_), stat=info) + k=1 + do j=1,n_ + do i=1, m_ + dat_(k) = dat(i,j) + k = k + 1 + end do + end do + call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) +#endif + end subroutine psb_i4sndm + +#endif + + #if !defined(LONG_INTEGERS) subroutine psb_i8snds(ictxt,dat,dst) use psi_comm_buffers_mod @@ -1384,6 +1486,95 @@ contains end subroutine psb_hrcvs +#if defined(LONG_INTEGERS) + + subroutine psb_i4rcvs(ictxt,dat,src) + use psi_comm_buffers_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(out) :: dat + integer(psb_mpik_), intent(in) :: src + integer(psb_mpik_) :: info + integer(psb_mpik_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! do nothing +#else + call mpi_recv(dat,1,psb_mpi_def_integer,src,psb_int4_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_i4rcvs + + subroutine psb_i4rcvv(ictxt,dat,src) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(out) :: dat(:) + integer(psb_mpik_), intent(in) :: src + integer(psb_mpik_) :: info + integer(psb_mpik_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) +#else + call mpi_recv(dat,size(dat),psb_mpi_def_integer,src,psb_int4_tag,ictxt,status,info) + call psb_test_nodes(psb_mesg_queue) +#endif + + end subroutine psb_i4rcvv + + subroutine psb_i4rcvm(ictxt,dat,src,m) + use psi_comm_buffers_mod + +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(out) :: dat(:,:) + integer(psb_mpik_), intent(in) :: src + integer(psb_mpik_), intent(in), optional :: m + integer(psb_mpik_) :: info ,m_,n_, ld, mp_rcv_type + integer(psb_mpik_) :: i,j,k + integer(psb_mpik_) :: status(mpi_status_size) +#if defined(SERIAL_MPI) + ! What should we do here?? +#else + if (present(m)) then + m_ = m + ld = size(dat,1) + n_ = size(dat,2) + call mpi_type_vector(n_,m_,ld,psb_mpi_def_integer,mp_rcv_type,info) + if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& + & psb_int4_tag,ictxt,status,info) + if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) + else + call mpi_recv(dat,size(dat),psb_mpi_def_integer,src,& + & psb_int4_tag,ictxt,status,info) + end if + if (info /= mpi_success) then + write(psb_err_unit,*) 'Error in psb_recv', info + end if + call psb_test_nodes(psb_mesg_queue) +#endif + end subroutine psb_i4rcvm + +#endif + #if !defined(LONG_INTEGERS) subroutine psb_i8rcvs(ictxt,dat,src) diff --git a/base/modules/psi_reduce_mod.F90 b/base/modules/psi_reduce_mod.F90 index 0d07deef..676d74d2 100644 --- a/base/modules/psi_reduce_mod.F90 +++ b/base/modules/psi_reduce_mod.F90 @@ -5,6 +5,11 @@ module psi_reduce_mod & psb_smaxs, psb_smaxv, psb_smaxm,& & psb_dmaxs, psb_dmaxv, psb_dmaxm end interface +#if defined(LONG_INTEGERS) + interface psb_max + module procedure psb_i4maxs, psb_i4maxv, psb_i4maxm + end interface +#endif #if !defined(LONG_INTEGERS) interface psb_max module procedure psb_i8maxs, psb_i8maxv, psb_i8maxm @@ -21,6 +26,11 @@ module psi_reduce_mod module procedure psb_i8mins, psb_i8minv, psb_i8minm end interface #endif +#if defined(LONG_INTEGERS) + interface psb_min + module procedure psb_i4mins, psb_i4minv, psb_i4minm + end interface +#endif interface psb_amx @@ -280,6 +290,133 @@ contains #endif end subroutine psb_imaxm +#if defined(LONG_INTEGERS) + subroutine psb_i4maxs(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_) :: dat_ + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_def_integer,mpi_max,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_def_integer,mpi_max,root_,ictxt,info) + dat = dat_ + endif +#endif + end subroutine psb_i4maxs + + subroutine psb_i4maxv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat(:) + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_), allocatable :: dat_(:) + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_=dat + if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& + & psb_mpi_def_integer,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i4maxv + + subroutine psb_i4maxm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat(:,:) + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_), allocatable :: dat_(:,:) + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_=dat + if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& + & psb_mpi_def_integer,mpi_max,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer,mpi_max,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer,mpi_max,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i4maxm + +#endif + + #if !defined(LONG_INTEGERS) subroutine psb_i8maxs(ictxt,dat,root) #ifdef MPI_MOD @@ -407,7 +544,6 @@ contains #endif - subroutine psb_smaxs(ictxt,dat,root) #ifdef MPI_MOD use mpi @@ -785,6 +921,133 @@ contains #endif end subroutine psb_iminm +#if defined(LONG_INTEGERS) + subroutine psb_i4mins(ictxt,dat,root) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_) :: dat_ + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call mpi_allreduce(dat,dat_,1,psb_mpi_def_integer,mpi_min,ictxt,info) + dat = dat_ + else + call mpi_reduce(dat,dat_,1,psb_mpi_def_integer,mpi_min,root_,ictxt,info) + dat = dat_ + endif +#endif + end subroutine psb_i4mins + + subroutine psb_i4minv(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat(:) + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_), allocatable :: dat_(:) + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + +#if !defined(SERIAL_MPI) + + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat),dat_,iinfo) + dat_=dat + if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& + & psb_mpi_def_integer,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat),dat_,iinfo) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i4minv + + subroutine psb_i4minm(ictxt,dat,root) + use psb_realloc_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + integer(psb_mpik_), intent(in) :: ictxt + integer(psb_mpik_), intent(inout) :: dat(:,:) + integer(psb_mpik_), intent(in), optional :: root + integer(psb_mpik_) :: root_ + integer(psb_mpik_), allocatable :: dat_(:,:) + integer(psb_mpik_) :: iam, np, info + integer(psb_mpik_) :: iinfo + + +#if !defined(SERIAL_MPI) + call psb_info(ictxt,iam,np) + + if (present(root)) then + root_ = root + else + root_ = -1 + endif + if (root_ == -1) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_=dat + if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& + & psb_mpi_def_integer,mpi_min,ictxt,info) + else + if (iam == root_) then + call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),psb_mpi_def_integer,mpi_min,root_,ictxt,info) + else + call psb_realloc(1,1,dat_,iinfo) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_def_integer,mpi_min,root_,ictxt,info) + end if + endif +#endif + end subroutine psb_i4minm + +#endif + + #if !defined(LONG_INTEGERS) subroutine psb_i8mins(ictxt,dat,root) #ifdef MPI_MOD