psblas3-integer8:

base/modules/parts.fh
 base/modules/psb_const_mod.F90
 base/modules/psi_bcast_mod.F90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cd_inloc.f90
 base/tools/psb_cdall.f90
 base/tools/psb_cdals.f90
 base/tools/psb_cdalv.f90
 base/tools/psb_cdrep.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_scdbldext.F90
 base/tools/psb_zcdbldext.F90

Added broadcasts with handling of ICTXT. 
Advance in tools.

base/modules/parts.fh

@@ -1,7 +1,8 @@
 interface 
    !.....user passed subroutine.....
    subroutine parts(glob_index,nrow,np,pv,nv)
-     integer, intent (in)  :: glob_index,np,nrow
-     integer, intent (out) :: nv, pv(*)
+     import :: psb_ipk_
+     integer(psb_ipk_), intent (in)  :: glob_index,np,nrow
+     integer(psb_ipk_), intent (out) :: nv, pv(*)
    end subroutine parts
 end interface

base/modules/psb_const_mod.F90

@@ -59,16 +59,17 @@ module psb_const_mod
   ! 
   ! Version
   !
-  character(len=*), parameter :: psb_version_string_ = "3.0.0"
-  integer(psb_ipk_), parameter          :: psb_version_major_  = 3
-  integer(psb_ipk_), parameter          :: psb_version_minor_  = 0
-  integer(psb_ipk_), parameter          :: psb_patchlevel_     = 0
+  character(len=*), parameter    :: psb_version_string_ = "3.0.0"
+  integer(psb_ipk_), parameter   :: psb_version_major_  = 3
+  integer(psb_ipk_), parameter   :: psb_version_minor_  = 0
+  integer(psb_ipk_), parameter   :: psb_patchlevel_     = 0
 
   !
   !     Handy & miscellaneous constants
   !
-  integer(psb_ipk_), parameter             :: izero=0, ione=1
-  integer(psb_ipk_), parameter             :: itwo=2, ithree=3,mone=-1, psb_root_=0
+  integer(psb_ipk_), parameter   :: izero=0, ione=1
+  integer(psb_ipk_), parameter   :: itwo=2, ithree=3,mone=-1
+  integer(psb_ipk_), parameter   :: psb_root_=0
   real(psb_spk_), parameter      :: szero=0.e0, sone=1.e0
   real(psb_dpk_), parameter      :: dzero=0.d0, done=1.d0
   complex(psb_spk_), parameter   :: czero=(0.e0,0.0e0)

base/modules/psi_bcast_mod.F90

@@ -9,8 +9,25 @@ module psi_bcast_mod
          & psb_zbcasts, psb_zbcastv, psb_zbcastm,&
          & psb_sbcasts, psb_sbcastv, psb_sbcastm,&
          & psb_cbcasts, psb_cbcastv, psb_cbcastm,&
-         & psb_hbcasts, psb_hbcastv, psb_lbcasts, psb_lbcastv
-  end interface
+         & psb_hbcasts, psb_hbcastv,&
+         & psb_lbcasts, psb_lbcastv
+  end interface psb_bcast
+
+#if defined(LONG_INTEGERS)
+  interface psb_bcast
+    module procedure psb_ibcasts_ic, psb_ibcastv_ic, psb_ibcastm_ic,&
+         & psb_dbcasts_ic, psb_dbcastv_ic, psb_dbcastm_ic,&
+         & psb_zbcasts_ic, psb_zbcastv_ic, psb_zbcastm_ic,&
+         & psb_sbcasts_ic, psb_sbcastv_ic, psb_sbcastm_ic,&
+         & psb_cbcasts_ic, psb_cbcastv_ic, psb_cbcastm_ic,&
+         & psb_hbcasts_ic, psb_hbcastv_ic, &
+         & psb_lbcasts_ic, psb_lbcastv_ic
+  end interface psb_bcast
+#else 
+  interface psb_bcast
+    module procedure psb_i8bcasts, psb_i8bcastv, psb_i8bcastm
+  end interface psb_bcast
+#endif
 
 contains
 
@@ -535,4 +552,420 @@ contains
 
   end subroutine psb_lbcastv
 
