psblas3:

prec/Makefile
 prec/impl
 prec/impl/Makefile
 prec/impl/psb_c_prec_type_impl.f90
 prec/impl/psb_d_prec_type_impl.f90
 prec/impl/psb_s_prec_type_impl.f90
 prec/impl/psb_z_prec_type_impl.f90
 prec/psb_c_base_prec_mod.f90
 prec/psb_c_prec_mod.f90
 prec/psb_c_prec_type.f90
 prec/psb_cprecset.f90
 prec/psb_d_base_prec_mod.f90
 prec/psb_d_prec_mod.f90
 prec/psb_d_prec_type.f90
 prec/psb_dprecset.f90
 prec/psb_s_base_prec_mod.f90
 prec/psb_s_prec_mod.f90
 prec/psb_s_prec_type.f90
 prec/psb_sprecset.f90
 prec/psb_z_base_prec_mod.f90
 prec/psb_z_prec_mod.f90
 prec/psb_z_prec_type.f90
 prec/psb_zprecset.f90

Start decoupling interface/impl for PSB preconditioners.
Use IMPORT in interface definitions as much as possible.

prec/Makefile

@@ -25,15 +25,17 @@ LIBMOD=psb_prec_mod$(.mod)
 LOCAL_MODS=$(MODOBJS:.o=$(.mod))
 LIBNAME=$(PRECLIBNAME)
 COBJS=
-FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG).
+FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) 
 OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MODOBJS)
 
-lib:  $(OBJS)
+lib:  $(OBJS) impld
 	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
 	/bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR)
 	/bin/cp -p $(CPUPDFLAG) $(LIBMOD) $(LOCAL_MODS) $(LIBDIR)
 
+impld: $(OBJS)
+	cd impl && $(MAKE)
 
 $(OBJS): $(LIBDIR)/psb_base_mod$(.mod)
 

prec/impl/Makefile

@@ -0,0 +1,30 @@
+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 
+
+
+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 
+
+LIBNAME=$(PRECLIBNAME)
+COBJS=
+FINCLUDES=$(FMFLAG).. $(FMFLAG)$(LIBDIR) 
+
+lib:  $(OBJS) 
+	$(AR) $(HERE)/$(LIBNAME) $(OBJS)
+	$(RANLIB) $(HERE)/$(LIBNAME)
+
+veryclean: clean
+
+clean:
+	/bin/rm -f $(OBJS) $(LOCAL_MODS)
+

prec/impl/psb_c_prec_type_impl.f90

