psblas3:

base/comm/Makefile
 base/comm/psb_cspgather.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zspgather.F90
 base/modules/psb_comm_mod.f90
 test/serial/d_matgen.f03

Added sp_gather interfaces.

base/comm/Makefile

@@ -8,7 +8,7 @@ OBJS =  psb_dgather.o psb_dhalo.o psb_dovrl.o \
 
 
 MPFOBJS=psb_dscatter.o psb_zscatter.o psb_iscatter.o psb_cscatter.o psb_sscatter.o\
-	psb_dspgather.o
+	psb_dspgather.o psb_sspgather.o psb_zspgather.o psb_cspgather.o
 LIBDIR=..
 MODDIR=../modules
 FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG)$(MODDIR) $(FMFLAG).

base/comm/psb_cspgather.F90

@@ -0,0 +1,114 @@
+subroutine  psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+  use psb_descriptor_type
+  use psb_error_mod
+  use psb_mat_mod
+  use psb_penv_mod
+#ifdef MPI_MOD
+  use mpi
+#endif
+  implicit none
+#ifdef MPI_H
+  include 'mpif.h'
+#endif
+  type(psb_cspmat_type), intent(inout) :: loca
+  type(psb_cspmat_type), intent(inout) :: globa
+  type(psb_desc_type), intent(in) :: desc_a
+  integer, intent(out)            :: info
+  integer, intent(in), optional   :: root, dupl
+  logical, intent(in), optional   :: keepnum,keeploc
+
+  type(psb_c_coo_sparse_mat)      :: loc_coo, glob_coo
+  integer :: ictxt,np,me, err_act, icomm, dupl_, nrg, ncg, nzg
+  integer :: ip, ndx,naggrm1,naggrp1, i, j, k
+  logical :: keepnum_, keeploc_
+  integer, allocatable :: nzbr(:), idisp(:)
+  character(len=20) :: name
+  integer            :: debug_level, debug_unit
+
+  name='psb_gather'
+  if (psb_get_errstatus().ne.0) return 
+  info=psb_success_
+
+  call psb_erractionsave(err_act)
+  ictxt = psb_cd_get_context(desc_a)
+  icomm = psb_cd_get_mpic(desc_a)
+  call psb_info(ictxt, me, np)
+
+  if (present(keepnum)) then 
+    keepnum_ = keepnum
+  else
+    keepnum_ = .true.
+  end if
+  if (present(keeploc)) then 
+    keeploc_ = keeploc
+  else
+    keeploc_ = .true.
+  end if
+  call globa%free()
+
+  if (keepnum_) then 
+    nrg = psb_cd_get_global_rows(desc_a)
+    ncg = psb_cd_get_global_rows(desc_a)
+
+    allocate(nzbr(np), idisp(np),stat=info)
+    if (info /= psb_success_) then 
+      info=psb_err_alloc_request_
+      call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
+           & a_err='integer')
+      goto 9999      
+    end if
+    call loca%mv_to(loc_coo)
+    nzbr(:) = 0
+    nzbr(me+1) = loc_coo%get_nzeros()
+    call psb_sum(ictxt,nzbr(1:np))
+    nzg = sum(nzbr)
+    if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
+    if (info /= psb_success_) goto 9999
+    do ip=1,np
+      idisp(ip) = sum(nzbr(1:ip-1))
+    enddo
+    ndx = nzbr(me+1) 
+    call mpi_allgatherv(loc_coo%val,ndx,mpi_complex,&
+         & glob_coo%val,nzbr,idisp,&
+         & mpi_double_precision,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,mpi_integer,&
+         & glob_coo%ia,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,mpi_integer,&
+         & glob_coo%ja,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
+      goto 9999
+    end if
+    
+    if (keeploc_) then
+      call loca%mv_from(loc_coo)
+    else
+      call loc_coo%free()
+    end if
+    call glob_coo%set_nzeros(nzg)
+    if (present(dupl)) call glob_coo%set_dupl(dupl)
+    call globa%mv_from(glob_coo)
+
+  else
+    write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
+  end if
+
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act.eq.psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+ 
+end subroutine psb_csp_allgather

base/comm/psb_sspgather.F90

@@ -0,0 +1,114 @@
+subroutine  psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+  use psb_descriptor_type
+  use psb_error_mod
+  use psb_mat_mod
+  use psb_penv_mod
+#ifdef MPI_MOD
+  use mpi
+#endif
+  implicit none
+#ifdef MPI_H
+  include 'mpif.h'
+#endif
+  type(psb_sspmat_type), intent(inout) :: loca
+  type(psb_sspmat_type), intent(inout) :: globa
+  type(psb_desc_type), intent(in) :: desc_a
+  integer, intent(out)            :: info
+  integer, intent(in), optional   :: root, dupl
+  logical, intent(in), optional   :: keepnum,keeploc
+
+  type(psb_s_coo_sparse_mat)      :: loc_coo, glob_coo
+  integer :: ictxt,np,me, err_act, icomm, dupl_, nrg, ncg, nzg
+  integer :: ip, ndx,naggrm1,naggrp1, i, j, k
+  logical :: keepnum_, keeploc_
+  integer, allocatable :: nzbr(:), idisp(:)
+  character(len=20) :: name
+  integer            :: debug_level, debug_unit
+
+  name='psb_gather'
+  if (psb_get_errstatus().ne.0) return 
+  info=psb_success_
+
+  call psb_erractionsave(err_act)
+  ictxt = psb_cd_get_context(desc_a)
+  icomm = psb_cd_get_mpic(desc_a)
+  call psb_info(ictxt, me, np)
+
+  if (present(keepnum)) then 
+    keepnum_ = keepnum
+  else
+    keepnum_ = .true.
+  end if
+  if (present(keeploc)) then 
+    keeploc_ = keeploc
+  else
+    keeploc_ = .true.
+  end if
+  call globa%free()
+
+  if (keepnum_) then 
+    nrg = psb_cd_get_global_rows(desc_a)
+    ncg = psb_cd_get_global_rows(desc_a)
+
+    allocate(nzbr(np), idisp(np),stat=info)
+    if (info /= psb_success_) then 
+      info=psb_err_alloc_request_
+      call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
+           & a_err='integer')
+      goto 9999      
+    end if
+    call loca%mv_to(loc_coo)
+    nzbr(:) = 0
+    nzbr(me+1) = loc_coo%get_nzeros()
+    call psb_sum(ictxt,nzbr(1:np))
+    nzg = sum(nzbr)
+    if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
+    if (info /= psb_success_) goto 9999
+    do ip=1,np
+      idisp(ip) = sum(nzbr(1:ip-1))
+    enddo
+    ndx = nzbr(me+1) 
+    call mpi_allgatherv(loc_coo%val,ndx,mpi_real,&
+         & glob_coo%val,nzbr,idisp,&
+         & mpi_double_precision,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,mpi_integer,&
+         & glob_coo%ia,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,mpi_integer,&
+         & glob_coo%ja,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
+      goto 9999
+    end if
+    
+    if (keeploc_) then
+      call loca%mv_from(loc_coo)
+    else
+      call loc_coo%free()
+    end if
+    call glob_coo%set_nzeros(nzg)
+    if (present(dupl)) call glob_coo%set_dupl(dupl)
+    call globa%mv_from(glob_coo)
+
+  else
+    write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
+  end if
+
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act.eq.psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+ 
+end subroutine psb_ssp_allgather

base/comm/psb_zspgather.F90

@@ -0,0 +1,114 @@
+subroutine  psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+  use psb_descriptor_type
+  use psb_error_mod
+  use psb_mat_mod
+  use psb_penv_mod
+#ifdef MPI_MOD
+  use mpi
+#endif
+  implicit none
+#ifdef MPI_H
+  include 'mpif.h'
+#endif
+  type(psb_zspmat_type), intent(inout) :: loca
+  type(psb_zspmat_type), intent(inout) :: globa
+  type(psb_desc_type), intent(in) :: desc_a
+  integer, intent(out)            :: info
+  integer, intent(in), optional   :: root, dupl
+  logical, intent(in), optional   :: keepnum,keeploc
+
+  type(psb_z_coo_sparse_mat)      :: loc_coo, glob_coo
+  integer :: ictxt,np,me, err_act, icomm, dupl_, nrg, ncg, nzg
+  integer :: ip, ndx,naggrm1,naggrp1, i, j, k
+  logical :: keepnum_, keeploc_
+  integer, allocatable :: nzbr(:), idisp(:)
+  character(len=20) :: name
+  integer            :: debug_level, debug_unit
+
+  name='psb_gather'
+  if (psb_get_errstatus().ne.0) return 
+  info=psb_success_
+
+  call psb_erractionsave(err_act)
+  ictxt = psb_cd_get_context(desc_a)
+  icomm = psb_cd_get_mpic(desc_a)
+  call psb_info(ictxt, me, np)
+
+  if (present(keepnum)) then 
+    keepnum_ = keepnum
+  else
+    keepnum_ = .true.
+  end if
+  if (present(keeploc)) then 
+    keeploc_ = keeploc
+  else
+    keeploc_ = .true.
+  end if
+  call globa%free()
+
+  if (keepnum_) then 
+    nrg = psb_cd_get_global_rows(desc_a)
+    ncg = psb_cd_get_global_rows(desc_a)
+
+    allocate(nzbr(np), idisp(np),stat=info)
+    if (info /= psb_success_) then 
+      info=psb_err_alloc_request_
+      call psb_errpush(info,name,i_err=(/2*np,0,0,0,0/),&
+           & a_err='integer')
+      goto 9999      
+    end if
+    call loca%mv_to(loc_coo)
+    nzbr(:) = 0
+    nzbr(me+1) = loc_coo%get_nzeros()
+    call psb_sum(ictxt,nzbr(1:np))
+    nzg = sum(nzbr)
+    if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
+    if (info /= psb_success_) goto 9999
+    do ip=1,np
+      idisp(ip) = sum(nzbr(1:ip-1))
+    enddo
+    ndx = nzbr(me+1) 
+    call mpi_allgatherv(loc_coo%val,ndx,mpi_double_complex,&
+         & glob_coo%val,nzbr,idisp,&
+         & mpi_double_precision,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ia,ndx,mpi_integer,&
+         & glob_coo%ia,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    if (info == psb_success_) call mpi_allgatherv(loc_coo%ja,ndx,mpi_integer,&
+         & glob_coo%ja,nzbr,idisp,&
+         & mpi_integer,icomm,info)
+    
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
+      goto 9999
+    end if
+    
+    if (keeploc_) then
+      call loca%mv_from(loc_coo)
+    else
+      call loc_coo%free()
+    end if
+    call glob_coo%set_nzeros(nzg)
+    if (present(dupl)) call glob_coo%set_dupl(dupl)
+    call globa%mv_from(glob_coo)
+
+  else
+    write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
+  end if
+
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act.eq.psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+ 
+end subroutine psb_zsp_allgather

base/modules/psb_comm_mod.f90

@@ -313,6 +313,39 @@ module psb_comm_mod
       integer, intent(in), optional   :: root,dupl
       logical, intent(in), optional   :: keepnum,keeploc
     end subroutine psb_dsp_allgather
+    subroutine  psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+      use psb_descriptor_type
+      use psb_mat_mod
+      implicit none
+      type(psb_sspmat_type), intent(inout) :: loca
+      type(psb_sspmat_type), intent(out)   :: globa
+      type(psb_desc_type), intent(in) :: desc_a
+      integer, intent(out)            :: info
+      integer, intent(in), optional   :: root,dupl
+      logical, intent(in), optional   :: keepnum,keeploc
+    end subroutine psb_ssp_allgather
+    subroutine  psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+      use psb_descriptor_type
+      use psb_mat_mod
+      implicit none
+      type(psb_zspmat_type), intent(inout) :: loca
+      type(psb_zspmat_type), intent(out)   :: globa
+      type(psb_desc_type), intent(in) :: desc_a
+      integer, intent(out)            :: info
+      integer, intent(in), optional   :: root,dupl
+      logical, intent(in), optional   :: keepnum,keeploc
+    end subroutine psb_zsp_allgather
+    subroutine  psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
+      use psb_descriptor_type
+      use psb_mat_mod
+      implicit none
+      type(psb_cspmat_type), intent(inout) :: loca
+      type(psb_cspmat_type), intent(out)   :: globa
+      type(psb_desc_type), intent(in) :: desc_a
+      integer, intent(out)            :: info
+      integer, intent(in), optional   :: root,dupl
+      logical, intent(in), optional   :: keepnum,keeploc
+    end subroutine psb_csp_allgather
     subroutine  psb_igatherm(globx, locx, desc_a, info, root)
       use psb_descriptor_type
       integer, intent(in)             :: locx(:,:)

test/serial/d_matgen.f03

@@ -1,11 +1,10 @@
 !
 program d_matgen
   use psb_sparse_mod
-!!$  use psb_prec_mod
-!!$  use psb_krylov_mod
   use psb_d_base_mat_mod
   use psb_d_csr_mat_mod
   use psb_d_mat_mod
+  use psb_d_cxx_mat_mod
   implicit none
 
   ! input parameters
@@ -31,6 +30,7 @@ program d_matgen
   integer            :: iter, itmax,itrace, istopc, irst
   integer(psb_long_int_k_) :: amatsize, precsize, descsize
   real(psb_dpk_)   :: err, eps
+  class(psb_d_cxx_sparse_mat), allocatable :: acxx
 
   ! other variables
   integer            :: info, err_act
@@ -61,7 +61,7 @@ program d_matgen
   !
   call psb_barrier(ictxt)
   t1 = psb_wtime()
-  call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info)  
+  call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acxx)  
   call psb_barrier(ictxt)
   t2 = psb_wtime() - t1
   if(info /= psb_success_) then