+
+#if !defined(LONG_INTEGERS)
+
+  subroutine psb_i8bcasts(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_long_int_k_), intent(inout)   :: dat
+    integer(psb_mpik_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iam, np, root_,  info
+
+#if !defined(SERIAL_MPI)
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+
+    call psb_info(ictxt,iam,np)
+    call mpi_bcast(dat,1,mpi_integer8,root_,ictxt,info)
+#endif    
+  end subroutine psb_i8bcasts
+
+  subroutine psb_i8bcastv(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_long_int_k_), intent(inout) :: dat(:)
+    integer(psb_mpik_), intent(in), optional  :: root
+
+    integer(psb_mpik_) :: iam, np, root_,  info
+#if !defined(SERIAL_MPI)
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+
+    call psb_info(ictxt,iam,np)
+    call mpi_bcast(dat,size(dat),mpi_integer8,root_,ictxt,info)
+#endif    
+  end subroutine psb_ibcastv
+
+  subroutine psb_ibcastm(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_long_int_k_), intent(inout) :: dat(:,:)
+    integer(psb_mpik_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iam, np, root_,  info
+
+#if !defined(SERIAL_MPI)
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+
+    call psb_info(ictxt,iam,np)
+    call mpi_bcast(dat,size(dat),mpi_integer8,root_,ictxt,info)
+#endif    
+  end subroutine psb_ibcastm
+
+#endif
+
+
+#if defined(LONG_INTEGERS)
+
+  subroutine psb_ibcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)      :: ictxt
+    integer(psb_ipk_), intent(inout)   :: dat
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_ibcasts_ic
+
+  subroutine psb_ibcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    integer(psb_ipk_), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional  :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_ibcastv_ic
+
+  subroutine psb_ibcastm_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    integer(psb_ipk_), intent(inout) :: dat(:,:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_ibcastm_ic
+
+
+  subroutine psb_sbcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)      :: ictxt
+    real(psb_spk_), intent(inout)   :: dat
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_sbcasts_ic
+
+
+  subroutine psb_sbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    real(psb_spk_), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_sbcastv_ic
+
+  subroutine psb_sbcastm_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    real(psb_spk_), intent(inout) :: dat(:,:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_sbcastm_ic
+
+
+  subroutine psb_dbcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)      :: ictxt
+    real(psb_dpk_), intent(inout)   :: dat
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_dbcasts_ic
+
+
+  subroutine psb_dbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    real(psb_dpk_), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_dbcastv_ic
+
+  subroutine psb_dbcastm_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    real(psb_dpk_), intent(inout) :: dat(:,:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_dbcastm_ic
+
+  subroutine psb_cbcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)      :: ictxt
+    complex(psb_spk_), intent(inout)   :: dat
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_cbcasts_ic
+
+  subroutine psb_cbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    complex(psb_spk_), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_cbcastv_ic
+
+  subroutine psb_cbcastm_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    complex(psb_spk_), intent(inout) :: dat(:,:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_cbcastm_ic
+
+  subroutine psb_zbcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)      :: ictxt
+    complex(psb_dpk_), intent(inout)   :: dat
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_zbcasts_ic
+
+  subroutine psb_zbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    complex(psb_dpk_), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_zbcastv_ic
+
+  subroutine psb_zbcastm_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)    :: ictxt
+    complex(psb_dpk_), intent(inout) :: dat(:,:)
+    integer(psb_ipk_), intent(in), optional :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_zbcastm_ic
+
+
+  subroutine psb_hbcasts_ic(ictxt,dat,root,length)
+    implicit none 
+    integer(psb_ipk_), intent(in)             :: ictxt
+    character(len=*), intent(inout) :: dat
+    integer(psb_ipk_), intent(in), optional   :: root,length
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_hbcasts_ic
+
+  subroutine psb_hbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)             :: ictxt
+    character(len=*), intent(inout) :: dat(:)
+    integer(psb_ipk_), intent(in), optional   :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_hbcastv_ic
+
+  subroutine psb_lbcasts_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)             :: ictxt
+    logical, intent(inout)          :: dat
+    integer(psb_ipk_), intent(in), optional   :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_lbcasts_ic
+
+
+  subroutine psb_lbcastv_ic(ictxt,dat,root)
+    implicit none 
+    integer(psb_ipk_), intent(in)             :: ictxt
+    logical, intent(inout)          :: dat(:)
+    integer(psb_ipk_), intent(in), optional   :: root
+
+    integer(psb_mpik_) :: iictxt, root_
+
+    iictxt = ictxt 
+    if (present(root)) then
+      root_ = root
+    else
+      root_ = psb_root_
+    endif
+    call psb_bcast(iictxt,dat,root_)
+  end subroutine psb_lbcastv_ic
+#endif
+
+
 end module psi_bcast_mod

base/tools/psb_ccdbldext.F90

@@ -80,16 +80,15 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
   integer(psb_ipk_), intent(out)                    :: info
   integer(psb_ipk_), intent(in),optional            :: extype
 
-
   !     .. Local Scalars ..
-  integer(psb_ipk_) ::  i, j, np, me,m,&
-       &  ictxt, lovr, lworks,lworkr, n_row,n_col, n_col_prev, int_err(5),&
+  integer(psb_ipk_) ::  i, j, err_act,m,&
+       &  lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
        &  index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
   integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
        & n_elem_send,tot_recv,tot_elem,cntov_o,&
        & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
        & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
-  integer(psb_ipk_) :: icomm, err_act
+  integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
 
   integer(psb_ipk_), allocatable  :: irow(:), icol(:)
   integer(psb_ipk_), allocatable  :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
@@ -97,14 +96,21 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
        & t_halo_out(:),temp(:),maskr(:)
   integer(psb_ipk_),allocatable  :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
   integer(psb_ipk_) :: debug_level, debug_unit
-  character(len=20)    :: name, ch_err
+  integer(psb_ipk_) :: ierr(5)
+  character(len=20) :: name, ch_err
 
   name='psb_ccdbldext'
   info  = psb_success_
+  if (psb_errstatus_fatal()) return
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()
   Call psb_info(ictxt, me, np)
@@ -125,17 +131,17 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (novr<0) then
     info=psb_err_iarg_neg_
-    int_err(1)=1
-    int_err(2)=novr
-    call psb_errpush(info,name,i_err=int_err)
+    ierr(1)=1; ierr(2)=novr
+    call psb_errpush(info,name,i_err=ierr)
     goto 9999
   endif
 
   select case(extype_) 
   case(psb_ovt_xhal_,psb_ovt_asov_)
   case default
+    ierr(1)=5; ierr(2)=extype_
     call psb_errpush(psb_err_input_value_invalid_i_,&
-         & name,i_err=(/5,extype_,0,0,0/))
+         & name,i_err=ierr)
     goto 9999
   end select
 
@@ -144,10 +150,10 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
        & ': Calling desccpy'
 
   call psb_cdcpy(desc_a,desc_ov,info)
-  if (info /= psb_success_) then
+
+  if (psb_errstatus_fatal()) then
     info=psb_err_from_subroutine_