@@ -0,0 +1,319 @@
+!!$ 
+!!$              Parallel Sparse BLAS  version 3.0
+!!$    (C) Copyright 2006, 2007, 2008, 2009, 2010
+!!$                       Salvatore Filippone    University of Rome Tor Vergata
+!!$                       Alfredo Buttari        CNRS-IRIT, Toulouse
+!!$ 
+!!$  Redistribution and use in source and binary forms, with or without
+!!$  modification, are permitted provided that the following conditions
+!!$  are met:
+!!$    1. Redistributions of source code must retain the above copyright
+!!$       notice, this list of conditions and the following disclaimer.
+!!$    2. Redistributions in binary form must reproduce the above copyright
+!!$       notice, this list of conditions, and the following disclaimer in the
+!!$       documentation and/or other materials provided with the distribution.
+!!$    3. The name of the PSBLAS group or the names of its contributors may
+!!$       not be used to endorse or promote products derived from this
+!!$       software without specific written permission.
+!!$ 
+!!$  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!!$  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!!$  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!!$  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!!$  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!!$  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!!$  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!!$  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!!$  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!!$  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!!$  POSSIBILITY OF SUCH DAMAGE.
+!!$ 
+!!$  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_prec_type, psb_protect_name => psb_c_apply2_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_cprec_type), intent(inout) :: prec
+  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(:)
+
+  character     :: trans_ 
+  complex(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_c_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call prec%prec%apply(cone,x,czero,y,desc_data,info,&
+       & trans=trans_,work=work_)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2_vect
+
+subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_prec_type, psb_protect_name => psb_c_apply1_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_cprec_type), intent(inout) :: prec
+  type(psb_c_vect_type),intent(inout)  :: x
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_spk_),intent(inout), optional, target :: work(:)
+
+  type(psb_c_vect_type)       :: ww
+  character     :: trans_ 
+  complex(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_c_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call psb_geall(ww,desc_data,info)
+  if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
+  if (info == 0) call prec%prec%apply(cone,x,czero,ww,desc_data,info,&
+       & trans=trans_,work=work_)
+  if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply1_vect
+
+subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_c_prec_type, psb_protect_name => psb_c_apply2v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_cprec_type), intent(in) :: prec
+  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(:)
+
+  character     :: trans_ 
+  complex(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name='psb_c_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=trans
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  call prec%prec%apply(cone,x,czero,y,desc_data,info,trans_,work=work_)
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2v
+
+subroutine psb_c_apply1v(prec,x,desc_data,info,trans)
+  use psb_base_mod
+  use psb_c_prec_type, psb_protect_name => psb_c_apply1v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_cprec_type), intent(in) :: prec
+  complex(psb_spk_),intent(inout)   :: x(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+
+  character     :: trans_
+  integer :: ictxt,np,me, err_act
+  complex(psb_spk_), pointer :: WW(:), w1(:)
+  character(len=20)   :: name
+  name='psb_c_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+
+  ictxt=desc_data%get_context()
+  call psb_info(ictxt, me, np)
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  allocate(ww(size(x)),w1(size(x)),stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='Allocate')
+    goto 9999      
+  end if
+  call prec%prec%apply(cone,x,czero,ww,desc_data,info,&
+       & trans_,work=w1)
+  if(info /= psb_success_) goto 9999
+  x(:) = ww(:)
+  deallocate(ww,W1,stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='DeAllocate')
+    goto 9999      
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_c_apply1v
+

prec/impl/psb_d_prec_type_impl.f90

@@ -0,0 +1,319 @@
+!!$ 
+!!$              Parallel Sparse BLAS  version 3.0
+!!$    (C) Copyright 2006, 2007, 2008, 2009, 2010
+!!$                       Salvatore Filippone    University of Rome Tor Vergata
+!!$                       Alfredo Buttari        CNRS-IRIT, Toulouse
+!!$ 
+!!$  Redistribution and use in source and binary forms, with or without
+!!$  modification, are permitted provided that the following conditions
+!!$  are met:
+!!$    1. Redistributions of source code must retain the above copyright
+!!$       notice, this list of conditions and the following disclaimer.
+!!$    2. Redistributions in binary form must reproduce the above copyright
+!!$       notice, this list of conditions, and the following disclaimer in the
+!!$       documentation and/or other materials provided with the distribution.
+!!$    3. The name of the PSBLAS group or the names of its contributors may
+!!$       not be used to endorse or promote products derived from this
+!!$       software without specific written permission.
+!!$ 
+!!$  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!!$  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!!$  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!!$  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!!$  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!!$  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!!$  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!!$  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!!$  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!!$  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!!$  POSSIBILITY OF SUCH DAMAGE.
+!!$ 
+!!$  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_prec_type, psb_protect_name => psb_d_apply2_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_dprec_type), intent(inout) :: prec
+  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(:)
+
+  character     :: trans_ 
+  real(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_d_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call prec%prec%apply(done,x,dzero,y,desc_data,info,&
+       & trans=trans_,work=work_)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2_vect
+
+subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_prec_type, psb_protect_name => psb_d_apply1_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_dprec_type), intent(inout) :: prec
+  type(psb_d_vect_type),intent(inout)  :: x
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  type(psb_d_vect_type)       :: ww
+  character     :: trans_ 
+  real(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_d_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call psb_geall(ww,desc_data,info)
+  if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
+  if (info == 0) call prec%prec%apply(done,x,dzero,ww,desc_data,info,&
+       & trans=trans_,work=work_)
+  if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply1_vect
+
+subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_d_prec_type, psb_protect_name => psb_d_apply2v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_dprec_type), intent(in) :: prec
+  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(:)
+
+  character     :: trans_ 
+  real(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name='psb_d_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=trans
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  call prec%prec%apply(done,x,dzero,y,desc_data,info,trans_,work=work_)
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2v
+
+subroutine psb_d_apply1v(prec,x,desc_data,info,trans)
+  use psb_base_mod
+  use psb_d_prec_type, psb_protect_name => psb_d_apply1v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_dprec_type), intent(in) :: prec
+  real(psb_dpk_),intent(inout)   :: x(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+
+  character     :: trans_
+  integer :: ictxt,np,me, err_act
+  real(psb_dpk_), pointer :: WW(:), w1(:)
+  character(len=20)   :: name
+  name='psb_d_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+
+  ictxt=desc_data%get_context()
+  call psb_info(ictxt, me, np)
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  allocate(ww(size(x)),w1(size(x)),stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='Allocate')
+    goto 9999      
+  end if
+  call prec%prec%apply(done,x,dzero,ww,desc_data,info,&
+       & trans_,work=w1)
+  if(info /= psb_success_) goto 9999
+  x(:) = ww(:)
+  deallocate(ww,W1,stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='DeAllocate')
+    goto 9999      
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_d_apply1v
+

prec/impl/psb_s_prec_type_impl.f90

@@ -0,0 +1,319 @@
+!!$ 
+!!$              Parallel Sparse BLAS  version 3.0
+!!$    (C) Copyright 2006, 2007, 2008, 2009, 2010
+!!$                       Salvatore Filippone    University of Rome Tor Vergata
+!!$                       Alfredo Buttari        CNRS-IRIT, Toulouse
+!!$ 
+!!$  Redistribution and use in source and binary forms, with or without
+!!$  modification, are permitted provided that the following conditions
+!!$  are met:
+!!$    1. Redistributions of source code must retain the above copyright
+!!$       notice, this list of conditions and the following disclaimer.
+!!$    2. Redistributions in binary form must reproduce the above copyright
+!!$       notice, this list of conditions, and the following disclaimer in the
+!!$       documentation and/or other materials provided with the distribution.
+!!$    3. The name of the PSBLAS group or the names of its contributors may
+!!$       not be used to endorse or promote products derived from this
+!!$       software without specific written permission.
+!!$ 
+!!$  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!!$  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!!$  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!!$  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!!$  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!!$  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!!$  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!!$  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!!$  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!!$  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!!$  POSSIBILITY OF SUCH DAMAGE.
+!!$ 
+!!$  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_prec_type, psb_protect_name => psb_s_apply2_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_sprec_type), intent(inout) :: prec
+  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(:)
+
+  character     :: trans_ 
+  real(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_s_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call prec%prec%apply(sone,x,szero,y,desc_data,info,&
+       & trans=trans_,work=work_)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2_vect
+
+subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_prec_type, psb_protect_name => psb_s_apply1_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_sprec_type), intent(inout) :: prec
+  type(psb_s_vect_type),intent(inout)  :: x
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  real(psb_spk_),intent(inout), optional, target :: work(:)
+
+  type(psb_s_vect_type)       :: ww
+  character     :: trans_ 
+  real(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_s_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call psb_geall(ww,desc_data,info)
+  if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
+  if (info == 0) call prec%prec%apply(sone,x,szero,ww,desc_data,info,&
+       & trans=trans_,work=work_)
+  if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply1_vect
+
+subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_s_prec_type, psb_protect_name => psb_s_apply2v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_sprec_type), intent(in) :: prec
+  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(:)
+
+  character     :: trans_ 
+  real(psb_spk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name='psb_s_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=trans
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  call prec%prec%apply(sone,x,szero,y,desc_data,info,trans_,work=work_)
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2v
+
+subroutine psb_s_apply1v(prec,x,desc_data,info,trans)
+  use psb_base_mod
+  use psb_s_prec_type, psb_protect_name => psb_s_apply1v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_sprec_type), intent(in) :: prec
+  real(psb_spk_),intent(inout)   :: x(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+
+  character     :: trans_
+  integer :: ictxt,np,me, err_act
+  real(psb_spk_), pointer :: WW(:), w1(:)
+  character(len=20)   :: name
+  name='psb_s_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+
+  ictxt=desc_data%get_context()
+  call psb_info(ictxt, me, np)
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  allocate(ww(size(x)),w1(size(x)),stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='Allocate')
+    goto 9999      
+  end if
+  call prec%prec%apply(sone,x,szero,ww,desc_data,info,&
+       & trans_,work=w1)
+  if(info /= psb_success_) goto 9999
+  x(:) = ww(:)
+  deallocate(ww,W1,stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='DeAllocate')
+    goto 9999      
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_s_apply1v
+

prec/impl/psb_z_prec_type_impl.f90

@@ -0,0 +1,319 @@
+!!$ 
+!!$              Parallel Sparse BLAS  version 3.0
+!!$    (C) Copyright 2006, 2007, 2008, 2009, 2010
+!!$                       Salvatore Filippone    University of Rome Tor Vergata
+!!$                       Alfredo Buttari        CNRS-IRIT, Toulouse
+!!$ 
+!!$  Redistribution and use in source and binary forms, with or without
+!!$  modification, are permitted provided that the following conditions
+!!$  are met:
+!!$    1. Redistributions of source code must retain the above copyright
+!!$       notice, this list of conditions and the following disclaimer.
+!!$    2. Redistributions in binary form must reproduce the above copyright
+!!$       notice, this list of conditions, and the following disclaimer in the
+!!$       documentation and/or other materials provided with the distribution.
+!!$    3. The name of the PSBLAS group or the names of its contributors may
+!!$       not be used to endorse or promote products derived from this
+!!$       software without specific written permission.
+!!$ 
+!!$  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!!$  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!!$  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!!$  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
+!!$  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!!$  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!!$  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!!$  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!!$  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!!$  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!!$  POSSIBILITY OF SUCH DAMAGE.
+!!$ 
+!!$  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_prec_type, psb_protect_name => psb_z_apply2_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_zprec_type), intent(inout) :: prec
+  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(:)
+
+  character     :: trans_ 
+  complex(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_z_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call prec%prec%apply(zone,x,zzero,y,desc_data,info,&
+       & trans=trans_,work=work_)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2_vect
+
+subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_prec_type, psb_protect_name => psb_z_apply1_vect
+  implicit none 
+  type(psb_desc_type),intent(in)       :: desc_data
+  class(psb_zprec_type), intent(inout) :: prec
+  type(psb_z_vect_type),intent(inout)  :: x
+  integer, intent(out)                 :: info
+  character(len=1), optional           :: trans
+  complex(psb_dpk_),intent(inout), optional, target :: work(:)
+
+  type(psb_z_vect_type)       :: ww
+  character     :: trans_ 
+  complex(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name = 'psb_z_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+
+  call psb_geall(ww,desc_data,info)
+  if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
+  if (info == 0) call prec%prec%apply(zone,x,zzero,ww,desc_data,info,&
+       & trans=trans_,work=work_)
+  if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
+
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply1_vect
+
+subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work)
+  use psb_base_mod
+  use psb_z_prec_type, psb_protect_name => psb_z_apply2v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_zprec_type), intent(in) :: prec
+  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(:)
+
+  character     :: trans_ 
+  complex(psb_dpk_), pointer :: work_(:)
+  integer :: ictxt,np,me,err_act
+  character(len=20)   :: name
+
+  name='psb_z_apply2v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt = desc_data%get_context()
+  call psb_info(ictxt, me, np)
+
+  if (present(trans)) then 
+    trans_=trans
+  else
+    trans_='N'
+  end if
+
+  if (present(work)) then 
+    work_ => work
+  else
+    allocate(work_(4*desc_data%get_local_cols()),stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name,a_err='Allocate')
+      goto 9999      
+    end if
+
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  call prec%prec%apply(zone,x,zzero,y,desc_data,info,trans_,work=work_)
+  if (present(work)) then 
+  else
+    deallocate(work_,stat=info)
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,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_apply2v
+
+subroutine psb_z_apply1v(prec,x,desc_data,info,trans)
+  use psb_base_mod
+  use psb_z_prec_type, psb_protect_name => psb_z_apply1v
+  implicit none 
+  type(psb_desc_type),intent(in)    :: desc_data
+  class(psb_zprec_type), intent(in) :: prec
+  complex(psb_dpk_),intent(inout)   :: x(:)
+  integer, intent(out)              :: info
+  character(len=1), optional        :: trans
+
+  character     :: trans_
+  integer :: ictxt,np,me, err_act
+  complex(psb_dpk_), pointer :: WW(:), w1(:)
+  character(len=20)   :: name
+  name='psb_z_apply1v'
+  info = psb_success_
+  call psb_erractionsave(err_act)
+
+
+  ictxt=desc_data%get_context()
+  call psb_info(ictxt, me, np)
+  if (present(trans)) then 
+    trans_=psb_toupper(trans)
+  else
+    trans_='N'
+  end if
+
+  if (.not.allocated(prec%prec)) then 
+    info = 1124
+    call psb_errpush(info,name,a_err="preconditioner")
+    goto 9999
+  end if
+  allocate(ww(size(x)),w1(size(x)),stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='Allocate')
+    goto 9999      
+  end if
+  call prec%prec%apply(zone,x,zzero,ww,desc_data,info,&
+       & trans_,work=w1)
+  if(info /= psb_success_) goto 9999
+  x(:) = ww(:)
+  deallocate(ww,W1,stat=info)
+  if (info /= psb_success_) then 
+    info = psb_err_from_subroutine_
+    call psb_errpush(info,name,a_err='DeAllocate')
+    goto 9999      
+  end if
+
+
+  call psb_erractionrestore(err_act)
+  return
+
+9999 continue
+  call psb_errpush(info,name)
+  call psb_erractionrestore(err_act)
+  if (err_act == psb_act_abort_) then
+    call psb_error()
+    return
+  end if
+  return
+
+end subroutine psb_z_apply1v
+

prec/psb_c_base_prec_mod.f90

@@ -36,10 +36,11 @@
 module psb_c_base_prec_mod
 
   ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
+  use psb_base_mod, only : psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
+       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
        & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_cspmat_type, psb_c_base_vect, psb_c_vect_type
+       & psb_c_base_sparse_mat, psb_cspmat_type, psb_c_csr_sparse_mat,& 
+       & psb_c_base_vect_type, psb_c_vect_type
 
   use psb_prec_const_mod
 
@@ -73,7 +74,7 @@ module psb_c_base_prec_mod
 contains
 
   subroutine psb_c_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
     type(psb_desc_type),intent(in)        :: desc_data
     class(psb_c_base_prec_type), intent(inout)  :: prec
     complex(psb_spk_),intent(in)          :: alpha, beta
