psblas3:

prec/Makefile
 prec/impl/Makefile
 prec/impl/psb_c_bjacprec_impl.f90
 prec/impl/psb_c_diagprec_impl.f90
 prec/impl/psb_c_nullprec_impl.f90
 prec/impl/psb_cilu_fct.f90
 prec/impl/psb_cprecbld.f90
 prec/impl/psb_cprecinit.f90
 prec/impl/psb_cprecset.f90
 prec/impl/psb_d_bjacprec_impl.f90
 prec/impl/psb_d_diagprec_impl.f90
 prec/impl/psb_d_nullprec_impl.f90
 prec/impl/psb_dilu_fct.f90
 prec/impl/psb_dprecbld.f90
 prec/impl/psb_dprecinit.f90
 prec/impl/psb_dprecset.f90
 prec/impl/psb_s_bjacprec_impl.f90
 prec/impl/psb_s_diagprec_impl.f90
 prec/impl/psb_s_nullprec_impl.f90
 prec/impl/psb_silu_fct.f90
 prec/impl/psb_sprecbld.f90
 prec/impl/psb_sprecinit.f90
 prec/impl/psb_sprecset.f90
 prec/impl/psb_z_bjacprec_impl.f90
 prec/impl/psb_z_diagprec_impl.f90
 prec/impl/psb_z_nullprec_impl.f90
 prec/impl/psb_zilu_fct.f90
 prec/impl/psb_zprecbld.f90
 prec/impl/psb_zprecinit.f90
 prec/impl/psb_zprecset.f90
 prec/psb_c_base_prec_mod.f90
 prec/psb_c_bjacprec.f90
 prec/psb_c_diagprec.f90
 prec/psb_c_nullprec.f90
 prec/psb_cilu_fct.f90
 prec/psb_cprecbld.f90
 prec/psb_cprecinit.f90
 prec/psb_cprecset.f90
 prec/psb_d_base_prec_mod.f90
 prec/psb_d_bjacprec.f90
 prec/psb_d_diagprec.f90
 prec/psb_d_nullprec.f90
 prec/psb_dilu_fct.f90
 prec/psb_dprecbld.f90
 prec/psb_dprecinit.f90
 prec/psb_dprecset.f90
 prec/psb_s_base_prec_mod.f90
 prec/psb_s_bjacprec.f90
 prec/psb_s_diagprec.f90
 prec/psb_s_nullprec.f90
 prec/psb_silu_fct.f90
 prec/psb_sprecbld.f90
 prec/psb_sprecinit.f90
 prec/psb_sprecset.f90
 prec/psb_z_base_prec_mod.f90
 prec/psb_z_bjacprec.f90
 prec/psb_z_diagprec.f90
 prec/psb_z_nullprec.f90
 prec/psb_zilu_fct.f90
 prec/psb_zprecbld.f90
 prec/psb_zprecinit.f90
 prec/psb_zprecset.f90

Split and reorganization of PREC subdir (from preprocessing).
Split of preconditioners into interface/implementation.

prec/Makefile

@@ -12,14 +12,6 @@ MODOBJS=psb_prec_const_mod.o\
 	psb_c_diagprec.o psb_c_nullprec.o psb_c_bjacprec.o \
 	psb_z_diagprec.o psb_z_nullprec.o psb_z_bjacprec.o 
 
-F90OBJS=  psb_dilu_fct.o\
-	psb_dprecbld.o psb_dprecset.o psb_dprecinit.o \
-	psb_silu_fct.o\
-	psb_sprecbld.o psb_sprecset.o psb_sprecinit.o \
-	psb_cilu_fct.o\
-	psb_cprecbld.o psb_cprecset.o psb_cprecinit.o \
-	psb_zilu_fct.o\
-	psb_zprecbld.o psb_zprecset.o psb_zprecinit.o 
 
 LIBMOD=psb_prec_mod$(.mod)
 LOCAL_MODS=$(MODOBJS:.o=$(.mod))
@@ -39,7 +31,6 @@ impld: $(OBJS)
 
 $(OBJS): $(LIBDIR)/psb_base_mod$(.mod)
 
-$(F90OBJS): $(MODOBJS)
 
 psb_s_base_prec_mod.o psb_d_base_prec_mod.o psb_c_base_prec_mod.o psb_z_base_prec_mod.o: psb_prec_const_mod.o
 psb_s_prec_type.o: psb_s_base_prec_mod.o
@@ -60,6 +51,8 @@ psb_z_bjacprec.o psb_z_diagprec.o psb_z_nullprec.o: psb_prec_mod.o psb_z_base_pr
 veryclean: clean
 	/bin/rm -f $(LIBNAME)
 
-clean:
+iclean:
+	cd impl && $(MAKE) clean
+clean: iclean
 	/bin/rm -f $(OBJS) $(LOCAL_MODS)
 

prec/impl/Makefile

@@ -3,15 +3,17 @@ include ../../Make.inc
 LIBDIR=../../lib
 HERE=..
 OBJS=psb_s_prec_type_impl.o psb_d_prec_type_impl.o \
-	psb_c_prec_type_impl.o psb_z_prec_type_impl.o 
+     psb_c_prec_type_impl.o psb_z_prec_type_impl.o \
-
+     psb_d_diagprec_impl.o psb_d_bjacprec_impl.o psb_d_nullprec_impl.o \
-
+     psb_dilu_fct.o\
-F90OBJS=  psb_dilu_fct.o\
      psb_dprecbld.o psb_dprecset.o psb_dprecinit.o \
+     psb_s_diagprec_impl.o psb_s_bjacprec_impl.o psb_s_nullprec_impl.o \
      psb_silu_fct.o\
      psb_sprecbld.o psb_sprecset.o psb_sprecinit.o \
+     psb_c_diagprec_impl.o psb_c_bjacprec_impl.o psb_c_nullprec_impl.o \
      psb_cilu_fct.o\
      psb_cprecbld.o psb_cprecset.o psb_cprecinit.o \
+     psb_z_diagprec_impl.o psb_z_bjacprec_impl.o psb_z_nullprec_impl.o \
      psb_zilu_fct.o\
      psb_zprecbld.o psb_zprecset.o psb_zprecinit.o 
 

prec/impl/psb_c_bjacprec_impl.f90

@@ -0,0 +1,605 @@
+
+subroutine psb_c_bjac_dump(prec,info,prefix,head)
+  use psb_base_mod
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_dump
+  implicit none 
+  class(psb_c_bjac_prec_type), intent(in) :: prec
+  integer, intent(out)                    :: info
+  character(len=*), intent(in), optional  :: prefix,head
+  integer :: i, j, il1, iln, lname, lev
+  integer :: ictxt,iam, np
+  character(len=80)  :: prefix_
+  character(len=120) :: fname ! len should be at least 20 more than
+
+  !  len of prefix_ 
+
+  info = 0
+  ictxt = prec%get_ctxt()
+  call psb_info(ictxt,iam,np)
+
+  if (present(prefix)) then 
+    prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
+  else
+    prefix_ = "dump_fact_c"
+  end if
+
+  lname = len_trim(prefix_)
+  fname = trim(prefix_)
+  write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
+  lname = lname + 5
+  write(fname(lname+1:),'(a)')'_lower.mtx'
+  if (prec%av(psb_l_pr_)%is_asb())  &
+       & call prec%av(psb_l_pr_)%print(fname,head=head)
+  write(fname(lname+1:),'(a,a)')'_diag.mtx'
+  if (allocated(prec%d)) &
+       & call psb_geprt(fname,prec%d,head=head)
+  write(fname(lname+1:),'(a)')'_upper.mtx'
+  if (prec%av(psb_u_pr_)%is_asb()) &
+       & call prec%av(psb_u_pr_)%print(fname,head=head)
+
+end subroutine psb_c_bjac_dump
+
+subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_c_bjac_prec_type), intent(inout)  :: prec
+  complex(psb_spk_),intent(in)         :: alpha,beta
+  type(psb_c_vect_type),intent(inout)   :: x
+  type(psb_c_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  complex(psb_spk_), pointer :: ww(:), aux(:)
+  type(psb_c_vect_type) :: wv, wv1
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='c_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (x%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+  endif
+  if (info == psb_success_) allocate(wv%v,mold=x%v)
+
+  if (info /= psb_success_) then 
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    goto 9999      
+  end if
+
+  call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.) 
+  call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+      call wv1%mlt(cone,prec%dv,wv,czero,info,conjgx=trans_)
+  
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  call wv%free(info)
+  call wv1%free(info)
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_c_bjac_apply_vect
+
+subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_apply
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_c_bjac_prec_type), intent(in)  :: prec
+  complex(psb_spk_),intent(in)         :: alpha,beta
+  complex(psb_spk_),intent(inout)      :: x(:)
+  complex(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  complex(psb_spk_), pointer :: ww(:), aux(:)
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='c_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (size(x) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+      if (info /= psb_success_) then 
+        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+        goto 9999      
+      end if
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    end if
+  endif
+
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+      ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row))
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_c_bjac_apply
+
+subroutine psb_c_bjac_precinit(prec,info)
+  use psb_base_mod
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_precinit
+  Implicit None
+
+  class(psb_c_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_bjac_precinit'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  call psb_realloc(psb_ifpsz,prec%iprcparm,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_Errpush(info,name)
+    goto 9999
+  end if
+
+  prec%iprcparm(:)                = 0
+  prec%iprcparm(psb_p_type_)      = psb_bjac_
+  prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
+  prec%iprcparm(psb_ilu_fill_in_) = 0
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_c_bjac_precinit
+
+
+subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+
+  use psb_base_mod
+  use psb_prec_mod, only : psb_ilu_fct
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_precbld
+  Implicit None
+
+  type(psb_cspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_c_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_c_base_sparse_mat), intent(in), optional :: amold
+  class(psb_c_base_vect_type), intent(in), optional  :: vmold
+
+  !     .. Local Scalars ..                                                       
+  integer  ::    i, m
+  integer  ::    int_err(5)
+  character ::        trans, unitd
+  type(psb_c_csr_sparse_mat), allocatable  :: lf, uf
+  complex(psb_spk_), allocatable :: dd(:)
+  integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+  integer :: ictxt,np,me
+  character(len=20)  :: name='c_bjac_precbld'
+  character(len=20)  :: ch_err
+
+
+  if(psb_get_errstatus() /= 0) return 
+  info = psb_success_
+
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+
+  call prec%set_ctxt(ictxt)
+
+  m = a%get_nrows()
+  if (m < 0) then
+    info = psb_err_iarg_neg_
+    int_err(1) = 1
+    int_err(2) = m
+    call psb_errpush(info,name,i_err=int_err)
+    goto 9999
+  endif
+  trans = 'N'
+  unitd = 'U'
+
+  select case(prec%iprcparm(psb_f_type_))
+
+  case(psb_f_ilu_n_) 
+
+    if (allocated(prec%av)) then 
+      if (size(prec%av) < psb_bp_ilu_avsz) then 
+        do i=1,size(prec%av) 
+          call prec%av(i)%free()
+        enddo
+        deallocate(prec%av,stat=info)
+      endif
+    end if
+    if (.not.allocated(prec%av)) then 
+      allocate(prec%av(psb_max_avsz),stat=info)
+      if (info /= psb_success_) then
+        call psb_errpush(psb_err_alloc_dealloc_,name)
+        goto 9999
+      end if
+    endif
+
+    nrow_a = desc_a%get_local_rows()
+    nztota = a%get_nzeros()
+
+    n_col  = desc_a%get_local_cols()
+    nhalo  = n_col-nrow_a
+    n_row  = nrow_a
+
+    allocate(lf,uf,stat=info)
+    if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
+    if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
+
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='psb_sp_all'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    allocate(dd(n_row),stat=info)
+    if (info == psb_success_) then 
+      allocate(prec%dv, stat=info)
+      if (info == 0) then 
+        if (present(vmold)) then 
+          allocate(prec%dv%v,mold=vmold,stat=info) 
+        else       
+          allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) 
+        end if
+      end if
+    end if
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    endif
+    ! This is where we have no renumbering, thus no need 
+    call psb_ilu_fct(a,lf,uf,dd,info)
+
+    if(info == psb_success_) then
+      call prec%av(psb_l_pr_)%mv_from(lf)
+      call prec%av(psb_u_pr_)%mv_from(uf)
+      call prec%av(psb_l_pr_)%set_asb()
+      call prec%av(psb_u_pr_)%set_asb()
+      call prec%av(psb_l_pr_)%trim()
+      call prec%av(psb_u_pr_)%trim()
+      call prec%dv%bld(dd)
+      call move_alloc(dd,prec%d)
+    else
+      info=psb_err_from_subroutine_
+      ch_err='psb_ilu_fct'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+  case(psb_f_none_) 
+    info=psb_err_from_subroutine_
+    ch_err='Inconsistent prec  psb_f_none_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+
+  case default
+    info=psb_err_from_subroutine_
+    ch_err='Unknown psb_f_type_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  if (present(amold)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
+    call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
+  else if (present(afmt)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
+    call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_bjac_precbld
+
+subroutine psb_c_bjac_precseti(prec,what,val,info)
+
+  use psb_base_mod
+  use psb_c_bjacprec, psb_protect_name => psb_c_bjac_precseti
+  Implicit None
+
+  class(psb_c_bjac_prec_type),intent(inout) :: prec
+  integer, intent(in)                      :: what 
+  integer, intent(in)                      :: val 
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_bjac_precset'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  if (.not.allocated(prec%iprcparm)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  select case(what)
+  case (psb_f_type_) 
+    if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_f_type_)     = val
+
+  case (psb_ilu_fill_in_) 
+    if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
+         & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_ilu_fill_in_) = val
+
+  case default
+    write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
+
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_c_bjac_precseti

prec/impl/psb_c_diagprec_impl.f90

@@ -0,0 +1,259 @@
+
+subroutine psb_c_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_diagprec, psb_protect_name =>  psb_c_diag_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_c_diag_prec_type), intent(inout)  :: prec
+  type(psb_c_vect_type),intent(inout)   :: x
+  complex(psb_spk_),intent(in)         :: alpha, beta
+  type(psb_c_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_diag_prec_apply'
+  complex(psb_spk_), pointer :: ww(:)
+  class(psb_c_base_vect_type), allocatable :: dw
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the DIAG preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+  if (size(work) >= x%get_nrows()) then 
+    ww => work
+  else
+    allocate(ww(x%get_nrows()),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_spk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
+
+  if (size(work) < x%get_nrows()) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_diag_apply_vect
+
+
+subroutine psb_c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_diagprec, psb_protect_name =>  psb_c_diag_apply
+  implicit none 
+
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_c_diag_prec_type), intent(in)  :: prec
+  complex(psb_spk_),intent(inout)      :: x(:)
+  complex(psb_spk_),intent(in)         :: alpha, beta
+  complex(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character :: trans_
+  character(len=20)  :: name='c_diag_prec_apply'
+  complex(psb_spk_), pointer :: ww(:)
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (present(trans)) then 
+    trans_ = psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  select case(trans_)
+  case('N')
+  case('T','C')
+  case default
+    info=psb_err_iarg_invalid_i_
+    call psb_errpush(info,name,&
+         & i_err=(/6,0,0,0,0/),a_err=trans_)
+    goto 9999
+  end select
+
+  if (size(work) >= size(x)) then 
+    ww => work
+  else
+    allocate(ww(size(x)),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/size(x),0,0,0,0/),a_err='complex(psb_spk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  if (trans_ == 'C') then 
+    ww(1:nrow) = x(1:nrow)*conjg(prec%d(1:nrow))
+  else
+    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+  endif
+  call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+
+  if (size(work) < size(x)) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_diag_apply
+
+
+subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+  use psb_base_mod
+  use psb_c_diagprec, psb_protect_name =>  psb_c_diag_precbld
+
+  Implicit None
+
+  type(psb_cspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_c_diag_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_c_base_sparse_mat), intent(in), optional :: amold
+  class(psb_c_base_vect_type), intent(in), optional  :: vmold
+  Integer :: err_act, nrow,i
+  character(len=20)  :: name='c_diag_precbld'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  nrow = desc_a%get_local_cols()
+  if (allocated(prec%d)) then 
+    if (size(prec%d) < nrow) then 
+      deallocate(prec%d,stat=info)
+    end if
+  end if
+  if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
+    allocate(prec%d(nrow), stat=info)
+  end if
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call a%get_diag(prec%d,info) 
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name, a_err='get_diag')
+    goto 9999
+  end if
+
+  do i=1,nrow
+    if (prec%d(i) == dzero) then
+      prec%d(i) = done
+    else
+      prec%d(i) = done/prec%d(i)
+    endif
+  end do
+  allocate(prec%dv,stat=info) 
+  if (info == 0) then 
+    if (present(vmold)) then 
+      allocate(prec%dv%v,mold=vmold,stat=info) 
+    else
+      allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) 
+    end if
+  end if
+  if (info == 0) then 
+    call prec%dv%bld(prec%d)
+  else 
+    write(0,*) 'Error on precbld ',info
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_c_diag_precbld
+

prec/impl/psb_c_nullprec_impl.f90