-    ch_err='psb_cdcpy'
-    call psb_errpush(info,name,a_err=ch_err)
+    call psb_errpush(info,name,a_err='psb_cdcpy')
     goto 9999
   end if
 
@@ -220,15 +226,12 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   Allocate(works(lworks),workr(lworkr),t_halo_in(l_tmp_halo),&
        & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
-  if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-    goto 9999      
-  end if
-
-  Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),&
+  if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
+       & tmp_ovr_idx(l_tmp_ovr_idx), &
        & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
+
   if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    call psb_errpush(psb_err_alloc_dealloc_,name)
     goto 9999      
   end if
   halo(:)        = desc_a%halo_index(:)
@@ -257,7 +260,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
         call psb_errpush(info,name)
         goto 9999
       endif
-      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-1)
+      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -358,7 +361,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -370,7 +373,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
         tmp_ovr_idx(counter_o+2) = gidx
         tmp_ovr_idx(counter_o+3) = -1
         counter_o=counter_o+3
-        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1)
+        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -402,7 +405,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -464,11 +467,10 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
       ! accumulated RECV requests, we have an all-to-all to build
       ! matchings SENDs.
       !       
-      call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoall'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoall')
         goto 9999
       end if
       idxs = 0
@@ -491,21 +493,20 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
       iszr=sum(rvsz)
       if (max(iszr,1) > lworkr) then 
         call psb_realloc(max(iszr,1),workr,info)
-        if (info /= psb_success_) then
-          info=psb_err_from_subroutine_
-          ch_err='psb_realloc'
-          call psb_errpush(info,name,a_err=ch_err)
+
+        if (psb_errstatus_fatal()) then
+          info=psb_err_alloc_dealloc_
+          call psb_errpush(info,name)
           goto 9999
         end if
         lworkr = max(iszr,1)
       end if
 
       call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
-           & workr,rvsz,brvindx,psb_mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+           & workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoallv'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoallv')
         goto 9999
       end if
 
@@ -561,7 +562,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
           !
           proc_id = temp(i) 
           
-          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-1)
+          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-ione)
           if (info /= psb_success_) then
             info=psb_err_from_subroutine_
             call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -622,7 +623,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     !
     call psb_move_alloc(orig_ovr,desc_ov%ovrlap_index,info)
-    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-1)
+    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -649,7 +650,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     ! 
     call desc_ov%indxmap%set_lr(n_col_prev)
-    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-1)
+    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -667,7 +668,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
     call psb_move_alloc(tmp_halo,desc_ov%ext_index,info)
     call psb_move_alloc(t_halo_in,desc_ov%halo_index,info)
   case default
-    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/5,extype_,0,0,0/))
+    ierr(1)=5; ierr(2)=extype_
+    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
     goto 9999
   end select
 
@@ -693,10 +695,12 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (info == psb_success_)  then 
     if (allocated(irow)) deallocate(irow,stat=info)
-    if ((info == psb_success_).and.allocated(icol)) deallocate(icol,stat=info)
+    if ((info == psb_success_).and.allocated(icol)) &
+         & deallocate(icol,stat=info)
     if (info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_ai_,name,&
-           & a_err='deallocate',i_err=(/info,0,0,0,0/))
+      ierr(1) = info
+      call psb_errpush(psb_err_from_subroutine_ai_,name, &
+           & a_err='deallocate',i_err=ierr)
       goto 9999
     end if
   end if

base/tools/psb_cd_inloc.f90

@@ -62,9 +62,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
   integer(psb_ipk_) :: int_err(5),exch(3)
   integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), vl(:),&
        & nov(:), ov_idx(:,:)
-  integer(psb_ipk_) :: debug_level, debug_unit
-  logical              :: check_, islarge
-  character(len=20)    :: name
+  integer(psb_ipk_)  :: debug_level, debug_unit
+  integer(psb_mpik_) :: iictxt
+  logical            :: check_, islarge
+  character(len=20)  :: name
 
   if(psb_get_errstatus() /= 0) return 
   info=psb_success_
@@ -77,7 +78,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
   call psb_info(ictxt, me, np)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': start',np
-
+  iictxt = ictxt
 
   loc_row = size(v)
   if (.false.) then 
@@ -325,7 +326,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
           if (ov_idx(j,1) == i) exit
           j = j + 1 
         end do
-        call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1)
+        call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -353,9 +354,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
 
   select type(aa => desc%indxmap) 
   type is (psb_repl_map) 
-    call aa%repl_map_init(ictxt,m,info)
+    call aa%repl_map_init(iictxt,m,info)
   class default 
-    call aa%init(ictxt,vl(1:nlu),info)
+    call aa%init(iictxt,vl(1:nlu),info)
   end select
 
   call psi_bld_tmpovrl(temp_ovrlap,desc,info)
@@ -371,31 +372,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
     goto 9999
   endif
 
-!!$  ! set fields in desc%MATRIX_DATA....
-!!$  desc%matrix_data(psb_n_row_)  = loc_row
-!!$  desc%matrix_data(psb_n_col_)  = loc_row
-
-!!$  call psb_realloc(max(1,loc_row/2),desc%halo_index, info)
-!!$  if (info == psb_success_) call psb_realloc(1,desc%ext_index, info)
-!!$  if (info /= psb_success_) then
-!!$    info=psb_err_from_subroutine_
-!!$    call psb_errpush(info,name,a_err='psb_realloc')
-!!$    Goto 9999
-!!$  end if
-!!$  desc%matrix_data(psb_pnt_h_) = 1
-!!$  desc%halo_index(:)           = -1
-!!$  desc%ext_index(:)            = -1
-!!$
-!!$  if (debug_level >= psb_debug_ext_) &
-!!$       & write(debug_unit,*) me,' ',trim(name),': end'
-!!$
-!!$  call psb_cd_set_bld(desc,info)
-!!$  if (info /= psb_success_) then
-!!$    info=psb_err_from_subroutine_
-!!$    call psb_errpush(info,name,a_err='psb_cd_set_bld')
-!!$    Goto 9999
-!!$  end if
-
   call psb_erractionrestore(err_act)
   return
 

