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

@@ -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

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)

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