@@ -0,0 +1,107 @@
+subroutine psb_c_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_nullprec, psb_protect_name => psb_c_null_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_c_null_prec_type), intent(inout)  :: prec
+  type(psb_c_vect_type),intent(inout)  :: x
+  complex(psb_spk_),intent(in)         :: alpha, beta
+  type(psb_c_vect_type),intent(inout)  :: y
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the NULL preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_null_apply_vect
+
+subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_nullprec, psb_protect_name => psb_c_null_apply
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_c_null_prec_type), intent(in)  :: prec
+  complex(psb_spk_),intent(inout)      :: x(:)
+  complex(psb_spk_),intent(in)         :: alpha, beta
+  complex(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_null_apply

prec/impl/psb_d_bjacprec_impl.f90

@@ -0,0 +1,605 @@
+
+subroutine psb_d_bjac_dump(prec,info,prefix,head)
+  use psb_base_mod
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_dump
+  implicit none 
+  class(psb_d_bjac_prec_type), intent(in) :: prec
+  integer, intent(out)                    :: info
+  character(len=*), intent(in), optional  :: prefix,head
+  integer :: i, j, il1, iln, lname, lev
+  integer :: ictxt,iam, np
+  character(len=80)  :: prefix_
+  character(len=120) :: fname ! len should be at least 20 more than
+
+  !  len of prefix_ 
+
+  info = 0
+  ictxt = prec%get_ctxt()
+  call psb_info(ictxt,iam,np)
+
+  if (present(prefix)) then 
+    prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
+  else
+    prefix_ = "dump_fact_d"
+  end if
+
+  lname = len_trim(prefix_)
+  fname = trim(prefix_)
+  write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
+  lname = lname + 5
+  write(fname(lname+1:),'(a)')'_lower.mtx'
+  if (prec%av(psb_l_pr_)%is_asb())  &
+       & call prec%av(psb_l_pr_)%print(fname,head=head)
+  write(fname(lname+1:),'(a,a)')'_diag.mtx'
+  if (allocated(prec%d)) &
+       & call psb_geprt(fname,prec%d,head=head)
+  write(fname(lname+1:),'(a)')'_upper.mtx'
+  if (prec%av(psb_u_pr_)%is_asb()) &
+       & call prec%av(psb_u_pr_)%print(fname,head=head)
+
+end subroutine psb_d_bjac_dump
+
+subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_d_bjac_prec_type), intent(inout)  :: prec
+  real(psb_dpk_),intent(in)         :: alpha,beta
+  type(psb_d_vect_type),intent(inout)   :: x
+  type(psb_d_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  real(psb_dpk_), pointer :: ww(:), aux(:)
+  type(psb_d_vect_type) :: wv, wv1
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='d_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (x%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+  endif
+  if (info == psb_success_) allocate(wv%v,mold=x%v)
+
+  if (info /= psb_success_) then 
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    goto 9999      
+  end if
+
+  call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.) 
+  call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,wv,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+      call wv1%mlt(done,prec%dv,wv,dzero,info,conjgx=trans_)
+  
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  call wv%free(info)
+  call wv1%free(info)
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_d_bjac_apply_vect
+
+subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_apply
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_d_bjac_prec_type), intent(in)  :: prec
+  real(psb_dpk_),intent(in)         :: alpha,beta
+  real(psb_dpk_),intent(inout)      :: x(:)
+  real(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  real(psb_dpk_), pointer :: ww(:), aux(:)
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='d_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (size(x) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+      if (info /= psb_success_) then 
+        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+        goto 9999      
+      end if
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    end if
+  endif
+
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+      ww(1:n_row) = ww(1:n_row)*(prec%dv%v%v(1:n_row))
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_d_bjac_apply
+
+subroutine psb_d_bjac_precinit(prec,info)
+  use psb_base_mod
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_precinit
+  Implicit None
+
+  class(psb_d_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='d_bjac_precinit'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  call psb_realloc(psb_ifpsz,prec%iprcparm,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_Errpush(info,name)
+    goto 9999
+  end if
+
+  prec%iprcparm(:)                = 0
+  prec%iprcparm(psb_p_type_)      = psb_bjac_
+  prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
+  prec%iprcparm(psb_ilu_fill_in_) = 0
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_d_bjac_precinit
+
+
+subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+
+  use psb_base_mod
+  use psb_prec_mod, only : psb_ilu_fct
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_precbld
+  Implicit None
+
+  type(psb_dspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_d_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_d_base_sparse_mat), intent(in), optional :: amold
+  class(psb_d_base_vect_type), intent(in), optional  :: vmold
+
+  !     .. Local Scalars ..                                                       
+  integer  ::    i, m
+  integer  ::    int_err(5)
+  character ::        trans, unitd
+  type(psb_d_csr_sparse_mat), allocatable  :: lf, uf
+  real(psb_dpk_), allocatable :: dd(:)
+  integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+  integer :: ictxt,np,me
+  character(len=20)  :: name='d_bjac_precbld'
+  character(len=20)  :: ch_err
+
+
+  if(psb_get_errstatus() /= 0) return 
+  info = psb_success_
+
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+
+  call prec%set_ctxt(ictxt)
+
+  m = a%get_nrows()
+  if (m < 0) then
+    info = psb_err_iarg_neg_
+    int_err(1) = 1
+    int_err(2) = m
+    call psb_errpush(info,name,i_err=int_err)
+    goto 9999
+  endif
+  trans = 'N'
+  unitd = 'U'
+
+  select case(prec%iprcparm(psb_f_type_))
+
+  case(psb_f_ilu_n_) 
+
+    if (allocated(prec%av)) then 
+      if (size(prec%av) < psb_bp_ilu_avsz) then 
+        do i=1,size(prec%av) 
+          call prec%av(i)%free()
+        enddo
+        deallocate(prec%av,stat=info)
+      endif
+    end if
+    if (.not.allocated(prec%av)) then 
+      allocate(prec%av(psb_max_avsz),stat=info)
+      if (info /= psb_success_) then
+        call psb_errpush(psb_err_alloc_dealloc_,name)
+        goto 9999
+      end if
+    endif
+
+    nrow_a = desc_a%get_local_rows()
+    nztota = a%get_nzeros()
+
+    n_col  = desc_a%get_local_cols()
+    nhalo  = n_col-nrow_a
+    n_row  = nrow_a
+
+    allocate(lf,uf,stat=info)
+    if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
+    if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
+
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='psb_sp_all'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    allocate(dd(n_row),stat=info)
+    if (info == psb_success_) then 
+      allocate(prec%dv, stat=info)
+      if (info == 0) then 
+        if (present(vmold)) then 
+          allocate(prec%dv%v,mold=vmold,stat=info) 
+        else       
+          allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) 
+        end if
+      end if
+    end if
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    endif
+    ! This is where we have no renumbering, thus no need 
+    call psb_ilu_fct(a,lf,uf,dd,info)
+
+    if(info == psb_success_) then
+      call prec%av(psb_l_pr_)%mv_from(lf)
+      call prec%av(psb_u_pr_)%mv_from(uf)
+      call prec%av(psb_l_pr_)%set_asb()
+      call prec%av(psb_u_pr_)%set_asb()
+      call prec%av(psb_l_pr_)%trim()
+      call prec%av(psb_u_pr_)%trim()
+      call prec%dv%bld(dd)
+      call move_alloc(dd,prec%d)
+    else
+      info=psb_err_from_subroutine_
+      ch_err='psb_ilu_fct'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+  case(psb_f_none_) 
+    info=psb_err_from_subroutine_
+    ch_err='Inconsistent prec  psb_f_none_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+
+  case default
+    info=psb_err_from_subroutine_
+    ch_err='Unknown psb_f_type_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  if (present(amold)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
+    call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
+  else if (present(afmt)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
+    call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_bjac_precbld
+
+subroutine psb_d_bjac_precseti(prec,what,val,info)
+
+  use psb_base_mod
+  use psb_d_bjacprec, psb_protect_name => psb_d_bjac_precseti
+  Implicit None
+
+  class(psb_d_bjac_prec_type),intent(inout) :: prec
+  integer, intent(in)                      :: what 
+  integer, intent(in)                      :: val 
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='d_bjac_precset'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  if (.not.allocated(prec%iprcparm)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  select case(what)
+  case (psb_f_type_) 
+    if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_f_type_)     = val
+
+  case (psb_ilu_fill_in_) 
+    if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
+         & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_ilu_fill_in_) = val
+
+  case default
+    write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
+
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_d_bjac_precseti

prec/impl/psb_d_diagprec_impl.f90

@@ -0,0 +1,259 @@
+
+subroutine psb_d_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_diagprec, psb_protect_name =>  psb_d_diag_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_d_diag_prec_type), intent(inout)  :: prec
+  type(psb_d_vect_type),intent(inout)   :: x
+  real(psb_dpk_),intent(in)         :: alpha, beta
+  type(psb_d_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='d_diag_prec_apply'
+  real(psb_dpk_), pointer :: ww(:)
+  class(psb_d_base_vect_type), allocatable :: dw
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the DIAG preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+  if (size(work) >= x%get_nrows()) then 
+    ww => work
+  else
+    allocate(ww(x%get_nrows()),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_dpk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
+
+  if (size(work) < x%get_nrows()) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_diag_apply_vect
+
+
+subroutine psb_d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_diagprec, psb_protect_name =>  psb_d_diag_apply
+  implicit none 
+
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_d_diag_prec_type), intent(in)  :: prec
+  real(psb_dpk_),intent(inout)      :: x(:)
+  real(psb_dpk_),intent(in)         :: alpha, beta
+  real(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character :: trans_
+  character(len=20)  :: name='d_diag_prec_apply'
+  real(psb_dpk_), pointer :: ww(:)
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (present(trans)) then 
+    trans_ = psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  select case(trans_)
+  case('N')
+  case('T','C')
+  case default
+    info=psb_err_iarg_invalid_i_
+    call psb_errpush(info,name,&
+         & i_err=(/6,0,0,0,0/),a_err=trans_)
+    goto 9999
+  end select
+
+  if (size(work) >= size(x)) then 
+    ww => work
+  else
+    allocate(ww(size(x)),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/size(x),0,0,0,0/),a_err='real(psb_dpk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  if (trans_ == 'C') then 
+    ww(1:nrow) = x(1:nrow)*(prec%d(1:nrow))
+  else
+    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+  endif
+  call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+
+  if (size(work) < size(x)) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_diag_apply
+
+
+subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+  use psb_base_mod
+  use psb_d_diagprec, psb_protect_name =>  psb_d_diag_precbld
+
+  Implicit None
+
+  type(psb_dspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_d_diag_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_d_base_sparse_mat), intent(in), optional :: amold
+  class(psb_d_base_vect_type), intent(in), optional  :: vmold
+  Integer :: err_act, nrow,i
+  character(len=20)  :: name='d_diag_precbld'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  nrow = desc_a%get_local_cols()
+  if (allocated(prec%d)) then 
+    if (size(prec%d) < nrow) then 
+      deallocate(prec%d,stat=info)
+    end if
+  end if
+  if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
+    allocate(prec%d(nrow), stat=info)
+  end if
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call a%get_diag(prec%d,info) 
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name, a_err='get_diag')
+    goto 9999
+  end if
+
+  do i=1,nrow
+    if (prec%d(i) == dzero) then
+      prec%d(i) = done
+    else
+      prec%d(i) = done/prec%d(i)
+    endif
+  end do
+  allocate(prec%dv,stat=info) 
+  if (info == 0) then 
+    if (present(vmold)) then 
+      allocate(prec%dv%v,mold=vmold,stat=info) 
+    else
+      allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) 
+    end if
+  end if
+  if (info == 0) then 
+    call prec%dv%bld(prec%d)
+  else 
+    write(0,*) 'Error on precbld ',info
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_d_diag_precbld
+

prec/impl/psb_d_nullprec_impl.f90

@@ -0,0 +1,107 @@
+subroutine psb_d_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_nullprec, psb_protect_name => psb_d_null_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_d_null_prec_type), intent(inout)  :: prec
+  type(psb_d_vect_type),intent(inout)  :: x
+  real(psb_dpk_),intent(in)         :: alpha, beta
+  type(psb_d_vect_type),intent(inout)  :: y
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the NULL preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_null_apply_vect
+
+subroutine psb_d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_nullprec, psb_protect_name => psb_d_null_apply
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_d_null_prec_type), intent(in)  :: prec
+  real(psb_dpk_),intent(inout)      :: x(:)
+  real(psb_dpk_),intent(in)         :: alpha, beta
+  real(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_null_apply

prec/impl/psb_s_bjacprec_impl.f90

@@ -0,0 +1,605 @@
+
+subroutine psb_s_bjac_dump(prec,info,prefix,head)
+  use psb_base_mod
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_dump
+  implicit none 
+  class(psb_s_bjac_prec_type), intent(in) :: prec
+  integer, intent(out)                    :: info
+  character(len=*), intent(in), optional  :: prefix,head
+  integer :: i, j, il1, iln, lname, lev
+  integer :: ictxt,iam, np
+  character(len=80)  :: prefix_
+  character(len=120) :: fname ! len should be at least 20 more than
+
+  !  len of prefix_ 
+
+  info = 0
+  ictxt = prec%get_ctxt()
+  call psb_info(ictxt,iam,np)
+
+  if (present(prefix)) then 
+    prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
+  else
+    prefix_ = "dump_fact_s"
+  end if
+
+  lname = len_trim(prefix_)
+  fname = trim(prefix_)
+  write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
+  lname = lname + 5
+  write(fname(lname+1:),'(a)')'_lower.mtx'
+  if (prec%av(psb_l_pr_)%is_asb())  &
+       & call prec%av(psb_l_pr_)%print(fname,head=head)
+  write(fname(lname+1:),'(a,a)')'_diag.mtx'
+  if (allocated(prec%d)) &
+       & call psb_geprt(fname,prec%d,head=head)
+  write(fname(lname+1:),'(a)')'_upper.mtx'
+  if (prec%av(psb_u_pr_)%is_asb()) &
+       & call prec%av(psb_u_pr_)%print(fname,head=head)
+
+end subroutine psb_s_bjac_dump
+
+subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_s_bjac_prec_type), intent(inout)  :: prec
+  real(psb_spk_),intent(in)         :: alpha,beta
+  type(psb_s_vect_type),intent(inout)   :: x
+  type(psb_s_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  real(psb_spk_), pointer :: ww(:), aux(:)
+  type(psb_s_vect_type) :: wv, wv1
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='s_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (x%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+  endif
+  if (info == psb_success_) allocate(wv%v,mold=x%v)
+
+  if (info /= psb_success_) then 
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    goto 9999      
+  end if
+
+  call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.) 
+  call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+      call wv1%mlt(sone,prec%dv,wv,szero,info,conjgx=trans_)
+  
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  call wv%free(info)
+  call wv1%free(info)
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_s_bjac_apply_vect
+
+subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_apply
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_s_bjac_prec_type), intent(in)  :: prec
+  real(psb_spk_),intent(in)         :: alpha,beta
+  real(psb_spk_),intent(inout)      :: x(:)
+  real(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  real(psb_spk_), pointer :: ww(:), aux(:)
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='s_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (size(x) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+      if (info /= psb_success_) then 
+        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+        goto 9999      
+      end if
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    end if
+  endif
+
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+      ww(1:n_row) = ww(1:n_row)*(prec%dv%v%v(1:n_row))
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_s_bjac_apply
+
+subroutine psb_s_bjac_precinit(prec,info)
+  use psb_base_mod
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_precinit
+  Implicit None
+
+  class(psb_s_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='s_bjac_precinit'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  call psb_realloc(psb_ifpsz,prec%iprcparm,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_Errpush(info,name)
+    goto 9999
+  end if
+
+  prec%iprcparm(:)                = 0
+  prec%iprcparm(psb_p_type_)      = psb_bjac_
+  prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
+  prec%iprcparm(psb_ilu_fill_in_) = 0
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_s_bjac_precinit
+
+
+subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+
+  use psb_base_mod
+  use psb_prec_mod, only : psb_ilu_fct
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_precbld
+  Implicit None
+
+  type(psb_sspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_s_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_s_base_sparse_mat), intent(in), optional :: amold
+  class(psb_s_base_vect_type), intent(in), optional  :: vmold
+
+  !     .. Local Scalars ..                                                       
+  integer  ::    i, m
+  integer  ::    int_err(5)
+  character ::        trans, unitd
+  type(psb_s_csr_sparse_mat), allocatable  :: lf, uf
+  real(psb_spk_), allocatable :: dd(:)
+  integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+  integer :: ictxt,np,me
+  character(len=20)  :: name='s_bjac_precbld'
+  character(len=20)  :: ch_err
+
+
+  if(psb_get_errstatus() /= 0) return 
+  info = psb_success_
+
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+
+  call prec%set_ctxt(ictxt)
+
+  m = a%get_nrows()
+  if (m < 0) then
+    info = psb_err_iarg_neg_
+    int_err(1) = 1
+    int_err(2) = m
+    call psb_errpush(info,name,i_err=int_err)
+    goto 9999
+  endif
+  trans = 'N'
+  unitd = 'U'
+
+  select case(prec%iprcparm(psb_f_type_))
+
+  case(psb_f_ilu_n_) 
+
+    if (allocated(prec%av)) then 
+      if (size(prec%av) < psb_bp_ilu_avsz) then 
+        do i=1,size(prec%av) 
+          call prec%av(i)%free()
+        enddo
+        deallocate(prec%av,stat=info)
+      endif
+    end if
+    if (.not.allocated(prec%av)) then 
+      allocate(prec%av(psb_max_avsz),stat=info)
+      if (info /= psb_success_) then
+        call psb_errpush(psb_err_alloc_dealloc_,name)
+        goto 9999
+      end if
+    endif
+
+    nrow_a = desc_a%get_local_rows()
+    nztota = a%get_nzeros()
+
+    n_col  = desc_a%get_local_cols()
+    nhalo  = n_col-nrow_a
+    n_row  = nrow_a
+
+    allocate(lf,uf,stat=info)
+    if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
+    if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
+
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='psb_sp_all'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    allocate(dd(n_row),stat=info)
+    if (info == psb_success_) then 
+      allocate(prec%dv, stat=info)
+      if (info == 0) then 
+        if (present(vmold)) then 
+          allocate(prec%dv%v,mold=vmold,stat=info) 
+        else       
+          allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) 
+        end if
+      end if
+    end if
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    endif
+    ! This is where we have no renumbering, thus no need 
+    call psb_ilu_fct(a,lf,uf,dd,info)
+
+    if(info == psb_success_) then
+      call prec%av(psb_l_pr_)%mv_from(lf)
+      call prec%av(psb_u_pr_)%mv_from(uf)
+      call prec%av(psb_l_pr_)%set_asb()
+      call prec%av(psb_u_pr_)%set_asb()
+      call prec%av(psb_l_pr_)%trim()
+      call prec%av(psb_u_pr_)%trim()
+      call prec%dv%bld(dd)
+      call move_alloc(dd,prec%d)
+    else
+      info=psb_err_from_subroutine_
+      ch_err='psb_ilu_fct'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+  case(psb_f_none_) 
+    info=psb_err_from_subroutine_
+    ch_err='Inconsistent prec  psb_f_none_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+
+  case default
+    info=psb_err_from_subroutine_
+    ch_err='Unknown psb_f_type_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  if (present(amold)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
+    call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
+  else if (present(afmt)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
+    call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_bjac_precbld
+
+subroutine psb_s_bjac_precseti(prec,what,val,info)
+
+  use psb_base_mod
+  use psb_s_bjacprec, psb_protect_name => psb_s_bjac_precseti
+  Implicit None
+
+  class(psb_s_bjac_prec_type),intent(inout) :: prec
+  integer, intent(in)                      :: what 
+  integer, intent(in)                      :: val 
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='s_bjac_precset'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  if (.not.allocated(prec%iprcparm)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  select case(what)
+  case (psb_f_type_) 
+    if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_f_type_)     = val
+
+  case (psb_ilu_fill_in_) 
+    if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
+         & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_ilu_fill_in_) = val
+
+  case default
+    write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
+
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_s_bjac_precseti

prec/impl/psb_s_diagprec_impl.f90

@@ -0,0 +1,259 @@
+
+subroutine psb_s_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_diagprec, psb_protect_name =>  psb_s_diag_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_s_diag_prec_type), intent(inout)  :: prec
+  type(psb_s_vect_type),intent(inout)   :: x
+  real(psb_spk_),intent(in)         :: alpha, beta
+  type(psb_s_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='s_diag_prec_apply'
+  real(psb_spk_), pointer :: ww(:)
+  class(psb_s_base_vect_type), allocatable :: dw
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the DIAG preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+  if (size(work) >= x%get_nrows()) then 
+    ww => work
+  else
+    allocate(ww(x%get_nrows()),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_spk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
+
+  if (size(work) < x%get_nrows()) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_diag_apply_vect
+
+
+subroutine psb_s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_diagprec, psb_protect_name =>  psb_s_diag_apply
+  implicit none 
+
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_s_diag_prec_type), intent(in)  :: prec
+  real(psb_spk_),intent(inout)      :: x(:)
+  real(psb_spk_),intent(in)         :: alpha, beta
+  real(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character :: trans_
+  character(len=20)  :: name='s_diag_prec_apply'
+  real(psb_spk_), pointer :: ww(:)
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (present(trans)) then 
+    trans_ = psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  select case(trans_)
+  case('N')
+  case('T','C')
+  case default
+    info=psb_err_iarg_invalid_i_
+    call psb_errpush(info,name,&
+         & i_err=(/6,0,0,0,0/),a_err=trans_)
+    goto 9999
+  end select
+
+  if (size(work) >= size(x)) then 
+    ww => work
+  else
+    allocate(ww(size(x)),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/size(x),0,0,0,0/),a_err='real(psb_spk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  if (trans_ == 'C') then 
+    ww(1:nrow) = x(1:nrow)*(prec%d(1:nrow))
+  else
+    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+  endif
+  call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+
+  if (size(work) < size(x)) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_diag_apply
+
+
+subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+  use psb_base_mod
+  use psb_s_diagprec, psb_protect_name =>  psb_s_diag_precbld
+
+  Implicit None
+
+  type(psb_sspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_s_diag_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_s_base_sparse_mat), intent(in), optional :: amold
+  class(psb_s_base_vect_type), intent(in), optional  :: vmold
+  Integer :: err_act, nrow,i
+  character(len=20)  :: name='s_diag_precbld'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  nrow = desc_a%get_local_cols()
+  if (allocated(prec%d)) then 
+    if (size(prec%d) < nrow) then 
+      deallocate(prec%d,stat=info)
+    end if
+  end if
+  if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
+    allocate(prec%d(nrow), stat=info)
+  end if
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call a%get_diag(prec%d,info) 
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name, a_err='get_diag')
+    goto 9999
+  end if
+
+  do i=1,nrow
+    if (prec%d(i) == dzero) then
+      prec%d(i) = done
+    else
+      prec%d(i) = done/prec%d(i)
+    endif
+  end do
+  allocate(prec%dv,stat=info) 
+  if (info == 0) then 
+    if (present(vmold)) then 
+      allocate(prec%dv%v,mold=vmold,stat=info) 
+    else
+      allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) 
+    end if
+  end if
+  if (info == 0) then 
+    call prec%dv%bld(prec%d)
+  else 
+    write(0,*) 'Error on precbld ',info
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_s_diag_precbld
+

prec/impl/psb_s_nullprec_impl.f90

@@ -0,0 +1,107 @@
+subroutine psb_s_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_nullprec, psb_protect_name => psb_s_null_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_s_null_prec_type), intent(inout)  :: prec
+  type(psb_s_vect_type),intent(inout)  :: x
+  real(psb_spk_),intent(in)         :: alpha, beta
+  type(psb_s_vect_type),intent(inout)  :: y
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the NULL preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_null_apply_vect
+
+subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_nullprec, psb_protect_name => psb_s_null_apply
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_s_null_prec_type), intent(in)  :: prec
+  real(psb_spk_),intent(inout)      :: x(:)
+  real(psb_spk_),intent(in)         :: alpha, beta
+  real(psb_spk_),intent(inout)      :: y(:)
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_null_apply

prec/impl/psb_z_bjacprec_impl.f90