base/tools/psb_cdall.f90

@@ -49,8 +49,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
   character(len=20)   :: name
   integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
   integer(psb_ipk_), allocatable :: itmpsz(:) 
-
-
+  integer(psb_mpik_) :: iictxt
+ 
+  
 
   if (psb_get_errstatus() /= 0) return 
   info=psb_success_
@@ -58,7 +59,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
   call psb_erractionsave(err_act)
 
   call psb_info(ictxt, me, np)
-
+  iictxt  = ictxt
   if (count((/ present(vg),present(vl),&
        &  present(parts),present(nl), present(repl) /)) /= 1) then 
     info=psb_err_no_optional_arg_
@@ -137,9 +138,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche
     if (info == psb_success_) then 
       select type(aa => desc%indxmap) 
       type is (psb_repl_map) 
-        call aa%repl_map_init(ictxt,nl,info)
+        call aa%repl_map_init(iictxt,nl,info)
       type is (psb_gen_block_map) 
-        call aa%gen_block_map_init(ictxt,nl,info)
+        call aa%gen_block_map_init(iictxt,nl,info)
       class default 
         ! This cannot happen 
         info = psb_err_internal_error_

base/tools/psb_cdals.f90

@@ -62,6 +62,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
   integer(psb_ipk_) :: int_err(5),exch(3)
   integer(psb_ipk_), allocatable  :: prc_v(:), temp_ovrlap(:), loc_idx(:) 
   integer(psb_ipk_) :: debug_level, debug_unit
+  integer(psb_mpik_) :: iictxt
   character(len=20)    :: name
 
   if(psb_get_errstatus() /= 0) return 
@@ -76,21 +77,20 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
   call psb_info(ictxt, me, np)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': ',np
+  iictxt = ictxt 
   !     ....verify blacs grid correctness..
-
+  
   !... check m and n parameters....
   if (m < 1) then
     info = psb_err_iarg_neg_
     err=info
-    int_err(1) = 1
-    int_err(2) = m
+    int_err(1) = 1; int_err(2) = m;
     call psb_errpush(err,name,int_err)
     goto 9999
   else if (n < 1) then
     info = psb_err_iarg_neg_
     err=info
-    int_err(1) = 2
-    int_err(2) = n
+    int_err(1) = 2 ;     int_err(2) = n;
     call psb_errpush(err,name,int_err)
     goto 9999
   endif
@@ -100,9 +100,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
        & write(debug_unit,*) me,' ',trim(name),':  doing global checks'  
   !global check on m and n parameters
   if (me == psb_root_) then
-    exch(1)=m
-    exch(2)=n
-    exch(3)=psb_cd_get_large_threshold()
+    exch(1)=m; exch(2)=n; exch(3)=psb_cd_get_large_threshold()
     call psb_bcast(ictxt,exch(1:3),root=psb_root_)
   else
     call psb_bcast(ictxt,exch(1:3),root=psb_root_)
@@ -125,9 +123,6 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
   ! count local rows number
   loc_row = max(1,(m+np-1)/np) 
   ! allocate work vector
-!!$  allocate(desc%matrix_data(psb_mdata_size_),&
-!!$       & temp_ovrlap(max(1,2*loc_row)), prc_v(np),stat=info)
-!!$  desc%matrix_data(:) = 0
   allocate(temp_ovrlap(max(1,2*loc_row)), prc_v(np),stat=info)
 
   if (info /= psb_success_) then     
@@ -229,7 +224,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
         if (prc_v(j) == me) then
           ! this point belongs to me
           k = k + 1 
-          call psb_ensure_size((k+1),loc_idx,info,pad=-1)
+          call psb_ensure_size((k+1),loc_idx,info,pad=-ione)
           if (info /= psb_success_) then
             info=psb_err_from_subroutine_
             call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -238,7 +233,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
           loc_idx(k) = i 
 
           if (nprocs > 1)  then
-            call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1)
+            call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-ione)
             if (info /= psb_success_) then
               info=psb_err_from_subroutine_
               call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -269,9 +264,9 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
 
   select type(aa => desc%indxmap) 
   type is (psb_repl_map) 
-    call aa%repl_map_init(ictxt,m,info)
+    call aa%repl_map_init(iictxt,m,info)
   class default 
-    call aa%init(ictxt,loc_idx(1:k),info)
+    call aa%init(iictxt,loc_idx(1:k),info)
   end select
 
 
@@ -289,16 +284,6 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
     Goto 9999
   endif
 
-!!$  ! set fields in desc%MATRIX_DATA....
-!!$  desc%matrix_data(psb_n_row_)  = loc_row
-!!$  desc%matrix_data(psb_n_col_)  = loc_row
-
-!!$  write(0,*) me,'CDALS: after init ', &
-!!$       & desc%indxmap%get_gr(), &
-!!$       & desc%indxmap%get_gc(), &
-!!$       & desc%indxmap%get_lr(), &
-!!$       & desc%indxmap%get_lc() 
-
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': end'
 

base/tools/psb_cdalv.f90