@@ -83,7 +84,7 @@ contains
     character(len=1), optional            :: trans
     complex(psb_spk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_prec_apply'
+    character(len=20)  :: name='c_base_prec_apply'
 
     call psb_erractionsave(err_act)
 
@@ -109,7 +110,7 @@ contains
   end subroutine psb_c_base_apply_vect
 
   subroutine psb_c_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
     type(psb_desc_type),intent(in)       :: desc_data
     class(psb_c_base_prec_type), intent(in)  :: prec
     complex(psb_spk_),intent(in)         :: alpha, beta
@@ -145,10 +146,8 @@ contains
   end subroutine psb_c_base_apply
 
   subroutine psb_c_base_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
-    
+   
     class(psb_c_base_prec_type),intent(inout) :: prec
     integer, intent(out)                     :: info
     Integer :: err_act, nrow
@@ -177,8 +176,6 @@ contains
   end subroutine psb_c_base_precinit
 
   subroutine psb_c_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
     Implicit None
     
     type(psb_cspmat_type), intent(in), target :: a
@@ -215,8 +212,6 @@ contains
   end subroutine psb_c_base_precbld
 
   subroutine psb_c_base_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_base_prec_type),intent(inout) :: prec
@@ -249,8 +244,6 @@ contains
   end subroutine psb_c_base_precseti
 
   subroutine psb_c_base_precsetr(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_base_prec_type),intent(inout) :: prec
@@ -283,8 +276,6 @@ contains
   end subroutine psb_c_base_precsetr
 
   subroutine psb_c_base_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_c_base_prec_type),intent(inout) :: prec
@@ -317,8 +308,6 @@ contains
   end subroutine psb_c_base_precsetc
 
   subroutine psb_c_base_precfree(prec,info)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_c_base_prec_type), intent(inout) :: prec
@@ -352,8 +341,6 @@ contains
   
 
   subroutine psb_c_base_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_c_base_prec_type), intent(in) :: prec
@@ -386,13 +373,12 @@ contains
   end subroutine psb_c_base_precdescr
   
   subroutine psb_c_base_precdump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     class(psb_c_base_prec_type), intent(in) :: prec
     integer, intent(out)             :: info
     character(len=*), intent(in), optional :: prefix,head
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_precdump'
+    character(len=20)  :: name='c_base_precdump'
 
     call psb_erractionsave(err_act)
 
@@ -418,7 +404,6 @@ contains
   end subroutine psb_c_base_precdump
 
   subroutine psb_c_base_set_ctxt(prec,ictxt)
-    use psb_base_mod
     implicit none 
     class(psb_c_base_prec_type), intent(inout) :: prec
     integer, intent(in)  :: ictxt
@@ -428,7 +413,6 @@ contains
   end subroutine psb_c_base_set_ctxt
 
   function psb_c_base_sizeof(prec) result(val)