@@ -0,0 +1,605 @@
+
+subroutine psb_z_bjac_dump(prec,info,prefix,head)
+  use psb_base_mod
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_dump
+  implicit none 
+  class(psb_z_bjac_prec_type), intent(in) :: prec
+  integer, intent(out)                    :: info
+  character(len=*), intent(in), optional  :: prefix,head
+  integer :: i, j, il1, iln, lname, lev
+  integer :: ictxt,iam, np
+  character(len=80)  :: prefix_
+  character(len=120) :: fname ! len should be at least 20 more than
+
+  !  len of prefix_ 
+
+  info = 0
+  ictxt = prec%get_ctxt()
+  call psb_info(ictxt,iam,np)
+
+  if (present(prefix)) then 
+    prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
+  else
+    prefix_ = "dump_fact_z"
+  end if
+
+  lname = len_trim(prefix_)
+  fname = trim(prefix_)
+  write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
+  lname = lname + 5
+  write(fname(lname+1:),'(a)')'_lower.mtx'
+  if (prec%av(psb_l_pr_)%is_asb())  &
+       & call prec%av(psb_l_pr_)%print(fname,head=head)
+  write(fname(lname+1:),'(a,a)')'_diag.mtx'
+  if (allocated(prec%d)) &
+       & call psb_geprt(fname,prec%d,head=head)
+  write(fname(lname+1:),'(a)')'_upper.mtx'
+  if (prec%av(psb_u_pr_)%is_asb()) &
+       & call prec%av(psb_u_pr_)%print(fname,head=head)
+
+end subroutine psb_z_bjac_dump
+
+subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_z_bjac_prec_type), intent(inout)  :: prec
+  complex(psb_dpk_),intent(in)         :: alpha,beta
+  type(psb_z_vect_type),intent(inout)   :: x
+  type(psb_z_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  complex(psb_dpk_), pointer :: ww(:), aux(:)
+  type(psb_z_vect_type) :: wv, wv1
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='z_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (x%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+  endif
+  if (info == psb_success_) allocate(wv%v,mold=x%v)
+
+  if (info /= psb_success_) then 
+    call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+    goto 9999      
+  end if
+
+  call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.) 
+  call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.) 
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+      call wv1%mlt(zone,prec%dv,wv,zzero,info,conjgx=trans_)
+  
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  call wv%free(info)
+  call wv1%free(info)
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_z_bjac_apply_vect
+
+subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_apply
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_z_bjac_prec_type), intent(in)  :: prec
+  complex(psb_dpk_),intent(in)         :: alpha,beta
+  complex(psb_dpk_),intent(inout)      :: x(:)
+  complex(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  ! Local variables
+  integer :: n_row,n_col
+  complex(psb_dpk_), pointer :: ww(:), aux(:)
+  integer :: ictxt,np,me, err_act, int_err(5)
+  integer            :: debug_level, debug_unit
+  character          :: trans_
+  character(len=20)  :: name='z_bjac_prec_apply'
+  character(len=20)  :: ch_err
+
+  info = psb_success_
+  call psb_erractionsave(err_act)
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
+  ictxt       = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+
+  trans_ = psb_toupper(trans)
+  select case(trans_)
+  case('N','T','C')
+    ! Ok
+  case default
+    call psb_errpush(psb_err_iarg_invalid_i_,name)
+    goto 9999
+  end select
+
+
+  n_row = desc_data%get_local_rows()
+  n_col = desc_data%get_local_cols()
+
+  if (size(x) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < n_row) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%dv)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (prec%dv%get_nrows() < n_row) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+
+  if (n_col <= size(work)) then 
+    ww => work(1:n_col)
+    if ((4*n_col+n_col) <= size(work)) then 
+      aux => work(n_col+1:)
+    else
+      allocate(aux(4*n_col),stat=info)
+      if (info /= psb_success_) then 
+        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+        goto 9999      
+      end if
+
+    endif
+  else
+    allocate(ww(n_col),aux(4*n_col),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    end if
+  endif
+
+
+  select case(prec%iprcparm(psb_f_type_))
+  case(psb_f_ilu_n_) 
+
+    select case(trans_)
+    case('N')
+      call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
+      if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+
+    case('T')
+      call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
+           & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    case('C')
+
+      call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_, work=aux)
+      ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row))
+      if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
+           & beta,y,desc_data,info,&
+           & trans=trans_,scale='U',choice=psb_none_,work=aux)
+
+    end select
+    if (info /= psb_success_) then 
+      ch_err="psb_spsm"
+      goto 9999
+    end if
+
+
+  case default
+    info = psb_err_internal_error_
+    call psb_errpush(info,name,a_err='Invalid factorization')
+    goto 9999
+  end select
+
+  call psb_halo(y,desc_data,info,data=psb_comm_mov_)
+
+  if (n_col <= size(work)) then 
+    if ((4*n_col+n_col) <= size(work)) then 
+    else
+      deallocate(aux)
+    endif
+  else
+    deallocate(ww,aux)
+  endif
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+
+end subroutine psb_z_bjac_apply
+
+subroutine psb_z_bjac_precinit(prec,info)
+  use psb_base_mod
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_precinit
+  Implicit None
+
+  class(psb_z_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='z_bjac_precinit'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  call psb_realloc(psb_ifpsz,prec%iprcparm,info)
+  if (info /= psb_success_) then
+    info = psb_err_alloc_dealloc_
+    call psb_Errpush(info,name)
+    goto 9999
+  end if
+
+  prec%iprcparm(:)                = 0
+  prec%iprcparm(psb_p_type_)      = psb_bjac_
+  prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
+  prec%iprcparm(psb_ilu_fill_in_) = 0
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_z_bjac_precinit
+
+
+subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+
+  use psb_base_mod
+  use psb_prec_mod, only : psb_ilu_fct
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_precbld
+  Implicit None
+
+  type(psb_zspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_z_bjac_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_z_base_sparse_mat), intent(in), optional :: amold
+  class(psb_z_base_vect_type), intent(in), optional  :: vmold
+
+  !     .. Local Scalars ..                                                       
+  integer  ::    i, m
+  integer  ::    int_err(5)
+  character ::        trans, unitd
+  type(psb_z_csr_sparse_mat), allocatable  :: lf, uf
+  complex(psb_dpk_), allocatable :: dd(:)
+  integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+  integer :: ictxt,np,me
+  character(len=20)  :: name='z_bjac_precbld'
+  character(len=20)  :: ch_err
+
+
+  if(psb_get_errstatus() /= 0) return 
+  info = psb_success_
+
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+  call psb_info(ictxt, me, np)
+
+  call prec%set_ctxt(ictxt)
+
+  m = a%get_nrows()
+  if (m < 0) then
+    info = psb_err_iarg_neg_
+    int_err(1) = 1
+    int_err(2) = m
+    call psb_errpush(info,name,i_err=int_err)
+    goto 9999
+  endif
+  trans = 'N'
+  unitd = 'U'
+
+  select case(prec%iprcparm(psb_f_type_))
+
+  case(psb_f_ilu_n_) 
+
+    if (allocated(prec%av)) then 
+      if (size(prec%av) < psb_bp_ilu_avsz) then 
+        do i=1,size(prec%av) 
+          call prec%av(i)%free()
+        enddo
+        deallocate(prec%av,stat=info)
+      endif
+    end if
+    if (.not.allocated(prec%av)) then 
+      allocate(prec%av(psb_max_avsz),stat=info)
+      if (info /= psb_success_) then
+        call psb_errpush(psb_err_alloc_dealloc_,name)
+        goto 9999
+      end if
+    endif
+
+    nrow_a = desc_a%get_local_rows()
+    nztota = a%get_nzeros()
+
+    n_col  = desc_a%get_local_cols()
+    nhalo  = n_col-nrow_a
+    n_row  = nrow_a
+
+    allocate(lf,uf,stat=info)
+    if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
+    if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
+
+    if(info /= psb_success_) then
+      info=psb_err_from_subroutine_
+      ch_err='psb_sp_all'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+    allocate(dd(n_row),stat=info)
+    if (info == psb_success_) then 
+      allocate(prec%dv, stat=info)
+      if (info == 0) then 
+        if (present(vmold)) then 
+          allocate(prec%dv%v,mold=vmold,stat=info) 
+        else       
+          allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) 
+        end if
+      end if
+    end if
+
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      goto 9999      
+    endif
+    ! This is where we have no renumbering, thus no need 
+    call psb_ilu_fct(a,lf,uf,dd,info)
+
+    if(info == psb_success_) then
+      call prec%av(psb_l_pr_)%mv_from(lf)
+      call prec%av(psb_u_pr_)%mv_from(uf)
+      call prec%av(psb_l_pr_)%set_asb()
+      call prec%av(psb_u_pr_)%set_asb()
+      call prec%av(psb_l_pr_)%trim()
+      call prec%av(psb_u_pr_)%trim()
+      call prec%dv%bld(dd)
+      call move_alloc(dd,prec%d)
+    else
+      info=psb_err_from_subroutine_
+      ch_err='psb_ilu_fct'
+      call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
+    end if
+
+  case(psb_f_none_) 
+    info=psb_err_from_subroutine_
+    ch_err='Inconsistent prec  psb_f_none_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+
+  case default
+    info=psb_err_from_subroutine_
+    ch_err='Unknown psb_f_type_'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end select
+
+  if (present(amold)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
+    call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
+  else if (present(afmt)) then 
+    call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
+    call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_bjac_precbld
+
+subroutine psb_z_bjac_precseti(prec,what,val,info)
+
+  use psb_base_mod
+  use psb_z_bjacprec, psb_protect_name => psb_z_bjac_precseti
+  Implicit None
+
+  class(psb_z_bjac_prec_type),intent(inout) :: prec
+  integer, intent(in)                      :: what 
+  integer, intent(in)                      :: val 
+  integer, intent(out)                     :: info
+  Integer :: err_act, nrow
+  character(len=20)  :: name='z_bjac_precset'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  if (.not.allocated(prec%iprcparm)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  select case(what)
+  case (psb_f_type_) 
+    if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_f_type_)     = val
+
+  case (psb_ilu_fill_in_) 
+    if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
+         & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
+      write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
+           & prec%iprcparm(psb_p_type_),&
+           & 'ignoring user specification'
+      return
+    endif
+    prec%iprcparm(psb_ilu_fill_in_) = val
+
+  case default
+    write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
+
+  end select
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_z_bjac_precseti

prec/impl/psb_z_diagprec_impl.f90

@@ -0,0 +1,259 @@
+
+subroutine psb_z_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_diagprec, psb_protect_name =>  psb_z_diag_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_z_diag_prec_type), intent(inout)  :: prec
+  type(psb_z_vect_type),intent(inout)   :: x
+  complex(psb_dpk_),intent(in)         :: alpha, beta
+  type(psb_z_vect_type),intent(inout)   :: y
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='z_diag_prec_apply'
+  complex(psb_dpk_), pointer :: ww(:)
+  class(psb_z_base_vect_type), allocatable :: dw
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the DIAG preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+
+  if (size(work) >= x%get_nrows()) then 
+    ww => work
+  else
+    allocate(ww(x%get_nrows()),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_dpk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
+
+  if (size(work) < x%get_nrows()) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_diag_apply_vect
+
+
+subroutine psb_z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_diagprec, psb_protect_name =>  psb_z_diag_apply
+  implicit none 
+
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_z_diag_prec_type), intent(in)  :: prec
+  complex(psb_dpk_),intent(inout)      :: x(:)
+  complex(psb_dpk_),intent(in)         :: alpha, beta
+  complex(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character :: trans_
+  character(len=20)  :: name='z_diag_prec_apply'
+  complex(psb_dpk_), pointer :: ww(:)
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (.not.allocated(prec%d)) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (size(prec%d) < nrow) then
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner: D")
+    goto 9999
+  end if
+  if (present(trans)) then 
+    trans_ = psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  select case(trans_)
+  case('N')
+  case('T','C')
+  case default
+    info=psb_err_iarg_invalid_i_
+    call psb_errpush(info,name,&
+         & i_err=(/6,0,0,0,0/),a_err=trans_)
+    goto 9999
+  end select
+
+  if (size(work) >= size(x)) then 
+    ww => work
+  else
+    allocate(ww(size(x)),stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_alloc_request_,name,&
+           & i_err=(/size(x),0,0,0,0/),a_err='complex(psb_dpk_)')
+      goto 9999      
+    end if
+  end if
+
+
+  if (trans_ == 'C') then 
+    ww(1:nrow) = x(1:nrow)*conjg(prec%d(1:nrow))
+  else
+    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+  endif
+  call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+
+  if (size(work) < size(x)) then 
+    deallocate(ww,stat=info)
+    if (info /= psb_success_) then 
+      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      goto 9999      
+    end if
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_diag_apply
+
+
+subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+  use psb_base_mod
+  use psb_z_diagprec, psb_protect_name =>  psb_z_diag_precbld
+
+  Implicit None
+
+  type(psb_zspmat_type), intent(in), target :: a
+  type(psb_desc_type), intent(in), target   :: desc_a
+  class(psb_z_diag_prec_type),intent(inout) :: prec
+  integer, intent(out)                      :: info
+  character, intent(in), optional           :: upd
+  character(len=*), intent(in), optional    :: afmt
+  class(psb_z_base_sparse_mat), intent(in), optional :: amold
+  class(psb_z_base_vect_type), intent(in), optional  :: vmold
+  Integer :: err_act, nrow,i
+  character(len=20)  :: name='z_diag_precbld'
+
+  call psb_erractionsave(err_act)
+
+  info = psb_success_
+  nrow = desc_a%get_local_cols()
+  if (allocated(prec%d)) then 
+    if (size(prec%d) < nrow) then 
+      deallocate(prec%d,stat=info)
+    end if
+  end if
+  if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
+    allocate(prec%d(nrow), stat=info)
+  end if
+  if (info /= psb_success_) then 
+    info = psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+
+  call a%get_diag(prec%d,info) 
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name, a_err='get_diag')
+    goto 9999
+  end if
+
+  do i=1,nrow
+    if (prec%d(i) == dzero) then
+      prec%d(i) = done
+    else
+      prec%d(i) = done/prec%d(i)
+    endif
+  end do
+  allocate(prec%dv,stat=info) 
+  if (info == 0) then 
+    if (present(vmold)) then 
+      allocate(prec%dv%v,mold=vmold,stat=info) 
+    else
+      allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) 
+    end if
+  end if
+  if (info == 0) then 
+    call prec%dv%bld(prec%d)
+  else 
+    write(0,*) 'Error on precbld ',info
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+end subroutine psb_z_diag_precbld
+

prec/impl/psb_z_nullprec_impl.f90

@@ -0,0 +1,107 @@
+subroutine psb_z_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_nullprec, psb_protect_name => psb_z_null_apply_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_z_null_prec_type), intent(inout)  :: prec
+  type(psb_z_vect_type),intent(inout)  :: x
+  complex(psb_dpk_),intent(in)         :: alpha, beta
+  type(psb_z_vect_type),intent(inout)  :: y
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  ! This is the base version and we should throw an error. 
+  ! Or should it be the NULL preonditioner???
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (x%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (y%get_nrows() < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_null_apply_vect
+
+subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_nullprec, psb_protect_name => psb_z_null_apply
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_z_null_prec_type), intent(in)  :: prec
+  complex(psb_dpk_),intent(inout)      :: x(:)
+  complex(psb_dpk_),intent(in)         :: alpha, beta
+  complex(psb_dpk_),intent(inout)      :: y(:)
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+  Integer :: err_act, nrow
+  character(len=20)  :: name='c_null_prec_apply'
+
+  call psb_erractionsave(err_act)
+
+  !
+  !
+  info = psb_success_
+
+  nrow = desc_data%get_local_rows()
+  if (size(x) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
+    goto 9999
+  end if
+  if (size(y) < nrow) then 
+    info = 36
+    call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
+    goto 9999
+  end if
+
+  call psb_geaxpby(alpha,x,beta,y,desc_data,info)
+  if (info /= psb_success_ ) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err="psb_geaxpby")
+    goto 9999
+  end if
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_null_apply

prec/psb_c_base_prec_mod.f90

@@ -38,7 +38,7 @@ module psb_c_base_prec_mod
   ! Reduces size of .mod file.
   use psb_base_mod, only : psb_spk_, psb_long_int_k_,&
        & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
+       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,&
        & psb_c_base_sparse_mat, psb_cspmat_type, psb_c_csr_sparse_mat,& 
        & psb_c_base_vect_type, psb_c_vect_type
 

prec/psb_c_bjacprec.f90

@@ -22,20 +22,26 @@ module psb_c_bjacprec
     procedure, pass(prec) :: get_nzeros => psb_c_bjac_get_nzeros
   end type psb_c_bjac_prec_type
 
-  private :: psb_c_bjac_apply, psb_c_bjac_precbld, psb_c_bjac_precseti,&
+  private :: psb_c_bjac_sizeof, psb_c_bjac_precdescr, psb_c_bjac_get_nzeros
-       & psb_c_bjac_precsetr, psb_c_bjac_precsetc, psb_c_bjac_sizeof,&
-       & psb_c_bjac_precinit, psb_c_bjac_precfree, psb_c_bjac_precdescr,&
-       & psb_c_bjac_dump, psb_c_bjac_apply_vect, psb_c_bjac_get_nzeros
  
 
   character(len=15), parameter, private :: &
        &  fact_names(0:2)=(/'None          ','ILU(n)        ',&
        &  'ILU(eps)      '/)
 
-contains
   
+  interface  psb_c_bjac_dump
+    subroutine psb_c_bjac_dump(prec,info,prefix,head)
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
+      class(psb_c_bjac_prec_type), intent(in) :: prec
+      integer, intent(out)                    :: info
+      character(len=*), intent(in), optional  :: prefix,head
+    end subroutine psb_c_bjac_dump
+  end interface psb_c_bjac_dump
+
+  interface  psb_c_bjac_apply_vect
     subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_c_bjac_prec_type), intent(inout)  :: prec
       complex(psb_spk_),intent(in)         :: alpha,beta
@@ -44,148 +50,13 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    complex(psb_spk_), pointer :: ww(:), aux(:)
-    type(psb_c_vect_type) :: wv
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='d_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (x%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < n_row) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-    endif
-    if (info == psb_success_) allocate(wv%v,mold=x%v)
-
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call wv%bld(n_col,mold=x%v)
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-
-      case('T')
-        call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-
-      case('C')
-        write(0,*) 'WARNING: Conjguate case not fixed yet'
-        call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    call wv%free(info)
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_c_bjac_apply_vect
+  end interface psb_c_bjac_apply_vect
 
+  interface  psb_c_bjac_apply
     subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
+      
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_c_bjac_prec_type), intent(in)  :: prec
       complex(psb_spk_),intent(in)         :: alpha,beta
@@ -194,193 +65,21 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    complex(psb_spk_), pointer :: ww(:), aux(:)
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='c_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (size(x) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-!!$    if (.not.allocated(prec%d)) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-!!$    if (size(prec%d) < n_row) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        if (info /= psb_success_) then 
-          call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-          goto 9999      
-        end if
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-        goto 9999      
-      end if
-    endif
-    
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      case('C')
-!!$        call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
-!!$             & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux)
-        call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
-            & trans=trans_,scale='L',choice=psb_none_, work=aux)
-        ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row))
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_c_bjac_apply
+  end interface psb_c_bjac_apply
   
+  interface  psb_c_bjac_precinit
     subroutine psb_c_bjac_precinit(prec,info)
-    
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
-    use psb_base_mod
-    Implicit None
-    
       class(psb_c_bjac_prec_type),intent(inout) :: prec
       integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='c_bjac_precinit'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    call psb_realloc(psb_ifpsz,prec%iprcparm,info)
-    if (info /= psb_success_) then
-      info = psb_err_alloc_dealloc_
-      call psb_Errpush(info,name)
-      goto 9999
-    end if
-    
-    prec%iprcparm(:)                = 0
-    prec%iprcparm(psb_p_type_)      = psb_bjac_
-    prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
-    prec%iprcparm(psb_ilu_fill_in_) = 0
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
     end subroutine psb_c_bjac_precinit
+  end interface psb_c_bjac_precinit
   
-
+  interface  psb_c_bjac_precbld
     subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_, &
-    use psb_base_mod
+           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
-    use psb_prec_mod, only : psb_ilu_fct
-    Implicit None
-
       type(psb_cspmat_type), intent(in), target :: a
       type(psb_desc_type), intent(in), target   :: desc_a
       class(psb_c_bjac_prec_type),intent(inout) :: prec
@@ -389,133 +88,78 @@ contains
       character(len=*), intent(in), optional    :: afmt
       class(psb_c_base_sparse_mat), intent(in), optional :: amold
       class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_c_bjac_precbld
+  end interface psb_c_bjac_precbld
   
-    !     .. Local Scalars ..                                                       
+  interface  psb_c_bjac_precseti
-    integer  ::    i, m
+    subroutine psb_c_bjac_precseti(prec,what,val,info)
-    integer  ::    int_err(5)
+      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
-    character ::        trans, unitd
+      class(psb_c_bjac_prec_type),intent(inout) :: prec
-    type(psb_c_csr_sparse_mat), allocatable  :: lf, uf
+      integer, intent(in)                      :: what 
-    complex(psb_spk_), allocatable :: dd(:)
+      integer, intent(in)                      :: val 
-    integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+      integer, intent(out)                     :: info
-    integer :: ictxt,np,me
+    end subroutine psb_c_bjac_precseti
-    character(len=20)  :: name='c_bjac_precbld'
+  end interface psb_c_bjac_precseti
-    character(len=20)  :: ch_err
+  
-
+!!$  interface  psb_c_bjac_precsetr
-
+!!$    subroutine psb_c_bjac_precsetr(prec,what,val,info)
-    if(psb_get_errstatus() /= 0) return 
+!!$      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
-    info = psb_success_
+!!$      class(psb_c_bjac_prec_type),intent(inout) :: prec
-
+!!$      integer, intent(in)                      :: what 
-    call psb_erractionsave(err_act)
+!!$      real(psb_spk_), intent(in)               :: val 
-
+!!$      integer, intent(out)                     :: info
-    ictxt=desc_a%get_context()
+!!$    end subroutine psb_c_bjac_precsetr
-    call psb_info(ictxt, me, np)
+!!$  end interface psb_c_bjac_precsetr
-
+!!$  
-    call prec%set_ctxt(ictxt)
+!!$  interface  psb_c_bjac_precsetc
-
+!!$    subroutine psb_c_bjac_precsetc(prec,what,val,info)
-    m = a%get_nrows()
+!!$      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
-    if (m < 0) then
+!!$      class(psb_c_bjac_prec_type),intent(inout) :: prec
-      info = psb_err_iarg_neg_
+!!$      integer, intent(in)                      :: what 
-      int_err(1) = 1
+!!$      character(len=*), intent(in)             :: val
-      int_err(2) = m
+!!$      integer, intent(out)                     :: info
-      call psb_errpush(info,name,i_err=int_err)
+!!$    end subroutine psb_c_bjac_precsetc
-      goto 9999
+!!$  end interface psb_c_bjac_precsetc
-    endif
+!!$  
-    trans = 'N'
+!!$  interface  psb_c_bjac_precfree
-    unitd = 'U'
+!!$    subroutine psb_c_bjac_precfree(prec,info)
+!!$      import :: psb_desc_type, psb_c_bjac_prec_type, psb_c_vect_type, psb_spk_
+!!$      class(psb_c_bjac_prec_type), intent(inout) :: prec
+!!$      integer, intent(out)                :: info
+!!$    end subroutine psb_c_bjac_precfree
+!!$  end interface psb_c_bjac_precfree
 