@@ -63,7 +63,8 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
   integer(psb_ipk_) :: int_err(5),exch(3)
   integer(psb_ipk_), allocatable  :: temp_ovrlap(:)
   integer(psb_ipk_) :: debug_level, debug_unit
-  character(len=20)   :: name
+  integer(psb_mpik_) :: iictxt
+  character(len=20)  :: name
 
   if(psb_get_errstatus() /= 0) return 
   debug_unit  = psb_get_debug_unit()
@@ -75,7 +76,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
   call psb_info(ictxt, me, np)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': ',np,me
-
+  iictxt = ictxt 
   m = size(v)
   n = m
   !... check m and n parameters....
@@ -189,11 +190,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
 
   select type(aa => desc%indxmap) 
   type is (psb_repl_map) 
-    call aa%repl_map_init(ictxt,m,info)
+    call aa%repl_map_init(iictxt,m,info)
   type is (psb_hash_map) 
-    call aa%hash_map_init(ictxt,v,info)
+    call aa%hash_map_init(iictxt,v,info)
   type is (psb_glist_map) 
-    call aa%glist_map_init(ictxt,v,info)
+    call aa%glist_map_init(iictxt,v,info)
   class default 
       ! This cannot happen 
     info = psb_err_internal_error_

base/tools/psb_cdrep.f90

@@ -115,6 +115,7 @@ subroutine psb_cdrep(m, ictxt, desc, info)
   integer(psb_ipk_) :: i,np,me,err,n,err_act
   integer(psb_ipk_) :: int_err(5),exch(2), thalo(1), tovr(1), text(1)
   integer(psb_ipk_) :: debug_level, debug_unit
+  integer(psb_mpik_) :: iictxt
   character(len=20)   :: name
 
   if(psb_get_errstatus() /= 0) return 
@@ -127,7 +128,7 @@ subroutine psb_cdrep(m, ictxt, desc, info)
   call psb_info(ictxt, me, np)
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': ',np
-
+  iictxt = ictxt
   n = m
   !... check m and n parameters....
   if (m < 1) then
@@ -197,7 +198,7 @@ subroutine psb_cdrep(m, ictxt, desc, info)
   allocate(psb_repl_map :: desc%indxmap, stat=info)
   select type(aa => desc%indxmap) 
   type is (psb_repl_map) 
-    call aa%repl_map_init(ictxt,m,info)
+    call aa%repl_map_init(iictxt,m,info)
   class default 
     ! This cannot happen 
     info = psb_err_internal_error_
@@ -208,8 +209,6 @@ subroutine psb_cdrep(m, ictxt, desc, info)
 
   tovr  = -1 
   call psi_bld_tmpovrl(tovr,desc,info)
-!!$  desc%matrix_data(psb_dec_type_) = psb_desc_bld_
-  
 
   if (debug_level >= psb_debug_ext_) &
        & write(debug_unit,*) me,' ',trim(name),': end'

base/tools/psb_dcdbldext.F90

@@ -29,9 +29,9 @@
 !!$  POSSIBILITY OF SUCH DAMAGE.
 !!$ 
 !!$  
-! File: psb_cdbldext.f90
+! File: psb_dcdbldext.f90
 !
-! Subroutine: psb_cdbldext
+! Subroutine: psb_dcdbldext
 !    This routine takes a matrix A with its descriptor, and builds the 
 !    auxiliary descriptor corresponding to the number of overlap levels
 !    specified on input. 
@@ -73,22 +73,22 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
 #endif
 
   !     .. Array Arguments ..
-  integer(psb_ipk_), intent(in)                     :: novr
-  Type(psb_dspmat_type), Intent(in)       :: a
+  integer(psb_ipk_), intent(in)                      :: novr
+  Type(psb_dspmat_type), Intent(in)       ::  a
   Type(psb_desc_type), Intent(in), target :: desc_a
   Type(psb_desc_type), Intent(out)        :: desc_ov
   integer(psb_ipk_), intent(out)                    :: info
   integer(psb_ipk_), intent(in),optional            :: extype
 
   !     .. Local Scalars ..
-  integer(psb_ipk_) ::  i, j, np, me,m,&
-       &  ictxt, lovr, lworks,lworkr, n_row,n_col, n_col_prev, int_err(5),&
+  integer(psb_ipk_) ::  i, j, err_act,m,&
+       &  lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
        &  index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
   integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
        & n_elem_send,tot_recv,tot_elem,cntov_o,&
        & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
        & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
-  integer(psb_ipk_) :: icomm, err_act
+  integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
 
   integer(psb_ipk_), allocatable  :: irow(:), icol(:)
   integer(psb_ipk_), allocatable  :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
@@ -96,7 +96,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
        & t_halo_out(:),temp(:),maskr(:)
   integer(psb_ipk_),allocatable  :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
   integer(psb_ipk_) :: debug_level, debug_unit
-  character(len=20)    :: name, ch_err
+  integer(psb_ipk_) :: ierr(5)
+  character(len=20) :: name, ch_err
 
   name='psb_dcdbldext'
   info  = psb_success_
@@ -130,17 +131,17 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (novr<0) then
     info=psb_err_iarg_neg_
-    int_err(1)=1
-    int_err(2)=novr
-    call psb_errpush(info,name,i_err=int_err)
+    ierr(1)=1; ierr(2)=novr
+    call psb_errpush(info,name,i_err=ierr)
     goto 9999
   endif
 
   select case(extype_) 
   case(psb_ovt_xhal_,psb_ovt_asov_)
   case default
+    ierr(1)=5; ierr(2)=extype_
     call psb_errpush(psb_err_input_value_invalid_i_,&
-         & name,i_err=(/5,extype_,0,0,0/))
+         & name,i_err=ierr)
     goto 9999
   end select
 