@@ -121,7 +121,7 @@ contains
   !  subroutine to allocate and fill in the coefficient matrix and
   !  the rhs. 
   !
-  subroutine create_matrix(idim,a,b,xv,desc_a,ictxt,afmt,info)
+  subroutine create_matrix(idim,a,b,xv,desc_a,ictxt,afmt,info,mold)
     !
     !   discretize the partial diferential equation
     ! 
@@ -139,12 +139,12 @@ contains
     ! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation.
     !
     use psb_sparse_mod
-    use psb_d_cxx_mat_mod
     implicit none
     integer                        :: idim
     integer, parameter             :: nb=20
     real(psb_dpk_), allocatable    :: b(:),xv(:)
     type(psb_desc_type)            :: desc_a
+    class(psb_d_base_sparse_mat), allocatable :: mold
     integer                        :: ictxt, info
     character                      :: afmt*5
     type(psb_dspmat_type)    :: a
@@ -158,7 +158,6 @@ contains
     type(psb_dspmat_type)     :: a_n
     class(psb_d_coo_sparse_mat), allocatable :: acoo
     class(psb_d_csr_sparse_mat), allocatable :: acsr
-    class(psb_d_cxx_sparse_mat), allocatable :: acxx
     ! deltah dimension of each grid cell
     ! deltat discretization time
     real(psb_dpk_)         :: deltah, anorm
@@ -170,7 +169,6 @@ contains
 
     character(len=20)  :: name, ch_err
 
-    allocate(psb_d_cxx_sparse_mat :: acxx)
     allocate(psb_d_csr_sparse_mat :: acsr)
     info = psb_success_
     name = 'create_matrix'
@@ -373,7 +371,7 @@ contains
     end if
 !!$    call a_n%print(19)
     t1 = psb_wtime()
-    call a_n%cscnv(info,mold=acxx)
+    call a_n%cscnv(info,mold=mold)
 
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_