-    select case(prec%iprcparm(psb_f_type_))
+contains
 
-    case(psb_f_ilu_n_) 
+  subroutine psb_c_bjac_precdescr(prec,iout)
     
-      if (allocated(prec%av)) then 
+    Implicit None
-        if (size(prec%av) < psb_bp_ilu_avsz) then 
-          do i=1,size(prec%av) 
-            call prec%av(i)%free()
-          enddo
-          deallocate(prec%av,stat=info)
-        endif
-      end if
-      if (.not.allocated(prec%av)) then 
-        allocate(prec%av(psb_max_avsz),stat=info)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_alloc_dealloc_,name)
-          goto 9999
-        end if
-      endif
 
-      nrow_a = desc_a%get_local_rows()
+    class(psb_c_bjac_prec_type), intent(in) :: prec
-      nztota = a%get_nzeros()
+    integer, intent(in), optional    :: iout
 
-      n_col  = desc_a%get_local_cols()
+    Integer :: err_act, nrow, info
-      nhalo  = n_col-nrow_a
+    character(len=20)  :: name='c_bjac_precdescr'
-      n_row  = nrow_a
+    integer :: iout_
 
-      allocate(lf,uf,stat=info)
+    call psb_erractionsave(err_act)
-      if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
-      if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
 
-      if(info /= psb_success_) then
+    info = psb_success_
-        info=psb_err_from_subroutine_
-        ch_err='psb_sp_all'
-        call psb_errpush(info,name,a_err=ch_err)
-        goto 9999
-      end if
    
-      allocate(dd(n_row),stat=info)
+    if (present(iout)) then 
-      if (info == psb_success_) then 
+      iout_ = iout
-        allocate(prec%dv, stat=info)
-        if (info == 0) then 
-          if (present(vmold)) then 
-            allocate(prec%dv%v,mold=vmold,stat=info) 
     else
-            allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) 
+      iout_ = 6 
-          end if
-        end if
     end if
 
-      if (info /= psb_success_) then 
+    if (.not.allocated(prec%iprcparm)) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      info = 1124
-        goto 9999      
+      call psb_errpush(info,name,a_err="preconditioner")
-      endif
-      ! This is where we have no renumbering, thus no need 
-      call psb_ilu_fct(a,lf,uf,dd,info)
-
-      if(info == psb_success_) then
-        call prec%av(psb_l_pr_)%mv_from(lf)
-        call prec%av(psb_u_pr_)%mv_from(uf)
-        call prec%av(psb_l_pr_)%set_asb()
-        call prec%av(psb_u_pr_)%set_asb()
-        call prec%av(psb_l_pr_)%trim()
-        call prec%av(psb_u_pr_)%trim()
-        call prec%dv%bld(dd)
-        call move_alloc(dd,prec%d)
-      else
-        info=psb_err_from_subroutine_
-        ch_err='psb_ilu_fct'
-        call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
     
-    case(psb_f_none_) 
+    write(iout_,*) 'Block Jacobi with: ',&
-      info=psb_err_from_subroutine_
+         &  fact_names(prec%iprcparm(psb_f_type_))
-      ch_err='Inconsistent prec  psb_f_none_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    case default
-      info=psb_err_from_subroutine_
-      ch_err='Unknown psb_f_type_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end select
-
-    if (present(amold)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
-      call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
-    else if (present(afmt)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
-      call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
-    end if
     
     call psb_erractionrestore(err_act)
     return
@@ -528,69 +172,43 @@ contains
     end if
     return
     
-  end subroutine psb_c_bjac_precbld
+  end subroutine psb_c_bjac_precdescr
-
-  subroutine psb_c_bjac_precseti(prec,what,val,info)
-    
-    use psb_base_mod
-    Implicit None
-    
-    class(psb_c_bjac_prec_type),intent(inout) :: prec
-    integer, intent(in)                      :: what 
-    integer, intent(in)                      :: val 
-    integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='c_bjac_precset'
 
-    call psb_erractionsave(err_act)
 
-    info = psb_success_
+  function psb_c_bjac_sizeof(prec) result(val)
-    if (.not.allocated(prec%iprcparm)) then 
+    class(psb_c_bjac_prec_type), intent(in) :: prec
-      info = 1124
+    integer(psb_long_int_k_) :: val
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
     
-    select case(what)
+    val = 0
-    case (psb_f_type_) 
+    if (allocated(prec%dv)) then 
-      if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      val = val + (2*psb_sizeof_sp) * prec%dv%get_nrows()
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_f_type_)     = val
+    if (allocated(prec%av)) then 
-      
+      val = val + prec%av(psb_l_pr_)%sizeof()
-    case (psb_ilu_fill_in_) 
+      val = val + prec%av(psb_u_pr_)%sizeof()
-      if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
-           & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_ilu_fill_in_) = val
+    return
+  end function psb_c_bjac_sizeof
 
-    case default
+  function psb_c_bjac_get_nzeros(prec) result(val)
-      write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
 
-    end select
+    class(psb_c_bjac_prec_type), intent(in) :: prec
+    integer(psb_long_int_k_) :: val
     
-    call psb_erractionrestore(err_act)
+    val = 0
+    if (allocated(prec%dv)) then 
+      val = val + prec%dv%get_nrows()
+    endif
+    if (allocated(prec%av)) then 
+      val = val + prec%av(psb_l_pr_)%get_nzeros()
+      val = val + prec%av(psb_u_pr_)%get_nzeros()
+    endif
     return
+  end function psb_c_bjac_get_nzeros
 
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_c_bjac_precseti
 
   subroutine psb_c_bjac_precsetr(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_c_bjac_prec_type),intent(inout) :: prec
@@ -618,7 +236,6 @@ contains
 
   subroutine psb_c_bjac_precsetc(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_c_bjac_prec_type),intent(inout) :: prec
@@ -646,7 +263,6 @@ contains
 
   subroutine psb_c_bjac_precfree(prec,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_c_bjac_prec_type), intent(inout) :: prec
@@ -684,125 +300,4 @@ contains
 
   end subroutine psb_c_bjac_precfree
 
-
-  subroutine psb_c_bjac_precdescr(prec,iout)
-    
-    use psb_base_mod
-    Implicit None
-
-    class(psb_c_bjac_prec_type), intent(in) :: prec
-    integer, intent(in), optional    :: iout
-
-    Integer :: err_act, nrow, info
-    character(len=20)  :: name='c_bjac_precdescr'
-    integer :: iout_
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-   
-    if (present(iout)) then 
-      iout_ = iout
-    else
-      iout_ = 6 
-    end if
-
-    if (.not.allocated(prec%iprcparm)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    
-    write(iout_,*) 'Block Jacobi with: ',&
-         &  fact_names(prec%iprcparm(psb_f_type_))
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine psb_c_bjac_precdescr
-
-
-  subroutine psb_c_bjac_dump(prec,info,prefix,head)
-    use psb_base_mod
-    implicit none 
-    class(psb_c_bjac_prec_type), intent(in) :: prec
-    integer, intent(out)                    :: info
-    character(len=*), intent(in), optional  :: prefix,head
-    integer :: i, j, il1, iln, lname, lev
-    integer :: ictxt,iam, np
-    character(len=80)  :: prefix_
-    character(len=120) :: fname ! len should be at least 20 more than
-
-    !  len of prefix_ 
-
-    info = 0
-    ictxt = prec%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    if (present(prefix)) then 
-      prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
-    else
-      prefix_ = "dump_fact_d"
-    end if
-
-    lname = len_trim(prefix_)
-    fname = trim(prefix_)
-    write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
-    lname = lname + 5
-    write(fname(lname+1:),'(a)')'_lower.mtx'
-    if (prec%av(psb_l_pr_)%is_asb())  &
-         & call prec%av(psb_l_pr_)%print(fname,head=head)
-    write(fname(lname+1:),'(a,a)')'_diag.mtx'
-    if (allocated(prec%d)) &
-         & call psb_geprt(fname,prec%d,head=head)
-    write(fname(lname+1:),'(a)')'_upper.mtx'
-    if (prec%av(psb_u_pr_)%is_asb()) &
-         & call prec%av(psb_u_pr_)%print(fname,head=head)
-    
-  end subroutine psb_c_bjac_dump
-
-  function psb_c_bjac_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_c_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%d)) then 
-      val = val + 2*psb_sizeof_sp * size(prec%d)
-    endif
-    if (allocated(prec%av)) then 
-      val = val + psb_sizeof(prec%av(psb_l_pr_))
-      val = val + psb_sizeof(prec%av(psb_u_pr_))
-    endif
-    return
-  end function psb_c_bjac_sizeof
-
-  function psb_c_bjac_get_nzeros(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_c_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%dv)) then 
-      val = val + prec%dv%get_nrows()
-    endif
-    if (allocated(prec%av)) then 
-      val = val + prec%av(psb_l_pr_)%get_nzeros()
-      val = val + prec%av(psb_u_pr_)%get_nzeros()
-    endif
-    return
-  end function psb_c_bjac_get_nzeros
-
 end module psb_c_bjacprec

prec/psb_c_diagprec.f90

@@ -19,17 +19,16 @@ module psb_c_diagprec
     procedure, pass(prec) :: get_nzeros => psb_c_diag_get_nzeros
   end type psb_c_diag_prec_type
 
-  private :: psb_c_diag_apply, psb_c_diag_precbld, psb_c_diag_precseti,&
+  private :: psb_c_diag_precseti,&
        & psb_c_diag_precsetr, psb_c_diag_precsetc, psb_c_diag_sizeof,&
        & psb_c_diag_precinit, psb_c_diag_precfree, psb_c_diag_precdescr,&
-       & psb_c_diag_apply_vect, psb_c_diag_get_nzeros
+       & psb_c_diag_get_nzeros
   
   
-contains
-  
   
+  interface  psb_c_diag_apply_vect
     subroutine psb_c_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_diag_prec_type, psb_c_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_c_diag_prec_type), intent(inout)  :: prec
       type(psb_c_vect_type),intent(inout)   :: x
@@ -38,79 +37,12 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_diag_prec_apply'
-    complex(psb_spk_), pointer :: ww(:)
-    class(psb_c_base_vect_type), allocatable :: dw
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    
-    if (size(work) >= x%get_nrows()) then 
-      ww => work
-    else
-      allocate(ww(x%get_nrows()),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_spk_)')
-        goto 9999      
-      end if
-    end if
-
-
-    call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
-
-    if (size(work) < x%get_nrows()) then 
-      deallocate(ww,stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-        goto 9999      
-      end if
-    end if
-   
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
     end subroutine psb_c_diag_apply_vect
+  end interface psb_c_diag_apply_vect
   
-
+  interface  psb_c_diag_apply
     subroutine psb_c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_diag_prec_type, psb_c_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_c_diag_prec_type), intent(in)  :: prec
       complex(psb_spk_),intent(inout)      :: x(:)
@@ -119,95 +51,29 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_c_diag_apply
-    character :: trans_
+  end interface psb_c_diag_apply
-    character(len=20)  :: name='c_diag_prec_apply'
-    complex(psb_spk_), pointer :: ww(:)
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (present(trans)) then 
-      trans_ = psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    select case(trans_)
-    case('N')
-    case('T','C')
-    case default
-      info=psb_err_iarg_invalid_i_
-      call psb_errpush(info,name,&
-           & i_err=(/6,0,0,0,0/),a_err=trans_)
-      goto 9999
-    end select
-    
-    if (size(work) >= size(x)) then 
-      ww => work
-    else
-      allocate(ww(size(x)),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/size(x),0,0,0,0/),a_err='complex(psb_spk_)')
-        goto 9999      
-      end if
-    end if
-
   
-    if (trans_ == 'C') then 
+  interface  psb_c_diag_precbld
-      ww(1:nrow) = x(1:nrow)*conjg(prec%d(1:nrow))
+    subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    else
+      import :: psb_desc_type, psb_c_diag_prec_type, psb_c_vect_type, psb_spk_, &
-      ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type
-    endif
+      type(psb_cspmat_type), intent(in), target :: a
-    call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+      type(psb_desc_type), intent(in), target   :: desc_a
-
+      class(psb_c_diag_prec_type),intent(inout) :: prec
-    if (size(work) < size(x)) then 
+      integer, intent(out)                      :: info
-      deallocate(ww,stat=info)
+      character, intent(in), optional           :: upd
-      if (info /= psb_success_) then 
+      character(len=*), intent(in), optional    :: afmt
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      class(psb_c_base_sparse_mat), intent(in), optional :: amold
-        goto 9999      
+      class(psb_c_base_vect_type), intent(in), optional  :: vmold
-      end if
+    end subroutine psb_c_diag_precbld
-    end if
+  end interface psb_c_diag_precbld
   
-    call psb_erractionrestore(err_act)
-    return
 
-9999 continue
+contains
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_c_diag_apply
 
   subroutine psb_c_diag_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_diag_prec_type),intent(inout) :: prec
@@ -233,83 +99,7 @@ contains
   end subroutine psb_c_diag_precinit
 
 
-  subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
-    Implicit None
-    
-    type(psb_cspmat_type), intent(in), target :: a
-    type(psb_desc_type), intent(in), target   :: desc_a
-    class(psb_c_diag_prec_type),intent(inout) :: prec
-    integer, intent(out)                      :: info
-    character, intent(in), optional           :: upd
-    character(len=*), intent(in), optional    :: afmt
-    class(psb_c_base_sparse_mat), intent(in), optional :: amold
-    class(psb_c_base_vect_type), intent(in), optional  :: vmold
-    Integer :: err_act, nrow,i
-    character(len=20)  :: name='c_diag_precbld'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    nrow = desc_a%get_local_cols()
-    if (allocated(prec%d)) then 
-      if (size(prec%d) < nrow) then 
-        deallocate(prec%d,stat=info)
-      end if
-    end if
-    if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
-      allocate(prec%d(nrow), stat=info)
-    end if
-    if (info /= psb_success_) then 
-      info = psb_err_alloc_dealloc_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-
-    call a%get_diag(prec%d,info) 
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name, a_err='get_diag')
-      goto 9999
-    end if
-    
-    do i=1,nrow
-      if (prec%d(i) == dzero) then
-        prec%d(i) = done
-      else
-        prec%d(i) = done/prec%d(i)
-      endif
-    end do
-    allocate(prec%dv,stat=info) 
-    if (info == 0) then 
-      if (present(vmold)) then 
-        allocate(prec%dv%v,mold=vmold,stat=info) 
-      else
-        allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) 
-      end if
-    end if
-    if (info == 0) then 
-      call prec%dv%bld(prec%d)
-    else 
-      write(0,*) 'Error on precbld ',info
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_c_diag_precbld
-
   subroutine psb_c_diag_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_diag_prec_type),intent(inout) :: prec
@@ -337,7 +127,6 @@ contains
 
   subroutine psb_c_diag_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_c_diag_prec_type),intent(inout) :: prec
@@ -364,8 +153,6 @@ contains
   end subroutine psb_c_diag_precsetr
 
   subroutine psb_c_diag_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_diag_prec_type),intent(inout) :: prec
@@ -393,7 +180,6 @@ contains
 
   subroutine psb_c_diag_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_c_diag_prec_type), intent(inout) :: prec
@@ -423,8 +209,6 @@ contains
   
 
   subroutine psb_c_diag_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_c_diag_prec_type), intent(in) :: prec
@@ -465,17 +249,14 @@ contains
   end subroutine psb_c_diag_precdescr
 
   function psb_c_diag_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
     class(psb_c_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
-    val = 0
+    val = (2*psb_sizeof_sp) * prec%get_nzeros()
-    val = val + 2*psb_sizeof_sp * size(prec%d)
     return
   end function psb_c_diag_sizeof
 
   function psb_c_diag_get_nzeros(prec) result(val)
-    use psb_base_mod, only: psb_long_int_k_
     class(psb_c_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
 

prec/psb_c_nullprec.f90

@@ -16,16 +16,14 @@ module psb_c_nullprec
     procedure, pass(prec) :: sizeof    => psb_c_null_sizeof
   end type psb_c_null_prec_type
 
-  private :: psb_c_null_apply, psb_c_null_precbld, psb_c_null_precseti,&
+  private :: psb_c_null_precbld, psb_c_null_precseti,&
        & psb_c_null_precsetr, psb_c_null_precsetc, psb_c_null_sizeof,&
-       & psb_c_null_precinit, psb_c_null_precfree, psb_c_null_precdescr, &
+       & psb_c_null_precinit, psb_c_null_precfree, psb_c_null_precdescr
-       & psb_c_null_apply_vect
-  
-contains
   
 
+  interface  psb_c_null_apply_vect
     subroutine psb_c_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_null_prec_type, psb_c_vect_type, psb_spk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_c_null_prec_type), intent(inout)  :: prec
       type(psb_c_vect_type),intent(inout)  :: x
@@ -34,51 +32,13 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='c_null_prec_apply'
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the NULL preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
 
     end subroutine psb_c_null_apply_vect
+  end interface psb_c_null_apply_vect
   
+  interface  psb_c_null_apply
     subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_c_null_prec_type, psb_spk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_c_null_prec_type), intent(in)  :: prec
       complex(psb_spk_),intent(inout)      :: x(:)
@@ -87,51 +47,15 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       complex(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_c_null_apply
-    character(len=20)  :: name='c_null_prec_apply'
+  end interface psb_c_null_apply
-
-    call psb_erractionsave(err_act)
-
-    !
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
   
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_c_null_apply
+contains
   
 
   subroutine psb_c_null_precinit(prec,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_c_null_prec_type),intent(inout) :: prec
@@ -158,7 +82,6 @@ contains
 
   subroutine psb_c_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     
-    use psb_base_mod
     Implicit None
     
     type(psb_cspmat_type), intent(in), target :: a
@@ -191,7 +114,6 @@ contains
 
   subroutine psb_c_null_precseti(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_c_null_prec_type),intent(inout) :: prec
@@ -219,7 +141,6 @@ contains
 
   subroutine psb_c_null_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_c_null_prec_type),intent(inout) :: prec
@@ -247,7 +168,6 @@ contains
 
   subroutine psb_c_null_precsetc(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_c_null_prec_type),intent(inout) :: prec
@@ -275,7 +195,6 @@ contains
 
   subroutine psb_c_null_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_c_null_prec_type), intent(inout) :: prec
@@ -304,7 +223,6 @@ contains
 
   subroutine psb_c_null_precdescr(prec,iout)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_c_null_prec_type), intent(in) :: prec
@@ -340,7 +258,7 @@ contains
   end subroutine psb_c_null_precdescr
 
   function psb_c_null_sizeof(prec) result(val)
-    use psb_base_mod
+
     class(psb_c_null_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     

prec/psb_d_base_prec_mod.f90

@@ -38,7 +38,7 @@ module psb_d_base_prec_mod
   ! Reduces size of .mod file.
   use psb_base_mod, only : psb_dpk_, psb_long_int_k_,&
        & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
+       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,&
        & psb_d_base_sparse_mat, psb_dspmat_type, psb_d_csr_sparse_mat,& 
        & psb_d_base_vect_type, psb_d_vect_type
 

prec/psb_d_bjacprec.f90

@@ -1,4 +1,5 @@
 module psb_d_bjacprec
+
   use psb_d_base_prec_mod
   
   type, extends(psb_d_base_prec_type)   :: psb_d_bjac_prec_type
@@ -21,21 +22,26 @@ module psb_d_bjacprec
     procedure, pass(prec) :: get_nzeros => psb_d_bjac_get_nzeros
   end type psb_d_bjac_prec_type
 
-  private :: psb_d_bjac_apply, psb_d_bjac_precbld, psb_d_bjac_precseti,&
+  private :: psb_d_bjac_sizeof, psb_d_bjac_precdescr, psb_d_bjac_get_nzeros
-       & psb_d_bjac_precsetr, psb_d_bjac_precsetc, psb_d_bjac_sizeof,&
-       & psb_d_bjac_precinit, psb_d_bjac_precfree, psb_d_bjac_precdescr,&
-       & psb_d_bjac_dump, psb_d_bjac_apply_vect, psb_d_bjac_get_nzeros
  
 
   character(len=15), parameter, private :: &
        &  fact_names(0:2)=(/'None          ','ILU(n)        ',&
        &  'ILU(eps)      '/)
 
-contains
   
+  interface  psb_d_bjac_dump
+    subroutine psb_d_bjac_dump(prec,info,prefix,head)
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
+      class(psb_d_bjac_prec_type), intent(in) :: prec
+      integer, intent(out)                    :: info
+      character(len=*), intent(in), optional  :: prefix,head
+    end subroutine psb_d_bjac_dump
+  end interface psb_d_bjac_dump
 
+  interface  psb_d_bjac_apply_vect
     subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_d_bjac_prec_type), intent(inout)  :: prec
       real(psb_dpk_),intent(in)         :: alpha,beta