@@ -259,8 +260,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
         call psb_errpush(info,name)
         goto 9999
       endif
-      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-1)
-
+      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -361,7 +361,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -373,8 +373,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
         tmp_ovr_idx(counter_o+2) = gidx
         tmp_ovr_idx(counter_o+3) = -1
         counter_o=counter_o+3
-        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1)
-
+        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -406,7 +405,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -468,14 +467,12 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
       ! accumulated RECV requests, we have an all-to-all to build
       ! matchings SENDs.
       !       
-      call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
-
-      if (info /= psb_success_) then
+      call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='mpi_alltoall')
         goto 9999
       end if
-
       idxs = 0
       idxr = 0
       counter = 1
@@ -505,9 +502,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
         lworkr = max(iszr,1)
       end if
 
-      call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,&
-           & workr,rvsz,brvindx,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
+           & workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='mpi_alltoallv')
         goto 9999
@@ -517,7 +514,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
            & write(debug_unit,*) me,' ',trim(name),': ISZR :',iszr
 
       call psb_ensure_size(iszr,maskr,info)
-
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -566,7 +562,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
           !
           proc_id = temp(i) 
           
-          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-1)
+          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-ione)
           if (info /= psb_success_) then
             info=psb_err_from_subroutine_
             call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -627,7 +623,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     !
     call psb_move_alloc(orig_ovr,desc_ov%ovrlap_index,info)
-    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-1)
+    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -654,7 +650,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     ! 
     call desc_ov%indxmap%set_lr(n_col_prev)
-    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-1)
+    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -672,7 +668,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
     call psb_move_alloc(tmp_halo,desc_ov%ext_index,info)
     call psb_move_alloc(t_halo_in,desc_ov%halo_index,info)
   case default
-    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/5,extype_,0,0,0/))
+    ierr(1)=5; ierr(2)=extype_
+    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
     goto 9999
   end select
 
@@ -698,10 +695,12 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (info == psb_success_)  then 
     if (allocated(irow)) deallocate(irow,stat=info)
-    if ((info == psb_success_).and.allocated(icol)) deallocate(icol,stat=info)
+    if ((info == psb_success_).and.allocated(icol)) &
+         & deallocate(icol,stat=info)
     if (info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_ai_,name,&
-           & a_err='deallocate',i_err=(/info,0,0,0,0/))
+      ierr(1) = info
+      call psb_errpush(psb_err_from_subroutine_ai_,name, &
+           & a_err='deallocate',i_err=ierr)
       goto 9999
     end if
   end if

base/tools/psb_scdbldext.F90

@@ -29,9 +29,9 @@
 !!$  POSSIBILITY OF SUCH DAMAGE.
 !!$ 
 !!$  
-! File: psb_cdbldext.f90
+! File: psb_scdbldext.f90
 !
-! Subroutine: psb_cdbldext
+! Subroutine: psb_scdbldext
 !    This routine takes a matrix A with its descriptor, and builds the 
 !    auxiliary descriptor corresponding to the number of overlap levels
 !    specified on input. 
@@ -73,7 +73,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
 #endif
 
   !     .. Array Arguments ..
-  integer(psb_ipk_), intent(in)                     :: novr
+  integer(psb_ipk_), intent(in)                      :: novr
   Type(psb_sspmat_type), Intent(in)       ::  a
   Type(psb_desc_type), Intent(in), target :: desc_a
   Type(psb_desc_type), Intent(out)        :: desc_ov
@@ -81,14 +81,14 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
   integer(psb_ipk_), intent(in),optional            :: extype
 
   !     .. Local Scalars ..
-  integer(psb_ipk_) ::  i, j, np, me,m,&
-       &  ictxt, lovr, lworks,lworkr, n_row,n_col, n_col_prev, int_err(5),&
+  integer(psb_ipk_) ::  i, j, err_act,m,&
+       &  lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
        &  index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
   integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
        & n_elem_send,tot_recv,tot_elem,cntov_o,&
        & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
        & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
-  integer(psb_ipk_) :: icomm, err_act
+  integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
 
   integer(psb_ipk_), allocatable  :: irow(:), icol(:)
   integer(psb_ipk_), allocatable  :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
@@ -96,14 +96,21 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
        & t_halo_out(:),temp(:),maskr(:)
   integer(psb_ipk_),allocatable  :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
   integer(psb_ipk_) :: debug_level, debug_unit
-  character(len=20)    :: name, ch_err
+  integer(psb_ipk_) :: ierr(5)
+  character(len=20) :: name, ch_err
 
   name='psb_scdbldext'
   info  = psb_success_
+  if (psb_errstatus_fatal()) return
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()
   Call psb_info(ictxt, me, np)
@@ -124,17 +131,17 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (novr<0) then
     info=psb_err_iarg_neg_
-    int_err(1)=1
-    int_err(2)=novr
-    call psb_errpush(info,name,i_err=int_err)
+    ierr(1)=1; ierr(2)=novr
+    call psb_errpush(info,name,i_err=ierr)
     goto 9999
   endif
 
   select case(extype_) 
   case(psb_ovt_xhal_,psb_ovt_asov_)
   case default
+    ierr(1)=5; ierr(2)=extype_
     call psb_errpush(psb_err_input_value_invalid_i_,&
-         & name,i_err=(/5,extype_,0,0,0/))
+         & name,i_err=ierr)
     goto 9999
   end select
 
@@ -143,10 +150,10 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
        & ': Calling desccpy'
 
   call psb_cdcpy(desc_a,desc_ov,info)
-  if (info /= psb_success_) then
+
+  if (psb_errstatus_fatal()) then
     info=psb_err_from_subroutine_