-    use psb_base_mod
     class(psb_c_base_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
@@ -437,7 +421,6 @@ contains
   end function psb_c_base_sizeof
 
   function psb_c_base_get_ctxt(prec) result(val)
-    use psb_base_mod
     class(psb_c_base_prec_type), intent(in) :: prec
     integer :: val
     

prec/psb_c_prec_mod.f90

@@ -32,12 +32,13 @@
 
 module psb_c_prec_mod
   use psb_c_prec_type
+  use psb_c_base_prec_mod
 
   interface psb_precbld
     subroutine psb_cprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-      use psb_base_mod, only  : psb_desc_type, psb_cspmat_type,&
+      import :: psb_desc_type, psb_cspmat_type,&
-           & psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type
+           & psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type, &
-      use psb_prec_type, only : psb_cprec_type
+           & psb_cprec_type
       implicit none
       type(psb_cspmat_type), intent(in), target  :: a
       type(psb_desc_type), intent(in), target    :: desc_a
@@ -52,8 +53,7 @@ module psb_c_prec_mod
 
   interface psb_precinit
     subroutine psb_cprecinit(prec,ptype,info)
-      use psb_base_mod, only  : psb_desc_type, psb_cspmat_type, psb_spk_
+      import :: psb_desc_type, psb_cspmat_type, psb_spk_, psb_cprec_type
-      use psb_prec_type, only : psb_cprec_type
       implicit none
       type(psb_cprec_type), intent(inout)    :: prec
       character(len=*), intent(in)           :: ptype
@@ -63,27 +63,25 @@ module psb_c_prec_mod
 
   interface psb_precset
     subroutine psb_cprecseti(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_cspmat_type, psb_spk_
+      import :: psb_desc_type, psb_cspmat_type, psb_spk_, psb_cprec_type
-      use psb_prec_type, only : psb_cprec_type
       implicit none
       type(psb_cprec_type), intent(inout)    :: prec
       integer                                :: what, val 
       integer, intent(out)                   :: info
     end subroutine psb_cprecseti
-    subroutine psb_cprecsets(prec,what,val,info)
+    subroutine psb_cprecsetr(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_cspmat_type, psb_spk_
+      import :: psb_desc_type, psb_cspmat_type, psb_spk_, psb_cprec_type
-      use psb_prec_type, only : psb_cprec_type
       implicit none
       type(psb_cprec_type), intent(inout)    :: prec
       integer                                :: what
       real(psb_spk_)                       :: val 
       integer, intent(out)                   :: info
-    end subroutine psb_cprecsets
+    end subroutine psb_cprecsetr
   end interface
 
   interface psb_ilu_fct
     subroutine psb_cilu_fct(a,l,u,d,info,blck)
-      use psb_base_mod, only  : psb_desc_type, psb_cspmat_type, &
+      import :: psb_desc_type, psb_cspmat_type, &
            & psb_c_csr_sparse_mat, psb_spk_
       integer, intent(out)                ::     info
       type(psb_cspmat_type),intent(in)    :: a

prec/psb_c_prec_type.f90

@@ -35,24 +35,18 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 module psb_c_prec_type
 
-  ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_cspmat_type
-
   use psb_prec_const_mod
   use psb_c_base_prec_mod
 
   type psb_cprec_type
     class(psb_c_base_prec_type), allocatable :: prec
   contains
-    procedure, pass(prec)               :: c_apply1_vect
+    procedure, pass(prec)               :: psb_c_apply1_vect
-    procedure, pass(prec)               :: c_apply2_vect
+    procedure, pass(prec)               :: psb_c_apply2_vect
-    procedure, pass(prec)               :: c_apply2v
+    procedure, pass(prec)               :: psb_c_apply2v
-    procedure, pass(prec)               :: c_apply1v
+    procedure, pass(prec)               :: psb_c_apply1v
-    generic, public                     :: apply => c_apply2v, c_apply1v,&
+    generic, public                     :: apply => psb_c_apply2v, psb_c_apply1v,&
-         & c_apply1_vect, c_apply2_vect
+         & psb_c_apply1_vect, psb_c_apply2_vect
   end type psb_cprec_type
 
   interface psb_precfree
@@ -75,10 +69,58 @@ module psb_c_prec_type
     module procedure psb_cprec_sizeof
   end interface
 
+  interface psb_c_apply2_vect
+    subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_cprec_type, psb_c_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_cprec_type), intent(inout) :: prec
+      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(:)
+    end subroutine psb_c_apply2_vect
+  end interface psb_c_apply2_vect
+  
+  interface  psb_c_apply1_vect
+    subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_cprec_type, psb_c_vect_type, psb_spk_
+        type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_cprec_type), intent(inout) :: prec
+      type(psb_c_vect_type),intent(inout)  :: x
+      integer, intent(out)                 :: info
+      character(len=1), optional           :: trans
+      complex(psb_spk_),intent(inout), optional, target :: work(:)
+    end subroutine psb_c_apply1_vect
+  end interface psb_c_apply1_vect
+  
+  interface  psb_c_apply2v
+    subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_cprec_type, psb_c_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_cprec_type), intent(in) :: prec
+      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(:)
+    end subroutine psb_c_apply2v
+  end interface psb_c_apply2v
+  
+  interface  psb_c_apply1v
+    subroutine psb_c_apply1v(prec,x,desc_data,info,trans)
+      import :: psb_desc_type, psb_cprec_type, psb_c_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_cprec_type), intent(in) :: prec
+      complex(psb_spk_),intent(inout)   :: x(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+    end subroutine psb_c_apply1v
+  end interface psb_c_apply1v
+  
 contains
 
   subroutine psb_cfile_prec_descr(p,iout)
-    use psb_base_mod
     type(psb_cprec_type), intent(in) :: p
     integer, intent(in), optional    :: iout
     integer :: iout_,info
@@ -99,7 +141,6 @@ contains
   end subroutine psb_cfile_prec_descr
 
   subroutine psb_c_prec_dump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     type(psb_cprec_type), intent(in) :: prec
     integer, intent(out)             :: info
@@ -121,7 +162,6 @@ contains
 
 
   subroutine psb_c_precfree(p,info)
-    use psb_base_mod
     type(psb_cprec_type), intent(inout) :: p
     integer, intent(out)                :: info
     integer             :: me, err_act,i
@@ -154,11 +194,9 @@ contains
   subroutine psb_nullify_cprec(p)
     type(psb_cprec_type), intent(inout) :: p
 
-
   end subroutine psb_nullify_cprec
 
   function psb_cprec_sizeof(prec) result(val)
-    use psb_base_mod
     type(psb_cprec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     integer             :: i
@@ -170,282 +208,4 @@ contains
     
   end function psb_cprec_sizeof
 
-  subroutine c_apply2_vect(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_cprec_type), intent(inout) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    complex(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name = 'c_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call prec%prec%apply(cone,x,czero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 c_apply2_vect
-
-  subroutine c_apply1_vect(prec,x,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_cprec_type), intent(inout) :: prec
-    type(psb_c_vect_type),intent(inout)  :: x
-    integer, intent(out)                 :: info
-    character(len=1), optional           :: trans
-    complex(psb_spk_),intent(inout), optional, target :: work(:)
-
-    type(psb_c_vect_type)       :: ww
-    character     :: trans_ 
-    complex(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-
-    name = 'c_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-
-    end if
-
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call psb_geall(ww,desc_data,info)
-    if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
-    if (info == 0) call prec%prec%apply(cone,x,czero,ww,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 c_apply1_vect
- 
-  subroutine c_apply2v(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_cprec_type), intent(in) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    complex(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='c_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=trans
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    call prec%prec%apply(cone,x,czero,y,desc_data,info,trans_,work=work_)
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 c_apply2v
-
-  subroutine c_apply1v(prec,x,desc_data,info,trans)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_cprec_type), intent(in) :: prec
-    complex(psb_spk_),intent(inout)   :: x(:)
-    integer, intent(out)              :: info
-    character(len=1), optional        :: trans
-
-    character     :: trans_
-    integer :: ictxt,np,me, err_act
-    complex(psb_spk_), pointer :: WW(:), w1(:)
-    character(len=20)   :: name
-    name='c_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    
-    ictxt=desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    allocate(ww(size(x)),w1(size(x)),stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call prec%prec%apply(cone,x,czero,ww,desc_data,info,&
-         & trans_,work=w1)
-    if(info /= psb_success_) goto 9999
-    x(:) = ww(:)
-    deallocate(ww,W1,stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='DeAllocate')
-      goto 9999      
-    end if
-
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_errpush(info,name)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine c_apply1v
-
 end module psb_c_prec_type

prec/psb_cprecset.f90

@@ -54,10 +54,10 @@ subroutine psb_cprecseti(p,what,val,info)
 end subroutine psb_cprecseti
 
 
-subroutine psb_cprecsets(p,what,val,info)
+subroutine psb_cprecsetr(p,what,val,info)
 
   use psb_base_mod
-  use psb_prec_mod, psb_protect_name => psb_cprecsets
+  use psb_prec_mod, psb_protect_name => psb_cprecsetr
   implicit none
   type(psb_cprec_type), intent(inout)    :: p
   integer                                :: what
@@ -77,4 +77,4 @@ subroutine psb_cprecsets(p,what,val,info)
 
   return
 
-end subroutine psb_cprecsets
+end subroutine psb_cprecsetr

prec/psb_d_base_prec_mod.f90

@@ -36,12 +36,12 @@
 module psb_d_base_prec_mod
 
   ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
+  use psb_base_mod, only : psb_dpk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
+       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
        & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_dspmat_type, psb_d_base_vect, psb_d_vect_type
+       & psb_d_base_sparse_mat, psb_dspmat_type, psb_d_csr_sparse_mat,& 
+       & psb_d_base_vect_type, psb_d_vect_type
 
-  
   use psb_prec_const_mod
 
   type psb_d_base_prec_type
@@ -64,7 +64,7 @@ module psb_d_base_prec_mod
     procedure, pass(prec) :: dump      => psb_d_base_precdump
     procedure, pass(prec) :: get_nzeros => psb_d_base_get_nzeros
   end type psb_d_base_prec_type
-
+  
   private :: psb_d_base_apply, psb_d_base_precbld, psb_d_base_precseti,&
        & psb_d_base_precsetr, psb_d_base_precsetc, psb_d_base_sizeof,&
        & psb_d_base_precinit, psb_d_base_precfree, psb_d_base_precdescr,&
@@ -74,14 +74,14 @@ module psb_d_base_prec_mod
 contains
 
   subroutine psb_d_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
-    type(psb_desc_type),intent(in)    :: desc_data
+    type(psb_desc_type),intent(in)        :: desc_data
     class(psb_d_base_prec_type), intent(inout)  :: prec
-    real(psb_dpk_),intent(in)         :: alpha, beta
+    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
+    integer, intent(out)                  :: info
-    character(len=1), optional        :: trans
+    character(len=1), optional            :: trans
     real(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
     character(len=20)  :: name='d_base_prec_apply'
@@ -110,14 +110,14 @@ contains
   end subroutine psb_d_base_apply_vect
 
   subroutine psb_d_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
-    type(psb_desc_type),intent(in)    :: desc_data
+    type(psb_desc_type),intent(in)       :: desc_data
     class(psb_d_base_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
+    integer, intent(out)                 :: info
-    character(len=1), optional        :: trans
+    character(len=1), optional           :: trans
     real(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
     character(len=20)  :: name='d_base_prec_apply'
@@ -146,10 +146,8 @@ contains
   end subroutine psb_d_base_apply
 
   subroutine psb_d_base_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
-    
+   
     class(psb_d_base_prec_type),intent(inout) :: prec
     integer, intent(out)                     :: info
     Integer :: err_act, nrow
@@ -178,8 +176,6 @@ contains
   end subroutine psb_d_base_precinit
 
   subroutine psb_d_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
     Implicit None
     
     type(psb_dspmat_type), intent(in), target :: a
@@ -189,7 +185,7 @@ contains
     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
+    class(psb_d_base_vect_type), intent(in), optional  :: vmold
     Integer :: err_act, nrow
     character(len=20)  :: name='d_base_precbld'
 
@@ -216,8 +212,6 @@ contains
   end subroutine psb_d_base_precbld
 
   subroutine psb_d_base_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_base_prec_type),intent(inout) :: prec
@@ -250,8 +244,6 @@ contains
   end subroutine psb_d_base_precseti
 
   subroutine psb_d_base_precsetr(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_base_prec_type),intent(inout) :: prec
@@ -284,8 +276,6 @@ contains
   end subroutine psb_d_base_precsetr
 
   subroutine psb_d_base_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_d_base_prec_type),intent(inout) :: prec
@@ -318,8 +308,6 @@ contains
   end subroutine psb_d_base_precsetc
 
   subroutine psb_d_base_precfree(prec,info)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_d_base_prec_type), intent(inout) :: prec
@@ -353,8 +341,6 @@ contains
   
 
   subroutine psb_d_base_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_d_base_prec_type), intent(in) :: prec
@@ -387,7 +373,6 @@ contains
   end subroutine psb_d_base_precdescr
   
   subroutine psb_d_base_precdump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     class(psb_d_base_prec_type), intent(in) :: prec
     integer, intent(out)             :: info
@@ -419,7 +404,6 @@ contains
   end subroutine psb_d_base_precdump
 
   subroutine psb_d_base_set_ctxt(prec,ictxt)
-    use psb_base_mod
     implicit none 
     class(psb_d_base_prec_type), intent(inout) :: prec
     integer, intent(in)  :: ictxt
@@ -429,7 +413,6 @@ contains
   end subroutine psb_d_base_set_ctxt
 
   function psb_d_base_sizeof(prec) result(val)
-    use psb_base_mod
     class(psb_d_base_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
@@ -438,7 +421,6 @@ contains
   end function psb_d_base_sizeof
 
   function psb_d_base_get_ctxt(prec) result(val)
-    use psb_base_mod
     class(psb_d_base_prec_type), intent(in) :: prec
     integer :: val
     
@@ -454,5 +436,4 @@ contains
 
   end function psb_d_base_get_nzeros
 
-
 end module psb_d_base_prec_mod

prec/psb_d_prec_mod.f90

@@ -32,12 +32,13 @@
 
 module psb_d_prec_mod
   use psb_d_prec_type
+  use psb_d_base_prec_mod
 
   interface psb_precbld
     subroutine psb_dprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-      use psb_base_mod, only  : psb_desc_type, psb_dspmat_type,&
+      import :: psb_desc_type, psb_dspmat_type,&
-           & psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type
+           & psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type, &
-      use psb_prec_type, only : psb_dprec_type
+           & psb_dprec_type
       implicit none
       type(psb_dspmat_type), intent(in), target  :: a
       type(psb_desc_type), intent(in), target    :: desc_a
@@ -52,8 +53,7 @@ module psb_d_prec_mod
 
   interface psb_precinit
     subroutine psb_dprecinit(prec,ptype,info)
-      use psb_base_mod, only  : psb_desc_type, psb_dpk_
+      import :: psb_desc_type, psb_dspmat_type, psb_dpk_, psb_dprec_type
-      use psb_prec_type, only : psb_dprec_type
       implicit none
       type(psb_dprec_type), intent(inout)    :: prec
       character(len=*), intent(in)           :: ptype
@@ -63,27 +63,25 @@ module psb_d_prec_mod
 
   interface psb_precset
     subroutine psb_dprecseti(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_dpk_
+      import :: psb_desc_type, psb_dspmat_type, psb_dpk_, psb_dprec_type
-      use psb_prec_type, only : psb_dprec_type
       implicit none
       type(psb_dprec_type), intent(inout)    :: prec
       integer                                :: what, val 
       integer, intent(out)                   :: info
     end subroutine psb_dprecseti
-    subroutine psb_dprecsetd(prec,what,val,info)
+    subroutine psb_dprecsetr(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_dpk_
+      import :: psb_desc_type, psb_dspmat_type, psb_dpk_, psb_dprec_type
-      use psb_prec_type, only : psb_dprec_type
       implicit none
       type(psb_dprec_type), intent(inout)    :: prec
       integer                                :: what
       real(psb_dpk_)                       :: val 
       integer, intent(out)                   :: info
-    end subroutine psb_dprecsetd
+    end subroutine psb_dprecsetr
   end interface
 
   interface psb_ilu_fct
     subroutine psb_dilu_fct(a,l,u,d,info,blck)
-      use psb_base_mod, only  : psb_desc_type, psb_dspmat_type,&
+      import :: psb_desc_type, psb_dspmat_type, &
            & psb_d_csr_sparse_mat, psb_dpk_
       integer, intent(out)                ::     info
       type(psb_dspmat_type),intent(in)    :: a

prec/psb_d_prec_type.f90

@@ -35,25 +35,18 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 module psb_d_prec_type
 
-  ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_dspmat_type
-
-  
   use psb_prec_const_mod
   use psb_d_base_prec_mod
-  
+
   type psb_dprec_type
     class(psb_d_base_prec_type), allocatable :: prec
   contains
-    procedure, pass(prec)               :: d_apply1_vect
+    procedure, pass(prec)               :: psb_d_apply1_vect
-    procedure, pass(prec)               :: d_apply2_vect
+    procedure, pass(prec)               :: psb_d_apply2_vect
-    procedure, pass(prec)               :: d_apply2v
+    procedure, pass(prec)               :: psb_d_apply2v
-    procedure, pass(prec)               :: d_apply1v
+    procedure, pass(prec)               :: psb_d_apply1v
-    generic, public                     :: apply => d_apply2v, d_apply1v,&
+    generic, public                     :: apply => psb_d_apply2v, psb_d_apply1v,&
-         & d_apply1_vect, d_apply2_vect
+         & psb_d_apply1_vect, psb_d_apply2_vect
   end type psb_dprec_type
 
   interface psb_precfree
@@ -61,12 +54,11 @@ module psb_d_prec_type
   end interface
 
   interface psb_nullify_prec
-    module procedure psb_nullify_dprec
+    module procedure psb_nullify_cprec
   end interface
 
-
   interface psb_precdescr
-    module procedure psb_file_prec_descr
+    module procedure psb_dfile_prec_descr
   end interface
 
   interface psb_precdump
@@ -77,15 +69,61 @@ module psb_d_prec_type
     module procedure psb_dprec_sizeof
   end interface
 
-
+  interface psb_d_apply2_vect
+    subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_dprec_type, psb_d_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_dprec_type), intent(inout) :: prec
+      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(:)
+    end subroutine psb_d_apply2_vect
+  end interface psb_d_apply2_vect
+  
+  interface  psb_d_apply1_vect
+    subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_dprec_type, psb_d_vect_type, psb_dpk_
+        type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_dprec_type), intent(inout) :: prec
+      type(psb_d_vect_type),intent(inout)  :: x
+      integer, intent(out)                 :: info
+      character(len=1), optional           :: trans
+      real(psb_dpk_),intent(inout), optional, target :: work(:)
+    end subroutine psb_d_apply1_vect
+  end interface psb_d_apply1_vect
+  
+  interface  psb_d_apply2v
+    subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_dprec_type, psb_d_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_dprec_type), intent(in) :: prec
+      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(:)
+    end subroutine psb_d_apply2v
+  end interface psb_d_apply2v
+  
+  interface  psb_d_apply1v
+    subroutine psb_d_apply1v(prec,x,desc_data,info,trans)
+      import :: psb_desc_type, psb_dprec_type, psb_d_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_dprec_type), intent(in) :: prec
+      real(psb_dpk_),intent(inout)   :: x(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+    end subroutine psb_d_apply1v
+  end interface psb_d_apply1v
+  
 contains
 
-
+  subroutine psb_dfile_prec_descr(p,iout)
-  subroutine psb_file_prec_descr(p,iout)
-    use psb_base_mod
     type(psb_dprec_type), intent(in) :: p
     integer, intent(in), optional    :: iout
-    integer :: iout_, info
+    integer :: iout_,info
     character(len=20) :: name='prec_descr' 
     
     if (present(iout)) then 
@@ -99,12 +137,10 @@ contains
       call psb_errpush(info,name,a_err="preconditioner")
     end if
     call p%prec%precdescr(iout)
-
+    
-  end subroutine psb_file_prec_descr
+  end subroutine psb_dfile_prec_descr
-
 
   subroutine psb_d_prec_dump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     type(psb_dprec_type), intent(in) :: prec
     integer, intent(out)             :: info
@@ -126,7 +162,6 @@ contains
 
 
   subroutine psb_d_precfree(p,info)
-    use psb_base_mod
     type(psb_dprec_type), intent(inout) :: p
     integer, intent(out)                :: info
     integer             :: me, err_act,i
@@ -154,307 +189,23 @@ contains
       return
     end if
     return
-
   end subroutine psb_d_precfree
 
-  subroutine psb_nullify_dprec(p)
+  subroutine psb_nullify_cprec(p)
     type(psb_dprec_type), intent(inout) :: p
 
-
+  end subroutine psb_nullify_cprec
-  end subroutine psb_nullify_dprec
-
 
   function psb_dprec_sizeof(prec) result(val)
-    use psb_base_mod
     type(psb_dprec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
-    integer :: i
+    integer             :: i
-    val = 0
     
+    val = 0
     if (allocated(prec%prec)) then 
       val = val + prec%prec%sizeof()
     end if
-  end function psb_dprec_sizeof
-
-
-  subroutine d_apply2_vect(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_dprec_type), intent(inout) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    real(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='d_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call prec%prec%apply(done,x,dzero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 d_apply2_vect
-
-
-  subroutine d_apply1_vect(prec,x,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_dprec_type), intent(inout) :: prec
-    type(psb_d_vect_type),intent(inout)  :: x
-    integer, intent(out)                 :: info
-    character(len=1), optional           :: trans
-    real(psb_dpk_),intent(inout), optional, target :: work(:)
     
-    type(psb_d_vect_type)       :: ww
+  end function psb_dprec_sizeof
-    character     :: trans_ 
-    real(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='d_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call psb_geall(ww,desc_data,info)
-    if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
-    if (info == 0) call prec%prec%apply(done,x,dzero,ww,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 d_apply1_vect
-
-  subroutine d_apply2v(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_dprec_type), intent(in) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    real(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='d_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    call prec%prec%apply(done,x,dzero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 d_apply2v
-
-  subroutine d_apply1v(prec,x,desc_data,info,trans)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_dprec_type), intent(in) :: prec
-    real(psb_dpk_),intent(inout)      :: x(:)
-    integer, intent(out)              :: info
-    character(len=1), optional        :: trans
-
-    character     :: trans_
-    integer :: ictxt,np,me, err_act
-    real(psb_dpk_), pointer :: WW(:), w1(:)
-    character(len=20)   :: name
-    name='d_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    
-    ictxt=desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    allocate(ww(size(x)),w1(size(x)),stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call prec%prec%apply(done,x,dzero,ww,desc_data,info,&
-         & trans=trans_,work=w1)
-    if(info /= psb_success_) goto 9999
-    x(:) = ww(:)
-    deallocate(ww,W1,stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='DeAllocate')
-      goto 9999      
-    end if
-
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_errpush(info,name)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine d_apply1v
 
 end module psb_d_prec_type

prec/psb_dprecset.f90

@@ -54,10 +54,10 @@ subroutine psb_dprecseti(p,what,val,info)
 end subroutine psb_dprecseti
 
 
-subroutine psb_dprecsetd(p,what,val,info)
+subroutine psb_dprecsetr(p,what,val,info)
 
   use psb_base_mod
-  use psb_prec_mod, psb_protect_name => psb_dprecsetd
+  use psb_prec_mod, psb_protect_name => psb_dprecsetr
   implicit none
   type(psb_dprec_type), intent(inout)    :: p
   integer                                :: what
@@ -77,4 +77,4 @@ subroutine psb_dprecsetd(p,what,val,info)
 
   return
 
-end subroutine psb_dprecsetd
+end subroutine psb_dprecsetr

prec/psb_s_base_prec_mod.f90

@@ -36,12 +36,12 @@
 module psb_s_base_prec_mod
 
   ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
+  use psb_base_mod, only : psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
+       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
        & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_sspmat_type, psb_s_base_vect, psb_s_vect_type
+       & psb_s_base_sparse_mat, psb_sspmat_type, psb_s_csr_sparse_mat,& 
+       & psb_s_base_vect_type, psb_s_vect_type
 
-  
   use psb_prec_const_mod
 
   type psb_s_base_prec_type
@@ -74,17 +74,17 @@ module psb_s_base_prec_mod
 contains
 
   subroutine psb_s_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
-    type(psb_desc_type),intent(in)    :: desc_data
+    type(psb_desc_type),intent(in)        :: desc_data
     class(psb_s_base_prec_type), intent(inout)  :: prec
-    real(psb_spk_),intent(in)         :: alpha, beta
+    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
+    integer, intent(out)                  :: info
-    character(len=1), optional        :: trans
+    character(len=1), optional            :: trans
     real(psb_spk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_prec_apply'
+    character(len=20)  :: name='s_base_prec_apply'
 
     call psb_erractionsave(err_act)
 
@@ -110,14 +110,14 @@ contains
   end subroutine psb_s_base_apply_vect
 
   subroutine psb_s_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
-    type(psb_desc_type),intent(in)    :: desc_data
+    type(psb_desc_type),intent(in)       :: desc_data
     class(psb_s_base_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
+    integer, intent(out)                 :: info
-    character(len=1), optional        :: trans
+    character(len=1), optional           :: trans
     real(psb_spk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
     character(len=20)  :: name='s_base_prec_apply'
@@ -146,10 +146,8 @@ contains
   end subroutine psb_s_base_apply
 
   subroutine psb_s_base_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
-    
+   
     class(psb_s_base_prec_type),intent(inout) :: prec
     integer, intent(out)                     :: info
     Integer :: err_act, nrow
@@ -178,8 +176,6 @@ contains
   end subroutine psb_s_base_precinit
 
   subroutine psb_s_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
     Implicit None
     
     type(psb_sspmat_type), intent(in), target :: a
@@ -216,8 +212,6 @@ contains
   end subroutine psb_s_base_precbld
 
   subroutine psb_s_base_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_base_prec_type),intent(inout) :: prec
@@ -250,8 +244,6 @@ contains
   end subroutine psb_s_base_precseti
 
   subroutine psb_s_base_precsetr(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_base_prec_type),intent(inout) :: prec
@@ -284,8 +276,6 @@ contains
   end subroutine psb_s_base_precsetr
 
   subroutine psb_s_base_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_s_base_prec_type),intent(inout) :: prec
@@ -318,8 +308,6 @@ contains
   end subroutine psb_s_base_precsetc
 
   subroutine psb_s_base_precfree(prec,info)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_s_base_prec_type), intent(inout) :: prec
@@ -353,8 +341,6 @@ contains
   
 
   subroutine psb_s_base_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_s_base_prec_type), intent(in) :: prec
@@ -387,13 +373,12 @@ contains
   end subroutine psb_s_base_precdescr
   
   subroutine psb_s_base_precdump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     class(psb_s_base_prec_type), intent(in) :: prec
     integer, intent(out)             :: info
     character(len=*), intent(in), optional :: prefix,head
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_precdump'
+    character(len=20)  :: name='s_base_precdump'
 
     call psb_erractionsave(err_act)
 
@@ -419,7 +404,6 @@ contains
   end subroutine psb_s_base_precdump
 
   subroutine psb_s_base_set_ctxt(prec,ictxt)
-    use psb_base_mod
     implicit none 
     class(psb_s_base_prec_type), intent(inout) :: prec
     integer, intent(in)  :: ictxt
@@ -429,7 +413,6 @@ contains
   end subroutine psb_s_base_set_ctxt
 
   function psb_s_base_sizeof(prec) result(val)
-    use psb_base_mod
     class(psb_s_base_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
@@ -438,7 +421,6 @@ contains
   end function psb_s_base_sizeof
 
   function psb_s_base_get_ctxt(prec) result(val)
-    use psb_base_mod
     class(psb_s_base_prec_type), intent(in) :: prec
     integer :: val
     

prec/psb_s_prec_mod.f90

@@ -32,12 +32,13 @@
 
 module psb_s_prec_mod
   use psb_s_prec_type
+  use psb_s_base_prec_mod
 
   interface psb_precbld
     subroutine psb_sprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-      use psb_base_mod, only  : psb_desc_type, psb_sspmat_type,&
+      import :: psb_desc_type, psb_sspmat_type,&
-           & psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type
+           & psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type, &
-      use psb_prec_type, only : psb_sprec_type
+           & psb_sprec_type
       implicit none
       type(psb_sspmat_type), intent(in), target  :: a
       type(psb_desc_type), intent(in), target    :: desc_a
@@ -47,14 +48,12 @@ module psb_s_prec_mod
       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_sprecbld
   end interface
 
   interface psb_precinit
     subroutine psb_sprecinit(prec,ptype,info)
-      use psb_base_mod, only  : psb_desc_type, psb_sspmat_type, psb_spk_
+      import :: psb_desc_type, psb_sspmat_type, psb_spk_, psb_sprec_type
-      use psb_prec_type, only : psb_sprec_type
       implicit none
       type(psb_sprec_type), intent(inout)    :: prec
       character(len=*), intent(in)           :: ptype
@@ -64,27 +63,25 @@ module psb_s_prec_mod
 
   interface psb_precset
     subroutine psb_sprecseti(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_sspmat_type, psb_spk_
+      import :: psb_desc_type, psb_sspmat_type, psb_spk_, psb_sprec_type
-      use psb_prec_type, only : psb_sprec_type
       implicit none
       type(psb_sprec_type), intent(inout)    :: prec
       integer                                :: what, val 
       integer, intent(out)                   :: info
     end subroutine psb_sprecseti
-    subroutine psb_sprecsets(prec,what,val,info)
+    subroutine psb_sprecsetr(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_sspmat_type, psb_spk_
+      import :: psb_desc_type, psb_sspmat_type, psb_spk_, psb_sprec_type
-      use psb_prec_type, only : psb_sprec_type
       implicit none
       type(psb_sprec_type), intent(inout)    :: prec
       integer                                :: what
       real(psb_spk_)                       :: val 
       integer, intent(out)                   :: info
-    end subroutine psb_sprecsets
+    end subroutine psb_sprecsetr
   end interface
 
   interface psb_ilu_fct
     subroutine psb_silu_fct(a,l,u,d,info,blck)
-      use psb_base_mod, only  : psb_desc_type, psb_sspmat_type,&
+      import :: psb_desc_type, psb_sspmat_type, &
            & psb_s_csr_sparse_mat, psb_spk_
       integer, intent(out)                ::     info
       type(psb_sspmat_type),intent(in)    :: a

prec/psb_s_prec_type.f90

@@ -35,24 +35,18 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 module psb_s_prec_type
 
-  ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_sspmat_type
-  
   use psb_prec_const_mod
   use psb_s_base_prec_mod
 
   type psb_sprec_type
     class(psb_s_base_prec_type), allocatable :: prec
   contains
-    procedure, pass(prec)               :: s_apply1_vect
+    procedure, pass(prec)               :: psb_s_apply1_vect
-    procedure, pass(prec)               :: s_apply2_vect
+    procedure, pass(prec)               :: psb_s_apply2_vect
-    procedure, pass(prec)               :: s_apply2v
+    procedure, pass(prec)               :: psb_s_apply2v
-    procedure, pass(prec)               :: s_apply1v
+    procedure, pass(prec)               :: psb_s_apply1v
-    generic, public                     :: apply => s_apply2v, s_apply1v,&
+    generic, public                     :: apply => psb_s_apply2v, psb_s_apply1v,&
-         & s_apply1_vect, s_apply2_vect
+         & psb_s_apply1_vect, psb_s_apply2_vect
   end type psb_sprec_type
 
   interface psb_precfree
@@ -60,7 +54,7 @@ module psb_s_prec_type
   end interface
 
   interface psb_nullify_prec
-    module procedure psb_nullify_sprec
+    module procedure psb_nullify_cprec
   end interface
 
   interface psb_precdescr
@@ -75,10 +69,58 @@ module psb_s_prec_type
     module procedure psb_sprec_sizeof
   end interface
 
+  interface psb_s_apply2_vect
+    subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_sprec_type, psb_s_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_sprec_type), intent(inout) :: prec
+      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(:)
+    end subroutine psb_s_apply2_vect
+  end interface psb_s_apply2_vect
+  
+  interface  psb_s_apply1_vect
+    subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_sprec_type, psb_s_vect_type, psb_spk_
+        type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_sprec_type), intent(inout) :: prec
+      type(psb_s_vect_type),intent(inout)  :: x
+      integer, intent(out)                 :: info
+      character(len=1), optional           :: trans
+      real(psb_spk_),intent(inout), optional, target :: work(:)
+    end subroutine psb_s_apply1_vect
+  end interface psb_s_apply1_vect
+  
+  interface  psb_s_apply2v
+    subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_sprec_type, psb_s_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_sprec_type), intent(in) :: prec
+      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(:)
+    end subroutine psb_s_apply2v
+  end interface psb_s_apply2v
+  
+  interface  psb_s_apply1v
+    subroutine psb_s_apply1v(prec,x,desc_data,info,trans)
+      import :: psb_desc_type, psb_sprec_type, psb_s_vect_type, psb_spk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_sprec_type), intent(in) :: prec
+      real(psb_spk_),intent(inout)   :: x(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+    end subroutine psb_s_apply1v
+  end interface psb_s_apply1v
+  
 contains
 
   subroutine psb_sfile_prec_descr(p,iout)
-    use psb_base_mod
     type(psb_sprec_type), intent(in) :: p
     integer, intent(in), optional    :: iout
     integer :: iout_,info
@@ -99,7 +141,6 @@ contains
   end subroutine psb_sfile_prec_descr
 
   subroutine psb_s_prec_dump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     type(psb_sprec_type), intent(in) :: prec
     integer, intent(out)             :: info
@@ -121,12 +162,11 @@ contains
 
 
   subroutine psb_s_precfree(p,info)
-    use psb_base_mod
+    type(psb_sprec_type), intent(inout) :: p
-    type(psb_sprec_type), intent(inout) :: p 
+    integer, intent(out)                :: info
-    integer, intent(out) ::  info
+    integer             :: me, err_act,i
-    integer           :: me, err_act,i 
+    character(len=20)   :: name
-    character(len=20) :: name
+    if(psb_get_errstatus() /= 0) return 
-    if(psb_get_errstatus() /= 0) return
     info=psb_success_
     name = 'psb_precfree'
     call psb_erractionsave(err_act)
@@ -151,304 +191,21 @@ contains
     return
   end subroutine psb_s_precfree
 
-  subroutine psb_nullify_sprec(p)
+  subroutine psb_nullify_cprec(p)
     type(psb_sprec_type), intent(inout) :: p
 
-  end subroutine psb_nullify_sprec
+  end subroutine psb_nullify_cprec
 
   function psb_sprec_sizeof(prec) result(val)
-    use psb_base_mod
     type(psb_sprec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     integer             :: i
     
     val = 0
-    
     if (allocated(prec%prec)) then 
       val = val + prec%prec%sizeof()
     end if
     
   end function psb_sprec_sizeof
- 
-
-  subroutine s_apply2_vect(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_sprec_type), intent(inout) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    real(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='s_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call prec%prec%apply(sone,x,szero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 s_apply2_vect
-
-
-  subroutine s_apply1_vect(prec,x,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_sprec_type), intent(inout) :: prec
-    type(psb_s_vect_type),intent(inout)  :: x
-    integer, intent(out)                 :: info
-    character(len=1), optional           :: trans
-    real(psb_spk_),intent(inout), optional, target :: work(:)
-
-    type(psb_s_vect_type)       :: ww
-    character     :: trans_ 
-    real(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-
-    name='s_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-
-    end if
-
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call psb_geall(ww,desc_data,info)
-    if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
-    if (info == 0) call prec%prec%apply(sone,x,szero,ww,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 s_apply1_vect
-
-  subroutine s_apply2v(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_sprec_type), intent(in) :: prec
-    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(:)
-
-    character     :: trans_ 
-    real(psb_spk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-
-    name='s_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-
-    if (present(trans)) then 
-      trans_=trans
-    else
-      trans_='N'
-    end if
-
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-
-    end if
-
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    call prec%prec%apply(sone,x,szero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 s_apply2v
-
-  subroutine s_apply1v(prec,x,desc_data,info,trans)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_sprec_type), intent(in) :: prec
-    real(psb_spk_),intent(inout)      :: x(:)
-    integer, intent(out)              :: info
-    character(len=1), optional        :: trans
-
-    character     :: trans_
-    integer :: ictxt,np,me, err_act
-    real(psb_spk_), pointer :: WW(:), w1(:)
-    character(len=20)   :: name
-    name='s_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-
-    ictxt=desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    allocate(ww(size(x)),w1(size(x)),stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call prec%prec%apply(sone,x,szero,ww,desc_data,info,&
-         & trans=trans_,work=w1)
-    if(info /= psb_success_) goto 9999
-    x(:) = ww(:)
-    deallocate(ww,W1,stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='DeAllocate')
-      goto 9999      
-    end if
-
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_errpush(info,name)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-
-  end subroutine s_apply1v
 
 end module psb_s_prec_type

prec/psb_sprecset.f90

@@ -54,10 +54,9 @@ subroutine psb_sprecseti(p,what,val,info)
 end subroutine psb_sprecseti
 
 
-subroutine psb_sprecsets(p,what,val,info)
+subroutine psb_sprecsetr(p,what,val,info)
-
   use psb_base_mod
-  use psb_prec_mod, psb_protect_name => psb_sprecsets
+  use psb_prec_mod, psb_protect_name => psb_sprecsetr
   implicit none
   type(psb_sprec_type), intent(inout)    :: p
   integer                                :: what
@@ -77,4 +76,4 @@ subroutine psb_sprecsets(p,what,val,info)
 
   return
 
-end subroutine psb_sprecsets
+end subroutine psb_sprecsetr

prec/psb_z_base_prec_mod.f90

@@ -36,10 +36,11 @@
 module psb_z_base_prec_mod
 
   ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
+  use psb_base_mod, only : psb_dpk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
+       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,&
        & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_zspmat_type, psb_z_base_vect, psb_z_vect_type
+       & psb_z_base_sparse_mat, psb_zspmat_type, psb_z_csr_sparse_mat,& 
+       & psb_z_base_vect_type, psb_z_vect_type
 
   use psb_prec_const_mod
 
@@ -73,7 +74,7 @@ module psb_z_base_prec_mod
 contains
 
   subroutine psb_z_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
     type(psb_desc_type),intent(in)        :: desc_data
     class(psb_z_base_prec_type), intent(inout)  :: prec
     complex(psb_dpk_),intent(in)          :: alpha, beta
@@ -83,7 +84,7 @@ contains
     character(len=1), optional            :: trans
     complex(psb_dpk_),intent(inout), optional, target :: work(:)
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_prec_apply'
+    character(len=20)  :: name='z_base_prec_apply'
 
     call psb_erractionsave(err_act)
 
@@ -109,7 +110,7 @@ contains
   end subroutine psb_z_base_apply_vect
 
   subroutine psb_z_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work)
-    use psb_base_mod
+    implicit none 
     type(psb_desc_type),intent(in)       :: desc_data
     class(psb_z_base_prec_type), intent(in)  :: prec
     complex(psb_dpk_),intent(in)         :: alpha, beta
@@ -145,10 +146,8 @@ contains
   end subroutine psb_z_base_apply
 
   subroutine psb_z_base_precinit(prec,info)
-    
-    use psb_base_mod
     Implicit None
-    
+   
     class(psb_z_base_prec_type),intent(inout) :: prec
     integer, intent(out)                     :: info
     Integer :: err_act, nrow
@@ -177,8 +176,6 @@ contains
   end subroutine psb_z_base_precinit
 
   subroutine psb_z_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-    
-    use psb_base_mod
     Implicit None
     
     type(psb_zspmat_type), intent(in), target :: a
@@ -215,8 +212,6 @@ contains
   end subroutine psb_z_base_precbld
 
   subroutine psb_z_base_precseti(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_base_prec_type),intent(inout) :: prec
@@ -249,8 +244,6 @@ contains
   end subroutine psb_z_base_precseti
 
   subroutine psb_z_base_precsetr(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_base_prec_type),intent(inout) :: prec
@@ -283,8 +276,6 @@ contains
   end subroutine psb_z_base_precsetr
 
   subroutine psb_z_base_precsetc(prec,what,val,info)
-    
-    use psb_base_mod
     Implicit None
     
     class(psb_z_base_prec_type),intent(inout) :: prec
@@ -317,8 +308,6 @@ contains
   end subroutine psb_z_base_precsetc
 
   subroutine psb_z_base_precfree(prec,info)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_z_base_prec_type), intent(inout) :: prec
@@ -352,8 +341,6 @@ contains
   
 
   subroutine psb_z_base_precdescr(prec,iout)
-    
-    use psb_base_mod
     Implicit None
 
     class(psb_z_base_prec_type), intent(in) :: prec
@@ -386,13 +373,12 @@ contains
   end subroutine psb_z_base_precdescr
   
   subroutine psb_z_base_precdump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     class(psb_z_base_prec_type), intent(in) :: prec
     integer, intent(out)             :: info
     character(len=*), intent(in), optional :: prefix,head
     Integer :: err_act, nrow
-    character(len=20)  :: name='d_base_precdump'
+    character(len=20)  :: name='z_base_precdump'
 
     call psb_erractionsave(err_act)
 
@@ -418,7 +404,6 @@ contains
   end subroutine psb_z_base_precdump
 
   subroutine psb_z_base_set_ctxt(prec,ictxt)
-    use psb_base_mod
     implicit none 
     class(psb_z_base_prec_type), intent(inout) :: prec
     integer, intent(in)  :: ictxt
@@ -428,7 +413,6 @@ contains
   end subroutine psb_z_base_set_ctxt
 
   function psb_z_base_sizeof(prec) result(val)
-    use psb_base_mod
     class(psb_z_base_prec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     
@@ -437,7 +421,6 @@ contains
   end function psb_z_base_sizeof
 
   function psb_z_base_get_ctxt(prec) result(val)
-    use psb_base_mod
     class(psb_z_base_prec_type), intent(in) :: prec
     integer :: val
     

prec/psb_z_prec_mod.f90

@@ -32,12 +32,13 @@
 
 module psb_z_prec_mod
   use psb_z_prec_type
+  use psb_z_base_prec_mod
 
   interface psb_precbld
     subroutine psb_zprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
-      use psb_base_mod, only  : psb_desc_type, psb_zspmat_type,&
+      import :: psb_desc_type, psb_zspmat_type,&
-           & psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type
+           & psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type, &
-      use psb_prec_type, only : psb_zprec_type
+           & psb_zprec_type
       implicit none
       type(psb_zspmat_type), intent(in), target  :: a
       type(psb_desc_type), intent(in), target    :: desc_a
@@ -52,8 +53,7 @@ module psb_z_prec_mod
 
   interface psb_precinit
     subroutine psb_zprecinit(prec,ptype,info)
-      use psb_base_mod, only  : psb_desc_type, psb_zspmat_type, psb_dpk_
+      import :: psb_desc_type, psb_zspmat_type, psb_dpk_, psb_zprec_type
-      use psb_prec_type, only : psb_zprec_type
       implicit none
       type(psb_zprec_type), intent(inout)    :: prec
       character(len=*), intent(in)           :: ptype
@@ -63,27 +63,25 @@ module psb_z_prec_mod
 
   interface psb_precset
     subroutine psb_zprecseti(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_zspmat_type, psb_dpk_
+      import :: psb_desc_type, psb_zspmat_type, psb_dpk_, psb_zprec_type
-      use psb_prec_type, only : psb_zprec_type
       implicit none
       type(psb_zprec_type), intent(inout)    :: prec
       integer                                :: what, val 
       integer, intent(out)                   :: info
     end subroutine psb_zprecseti
-    subroutine psb_zprecsetd(prec,what,val,info)
+    subroutine psb_zprecsetr(prec,what,val,info)
-      use psb_base_mod, only  : psb_desc_type, psb_zspmat_type, psb_dpk_
+      import :: psb_desc_type, psb_zspmat_type, psb_dpk_, psb_zprec_type
-      use psb_prec_type, only : psb_zprec_type
       implicit none
       type(psb_zprec_type), intent(inout)    :: prec
       integer                                :: what
       real(psb_dpk_)                       :: val 
       integer, intent(out)                   :: info
-    end subroutine psb_zprecsetd
+    end subroutine psb_zprecsetr
   end interface
 
   interface psb_ilu_fct
     subroutine psb_zilu_fct(a,l,u,d,info,blck)
-      use psb_base_mod, only  : psb_desc_type, psb_zspmat_type, &
+      import :: psb_desc_type, psb_zspmat_type, &
            & psb_z_csr_sparse_mat, psb_dpk_
       integer, intent(out)                ::     info
       type(psb_zspmat_type),intent(in)    :: a

prec/psb_z_prec_type.f90

@@ -35,24 +35,18 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 module psb_z_prec_type
 
-  ! Reduces size of .mod file.
-  use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
-       & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
-       & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
-       & psb_zspmat_type
-  
   use psb_prec_const_mod
   use psb_z_base_prec_mod
-  
+
   type psb_zprec_type
     class(psb_z_base_prec_type), allocatable :: prec
   contains
-    procedure, pass(prec)               :: z_apply1_vect
+    procedure, pass(prec)               :: psb_z_apply1_vect
-    procedure, pass(prec)               :: z_apply2_vect
+    procedure, pass(prec)               :: psb_z_apply2_vect
-    procedure, pass(prec)               :: z_apply2v
+    procedure, pass(prec)               :: psb_z_apply2v
-    procedure, pass(prec)               :: z_apply1v
+    procedure, pass(prec)               :: psb_z_apply1v
-    generic, public                     :: apply => z_apply2v, z_apply1v,&
+    generic, public                     :: apply => psb_z_apply2v, psb_z_apply1v,&
-         & z_apply1_vect, z_apply2_vect
+         & psb_z_apply1_vect, psb_z_apply2_vect
   end type psb_zprec_type
 
   interface psb_precfree
@@ -60,7 +54,7 @@ module psb_z_prec_type
   end interface
 
   interface psb_nullify_prec
-    module procedure psb_nullify_zprec
+    module procedure psb_nullify_cprec
   end interface
 
   interface psb_precdescr
@@ -75,10 +69,58 @@ module psb_z_prec_type
     module procedure psb_zprec_sizeof
   end interface
 
+  interface psb_z_apply2_vect
+    subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_zprec_type, psb_z_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_zprec_type), intent(inout) :: prec
+      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(:)
+    end subroutine psb_z_apply2_vect
+  end interface psb_z_apply2_vect
+  
+  interface  psb_z_apply1_vect
+    subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_zprec_type, psb_z_vect_type, psb_dpk_
+        type(psb_desc_type),intent(in)       :: desc_data
+      class(psb_zprec_type), intent(inout) :: prec
+      type(psb_z_vect_type),intent(inout)  :: x
+      integer, intent(out)                 :: info
+      character(len=1), optional           :: trans
+      complex(psb_dpk_),intent(inout), optional, target :: work(:)
+    end subroutine psb_z_apply1_vect
+  end interface psb_z_apply1_vect
+  
+  interface  psb_z_apply2v
+    subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work)
+      import :: psb_desc_type, psb_zprec_type, psb_z_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_zprec_type), intent(in) :: prec
+      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(:)
+    end subroutine psb_z_apply2v
+  end interface psb_z_apply2v
+  
+  interface  psb_z_apply1v
+    subroutine psb_z_apply1v(prec,x,desc_data,info,trans)
+      import :: psb_desc_type, psb_zprec_type, psb_z_vect_type, psb_dpk_
+      type(psb_desc_type),intent(in)    :: desc_data
+      class(psb_zprec_type), intent(in) :: prec
+      complex(psb_dpk_),intent(inout)   :: x(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+    end subroutine psb_z_apply1v
+  end interface psb_z_apply1v
+  
 contains
 
   subroutine psb_zfile_prec_descr(p,iout)
-    use psb_base_mod
     type(psb_zprec_type), intent(in) :: p
     integer, intent(in), optional    :: iout
     integer :: iout_,info
@@ -99,7 +141,6 @@ contains
   end subroutine psb_zfile_prec_descr
 
   subroutine psb_z_prec_dump(prec,info,prefix,head)
-    use psb_base_mod
     implicit none 
     type(psb_zprec_type), intent(in) :: prec
     integer, intent(out)             :: info
@@ -121,7 +162,6 @@ contains
 
 
   subroutine psb_z_precfree(p,info)
-    use psb_base_mod
     type(psb_zprec_type), intent(inout) :: p
     integer, intent(out)                :: info
     integer             :: me, err_act,i
@@ -151,13 +191,12 @@ contains
     return
   end subroutine psb_z_precfree
 
-  subroutine psb_nullify_zprec(p)
+  subroutine psb_nullify_cprec(p)
     type(psb_zprec_type), intent(inout) :: p
 
-  end subroutine psb_nullify_zprec
+  end subroutine psb_nullify_cprec
 
   function psb_zprec_sizeof(prec) result(val)
-    use psb_base_mod
     type(psb_zprec_type), intent(in) :: prec
     integer(psb_long_int_k_) :: val
     integer             :: i
@@ -169,281 +208,4 @@ contains
     
   end function psb_zprec_sizeof
 
-  subroutine z_apply2_vect(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_zprec_type), intent(inout) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    complex(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name = 'z_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call prec%prec%apply(zone,x,zzero,y,desc_data,info,&
-         & trans=trans_,work=work_)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 z_apply2_vect
-
-  subroutine z_apply1_vect(prec,x,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)       :: desc_data
-    class(psb_zprec_type), intent(inout) :: prec
-    type(psb_z_vect_type),intent(inout)  :: x
-    integer, intent(out)                 :: info
-    character(len=1), optional           :: trans
-    complex(psb_dpk_),intent(inout), optional, target :: work(:)
-
-    type(psb_z_vect_type)       :: ww
-    character     :: trans_ 
-    complex(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-
-    name = 'z_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-
-    end if
-
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-
-    call psb_geall(ww,desc_data,info)
-    if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v)
-    if (info == 0) call prec%prec%apply(zone,x,zzero,ww,desc_data,info,&
-         & trans=trans_,work=work_)
-    if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
-
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 z_apply1_vect
- 
-  subroutine z_apply2v(prec,x,y,desc_data,info,trans,work)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_zprec_type), intent(in) :: prec
-    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(:)
-    
-    character     :: trans_ 
-    complex(psb_dpk_), pointer :: work_(:)
-    integer :: ictxt,np,me,err_act
-    character(len=20)   :: name
-    
-    name='z_apply2v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    ictxt = desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    
-    if (present(trans)) then 
-      trans_=trans
-    else
-      trans_='N'
-    end if
-    
-    if (present(work)) then 
-      work_ => work
-    else
-      allocate(work_(4*desc_data%get_local_cols()),stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,name,a_err='Allocate')
-        goto 9999      
-      end if
-      
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    call prec%prec%apply(zone,x,zzero,y,desc_data,info,trans_,work=work_)
-    if (present(work)) then 
-    else
-      deallocate(work_,stat=info)
-      if (info /= psb_success_) then 
-        info = psb_err_from_subroutine_
-        call psb_errpush(info,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 z_apply2v
-
-  subroutine z_apply1v(prec,x,desc_data,info,trans)
-    use psb_base_mod
-    type(psb_desc_type),intent(in)    :: desc_data
-    class(psb_zprec_type), intent(in) :: prec
-    complex(psb_dpk_),intent(inout)   :: x(:)
-    integer, intent(out)              :: info
-    character(len=1), optional        :: trans
-
-    character     :: trans_
-    integer :: ictxt,np,me, err_act
-    complex(psb_dpk_), pointer :: WW(:), w1(:)
-    character(len=20)   :: name
-    name='z_apply1v'
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    
-    
-    ictxt=desc_data%get_context()
-    call psb_info(ictxt, me, np)
-    if (present(trans)) then 
-      trans_=psb_toupper(trans)
-    else
-      trans_='N'
-    end if
-    
-    if (.not.allocated(prec%prec)) then 
-      info = 1124
-      call psb_errpush(info,name,a_err="preconditioner")
-      goto 9999
-    end if
-    allocate(ww(size(x)),w1(size(x)),stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='Allocate')
-      goto 9999      
-    end if
-    call prec%prec%apply(zone,x,zzero,ww,desc_data,info,trans_,work=w1)
-    if(info /= psb_success_) goto 9999
-    x(:) = ww(:)
-    deallocate(ww,W1,stat=info)
-    if (info /= psb_success_) then 
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name,a_err='DeAllocate')
-      goto 9999      
-    end if
-
-    
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_errpush(info,name)
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-    
-  end subroutine z_apply1v
-
 end module psb_z_prec_type

prec/psb_zprecset.f90

@@ -54,10 +54,10 @@ subroutine psb_zprecseti(p,what,val,info)
 end subroutine psb_zprecseti
 
 
-subroutine psb_zprecsetd(p,what,val,info)
+subroutine psb_zprecsetr(p,what,val,info)
 
   use psb_base_mod
-  use psb_prec_mod, psb_protect_name => psb_zprecsetd
+  use psb_prec_mod, psb_protect_name => psb_zprecsetr
   implicit none
   type(psb_zprec_type), intent(inout)    :: p
   integer                                :: what
@@ -77,4 +77,4 @@ subroutine psb_zprecsetd(p,what,val,info)
 
   return
 
-end subroutine psb_zprecsetd
+end subroutine psb_zprecsetr