@@ -44,147 +50,13 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    real(psb_dpk_), pointer :: ww(:), aux(:)
-    type(psb_d_vect_type) :: wv
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='d_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (x%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < n_row) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-    endif
-    if (info == psb_success_) allocate(wv%v,mold=x%v)
-
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call wv%bld(n_col,mold=x%v)
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      case('C')
-        call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    call wv%free(info)
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_d_bjac_apply_vect
+  end interface psb_d_bjac_apply_vect
 
+  interface  psb_d_bjac_apply
     subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
+      
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_d_bjac_prec_type), intent(in)  :: prec
       real(psb_dpk_),intent(in)         :: alpha,beta
@@ -193,183 +65,21 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    real(psb_dpk_), pointer :: ww(:), aux(:)
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='d_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (size(x) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-!!$    if (.not.allocated(prec%d)) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-!!$    if (size(prec%d) < n_row) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        if (info /= psb_success_) then 
-          call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-          goto 9999      
-        end if
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-        goto 9999      
-      end if
-    endif
-    
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T','C')
-        call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
-        if (info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_d_bjac_apply
+  end interface psb_d_bjac_apply
   
+  interface  psb_d_bjac_precinit
     subroutine psb_d_bjac_precinit(prec,info)
-    
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
-    use psb_base_mod
-    Implicit None
-    
       class(psb_d_bjac_prec_type),intent(inout) :: prec
       integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_null_precinit'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    call psb_realloc(psb_ifpsz,prec%iprcparm,info)
-    if (info /= psb_success_) then
-      info = psb_err_alloc_dealloc_
-      call psb_Errpush(info,name)
-      goto 9999
-    end if
-    
-    prec%iprcparm(:)                = 0
-    prec%iprcparm(psb_p_type_)      = psb_bjac_
-    prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
-    prec%iprcparm(psb_ilu_fill_in_) = 0
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
     end subroutine psb_d_bjac_precinit
+  end interface psb_d_bjac_precinit
   
-
+  interface  psb_d_bjac_precbld
     subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_, &
-    use psb_base_mod
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
-    use psb_prec_mod, only : psb_ilu_fct
-    Implicit None
-
       type(psb_dspmat_type), intent(in), target :: a
       type(psb_desc_type), intent(in), target   :: desc_a
       class(psb_d_bjac_prec_type),intent(inout) :: prec
@@ -378,133 +88,78 @@ contains
       character(len=*), intent(in), optional    :: afmt
       class(psb_d_base_sparse_mat), intent(in), optional :: amold
       class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_d_bjac_precbld
+  end interface psb_d_bjac_precbld
   
-    !     .. Local Scalars ..                                                       
+  interface  psb_d_bjac_precseti
-    integer  ::    i, m
+    subroutine psb_d_bjac_precseti(prec,what,val,info)
-    integer  ::    int_err(5)
+      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
-    character ::        trans, unitd
+      class(psb_d_bjac_prec_type),intent(inout) :: prec
-    type(psb_d_csr_sparse_mat), allocatable  :: lf, uf
+      integer, intent(in)                      :: what 
-    real(psb_dpk_), allocatable :: dd(:)
+      integer, intent(in)                      :: val 
-    integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+      integer, intent(out)                     :: info
-    integer :: ictxt,np,me
+    end subroutine psb_d_bjac_precseti
-    character(len=20)  :: name='d_bjac_precbld'
+  end interface psb_d_bjac_precseti
-    character(len=20)  :: ch_err
+  
-
+!!$  interface  psb_d_bjac_precsetr
-
+!!$    subroutine psb_d_bjac_precsetr(prec,what,val,info)
-    if(psb_get_errstatus() /= 0) return 
+!!$      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
-    info = psb_success_
+!!$      class(psb_d_bjac_prec_type),intent(inout) :: prec
-
+!!$      integer, intent(in)                      :: what 
-    call psb_erractionsave(err_act)
+!!$      real(psb_dpk_), intent(in)               :: val 
-
+!!$      integer, intent(out)                     :: info
-    ictxt=desc_a%get_context()
+!!$    end subroutine psb_d_bjac_precsetr
-    call psb_info(ictxt, me, np)
+!!$  end interface psb_d_bjac_precsetr
-
+!!$  
-    call prec%set_ctxt(ictxt)
+!!$  interface  psb_d_bjac_precsetc
-
+!!$    subroutine psb_d_bjac_precsetc(prec,what,val,info)
-    m = a%get_nrows()
+!!$      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
-    if (m < 0) then
+!!$      class(psb_d_bjac_prec_type),intent(inout) :: prec
-      info = psb_err_iarg_neg_
+!!$      integer, intent(in)                      :: what 
-      int_err(1) = 1
+!!$      character(len=*), intent(in)             :: val
-      int_err(2) = m
+!!$      integer, intent(out)                     :: info
-      call psb_errpush(info,name,i_err=int_err)
+!!$    end subroutine psb_d_bjac_precsetc
-      goto 9999
+!!$  end interface psb_d_bjac_precsetc
-    endif
+!!$  
-    trans = 'N'
+!!$  interface  psb_d_bjac_precfree
-    unitd = 'U'
+!!$    subroutine psb_d_bjac_precfree(prec,info)
+!!$      import :: psb_desc_type, psb_d_bjac_prec_type, psb_d_vect_type, psb_dpk_
+!!$      class(psb_d_bjac_prec_type), intent(inout) :: prec
+!!$      integer, intent(out)                :: info
+!!$    end subroutine psb_d_bjac_precfree
+!!$  end interface psb_d_bjac_precfree
 
-    select case(prec%iprcparm(psb_f_type_))
+contains
 
-    case(psb_f_ilu_n_) 
+  subroutine psb_d_bjac_precdescr(prec,iout)
     
-      if (allocated(prec%av)) then 
+    Implicit None
-        if (size(prec%av) < psb_bp_ilu_avsz) then 
-          do i=1,size(prec%av) 
-            call prec%av(i)%free()
-          enddo
-          deallocate(prec%av,stat=info)
-        endif
-      end if
-      if (.not.allocated(prec%av)) then 
-        allocate(prec%av(psb_max_avsz),stat=info)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_alloc_dealloc_,name)
-          goto 9999
-        end if
-      endif
 
-      nrow_a = desc_a%get_local_rows()
+    class(psb_d_bjac_prec_type), intent(in) :: prec
-      nztota = a%get_nzeros()
+    integer, intent(in), optional    :: iout
 
-      n_col  = desc_a%get_local_cols()
+    Integer :: err_act, nrow, info
-      nhalo  = n_col-nrow_a
+    character(len=20)  :: name='d_bjac_precdescr'
-      n_row  = nrow_a
+    integer :: iout_
 
-      allocate(lf,uf,stat=info)
+    call psb_erractionsave(err_act)
-      if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
-      if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
 
-      if(info /= psb_success_) then
+    info = psb_success_
-        info=psb_err_from_subroutine_
-        ch_err='psb_sp_all'
-        call psb_errpush(info,name,a_err=ch_err)
-        goto 9999
-      end if
    
-      allocate(dd(n_row),stat=info)
+    if (present(iout)) then 
-      if (info == psb_success_) then 
+      iout_ = iout
-        allocate(prec%dv, stat=info)
-        if (info == 0) then 
-          if (present(vmold)) then 
-            allocate(prec%dv%v,mold=vmold,stat=info) 
     else
-            allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) 
+      iout_ = 6 
-          end if
-        end if
     end if
 
-      if (info /= psb_success_) then 
+    if (.not.allocated(prec%iprcparm)) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      info = 1124
-        goto 9999      
+      call psb_errpush(info,name,a_err="preconditioner")
-      endif
-      ! This is where we have no renumbering, thus no need 
-      call psb_ilu_fct(a,lf,uf,dd,info)
-
-      if(info == psb_success_) then
-        call prec%av(psb_l_pr_)%mv_from(lf)
-        call prec%av(psb_u_pr_)%mv_from(uf)
-        call prec%av(psb_l_pr_)%set_asb()
-        call prec%av(psb_u_pr_)%set_asb()
-        call prec%av(psb_l_pr_)%trim()
-        call prec%av(psb_u_pr_)%trim()
-        call prec%dv%bld(dd)
-        call move_alloc(dd,prec%d)
-      else
-        info=psb_err_from_subroutine_
-        ch_err='psb_ilu_fct'
-        call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
     
-    case(psb_f_none_) 
+    write(iout_,*) 'Block Jacobi with: ',&
-      info=psb_err_from_subroutine_
+         &  fact_names(prec%iprcparm(psb_f_type_))
-      ch_err='Inconsistent prec  psb_f_none_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    case default
-      info=psb_err_from_subroutine_
-      ch_err='Unknown psb_f_type_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end select
-
-    if (present(amold)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
-      call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
-    else if (present(afmt)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
-      call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
-    end if
     
     call psb_erractionrestore(err_act)
     return
@@ -517,69 +172,43 @@ contains
     end if
     return
     
-  end subroutine psb_d_bjac_precbld
+  end subroutine psb_d_bjac_precdescr
-
-  subroutine psb_d_bjac_precseti(prec,what,val,info)
-    
-    use psb_base_mod
-    Implicit None
-    
-    class(psb_d_bjac_prec_type),intent(inout) :: prec
-    integer, intent(in)                      :: what 
-    integer, intent(in)                      :: val 
-    integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_bjac_precset'
 
-    call psb_erractionsave(err_act)
 
-    info = psb_success_
+  function psb_d_bjac_sizeof(prec) result(val)
-    if (.not.allocated(prec%iprcparm)) then 
+    class(psb_d_bjac_prec_type), intent(in) :: prec
-      info = 1124
+    integer(psb_long_int_k_) :: val
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
     
-    select case(what)
+    val = 0
-    case (psb_f_type_) 
+    if (allocated(prec%dv)) then 
-      if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      val = val + psb_sizeof_dp * prec%dv%get_nrows()
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_f_type_)     = val
+    if (allocated(prec%av)) then 
-      
+      val = val + prec%av(psb_l_pr_)%sizeof()
-    case (psb_ilu_fill_in_) 
+      val = val + prec%av(psb_u_pr_)%sizeof()
-      if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
-           & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_ilu_fill_in_) = val
+    return
+  end function psb_d_bjac_sizeof
 
-    case default
+  function psb_d_bjac_get_nzeros(prec) result(val)
-      write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
 
-    end select
+    class(psb_d_bjac_prec_type), intent(in) :: prec
+    integer(psb_long_int_k_) :: val
     
-    call psb_erractionrestore(err_act)
+    val = 0
+    if (allocated(prec%dv)) then 
+      val = val + prec%dv%get_nrows()
+    endif
+    if (allocated(prec%av)) then 
+      val = val + prec%av(psb_l_pr_)%get_nzeros()
+      val = val + prec%av(psb_u_pr_)%get_nzeros()
+    endif
     return
+  end function psb_d_bjac_get_nzeros
 
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_d_bjac_precseti
 
   subroutine psb_d_bjac_precsetr(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_d_bjac_prec_type),intent(inout) :: prec
@@ -607,7 +236,6 @@ contains
 
   subroutine psb_d_bjac_precsetc(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_d_bjac_prec_type),intent(inout) :: prec
@@ -635,7 +263,6 @@ contains
 
   subroutine psb_d_bjac_precfree(prec,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_d_bjac_prec_type), intent(inout) :: prec
@@ -673,125 +300,4 @@ contains
 
   end subroutine psb_d_bjac_precfree
 
-
-  subroutine psb_d_bjac_precdescr(prec,iout)
-    
-    use psb_base_mod
-    Implicit None
-
-    class(psb_d_bjac_prec_type), intent(in) :: prec
-    integer, intent(in), optional    :: iout
-
-    Integer :: err_act, nrow, info
-    character(len=20)  :: name='d_bjac_precdescr'
-    integer :: iout_
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-   
-    if (present(iout)) then 
-      iout_ = iout
-    else
-      iout_ = 6 
-    end if
-
-    if (.not.allocated(prec%iprcparm)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    
-    write(iout_,*) 'Block Jacobi with: ',&
-         &  fact_names(prec%iprcparm(psb_f_type_))
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine psb_d_bjac_precdescr
-
-
-  subroutine psb_d_bjac_dump(prec,info,prefix,head)
-    use psb_base_mod
-    implicit none 
-    class(psb_d_bjac_prec_type), intent(in) :: prec
-    integer, intent(out)                    :: info
-    character(len=*), intent(in), optional  :: prefix,head
-    integer :: i, j, il1, iln, lname, lev
-    integer :: ictxt,iam, np
-    character(len=80)  :: prefix_
-    character(len=120) :: fname ! len should be at least 20 more than
-
-    !  len of prefix_ 
-
-    info = 0
-    ictxt = prec%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    if (present(prefix)) then 
-      prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
-    else
-      prefix_ = "dump_fact_d"
-    end if
-
-    lname = len_trim(prefix_)
-    fname = trim(prefix_)
-    write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
-    lname = lname + 5
-    write(fname(lname+1:),'(a)')'_lower.mtx'
-    if (prec%av(psb_l_pr_)%is_asb())  &
-         & call prec%av(psb_l_pr_)%print(fname,head=head)
-    write(fname(lname+1:),'(a,a)')'_diag.mtx'
-    if (allocated(prec%d)) &
-         & call psb_geprt(fname,prec%d,head=head)
-    write(fname(lname+1:),'(a)')'_upper.mtx'
-    if (prec%av(psb_u_pr_)%is_asb()) &
-         & call prec%av(psb_u_pr_)%print(fname,head=head)
-    
-  end subroutine psb_d_bjac_dump
-
-  function psb_d_bjac_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_d_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%d)) then 
-      val = val + psb_sizeof_dp * size(prec%d)
-    endif
-    if (allocated(prec%av)) then 
-      val = val + psb_sizeof(prec%av(psb_l_pr_))
-      val = val + psb_sizeof(prec%av(psb_u_pr_))
-    endif
-    return
-  end function psb_d_bjac_sizeof
-
-  function psb_d_bjac_get_nzeros(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_d_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%dv)) then 
-      val = val + prec%dv%get_nrows()
-    endif
-    if (allocated(prec%av)) then 
-      val = val + prec%av(psb_l_pr_)%get_nzeros()
-      val = val + prec%av(psb_u_pr_)%get_nzeros()
-    endif
-    return
-  end function psb_d_bjac_get_nzeros
-
 end module psb_d_bjacprec

prec/psb_d_diagprec.f90

@@ -2,7 +2,6 @@ module psb_d_diagprec
 
   use psb_d_base_prec_mod
   
-  
   type, extends(psb_d_base_prec_type) :: psb_d_diag_prec_type
     real(psb_dpk_), allocatable     :: d(:)
     type(psb_d_vect_type), allocatable :: dv
@@ -20,17 +19,16 @@ module psb_d_diagprec
     procedure, pass(prec) :: get_nzeros => psb_d_diag_get_nzeros
   end type psb_d_diag_prec_type
 
-  private :: psb_d_diag_apply, psb_d_diag_precbld, psb_d_diag_precseti,&
+  private :: psb_d_diag_precseti,&
        & psb_d_diag_precsetr, psb_d_diag_precsetc, psb_d_diag_sizeof,&
        & psb_d_diag_precinit, psb_d_diag_precfree, psb_d_diag_precdescr,&
-       & psb_d_diag_apply_vect, psb_d_diag_get_nzeros
+       & psb_d_diag_get_nzeros
-  
   
-contains
   
   
+  interface  psb_d_diag_apply_vect
     subroutine psb_d_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_diag_prec_type, psb_d_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_d_diag_prec_type), intent(inout)  :: prec
       type(psb_d_vect_type),intent(inout)   :: x
@@ -39,97 +37,12 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_diag_prec_apply'
-    real(psb_dpk_), pointer :: ww(:)
-    class(psb_d_base_vect_type), allocatable :: dw
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    
-    if (size(work) >= x%get_nrows()) then 
-      ww => work
-    else
-      allocate(ww(x%get_nrows()),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_dpk_)')
-        goto 9999      
-      end if
-    end if
-    
-!!$      allocate(dw, mold=x, stat=info) 
-!!$      call dw%bld(x%get_nrows())
-!!$      if (.true.) then 
-!!$        if (info == 0) call dw%mlt(prec%dv,x,info)
-!!$      else
-!!$        if (info == 0) call dw%axpby(nrow,done,x,dzero,info) 
-!!$        if (info == 0) call dw%mlt(prec%dv,info)
-!!$      end if
-!!$      if (info == 0) call y%axpby(nrow,alpha,dw,beta,info)
-
-    call y%mlt(alpha,prec%dv,x,beta,info)
-
-!!$      call x%mlt(ww,prec%d(1:nrow),info)
-!!$    if (info == 0) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
-
-!!$    call dw%free(info) 
-!!$    if (info /= psb_success_) then 
-!!$      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-!!$      goto 9999      
-!!$    end if
-
-    if (size(work) < x%get_nrows()) then 
-      deallocate(ww,stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-        goto 9999      
-      end if
-    end if
-   
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
     end subroutine psb_d_diag_apply_vect
+  end interface psb_d_diag_apply_vect
   
-
+  interface  psb_d_diag_apply
     subroutine psb_d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_diag_prec_type, psb_d_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_d_diag_prec_type), intent(in)  :: prec
       real(psb_dpk_),intent(inout)      :: x(:)
@@ -138,78 +51,29 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_d_diag_apply
-    character(len=20)  :: name='d_diag_prec_apply'
+  end interface psb_d_diag_apply
-    real(psb_dpk_), pointer :: ww(:)
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    
-    if (size(work) >= size(x)) then 
-      ww => work
-    else
-      allocate(ww(size(x)),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/size(x),0,0,0,0/),a_err='real(psb_dpk_)')
-        goto 9999      
-      end if
-    end if
   
-    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+  interface  psb_d_diag_precbld
-    call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+    subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
+      import :: psb_desc_type, psb_d_diag_prec_type, psb_d_vect_type, psb_dpk_, &
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
+      type(psb_dspmat_type), intent(in), target :: a
+      type(psb_desc_type), intent(in), target   :: desc_a
+      class(psb_d_diag_prec_type),intent(inout) :: prec
+      integer, intent(out)                      :: info
+      character, intent(in), optional           :: upd
+      character(len=*), intent(in), optional    :: afmt
+      class(psb_d_base_sparse_mat), intent(in), optional :: amold
+      class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_d_diag_precbld
+  end interface psb_d_diag_precbld
   
-    if (size(work) < size(x)) then 
-      deallocate(ww,stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-        goto 9999      
-      end if
-    end if
 
-    call psb_erractionrestore(err_act)
+contains
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_d_diag_apply
 
   subroutine psb_d_diag_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_diag_prec_type),intent(inout) :: prec
@@ -235,83 +99,7 @@ contains
   end subroutine psb_d_diag_precinit
 
 
-  subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
-    Implicit None
-    
-    type(psb_dspmat_type), intent(in), target :: a
-    type(psb_desc_type), intent(in), target   :: desc_a
-    class(psb_d_diag_prec_type),intent(inout) :: prec
-    integer, intent(out)                      :: info
-    character, intent(in), optional           :: upd
-    character(len=*), intent(in), optional    :: afmt
-    class(psb_d_base_sparse_mat), intent(in), optional :: amold
-    class(psb_d_base_vect_type), intent(in), optional  :: vmold
-    Integer :: err_act, nrow,i
-    character(len=20)  :: name='d_diag_precbld'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    nrow = desc_a%get_local_cols()
-    if (allocated(prec%d)) then 
-      if (size(prec%d) < nrow) then 
-        deallocate(prec%d,stat=info)
-      end if
-    end if
-    if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
-      allocate(prec%d(nrow), stat=info)
-    end if
-    if (info /= psb_success_) then 
-      info = psb_err_alloc_dealloc_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-
-    call a%get_diag(prec%d,info) 
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name, a_err='get_diag')
-      goto 9999
-    end if
-    
-    do i=1,nrow
-      if (prec%d(i) == dzero) then
-        prec%d(i) = done
-      else
-        prec%d(i) = done/prec%d(i)
-      endif
-    end do
-    allocate(prec%dv,stat=info) 
-    if (info == 0) then 
-      if (present(vmold)) then 
-        allocate(prec%dv%v,mold=vmold,stat=info) 
-      else
-        allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) 
-      end if
-    end if
-    if (info == 0) then 
-      call prec%dv%bld(prec%d)
-    else 
-      write(0,*) 'Error on precbld ',info
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_d_diag_precbld
-
   subroutine psb_d_diag_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_diag_prec_type),intent(inout) :: prec
@@ -339,7 +127,6 @@ contains
 
   subroutine psb_d_diag_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_d_diag_prec_type),intent(inout) :: prec
@@ -366,8 +153,6 @@ contains
   end subroutine psb_d_diag_precsetr
 
   subroutine psb_d_diag_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_diag_prec_type),intent(inout) :: prec
@@ -395,7 +180,6 @@ contains
 
   subroutine psb_d_diag_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_d_diag_prec_type), intent(inout) :: prec
@@ -408,6 +192,8 @@ contains
     
     info = psb_success_
 
+    if (allocated(prec%dv)) call prec%dv%free(info)
+    
     call psb_erractionrestore(err_act)
     return
 
@@ -423,8 +209,6 @@ contains
   
 
   subroutine psb_d_diag_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_d_diag_prec_type), intent(in) :: prec
@@ -465,17 +249,14 @@ contains
   end subroutine psb_d_diag_precdescr
 
   function psb_d_diag_sizeof(prec) result(val)