-    ch_err='psb_cdcpy'
-    call psb_errpush(info,name,a_err=ch_err)
+    call psb_errpush(info,name,a_err='psb_cdcpy')
     goto 9999
   end if
 
@@ -219,15 +226,12 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   Allocate(works(lworks),workr(lworkr),t_halo_in(l_tmp_halo),&
        & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
-  if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-    goto 9999      
-  end if
-
-  Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),&
+  if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
+       & tmp_ovr_idx(l_tmp_ovr_idx), &
        & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
+
   if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    call psb_errpush(psb_err_alloc_dealloc_,name)
     goto 9999      
   end if
   halo(:)        = desc_a%halo_index(:)
@@ -256,7 +260,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
         call psb_errpush(info,name)
         goto 9999
       endif
-      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-1)
+      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -357,7 +361,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -369,7 +373,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
         tmp_ovr_idx(counter_o+2) = gidx
         tmp_ovr_idx(counter_o+3) = -1
         counter_o=counter_o+3
-        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1)
+        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -401,7 +405,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -463,11 +467,10 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
       ! accumulated RECV requests, we have an all-to-all to build
       ! matchings SENDs.
       !       
-      call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoall'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoall')
         goto 9999
       end if
       idxs = 0
@@ -490,21 +493,20 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
       iszr=sum(rvsz)
       if (max(iszr,1) > lworkr) then 
         call psb_realloc(max(iszr,1),workr,info)
-        if (info /= psb_success_) then
-          info=psb_err_from_subroutine_
-          ch_err='psb_realloc'
-          call psb_errpush(info,name,a_err=ch_err)
+
+        if (psb_errstatus_fatal()) then
+          info=psb_err_alloc_dealloc_
+          call psb_errpush(info,name)
           goto 9999
         end if
         lworkr = max(iszr,1)
       end if
 
-      call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,&
-           & workr,rvsz,brvindx,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
+           & workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoallv'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoallv')
         goto 9999
       end if
 
@@ -560,7 +562,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
           !
           proc_id = temp(i) 
           
-          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-1)
+          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-ione)
           if (info /= psb_success_) then
             info=psb_err_from_subroutine_
             call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -621,7 +623,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     !
     call psb_move_alloc(orig_ovr,desc_ov%ovrlap_index,info)
-    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-1)
+    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -648,7 +650,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     ! 
     call desc_ov%indxmap%set_lr(n_col_prev)
-    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-1)
+    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -666,7 +668,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
     call psb_move_alloc(tmp_halo,desc_ov%ext_index,info)
     call psb_move_alloc(t_halo_in,desc_ov%halo_index,info)
   case default
-    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/5,extype_,0,0,0/))
+    ierr(1)=5; ierr(2)=extype_
+    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
     goto 9999
   end select
 
@@ -692,10 +695,12 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (info == psb_success_)  then 
     if (allocated(irow)) deallocate(irow,stat=info)
-    if ((info == psb_success_).and.allocated(icol)) deallocate(icol,stat=info)
+    if ((info == psb_success_).and.allocated(icol)) &
+         & deallocate(icol,stat=info)
     if (info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_ai_,name,&
-           & a_err='deallocate',i_err=(/info,0,0,0,0/))
+      ierr(1) = info
+      call psb_errpush(psb_err_from_subroutine_ai_,name, &
+           & a_err='deallocate',i_err=ierr)
       goto 9999
     end if
   end if

base/tools/psb_zcdbldext.F90

@@ -73,23 +73,22 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
 #endif
 
   !     .. Array Arguments ..
-  integer(psb_ipk_), intent(in)                     :: novr
+  integer(psb_ipk_), intent(in)                      :: novr
   Type(psb_zspmat_type), Intent(in)       ::  a
   Type(psb_desc_type), Intent(in), target :: desc_a
   Type(psb_desc_type), Intent(out)        :: desc_ov
   integer(psb_ipk_), intent(out)                    :: info
   integer(psb_ipk_), intent(in),optional            :: extype
 
-
   !     .. Local Scalars ..
-  integer(psb_ipk_) ::  i, j, np, me,m,&
-       &  ictxt, lovr, lworks,lworkr, n_row,n_col, n_col_prev, int_err(5),&
+  integer(psb_ipk_) ::  i, j, err_act,m,&
+       &  lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
        &  index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
   integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
        & n_elem_send,tot_recv,tot_elem,cntov_o,&
        & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
        & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
-  integer(psb_ipk_) :: icomm, err_act
+  integer(psb_mpik_) :: icomm, ictxt, me, np, minfo
 
   integer(psb_ipk_), allocatable  :: irow(:), icol(:)
   integer(psb_ipk_), allocatable  :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
@@ -97,14 +96,21 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
        & t_halo_out(:),temp(:),maskr(:)
   integer(psb_ipk_),allocatable  :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
   integer(psb_ipk_) :: debug_level, debug_unit
-  character(len=20)    :: name, ch_err
+  integer(psb_ipk_) :: ierr(5)
+  character(len=20) :: name, ch_err
 
   name='psb_zcdbldext'
   info  = psb_success_
+  if (psb_errstatus_fatal()) return
   call psb_erractionsave(err_act)
   debug_unit  = psb_get_debug_unit()
   debug_level = psb_get_debug_level()
 
+  if (.not.desc_a%is_ok()) then
+    info = psb_err_invalid_cd_state_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()
   Call psb_info(ictxt, me, np)
@@ -125,17 +131,17 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (novr<0) then
     info=psb_err_iarg_neg_
-    int_err(1)=1
-    int_err(2)=novr
-    call psb_errpush(info,name,i_err=int_err)
+    ierr(1)=1; ierr(2)=novr
+    call psb_errpush(info,name,i_err=ierr)
     goto 9999
   endif
 
   select case(extype_) 
   case(psb_ovt_xhal_,psb_ovt_asov_)
   case default
+    ierr(1)=5; ierr(2)=extype_
     call psb_errpush(psb_err_input_value_invalid_i_,&
-         & name,i_err=(/5,extype_,0,0,0/))
+         & name,i_err=ierr)
     goto 9999
   end select
 
@@ -144,10 +150,10 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
        & ': Calling desccpy'
 
   call psb_cdcpy(desc_a,desc_ov,info)
-  if (info /= psb_success_) then
+
+  if (psb_errstatus_fatal()) then
     info=psb_err_from_subroutine_
-    ch_err='psb_cdcpy'
-    call psb_errpush(info,name,a_err=ch_err)
+    call psb_errpush(info,name,a_err='psb_cdcpy')
     goto 9999
   end if
 
@@ -220,15 +226,12 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   Allocate(works(lworks),workr(lworkr),t_halo_in(l_tmp_halo),&
        & t_halo_out(l_tmp_halo), temp(lworkr),stat=info)
-  if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-    goto 9999      
-  end if
-
-  Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),&
+  if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),&
+       & tmp_ovr_idx(l_tmp_ovr_idx), &
        & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
+
   if (info /= psb_success_) then 
-    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    call psb_errpush(psb_err_alloc_dealloc_,name)
     goto 9999      
   end if
   halo(:)        = desc_a%halo_index(:)
@@ -257,7 +260,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
         call psb_errpush(info,name)
         goto 9999
       endif
-      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-1)
+      call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-ione)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_
         call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -358,7 +361,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -370,7 +373,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
         tmp_ovr_idx(counter_o+2) = gidx
         tmp_ovr_idx(counter_o+3) = -1
         counter_o=counter_o+3
-        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1)
+        call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -402,7 +405,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
           call psb_errpush(info,name)
           goto 9999
         endif
-        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-1)
+        call psb_ensure_size((counter_o+3),tmp_ovr_idx,info,pad=-ione)
         if (info /= psb_success_) then
           info=psb_err_from_subroutine_
           call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -464,11 +467,10 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
       ! accumulated RECV requests, we have an all-to-all to build
       ! matchings SENDs.
       !       
-      call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoall'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoall')
         goto 9999
       end if
       idxs = 0
@@ -491,21 +493,20 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
       iszr=sum(rvsz)
       if (max(iszr,1) > lworkr) then 
         call psb_realloc(max(iszr,1),workr,info)
-        if (info /= psb_success_) then
-          info=psb_err_from_subroutine_
-          ch_err='psb_realloc'
-          call psb_errpush(info,name,a_err=ch_err)
+
+        if (psb_errstatus_fatal()) then
+          info=psb_err_alloc_dealloc_
+          call psb_errpush(info,name)
           goto 9999
         end if
         lworkr = max(iszr,1)
       end if
 
-      call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,&
-           & workr,rvsz,brvindx,mpi_integer,icomm,info)
-      if (info /= psb_success_) then
+      call mpi_alltoallv(works,sdsz,bsdindx,psb_mpi_integer,&
+           & workr,rvsz,brvindx,psb_mpi_integer,icomm,minfo)
+      if (minfo /= psb_success_) then
         info=psb_err_from_subroutine_
-        ch_err='mpi_alltoallv'
-        call psb_errpush(info,name,a_err=ch_err)
+        call psb_errpush(info,name,a_err='mpi_alltoallv')
         goto 9999
       end if
 
@@ -561,7 +562,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
           !
           proc_id = temp(i) 
           
-          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-1)
+          call psb_ensure_size((counter_t+3),t_halo_in,info,pad=-ione)
           if (info /= psb_success_) then
             info=psb_err_from_subroutine_
             call psb_errpush(info,name,a_err='psb_ensure_size')
@@ -622,7 +623,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     !
     call psb_move_alloc(orig_ovr,desc_ov%ovrlap_index,info)
-    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-1)
+    call psb_ensure_size((counter_h+counter_t+1),tmp_halo,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -649,7 +650,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
     !               5. n_col(ov)  current. 
     ! 
     call desc_ov%indxmap%set_lr(n_col_prev)
-    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-1)
+    call psb_ensure_size((cntov_o+counter_o+1),orig_ovr,info,pad=-ione)
     if (info /= psb_success_) then
       call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_ensure_size')
       goto 9999
@@ -667,7 +668,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
     call psb_move_alloc(tmp_halo,desc_ov%ext_index,info)
     call psb_move_alloc(t_halo_in,desc_ov%halo_index,info)
   case default
-    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/5,extype_,0,0,0/))
+    ierr(1)=5; ierr(2)=extype_
+    call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
     goto 9999
   end select
 
@@ -693,10 +695,12 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
 
   if (info == psb_success_)  then 
     if (allocated(irow)) deallocate(irow,stat=info)
-    if ((info == psb_success_).and.allocated(icol)) deallocate(icol,stat=info)
+    if ((info == psb_success_).and.allocated(icol)) &
+         & deallocate(icol,stat=info)
     if (info /= psb_success_) then
-      call psb_errpush(psb_err_from_subroutine_ai_,name,&
-           & a_err='deallocate',i_err=(/info,0,0,0,0/))
+      ierr(1) = info
+      call psb_errpush(psb_err_from_subroutine_ai_,name, &
+           & a_err='deallocate',i_err=ierr)
       goto 9999
     end if
   end if