-    use psb_base_mod, only: psb_long_int_k_
     class(psb_d_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
-    val = 0
+    val = psb_sizeof_dp * prec%get_nzeros()
-    val = val + psb_sizeof_dp * size(prec%d)
     return
   end function psb_d_diag_sizeof
 
   function psb_d_diag_get_nzeros(prec) result(val)
-    use psb_base_mod, only: psb_long_int_k_
     class(psb_d_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
 
@@ -484,4 +265,5 @@ contains
     return
   end function psb_d_diag_get_nzeros
 
+
 end module psb_d_diagprec

prec/psb_d_nullprec.f90

@@ -4,8 +4,8 @@ module psb_d_nullprec
   
   type, extends(psb_d_base_prec_type) :: psb_d_null_prec_type
   contains
-    procedure, pass(prec) :: d_apply_v => psb_d_null_apply_vect
+    procedure, pass(prec) :: c_apply_v => psb_d_null_apply_vect
-    procedure, pass(prec) :: d_apply   => psb_d_null_apply
+    procedure, pass(prec) :: c_apply   => psb_d_null_apply
     procedure, pass(prec) :: precbld   => psb_d_null_precbld
     procedure, pass(prec) :: precinit  => psb_d_null_precinit
     procedure, pass(prec) :: precseti  => psb_d_null_precseti
@@ -16,16 +16,14 @@ module psb_d_nullprec
     procedure, pass(prec) :: sizeof    => psb_d_null_sizeof
   end type psb_d_null_prec_type
 
-  private :: psb_d_null_apply, psb_d_null_precbld, psb_d_null_precseti,&
+  private :: psb_d_null_precbld, psb_d_null_precseti,&
        & psb_d_null_precsetr, psb_d_null_precsetc, psb_d_null_sizeof,&
-       & psb_d_null_precinit, psb_d_null_precfree, psb_d_null_precdescr, &
+       & psb_d_null_precinit, psb_d_null_precfree, psb_d_null_precdescr
-       & psb_d_null_apply_vect
-  
-contains
   
 
+  interface  psb_d_null_apply_vect
     subroutine psb_d_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_null_prec_type, psb_d_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_d_null_prec_type), intent(inout)  :: prec
       type(psb_d_vect_type),intent(inout)  :: x
@@ -34,51 +32,13 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_null_prec_apply'
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the NULL preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
 
     end subroutine psb_d_null_apply_vect
+  end interface psb_d_null_apply_vect
   
+  interface  psb_d_null_apply
     subroutine psb_d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_d_null_prec_type, psb_dpk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_d_null_prec_type), intent(in)  :: prec
       real(psb_dpk_),intent(inout)      :: x(:)
@@ -87,53 +47,15 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       real(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_d_null_apply
-    character(len=20)  :: name='d_null_prec_apply'
+  end interface psb_d_null_apply
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the NULL preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
   
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_d_null_apply
+contains
   
 
   subroutine psb_d_null_precinit(prec,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_d_null_prec_type),intent(inout) :: prec
@@ -160,7 +82,6 @@ contains
 
   subroutine psb_d_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     
-    use psb_base_mod
     Implicit None
     
     type(psb_dspmat_type), intent(in), target :: a
@@ -193,7 +114,6 @@ contains
 
   subroutine psb_d_null_precseti(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_d_null_prec_type),intent(inout) :: prec
@@ -221,7 +141,6 @@ contains
 
   subroutine psb_d_null_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_d_null_prec_type),intent(inout) :: prec
@@ -249,7 +168,6 @@ contains
 
   subroutine psb_d_null_precsetc(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_d_null_prec_type),intent(inout) :: prec
@@ -277,7 +195,6 @@ contains
 
   subroutine psb_d_null_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_d_null_prec_type), intent(inout) :: prec
@@ -306,7 +223,6 @@ contains
 
   subroutine psb_d_null_precdescr(prec,iout)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_d_null_prec_type), intent(in) :: prec
@@ -342,7 +258,7 @@ contains
   end subroutine psb_d_null_precdescr
 
   function psb_d_null_sizeof(prec) result(val)
-    use psb_base_mod
+
     class(psb_d_null_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     

prec/psb_s_base_prec_mod.f90

@@ -38,7 +38,7 @@ module psb_s_base_prec_mod
   ! Reduces size of .mod file.
   use psb_base_mod, only : psb_spk_, psb_long_int_k_,&
        & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
+       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,&
        & psb_s_base_sparse_mat, psb_sspmat_type, psb_s_csr_sparse_mat,& 
        & psb_s_base_vect_type, psb_s_vect_type
 

prec/psb_s_bjacprec.f90

@@ -22,21 +22,26 @@ module psb_s_bjacprec
     procedure, pass(prec) :: get_nzeros => psb_s_bjac_get_nzeros
   end type psb_s_bjac_prec_type
 
-  private :: psb_s_bjac_apply, psb_s_bjac_precbld, psb_s_bjac_precseti,&
+  private :: psb_s_bjac_sizeof, psb_s_bjac_precdescr, psb_s_bjac_get_nzeros
-       & psb_s_bjac_precsetr, psb_s_bjac_precsetc, psb_s_bjac_sizeof,&
-       & psb_s_bjac_precinit, psb_s_bjac_precfree, psb_s_bjac_precdescr,&
-       & psb_s_bjac_dump, psb_s_bjac_apply_vect, psb_s_bjac_get_nzeros
  
 
   character(len=15), parameter, private :: &
        &  fact_names(0:2)=(/'None          ','ILU(n)        ',&
        &  'ILU(eps)      '/)
 
-contains
   
+  interface  psb_s_bjac_dump
+    subroutine psb_s_bjac_dump(prec,info,prefix,head)
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
+      class(psb_s_bjac_prec_type), intent(in) :: prec
+      integer, intent(out)                    :: info
+      character(len=*), intent(in), optional  :: prefix,head
+    end subroutine psb_s_bjac_dump
+  end interface psb_s_bjac_dump
 
+  interface  psb_s_bjac_apply_vect
     subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_s_bjac_prec_type), intent(inout)  :: prec
       real(psb_spk_),intent(in)         :: alpha,beta
@@ -45,148 +50,13 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    real(psb_spk_), pointer :: ww(:), aux(:)
-    type(psb_s_vect_type) :: wv
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='d_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (x%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < n_row) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-    endif
-    if (info == psb_success_) allocate(wv%v,mold=x%v)
-
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call wv%bld(n_col,mold=x%v)
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-
-      case('C')
-        call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    call wv%free(info)
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_s_bjac_apply_vect
+  end interface psb_s_bjac_apply_vect
 
+  interface  psb_s_bjac_apply
     subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
+      
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_s_bjac_prec_type), intent(in)  :: prec
       real(psb_spk_),intent(in)         :: alpha,beta
@@ -195,190 +65,21 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    real(psb_spk_), pointer :: ww(:), aux(:)
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='s_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (size(x) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-!!$    if (.not.allocated(prec%d)) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-!!$    if (size(prec%d) < n_row) then
-!!$      info = 1124
-!!$      call psb_errpush(info,name,a_err="preconditioner: D")
-!!$      goto 9999
-!!$    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        if (info /= psb_success_) then 
-          call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-          goto 9999      
-        end if
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-        goto 9999      
-      end if
-    endif
-    
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      case('C')
-        call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_s_bjac_apply
+  end interface psb_s_bjac_apply
   
+  interface  psb_s_bjac_precinit
     subroutine psb_s_bjac_precinit(prec,info)
-    
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
-    use psb_base_mod
-    Implicit None
-    
       class(psb_s_bjac_prec_type),intent(inout) :: prec
       integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='s_null_precinit'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    call psb_realloc(psb_ifpsz,prec%iprcparm,info)
-    if (info /= psb_success_) then
-      info = psb_err_alloc_dealloc_
-      call psb_Errpush(info,name)
-      goto 9999
-    end if
-    
-    prec%iprcparm(:)                = 0
-    prec%iprcparm(psb_p_type_)      = psb_bjac_
-    prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
-    prec%iprcparm(psb_ilu_fill_in_) = 0
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
     end subroutine psb_s_bjac_precinit
+  end interface psb_s_bjac_precinit
   
-
+  interface  psb_s_bjac_precbld
     subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_, &
-    use psb_base_mod
+           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
-    use psb_prec_mod, only : psb_ilu_fct
-    Implicit None
-
       type(psb_sspmat_type), intent(in), target :: a
       type(psb_desc_type), intent(in), target   :: desc_a
       class(psb_s_bjac_prec_type),intent(inout) :: prec
@@ -387,133 +88,78 @@ contains
       character(len=*), intent(in), optional    :: afmt
       class(psb_s_base_sparse_mat), intent(in), optional :: amold
       class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_s_bjac_precbld
+  end interface psb_s_bjac_precbld
   
-    !     .. Local Scalars ..                                                       
+  interface  psb_s_bjac_precseti
-    integer  ::    i, m
+    subroutine psb_s_bjac_precseti(prec,what,val,info)
-    integer  ::    int_err(5)
+      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
-    character ::        trans, unitd
+      class(psb_s_bjac_prec_type),intent(inout) :: prec
-    type(psb_s_csr_sparse_mat), allocatable  :: lf, uf
+      integer, intent(in)                      :: what 
-    real(psb_spk_), allocatable :: dd(:)
+      integer, intent(in)                      :: val 
-    integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+      integer, intent(out)                     :: info
-    integer :: ictxt,np,me
+    end subroutine psb_s_bjac_precseti
-    character(len=20)  :: name='s_bjac_precbld'
+  end interface psb_s_bjac_precseti
-    character(len=20)  :: ch_err
+  
-
+!!$  interface  psb_s_bjac_precsetr
-
+!!$    subroutine psb_s_bjac_precsetr(prec,what,val,info)
-    if(psb_get_errstatus() /= 0) return 
+!!$      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
-    info = psb_success_
+!!$      class(psb_s_bjac_prec_type),intent(inout) :: prec
-
+!!$      integer, intent(in)                      :: what 
-    call psb_erractionsave(err_act)
+!!$      real(psb_spk_), intent(in)               :: val 
-
+!!$      integer, intent(out)                     :: info
-    ictxt=desc_a%get_context()
+!!$    end subroutine psb_s_bjac_precsetr
-    call psb_info(ictxt, me, np)
+!!$  end interface psb_s_bjac_precsetr
-
+!!$  
-    call prec%set_ctxt(ictxt)
+!!$  interface  psb_s_bjac_precsetc
-
+!!$    subroutine psb_s_bjac_precsetc(prec,what,val,info)
-    m = a%get_nrows()
+!!$      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
-    if (m < 0) then
+!!$      class(psb_s_bjac_prec_type),intent(inout) :: prec
-      info = psb_err_iarg_neg_
+!!$      integer, intent(in)                      :: what 
-      int_err(1) = 1
+!!$      character(len=*), intent(in)             :: val
-      int_err(2) = m
+!!$      integer, intent(out)                     :: info
-      call psb_errpush(info,name,i_err=int_err)
+!!$    end subroutine psb_s_bjac_precsetc
-      goto 9999
+!!$  end interface psb_s_bjac_precsetc
-    endif
+!!$  
-    trans = 'N'
+!!$  interface  psb_s_bjac_precfree
-    unitd = 'U'
+!!$    subroutine psb_s_bjac_precfree(prec,info)
+!!$      import :: psb_desc_type, psb_s_bjac_prec_type, psb_s_vect_type, psb_spk_
+!!$      class(psb_s_bjac_prec_type), intent(inout) :: prec
+!!$      integer, intent(out)                :: info
+!!$    end subroutine psb_s_bjac_precfree
+!!$  end interface psb_s_bjac_precfree
 
-    select case(prec%iprcparm(psb_f_type_))
+contains
 
-    case(psb_f_ilu_n_) 
+  subroutine psb_s_bjac_precdescr(prec,iout)
     
-      if (allocated(prec%av)) then 
+    Implicit None
-        if (size(prec%av) < psb_bp_ilu_avsz) then 
-          do i=1,size(prec%av) 
-            call prec%av(i)%free()
-          enddo
-          deallocate(prec%av,stat=info)
-        endif
-      end if
-      if (.not.allocated(prec%av)) then 
-        allocate(prec%av(psb_max_avsz),stat=info)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_alloc_dealloc_,name)
-          goto 9999
-        end if
-      endif
 
-      nrow_a = desc_a%get_local_rows()
+    class(psb_s_bjac_prec_type), intent(in) :: prec
-      nztota = a%get_nzeros()
+    integer, intent(in), optional    :: iout
 
-      n_col  = desc_a%get_local_cols()
+    Integer :: err_act, nrow, info
-      nhalo  = n_col-nrow_a
+    character(len=20)  :: name='s_bjac_precdescr'
-      n_row  = nrow_a
+    integer :: iout_
 
-      allocate(lf,uf,stat=info)
+    call psb_erractionsave(err_act)
-      if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
-      if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
 
-      if(info /= psb_success_) then
+    info = psb_success_
-        info=psb_err_from_subroutine_
-        ch_err='psb_sp_all'
-        call psb_errpush(info,name,a_err=ch_err)
-        goto 9999
-      end if
    
-      allocate(dd(n_row),stat=info)
+    if (present(iout)) then 
-      if (info == psb_success_) then 
+      iout_ = iout
-        allocate(prec%dv, stat=info)
-        if (info == 0) then 
-          if (present(vmold)) then 
-            allocate(prec%dv%v,mold=vmold,stat=info) 
     else
-            allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) 
+      iout_ = 6 
-          end if
-        end if
     end if
 
-      if (info /= psb_success_) then 
+    if (.not.allocated(prec%iprcparm)) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      info = 1124
-        goto 9999      
+      call psb_errpush(info,name,a_err="preconditioner")
-      endif
-      ! This is where we have no renumbering, thus no need 
-      call psb_ilu_fct(a,lf,uf,dd,info)
-
-      if(info == psb_success_) then
-        call prec%av(psb_l_pr_)%mv_from(lf)
-        call prec%av(psb_u_pr_)%mv_from(uf)
-        call prec%av(psb_l_pr_)%set_asb()
-        call prec%av(psb_u_pr_)%set_asb()
-        call prec%av(psb_l_pr_)%trim()
-        call prec%av(psb_u_pr_)%trim()
-        call prec%dv%bld(dd)
-        call move_alloc(dd,prec%d)
-      else
-        info=psb_err_from_subroutine_
-        ch_err='psb_ilu_fct'
-        call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
     
-    case(psb_f_none_) 
+    write(iout_,*) 'Block Jacobi with: ',&
-      info=psb_err_from_subroutine_
+         &  fact_names(prec%iprcparm(psb_f_type_))
-      ch_err='Inconsistent prec  psb_f_none_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    case default
-      info=psb_err_from_subroutine_
-      ch_err='Unknown psb_f_type_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end select
-
-    if (present(amold)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
-      call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
-    else if (present(afmt)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
-      call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
-    end if
     
     call psb_erractionrestore(err_act)
     return
@@ -526,69 +172,43 @@ contains
     end if
     return
     
-  end subroutine psb_s_bjac_precbld
+  end subroutine psb_s_bjac_precdescr
-
-  subroutine psb_s_bjac_precseti(prec,what,val,info)
-    
-    use psb_base_mod
-    Implicit None
-    
-    class(psb_s_bjac_prec_type),intent(inout) :: prec
-    integer, intent(in)                      :: what 
-    integer, intent(in)                      :: val 
-    integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='s_bjac_precset'
 
-    call psb_erractionsave(err_act)
 
-    info = psb_success_
+  function psb_s_bjac_sizeof(prec) result(val)
-    if (.not.allocated(prec%iprcparm)) then 
+    class(psb_s_bjac_prec_type), intent(in) :: prec
-      info = 1124
+    integer(psb_long_int_k_) :: val
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
     
-    select case(what)
+    val = 0
-    case (psb_f_type_) 
+    if (allocated(prec%dv)) then 
-      if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      val = val + psb_sizeof_sp * prec%dv%get_nrows()
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_f_type_)     = val
+    if (allocated(prec%av)) then 
-      
+      val = val + prec%av(psb_l_pr_)%sizeof()
-    case (psb_ilu_fill_in_) 
+      val = val + prec%av(psb_u_pr_)%sizeof()
-      if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
-           & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_ilu_fill_in_) = val
+    return
+  end function psb_s_bjac_sizeof
 
-    case default
+  function psb_s_bjac_get_nzeros(prec) result(val)
-      write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
 
-    end select
+    class(psb_s_bjac_prec_type), intent(in) :: prec
+    integer(psb_long_int_k_) :: val
     
-    call psb_erractionrestore(err_act)
+    val = 0
+    if (allocated(prec%dv)) then 
+      val = val + prec%dv%get_nrows()
+    endif
+    if (allocated(prec%av)) then 
+      val = val + prec%av(psb_l_pr_)%get_nzeros()
+      val = val + prec%av(psb_u_pr_)%get_nzeros()
+    endif
     return
+  end function psb_s_bjac_get_nzeros
 
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_s_bjac_precseti
 
   subroutine psb_s_bjac_precsetr(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_s_bjac_prec_type),intent(inout) :: prec
@@ -616,7 +236,6 @@ contains
 
   subroutine psb_s_bjac_precsetc(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_s_bjac_prec_type),intent(inout) :: prec
@@ -644,7 +263,6 @@ contains
 
   subroutine psb_s_bjac_precfree(prec,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_s_bjac_prec_type), intent(inout) :: prec
@@ -682,125 +300,4 @@ contains
 
   end subroutine psb_s_bjac_precfree
 
-
-  subroutine psb_s_bjac_precdescr(prec,iout)
-    
-    use psb_base_mod
-    Implicit None
-
-    class(psb_s_bjac_prec_type), intent(in) :: prec
-    integer, intent(in), optional    :: iout
-
-    Integer :: err_act, nrow, info
-    character(len=20)  :: name='s_bjac_precdescr'
-    integer :: iout_
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-   
-    if (present(iout)) then 
-      iout_ = iout
-    else
-      iout_ = 6 
-    end if
-
-    if (.not.allocated(prec%iprcparm)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    
-    write(iout_,*) 'Block Jacobi with: ',&
-         &  fact_names(prec%iprcparm(psb_f_type_))
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine psb_s_bjac_precdescr
-
-
-  subroutine psb_s_bjac_dump(prec,info,prefix,head)
-    use psb_base_mod
-    implicit none 
-    class(psb_s_bjac_prec_type), intent(in) :: prec
-    integer, intent(out)                    :: info
-    character(len=*), intent(in), optional  :: prefix,head
-    integer :: i, j, il1, iln, lname, lev
-    integer :: ictxt,iam, np
-    character(len=80)  :: prefix_
-    character(len=120) :: fname ! len should be at least 20 more than
-
-    !  len of prefix_ 
-
-    info = 0
-    ictxt = prec%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    if (present(prefix)) then 
-      prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
-    else
-      prefix_ = "dump_fact_d"
-    end if
-
-    lname = len_trim(prefix_)
-    fname = trim(prefix_)
-    write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
-    lname = lname + 5
-    write(fname(lname+1:),'(a)')'_lower.mtx'
-    if (prec%av(psb_l_pr_)%is_asb())  &
-         & call prec%av(psb_l_pr_)%print(fname,head=head)
-    write(fname(lname+1:),'(a,a)')'_diag.mtx'
-    if (allocated(prec%d)) &
-         & call psb_geprt(fname,prec%d,head=head)
-    write(fname(lname+1:),'(a)')'_upper.mtx'
-    if (prec%av(psb_u_pr_)%is_asb()) &
-         & call prec%av(psb_u_pr_)%print(fname,head=head)
-    
-  end subroutine psb_s_bjac_dump
-
-  function psb_s_bjac_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_s_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%d)) then 
-      val = val + psb_sizeof_sp * size(prec%d)
-    endif
-    if (allocated(prec%av)) then 
-      val = val + psb_sizeof(prec%av(psb_l_pr_))
-      val = val + psb_sizeof(prec%av(psb_u_pr_))
-    endif
-    return
-  end function psb_s_bjac_sizeof
-
-  function psb_s_bjac_get_nzeros(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_s_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-
-    val = 0
-    if (allocated(prec%dv)) then 
-      val = val + prec%dv%get_nrows()
-    endif
-    if (allocated(prec%av)) then 
-      val = val + prec%av(psb_l_pr_)%get_nzeros()
-      val = val + prec%av(psb_u_pr_)%get_nzeros()
-    endif
-    return
-  end function psb_s_bjac_get_nzeros
-
 end module psb_s_bjacprec

prec/psb_s_diagprec.f90

@@ -19,17 +19,16 @@ module psb_s_diagprec
     procedure, pass(prec) :: get_nzeros => psb_s_diag_get_nzeros
   end type psb_s_diag_prec_type
 
-  private :: psb_s_diag_apply, psb_s_diag_precbld, psb_s_diag_precseti,&
+  private :: psb_s_diag_precseti,&
        & psb_s_diag_precsetr, psb_s_diag_precsetc, psb_s_diag_sizeof,&
        & psb_s_diag_precinit, psb_s_diag_precfree, psb_s_diag_precdescr,&
-       & psb_s_diag_apply_vect, psb_s_diag_get_nzeros
+       & psb_s_diag_get_nzeros
   
   
-contains
-  
   
+  interface  psb_s_diag_apply_vect
     subroutine psb_s_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_diag_prec_type, psb_s_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_s_diag_prec_type), intent(inout)  :: prec
       type(psb_s_vect_type),intent(inout)   :: x
@@ -38,97 +37,12 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_diag_prec_apply'
-    real(psb_spk_), pointer :: ww(:)
-    class(psb_s_base_vect_type), allocatable :: dw
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    
-    if (size(work) >= x%get_nrows()) then 
-      ww => work
-    else
-      allocate(ww(x%get_nrows()),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_spk_)')
-        goto 9999      
-      end if
-    end if
-    
-!!$      allocate(dw, mold=x, stat=info) 
-!!$      call dw%bld(x%get_nrows())
-!!$      if (.true.) then 
-!!$        if (info == 0) call dw%mlt(prec%dv,x,info)
-!!$      else
-!!$        if (info == 0) call dw%axpby(nrow,done,x,dzero,info) 
-!!$        if (info == 0) call dw%mlt(prec%dv,info)
-!!$      end if
-!!$      if (info == 0) call y%axpby(nrow,alpha,dw,beta,info)
-
-    call y%mlt(alpha,prec%dv,x,beta,info)
-
-!!$      call x%mlt(ww,prec%d(1:nrow),info)
-!!$    if (info == 0) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
-
-!!$    call dw%free(info) 
-!!$    if (info /= psb_success_) then 
-!!$      call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-!!$      goto 9999      
-!!$    end if
-
-    if (size(work) < x%get_nrows()) then 
-      deallocate(ww,stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-        goto 9999      
-      end if
-    end if
-   
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
     end subroutine psb_s_diag_apply_vect
+  end interface psb_s_diag_apply_vect
   
-
+  interface  psb_s_diag_apply
     subroutine psb_s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_diag_prec_type, psb_s_vect_type, psb_spk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_s_diag_prec_type), intent(in)  :: prec
       real(psb_spk_),intent(inout)      :: x(:)
@@ -137,94 +51,29 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_s_diag_apply
-    character :: trans_
+  end interface psb_s_diag_apply
-    character(len=20)  :: name='s_diag_prec_apply'
-    real(psb_spk_), pointer :: ww(:)
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (present(trans)) then 
-      trans_ = psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    select case(trans_)
-    case('N')
-    case('T','C')
-    case default
-      info=psb_err_iarg_invalid_i_
-      call psb_errpush(info,name,&
-           & i_err=(/6,0,0,0,0/),a_err=trans_)
-      goto 9999
-    end select
-    
-    if (size(work) >= size(x)) then 
-      ww => work
-    else
-      allocate(ww(size(x)),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/size(x),0,0,0,0/),a_err='real(psb_spk_)')
-        goto 9999      
-      end if
-    end if
-
-    ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
-    call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
   
-    if (size(work) < size(x)) then 
+  interface  psb_s_diag_precbld
-      deallocate(ww,stat=info)
+    subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-      if (info /= psb_success_) then 
+      import :: psb_desc_type, psb_s_diag_prec_type, psb_s_vect_type, psb_spk_, &
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type
-        goto 9999      
+      type(psb_sspmat_type), intent(in), target :: a
-      end if
+      type(psb_desc_type), intent(in), target   :: desc_a
-    end if
+      class(psb_s_diag_prec_type),intent(inout) :: prec
+      integer, intent(out)                      :: info
+      character, intent(in), optional           :: upd
+      character(len=*), intent(in), optional    :: afmt
+      class(psb_s_base_sparse_mat), intent(in), optional :: amold
+      class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_s_diag_precbld
+  end interface psb_s_diag_precbld
   
-    call psb_erractionrestore(err_act)
-    return
 
-9999 continue
+contains
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_s_diag_apply
 
   subroutine psb_s_diag_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_diag_prec_type),intent(inout) :: prec
@@ -250,83 +99,7 @@ contains
   end subroutine psb_s_diag_precinit
 
 
-  subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
-    Implicit None
-    
-    type(psb_sspmat_type), intent(in), target :: a
-    type(psb_desc_type), intent(in), target   :: desc_a
-    class(psb_s_diag_prec_type),intent(inout) :: prec
-    integer, intent(out)                      :: info
-    character, intent(in), optional           :: upd
-    character(len=*), intent(in), optional    :: afmt
-    class(psb_s_base_sparse_mat), intent(in), optional :: amold
-    class(psb_s_base_vect_type), intent(in), optional  :: vmold
-    Integer :: err_act, nrow,i
-    character(len=20)  :: name='s_diag_precbld'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    nrow = desc_a%get_local_cols()
-    if (allocated(prec%d)) then 
-      if (size(prec%d) < nrow) then 
-        deallocate(prec%d,stat=info)
-      end if
-    end if
-    if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
-      allocate(prec%d(nrow), stat=info)
-    end if
-    if (info /= psb_success_) then 
-      info = psb_err_alloc_dealloc_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-
-    call a%get_diag(prec%d,info) 
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name, a_err='get_diag')
-      goto 9999
-    end if
-    
-    do i=1,nrow
-      if (prec%d(i) == dzero) then
-        prec%d(i) = done
-      else
-        prec%d(i) = done/prec%d(i)
-      endif
-    end do
-    allocate(prec%dv,stat=info) 
-    if (info == 0) then 
-      if (present(vmold)) then 
-        allocate(prec%dv%v,mold=vmold,stat=info) 
-      else
-        allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) 
-      end if
-    end if
-    if (info == 0) then 
-      call prec%dv%bld(prec%d)
-    else 
-      write(0,*) 'Error on precbld ',info
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_s_diag_precbld
-
   subroutine psb_s_diag_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_diag_prec_type),intent(inout) :: prec
@@ -354,7 +127,6 @@ contains
 
   subroutine psb_s_diag_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_s_diag_prec_type),intent(inout) :: prec
@@ -381,8 +153,6 @@ contains
   end subroutine psb_s_diag_precsetr
 
   subroutine psb_s_diag_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_diag_prec_type),intent(inout) :: prec
@@ -410,7 +180,6 @@ contains
 
   subroutine psb_s_diag_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_s_diag_prec_type), intent(inout) :: prec
@@ -440,8 +209,6 @@ contains
   
 
   subroutine psb_s_diag_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_s_diag_prec_type), intent(in) :: prec
@@ -482,17 +249,14 @@ contains
   end subroutine psb_s_diag_precdescr
 
   function psb_s_diag_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
     class(psb_s_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
-    val = 0
+    val = psb_sizeof_sp * prec%get_nzeros()
-    val = val + psb_sizeof_sp * size(prec%d)
     return
   end function psb_s_diag_sizeof
 
   function psb_s_diag_get_nzeros(prec) result(val)
-    use psb_base_mod, only: psb_long_int_k_
     class(psb_s_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
 
@@ -501,4 +265,5 @@ contains
     return
   end function psb_s_diag_get_nzeros
 
+
 end module psb_s_diagprec

prec/psb_s_nullprec.f90

@@ -4,8 +4,8 @@ module psb_s_nullprec
   
   type, extends(psb_s_base_prec_type) :: psb_s_null_prec_type
   contains
-    procedure, pass(prec) :: s_apply_v => psb_s_null_apply_vect
+    procedure, pass(prec) :: c_apply_v => psb_s_null_apply_vect
-    procedure, pass(prec) :: s_apply   => psb_s_null_apply
+    procedure, pass(prec) :: c_apply   => psb_s_null_apply
     procedure, pass(prec) :: precbld   => psb_s_null_precbld
     procedure, pass(prec) :: precinit  => psb_s_null_precinit
     procedure, pass(prec) :: precseti  => psb_s_null_precseti
@@ -16,16 +16,14 @@ module psb_s_nullprec
     procedure, pass(prec) :: sizeof    => psb_s_null_sizeof
   end type psb_s_null_prec_type
 
-  private :: psb_s_null_apply, psb_s_null_precbld, psb_s_null_precseti,&
+  private :: psb_s_null_precbld, psb_s_null_precseti,&
        & psb_s_null_precsetr, psb_s_null_precsetc, psb_s_null_sizeof,&
-       & psb_s_null_precinit, psb_s_null_precfree, psb_s_null_precdescr, &
+       & psb_s_null_precinit, psb_s_null_precfree, psb_s_null_precdescr
-       & psb_s_null_apply_vect
-  
-contains
   
 
+  interface  psb_s_null_apply_vect
     subroutine psb_s_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_null_prec_type, psb_s_vect_type, psb_spk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_s_null_prec_type), intent(inout)  :: prec
       type(psb_s_vect_type),intent(inout)  :: x
@@ -34,51 +32,13 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_null_prec_apply'
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the NULL preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
 
     end subroutine psb_s_null_apply_vect
+  end interface psb_s_null_apply_vect
   
+  interface  psb_s_null_apply
     subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_s_null_prec_type, psb_spk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_s_null_prec_type), intent(in)  :: prec
       real(psb_spk_),intent(inout)      :: x(:)
@@ -87,51 +47,15 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       real(psb_spk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_s_null_apply
-    character(len=20)  :: name='s_null_prec_apply'
+  end interface psb_s_null_apply
-
-    call psb_erractionsave(err_act)
-
-    !
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
   
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_s_null_apply
+contains
   
 
   subroutine psb_s_null_precinit(prec,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_s_null_prec_type),intent(inout) :: prec
@@ -158,7 +82,6 @@ contains
 
   subroutine psb_s_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     
-    use psb_base_mod
     Implicit None
     
     type(psb_sspmat_type), intent(in), target :: a
@@ -191,7 +114,6 @@ contains
 
   subroutine psb_s_null_precseti(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_s_null_prec_type),intent(inout) :: prec
@@ -219,7 +141,6 @@ contains
 
   subroutine psb_s_null_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_s_null_prec_type),intent(inout) :: prec
@@ -247,7 +168,6 @@ contains
 
   subroutine psb_s_null_precsetc(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_s_null_prec_type),intent(inout) :: prec
@@ -275,7 +195,6 @@ contains
 
   subroutine psb_s_null_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_s_null_prec_type), intent(inout) :: prec
@@ -304,7 +223,6 @@ contains
 
   subroutine psb_s_null_precdescr(prec,iout)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_s_null_prec_type), intent(in) :: prec
@@ -340,7 +258,7 @@ contains
   end subroutine psb_s_null_precdescr
 
   function psb_s_null_sizeof(prec) result(val)
-    use psb_base_mod
+
     class(psb_s_null_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     

prec/psb_z_base_prec_mod.f90

@@ -38,7 +38,7 @@ module psb_z_base_prec_mod
   ! Reduces size of .mod file.
   use psb_base_mod, only : psb_dpk_, psb_long_int_k_,&
        & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
+       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus, psb_success_,&
        & psb_z_base_sparse_mat, psb_zspmat_type, psb_z_csr_sparse_mat,& 
        & psb_z_base_vect_type, psb_z_vect_type
 

prec/psb_z_bjacprec.f90

@@ -22,20 +22,26 @@ module psb_z_bjacprec
     procedure, pass(prec) :: get_nzeros => psb_z_bjac_get_nzeros
   end type psb_z_bjac_prec_type
 
-  private :: psb_z_bjac_apply, psb_z_bjac_precbld, psb_z_bjac_precseti,&
+  private :: psb_z_bjac_sizeof, psb_z_bjac_precdescr, psb_z_bjac_get_nzeros
-       & psb_z_bjac_precsetr, psb_z_bjac_precsetc, psb_z_bjac_sizeof,&
-       & psb_z_bjac_precinit, psb_z_bjac_precfree, psb_z_bjac_precdescr,&
-       & psb_z_bjac_dump, psb_z_bjac_apply_vect, psb_z_bjac_get_nzeros
  
 
   character(len=15), parameter, private :: &
        &  fact_names(0:2)=(/'None          ','ILU(n)        ',&
        &  'ILU(eps)      '/)
 
-contains
   
+  interface  psb_z_bjac_dump
+    subroutine psb_z_bjac_dump(prec,info,prefix,head)
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
+      class(psb_z_bjac_prec_type), intent(in) :: prec
+      integer, intent(out)                    :: info
+      character(len=*), intent(in), optional  :: prefix,head
+    end subroutine psb_z_bjac_dump
+  end interface psb_z_bjac_dump
+
+  interface  psb_z_bjac_apply_vect
     subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_z_bjac_prec_type), intent(inout)  :: prec
       complex(psb_dpk_),intent(in)         :: alpha,beta
@@ -44,148 +50,13 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    complex(psb_dpk_), pointer :: ww(:), aux(:)
-    type(psb_z_vect_type) :: wv
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='d_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (x%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < n_row) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-    endif
-    if (info == psb_success_) allocate(wv%v,mold=x%v)
-
-    if (info /= psb_success_) then 
-      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call wv%bld(n_col,mold=x%v)
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-
-      case('C')
-        write(0,*) 'WARNING: Conjguate case not fixed yet'
-        call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),wv,&
-             & beta,y,desc_data,info,&
-           & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    call wv%free(info)
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_z_bjac_apply_vect
+  end interface psb_z_bjac_apply_vect
 
+  interface  psb_z_bjac_apply
     subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
+      
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_z_bjac_prec_type), intent(in)  :: prec
       complex(psb_dpk_),intent(in)         :: alpha,beta
@@ -194,183 +65,21 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-
-    ! Local variables
-    integer :: n_row,n_col
-    complex(psb_dpk_), pointer :: ww(:), aux(:)
-    integer :: ictxt,np,me, err_act, int_err(5)
-    integer            :: debug_level, debug_unit
-    character          :: trans_
-    character(len=20)  :: name='c_bjac_prec_apply'
-    character(len=20)  :: ch_err
-
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-    ictxt       = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    
-    trans_ = psb_toupper(trans)
-    select case(trans_)
-    case('N','T','C')
-      ! Ok
-    case default
-      call psb_errpush(psb_err_iarg_invalid_i_,name)
-      goto 9999
-    end select
-    
-    
-    n_row = desc_data%get_local_rows()
-    n_col = desc_data%get_local_cols()
-
-    if (size(x) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < n_row) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/))
-      goto 9999
-    end if
-
-    
-    if (n_col <= size(work)) then 
-      ww => work(1:n_col)
-      if ((4*n_col+n_col) <= size(work)) then 
-        aux => work(n_col+1:)
-      else
-        allocate(aux(4*n_col),stat=info)
-        if (info /= psb_success_) then 
-          call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-          goto 9999      
-        end if
-        
-      endif
-    else
-      allocate(ww(n_col),aux(4*n_col),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
-        goto 9999      
-      end if
-    endif
-    
-    
-    select case(prec%iprcparm(psb_f_type_))
-    case(psb_f_ilu_n_) 
-      
-      select case(trans_)
-      case('N')
-        call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux)
-        if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_, work=aux)
-        
-      case('T')
-        call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
-             & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux)
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      case('C')
-!!$        call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
-!!$             & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux)
-        call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
-             & trans=trans_,scale='L',choice=psb_none_, work=aux)
-        ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row))
-        if(info == psb_success_)  call psb_spsm(alpha,prec%av(psb_l_pr_),ww,&
-             & beta,y,desc_data,info,&
-             & trans=trans_,scale='U',choice=psb_none_,work=aux)
-        
-      end select
-      if (info /= psb_success_) then 
-        ch_err="psb_spsm"
-        goto 9999
-      end if
-      
-      
-    case default
-      info = psb_err_internal_error_
-      call psb_errpush(info,name,a_err='Invalid factorization')
-      goto 9999
-    end select
-    
-    call psb_halo(y,desc_data,info,data=psb_comm_mov_)
-    
-    if (n_col <= size(work)) then 
-      if ((4*n_col+n_col) <= size(work)) then 
-      else
-        deallocate(aux)
-      endif
-    else
-      deallocate(ww,aux)
-    endif
-    
-    
-    call psb_erractionrestore(err_act)
-    return
-    
-9999 continue
-    call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-
     end subroutine psb_z_bjac_apply
+  end interface psb_z_bjac_apply
   
+  interface  psb_z_bjac_precinit
     subroutine psb_z_bjac_precinit(prec,info)
-    
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
-    use psb_base_mod
-    Implicit None
-    
       class(psb_z_bjac_prec_type),intent(inout) :: prec
       integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='z_bjac_precinit'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    call psb_realloc(psb_ifpsz,prec%iprcparm,info)
-    if (info /= psb_success_) then
-      info = psb_err_alloc_dealloc_
-      call psb_Errpush(info,name)
-      goto 9999
-    end if
-    
-    prec%iprcparm(:)                = 0
-    prec%iprcparm(psb_p_type_)      = psb_bjac_
-    prec%iprcparm(psb_f_type_)      = psb_f_ilu_n_
-    prec%iprcparm(psb_ilu_fill_in_) = 0
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
     end subroutine psb_z_bjac_precinit
+  end interface psb_z_bjac_precinit
   
-
+  interface  psb_z_bjac_precbld
     subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_, &
-    use psb_base_mod
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
-    use psb_prec_mod, only : psb_ilu_fct
-    Implicit None
-
       type(psb_zspmat_type), intent(in), target :: a
       type(psb_desc_type), intent(in), target   :: desc_a
       class(psb_z_bjac_prec_type),intent(inout) :: prec
@@ -379,133 +88,78 @@ contains
       character(len=*), intent(in), optional    :: afmt
       class(psb_z_base_sparse_mat), intent(in), optional :: amold
       class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    end subroutine psb_z_bjac_precbld
+  end interface psb_z_bjac_precbld
   
-    !     .. Local Scalars ..                                                       
+  interface  psb_z_bjac_precseti
-    integer  ::    i, m
+    subroutine psb_z_bjac_precseti(prec,what,val,info)
-    integer  ::    int_err(5)
+      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
-    character ::        trans, unitd
+      class(psb_z_bjac_prec_type),intent(inout) :: prec
-    type(psb_z_csr_sparse_mat), allocatable  :: lf, uf
+      integer, intent(in)                      :: what 
-    complex(psb_dpk_), allocatable :: dd(:)
+      integer, intent(in)                      :: val 
-    integer   nztota,  err_act, n_row, nrow_a,n_col, nhalo
+      integer, intent(out)                     :: info
-    integer :: ictxt,np,me
+    end subroutine psb_z_bjac_precseti
-    character(len=20)  :: name='z_bjac_precbld'
+  end interface psb_z_bjac_precseti
-    character(len=20)  :: ch_err
+  
-
+!!$  interface  psb_z_bjac_precsetr
-
+!!$    subroutine psb_z_bjac_precsetr(prec,what,val,info)
-    if(psb_get_errstatus() /= 0) return 
+!!$      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
-    info = psb_success_
+!!$      class(psb_z_bjac_prec_type),intent(inout) :: prec
-
+!!$      integer, intent(in)                      :: what 
-    call psb_erractionsave(err_act)
+!!$      real(psb_dpk_), intent(in)               :: val 
-
+!!$      integer, intent(out)                     :: info
-    ictxt=desc_a%get_context()
+!!$    end subroutine psb_z_bjac_precsetr
-    call psb_info(ictxt, me, np)
+!!$  end interface psb_z_bjac_precsetr
-
+!!$  
-    call prec%set_ctxt(ictxt)
+!!$  interface  psb_z_bjac_precsetc
-
+!!$    subroutine psb_z_bjac_precsetc(prec,what,val,info)
-    m = a%get_nrows()
+!!$      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
-    if (m < 0) then
+!!$      class(psb_z_bjac_prec_type),intent(inout) :: prec
-      info = psb_err_iarg_neg_
+!!$      integer, intent(in)                      :: what 
-      int_err(1) = 1
+!!$      character(len=*), intent(in)             :: val
-      int_err(2) = m
+!!$      integer, intent(out)                     :: info
-      call psb_errpush(info,name,i_err=int_err)
+!!$    end subroutine psb_z_bjac_precsetc
-      goto 9999
+!!$  end interface psb_z_bjac_precsetc
-    endif
+!!$  
-    trans = 'N'
+!!$  interface  psb_z_bjac_precfree
-    unitd = 'U'
+!!$    subroutine psb_z_bjac_precfree(prec,info)
+!!$      import :: psb_desc_type, psb_z_bjac_prec_type, psb_z_vect_type, psb_dpk_
+!!$      class(psb_z_bjac_prec_type), intent(inout) :: prec
+!!$      integer, intent(out)                :: info
+!!$    end subroutine psb_z_bjac_precfree
+!!$  end interface psb_z_bjac_precfree
 
-    select case(prec%iprcparm(psb_f_type_))
+contains
 
-    case(psb_f_ilu_n_) 
+  subroutine psb_z_bjac_precdescr(prec,iout)
     
-      if (allocated(prec%av)) then 
+    Implicit None
-        if (size(prec%av) < psb_bp_ilu_avsz) then 
-          do i=1,size(prec%av) 
-            call prec%av(i)%free()
-          enddo
-          deallocate(prec%av,stat=info)
-        endif
-      end if
-      if (.not.allocated(prec%av)) then 
-        allocate(prec%av(psb_max_avsz),stat=info)
-        if (info /= psb_success_) then
-          call psb_errpush(psb_err_alloc_dealloc_,name)
-          goto 9999
-        end if
-      endif
 
-      nrow_a = desc_a%get_local_rows()
+    class(psb_z_bjac_prec_type), intent(in) :: prec
-      nztota = a%get_nzeros()
+    integer, intent(in), optional    :: iout
 
-      n_col  = desc_a%get_local_cols()
+    Integer :: err_act, nrow, info
-      nhalo  = n_col-nrow_a
+    character(len=20)  :: name='z_bjac_precdescr'
-      n_row  = nrow_a
+    integer :: iout_
 
-      allocate(lf,uf,stat=info)
+    call psb_erractionsave(err_act)
-      if (info == psb_success_) call lf%allocate(n_row,n_row,nztota)
-      if (info == psb_success_) call uf%allocate(n_row,n_row,nztota)
 
-      if(info /= psb_success_) then
+    info = psb_success_
-        info=psb_err_from_subroutine_
-        ch_err='psb_sp_all'
-        call psb_errpush(info,name,a_err=ch_err)
-        goto 9999
-      end if
    
-      allocate(dd(n_row),stat=info)
+    if (present(iout)) then 
-      if (info == psb_success_) then 
+      iout_ = iout
-        allocate(prec%dv, stat=info)
-        if (info == 0) then 
-          if (present(vmold)) then 
-            allocate(prec%dv%v,mold=vmold,stat=info) 
     else
-            allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) 
+      iout_ = 6 
-          end if
-        end if
     end if
 
-      if (info /= psb_success_) then 
+    if (.not.allocated(prec%iprcparm)) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
+      info = 1124
-        goto 9999      
+      call psb_errpush(info,name,a_err="preconditioner")
-      endif
-      ! This is where we have no renumbering, thus no need 
-      call psb_ilu_fct(a,lf,uf,dd,info)
-
-      if(info == psb_success_) then
-        call prec%av(psb_l_pr_)%mv_from(lf)
-        call prec%av(psb_u_pr_)%mv_from(uf)
-        call prec%av(psb_l_pr_)%set_asb()
-        call prec%av(psb_u_pr_)%set_asb()
-        call prec%av(psb_l_pr_)%trim()
-        call prec%av(psb_u_pr_)%trim()
-        call prec%dv%bld(dd)
-        call move_alloc(dd,prec%d)
-      else
-        info=psb_err_from_subroutine_
-        ch_err='psb_ilu_fct'
-        call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
     
-    case(psb_f_none_) 
+    write(iout_,*) 'Block Jacobi with: ',&
-      info=psb_err_from_subroutine_
+         &  fact_names(prec%iprcparm(psb_f_type_))
-      ch_err='Inconsistent prec  psb_f_none_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-
-    case default
-      info=psb_err_from_subroutine_
-      ch_err='Unknown psb_f_type_'
-      call psb_errpush(info,name,a_err=ch_err)
-      goto 9999
-    end select
-
-    if (present(amold)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,mold=amold)
-      call prec%av(psb_u_pr_)%cscnv(info,mold=amold)
-    else if (present(afmt)) then 
-      call prec%av(psb_l_pr_)%cscnv(info,type=afmt)
-      call prec%av(psb_u_pr_)%cscnv(info,type=afmt)
-    end if
     
     call psb_erractionrestore(err_act)
     return
@@ -518,69 +172,43 @@ contains
     end if
     return
     
-  end subroutine psb_z_bjac_precbld
+  end subroutine psb_z_bjac_precdescr
-
-  subroutine psb_z_bjac_precseti(prec,what,val,info)
-    
-    use psb_base_mod
-    Implicit None
-    
-    class(psb_z_bjac_prec_type),intent(inout) :: prec
-    integer, intent(in)                      :: what 
-    integer, intent(in)                      :: val 
-    integer, intent(out)                     :: info
-    Integer :: err_act, nrow
-    character(len=20)  :: name='z_bjac_precset'
 
-    call psb_erractionsave(err_act)
 
-    info = psb_success_
+  function psb_z_bjac_sizeof(prec) result(val)
-    if (.not.allocated(prec%iprcparm)) then 
+    class(psb_z_bjac_prec_type), intent(in) :: prec
-      info = 1124
+    integer(psb_long_int_k_) :: val
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
     
-    select case(what)
+    val = 0
-    case (psb_f_type_) 
+    if (allocated(prec%dv)) then 
-      if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then 
+      val = val + (2*psb_sizeof_dp) * prec%dv%get_nrows()
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_f_type_)     = val
+    if (allocated(prec%av)) then 
-      
+      val = val + prec%av(psb_l_pr_)%sizeof()
-    case (psb_ilu_fill_in_) 
+      val = val + prec%av(psb_u_pr_)%sizeof()
-      if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
-           & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then 
-        write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
-             & prec%iprcparm(psb_p_type_),&
-             & 'ignoring user specification'
-        return
     endif
-      prec%iprcparm(psb_ilu_fill_in_) = val
+    return
+  end function psb_z_bjac_sizeof
 
-    case default
+  function psb_z_bjac_get_nzeros(prec) result(val)
-      write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
 
-    end select
+    class(psb_z_bjac_prec_type), intent(in) :: prec
+    integer(psb_long_int_k_) :: val
     
-    call psb_erractionrestore(err_act)
+    val = 0
+    if (allocated(prec%dv)) then 
+      val = val + prec%dv%get_nrows()
+    endif
+    if (allocated(prec%av)) then 
+      val = val + prec%av(psb_l_pr_)%get_nzeros()
+      val = val + prec%av(psb_u_pr_)%get_nzeros()
+    endif
     return
+  end function psb_z_bjac_get_nzeros
 
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_z_bjac_precseti
 
   subroutine psb_z_bjac_precsetr(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_z_bjac_prec_type),intent(inout) :: prec
@@ -608,7 +236,6 @@ contains
 
   subroutine psb_z_bjac_precsetc(prec,what,val,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_z_bjac_prec_type),intent(inout) :: prec
@@ -616,7 +243,7 @@ contains
     character(len=*), intent(in)             :: val
     integer, intent(out)                     :: info
     Integer :: err_act, nrow
-    character(len=20)  :: name='c_bjac_precset'
+    character(len=20)  :: name='z_bjac_precset'
 
     call psb_erractionsave(err_act)
 
@@ -636,7 +263,6 @@ contains
 
   subroutine psb_z_bjac_precfree(prec,info)
 
-    use psb_base_mod
     Implicit None
 
     class(psb_z_bjac_prec_type), intent(inout) :: prec
@@ -674,125 +300,4 @@ contains
 
   end subroutine psb_z_bjac_precfree
 
-
-  subroutine psb_z_bjac_precdescr(prec,iout)
-    
-    use psb_base_mod
-    Implicit None
-
-    class(psb_z_bjac_prec_type), intent(in) :: prec
-    integer, intent(in), optional    :: iout
-
-    Integer :: err_act, nrow, info
-    character(len=20)  :: name='z_bjac_precdescr'
-    integer :: iout_
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-   
-    if (present(iout)) then 
-      iout_ = iout
-    else
-      iout_ = 6 
-    end if
-
-    if (.not.allocated(prec%iprcparm)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    
-    write(iout_,*) 'Block Jacobi with: ',&
-         &  fact_names(prec%iprcparm(psb_f_type_))
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine psb_z_bjac_precdescr
-
-
-  subroutine psb_z_bjac_dump(prec,info,prefix,head)
-    use psb_base_mod
-    implicit none 
-    class(psb_z_bjac_prec_type), intent(in) :: prec
-    integer, intent(out)                    :: info
-    character(len=*), intent(in), optional  :: prefix,head
-    integer :: i, j, il1, iln, lname, lev
-    integer :: ictxt,iam, np
-    character(len=80)  :: prefix_
-    character(len=120) :: fname ! len should be at least 20 more than
-
-    !  len of prefix_ 
-
-    info = 0
-    ictxt = prec%get_ctxt()
-    call psb_info(ictxt,iam,np)
-
-    if (present(prefix)) then 
-      prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
-    else
-      prefix_ = "dump_fact_d"
-    end if
-
-    lname = len_trim(prefix_)
-    fname = trim(prefix_)
-    write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam
-    lname = lname + 5
-    write(fname(lname+1:),'(a)')'_lower.mtx'
-    if (prec%av(psb_l_pr_)%is_asb())  &
-         & call prec%av(psb_l_pr_)%print(fname,head=head)
-    write(fname(lname+1:),'(a,a)')'_diag.mtx'
-    if (allocated(prec%d)) &
-         & call psb_geprt(fname,prec%d,head=head)
-    write(fname(lname+1:),'(a)')'_upper.mtx'
-    if (prec%av(psb_u_pr_)%is_asb()) &
-         & call prec%av(psb_u_pr_)%print(fname,head=head)
-    
-  end subroutine psb_z_bjac_dump
-
-  function psb_z_bjac_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_z_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-    
-    val = 0
-    if (allocated(prec%d)) then 
-      val = val + 2*psb_sizeof_dp * size(prec%d)
-    endif
-    if (allocated(prec%av)) then 
-      val = val + psb_sizeof(prec%av(psb_l_pr_))
-      val = val + psb_sizeof(prec%av(psb_u_pr_))
-    endif
-    return
-  end function psb_z_bjac_sizeof
-
-  function psb_z_bjac_get_nzeros(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
-    class(psb_z_bjac_prec_type), intent(in) :: prec
-    integer(psb_long_int_k_) :: val
-
-    val = 0
-    if (allocated(prec%dv)) then 
-      val = val + prec%dv%get_nrows()
-    endif
-    if (allocated(prec%av)) then 
-      val = val + prec%av(psb_l_pr_)%get_nzeros()
-      val = val + prec%av(psb_u_pr_)%get_nzeros()
-    endif
-    return
-  end function psb_z_bjac_get_nzeros
-
 end module psb_z_bjacprec

prec/psb_z_diagprec.f90

@@ -19,17 +19,16 @@ module psb_z_diagprec
     procedure, pass(prec) :: get_nzeros => psb_z_diag_get_nzeros
   end type psb_z_diag_prec_type
 
-  private :: psb_z_diag_apply, psb_z_diag_precbld, psb_z_diag_precseti,&
+  private :: psb_z_diag_precseti,&
        & psb_z_diag_precsetr, psb_z_diag_precsetc, psb_z_diag_sizeof,&
        & psb_z_diag_precinit, psb_z_diag_precfree, psb_z_diag_precdescr,&
-       & psb_z_diag_apply_vect, psb_z_diag_get_nzeros
+       & psb_z_diag_get_nzeros
   
   
-contains
-  
   
+  interface  psb_z_diag_apply_vect
     subroutine psb_z_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_diag_prec_type, psb_z_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_z_diag_prec_type), intent(inout)  :: prec
       type(psb_z_vect_type),intent(inout)   :: x
@@ -38,79 +37,12 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='d_diag_prec_apply'
-    complex(psb_dpk_), pointer :: ww(:)
-    class(psb_z_base_vect_type), allocatable :: dw
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the DIAG preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    
-    if (size(work) >= x%get_nrows()) then 
-      ww => work
-    else
-      allocate(ww(x%get_nrows()),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_dpk_)')
-        goto 9999      
-      end if
-    end if
-
-
-    call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
-
-    if (size(work) < x%get_nrows()) then 
-      deallocate(ww,stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
-        goto 9999      
-      end if
-    end if
-   
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
     end subroutine psb_z_diag_apply_vect
+  end interface psb_z_diag_apply_vect
   
-
+  interface  psb_z_diag_apply
     subroutine psb_z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_diag_prec_type, psb_z_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)    :: desc_data
       class(psb_z_diag_prec_type), intent(in)  :: prec
       complex(psb_dpk_),intent(inout)      :: x(:)
@@ -119,95 +51,29 @@ contains
       integer, intent(out)              :: info
       character(len=1), optional        :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_z_diag_apply
-    character :: trans_
+  end interface psb_z_diag_apply
-    character(len=20)  :: name='c_diag_prec_apply'
-    complex(psb_dpk_), pointer :: ww(:)
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (.not.allocated(prec%d)) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (size(prec%d) < nrow) then
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner: D")
-      goto 9999
-    end if
-    if (present(trans)) then 
-      trans_ = psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    select case(trans_)
-    case('N')
-    case('T','C')
-    case default
-      info=psb_err_iarg_invalid_i_
-      call psb_errpush(info,name,&
-           & i_err=(/6,0,0,0,0/),a_err=trans_)
-      goto 9999
-    end select
-    
-    if (size(work) >= size(x)) then 
-      ww => work
-    else
-      allocate(ww(size(x)),stat=info)
-      if (info /= psb_success_) then 
-        call psb_errpush(psb_err_alloc_request_,name,&
-             & i_err=(/size(x),0,0,0,0/),a_err='complex(psb_dpk_)')
-        goto 9999      
-      end if
-    end if
-
   
-    if (trans_ == 'C') then 
+  interface  psb_z_diag_precbld
-      ww(1:nrow) = x(1:nrow)*conjg(prec%d(1:nrow))
+    subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    else
+      import :: psb_desc_type, psb_z_diag_prec_type, psb_z_vect_type, psb_dpk_, &
-      ww(1:nrow) = x(1:nrow)*prec%d(1:nrow)
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type
-    endif
+      type(psb_zspmat_type), intent(in), target :: a
-    call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
+      type(psb_desc_type), intent(in), target   :: desc_a
-
+      class(psb_z_diag_prec_type),intent(inout) :: prec
-    if (size(work) < size(x)) then 
+      integer, intent(out)                      :: info
-      deallocate(ww,stat=info)
+      character, intent(in), optional           :: upd
-      if (info /= psb_success_) then 
+      character(len=*), intent(in), optional    :: afmt
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate')
+      class(psb_z_base_sparse_mat), intent(in), optional :: amold
-        goto 9999      
+      class(psb_z_base_vect_type), intent(in), optional  :: vmold
-      end if
+    end subroutine psb_z_diag_precbld
-    end if
+  end interface psb_z_diag_precbld
   
-    call psb_erractionrestore(err_act)
-    return
 
-9999 continue
+contains
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_z_diag_apply
 
   subroutine psb_z_diag_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_diag_prec_type),intent(inout) :: prec
@@ -233,83 +99,7 @@ contains
   end subroutine psb_z_diag_precinit
 
 
-  subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
-    Implicit None
-    
-    type(psb_zspmat_type), intent(in), target :: a
-    type(psb_desc_type), intent(in), target   :: desc_a
-    class(psb_z_diag_prec_type),intent(inout) :: prec
-    integer, intent(out)                      :: info
-    character, intent(in), optional           :: upd
-    character(len=*), intent(in), optional    :: afmt
-    class(psb_z_base_sparse_mat), intent(in), optional :: amold
-    class(psb_z_base_vect_type), intent(in), optional  :: vmold
-    Integer :: err_act, nrow,i
-    character(len=20)  :: name='z_diag_precbld'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-    nrow = desc_a%get_local_cols()
-    if (allocated(prec%d)) then 
-      if (size(prec%d) < nrow) then 
-        deallocate(prec%d,stat=info)
-      end if
-    end if
-    if ((info == psb_success_).and.(.not.allocated(prec%d))) then 
-      allocate(prec%d(nrow), stat=info)
-    end if
-    if (info /= psb_success_) then 
-      info = psb_err_alloc_dealloc_
-      call psb_errpush(info,name)
-      goto 9999
-    end if
-
-    call a%get_diag(prec%d,info) 
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name, a_err='get_diag')
-      goto 9999
-    end if
-    
-    do i=1,nrow
-      if (prec%d(i) == dzero) then
-        prec%d(i) = done
-      else
-        prec%d(i) = done/prec%d(i)
-      endif
-    end do
-    allocate(prec%dv,stat=info) 
-    if (info == 0) then 
-      if (present(vmold)) then 
-        allocate(prec%dv%v,mold=vmold,stat=info) 
-      else
-        allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) 
-      end if
-    end if
-    if (info == 0) then 
-      call prec%dv%bld(prec%d)
-    else 
-      write(0,*) 'Error on precbld ',info
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_z_diag_precbld
-
   subroutine psb_z_diag_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_diag_prec_type),intent(inout) :: prec
@@ -337,7 +127,6 @@ contains
 
   subroutine psb_z_diag_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_z_diag_prec_type),intent(inout) :: prec
@@ -364,8 +153,6 @@ contains
   end subroutine psb_z_diag_precsetr
 
   subroutine psb_z_diag_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_diag_prec_type),intent(inout) :: prec
@@ -393,7 +180,6 @@ contains
 
   subroutine psb_z_diag_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_z_diag_prec_type), intent(inout) :: prec
@@ -423,8 +209,6 @@ contains
   
 
   subroutine psb_z_diag_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_z_diag_prec_type), intent(in) :: prec
@@ -465,17 +249,14 @@ contains
   end subroutine psb_z_diag_precdescr
 
   function psb_z_diag_sizeof(prec) result(val)
-    use psb_base_mod, only : psb_long_int_k_
     class(psb_z_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
-    val = 0
+    val = (2*psb_sizeof_dp) * prec%get_nzeros()
-    val = val + 2*psb_sizeof_dp * size(prec%d)
     return
   end function psb_z_diag_sizeof
 
   function psb_z_diag_get_nzeros(prec) result(val)
-    use psb_base_mod, only: psb_long_int_k_
     class(psb_z_diag_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
 
@@ -484,4 +265,5 @@ contains
     return
   end function psb_z_diag_get_nzeros
 
+
 end module psb_z_diagprec

prec/psb_z_nullprec.f90

@@ -4,8 +4,8 @@ module psb_z_nullprec
   
   type, extends(psb_z_base_prec_type) :: psb_z_null_prec_type
   contains
-    procedure, pass(prec) :: z_apply_v => psb_z_null_apply_vect
+    procedure, pass(prec) :: c_apply_v => psb_z_null_apply_vect
-    procedure, pass(prec) :: z_apply   => psb_z_null_apply
+    procedure, pass(prec) :: c_apply   => psb_z_null_apply
     procedure, pass(prec) :: precbld   => psb_z_null_precbld
     procedure, pass(prec) :: precinit  => psb_z_null_precinit
     procedure, pass(prec) :: precseti  => psb_z_null_precseti
@@ -16,17 +16,14 @@ module psb_z_nullprec
     procedure, pass(prec) :: sizeof    => psb_z_null_sizeof
   end type psb_z_null_prec_type
 
-  private :: psb_z_null_apply, psb_z_null_precbld, psb_z_null_precseti,&
+  private :: psb_z_null_precbld, psb_z_null_precseti,&
        & psb_z_null_precsetr, psb_z_null_precsetc, psb_z_null_sizeof,&
-       & psb_z_null_precinit, psb_z_null_precfree, psb_z_null_precdescr, &
+       & psb_z_null_precinit, psb_z_null_precfree, psb_z_null_precdescr
-       & psb_z_null_apply_vect
-  
-
-contains
   
 
+  interface  psb_z_null_apply_vect
     subroutine psb_z_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_null_prec_type, psb_z_vect_type, psb_dpk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_z_null_prec_type), intent(inout)  :: prec
       type(psb_z_vect_type),intent(inout)  :: x
@@ -35,51 +32,13 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
-    character(len=20)  :: name='z_null_prec_apply'
-
-    call psb_erractionsave(err_act)
-
-    !
-    ! This is the base version and we should throw an error. 
-    ! Or should it be the NULL preonditioner???
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (x%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (y%get_nrows() < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
 
     end subroutine psb_z_null_apply_vect
+  end interface psb_z_null_apply_vect
   
+  interface  psb_z_null_apply
     subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+      import :: psb_desc_type, psb_z_null_prec_type, psb_dpk_
       type(psb_desc_type),intent(in)       :: desc_data
       class(psb_z_null_prec_type), intent(in)  :: prec
       complex(psb_dpk_),intent(inout)      :: x(:)
@@ -88,51 +47,15 @@ contains
       integer, intent(out)                 :: info
       character(len=1), optional           :: trans
       complex(psb_dpk_),intent(inout), optional, target :: work(:)
-    Integer :: err_act, nrow
+    end subroutine psb_z_null_apply
-    character(len=20)  :: name='z_null_prec_apply'
+  end interface psb_z_null_apply
-
-    call psb_erractionsave(err_act)
-
-    !
-    !
-    info = psb_success_
-    
-    nrow = desc_data%get_local_rows()
-    if (size(x) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/))
-      goto 9999
-    end if
-    if (size(y) < nrow) then 
-      info = 36
-      call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/))
-      goto 9999
-    end if
-
-    call psb_geaxpby(alpha,x,beta,y,desc_data,info)
-    if (info /= psb_success_ ) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(infoi,name,a_err="psb_geaxpby")
-      goto 9999
-    end if
-    
-    call psb_erractionrestore(err_act)
-    return
   
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
   
-  end subroutine psb_z_null_apply
+contains
   
 
   subroutine psb_z_null_precinit(prec,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_z_null_prec_type),intent(inout) :: prec
@@ -159,7 +82,6 @@ contains
 
   subroutine psb_z_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     
-    use psb_base_mod
     Implicit None
     
     type(psb_zspmat_type), intent(in), target :: a
@@ -192,7 +114,6 @@ contains
 
   subroutine psb_z_null_precseti(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_z_null_prec_type),intent(inout) :: prec
@@ -220,7 +141,6 @@ contains
 
   subroutine psb_z_null_precsetr(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_z_null_prec_type),intent(inout) :: prec
@@ -248,7 +168,6 @@ contains
 
   subroutine psb_z_null_precsetc(prec,what,val,info)
     
-    use psb_base_mod
     Implicit None
     
     class(psb_z_null_prec_type),intent(inout) :: prec
@@ -276,7 +195,6 @@ contains
 
   subroutine psb_z_null_precfree(prec,info)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_z_null_prec_type), intent(inout) :: prec
@@ -305,7 +223,6 @@ contains
 
   subroutine psb_z_null_precdescr(prec,iout)
     
-    use psb_base_mod
     Implicit None
 
     class(psb_z_null_prec_type), intent(in) :: prec
@@ -341,7 +258,7 @@ contains
   end subroutine psb_z_null_precdescr
 
   function psb_z_null_sizeof(prec) result(val)
-    use psb_base_mod
+
     class(psb_z_null_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val