Merge branch 'maint-1.2.0' of github.com:sfilippone/amg4psblas into maint-1.2.0

.VERSION

@@ -1,6 +1,6 @@
 $Format:%d%n%n$
 # Fall back version, probably last release:
-1.2.1
+1.2.0
 
 # AMG4PSBLAS version file.
 #

CMakeLists.txt

@@ -13,10 +13,15 @@ endif()
 
 
 # Check for the installation path for psblas
-message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};")
+#if(NOT DEFINED PSBLAS_INSTALL_DIR)
+#    message(FATAL_ERROR "Please specify the path to the psblas installation directory using -DPSBLAS_INSTALL_DIR=<path>")
+#endif()
+message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};;")
+
 
 message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
 
+
 #set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
 
 
@@ -26,7 +31,7 @@ find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
 if(NOT psblas_FOUND)
     message(FATAL_ERROR "PSBLAS not found!")
 else()
-    message(STATUS "Found PSBLAS: ${PSBLAS_LIBRARIES}")
+    message(STATUS "Found PSBLAS: ${psblas_LIBRARIES}")
 endif()
 
 if(CMAKE_BUILD_TYPE STREQUAL "Debug")
@@ -37,9 +42,9 @@ if(CMAKE_BUILD_TYPE STREQUAL "Debug")
     message(STATUS "Fortran and CXX debug flags added: -g")
 endif()
 
-string(APPEND CMAKE_Fortran_FLAGS " -O2")
-string(APPEND CMAKE_CXX_FLAGS " -O2")
-message(STATUS "Fortran and CXX optimization flags added: -O2")
+    string(APPEND CMAKE_Fortran_FLAGS " -O2")
+    string(APPEND CMAKE_CXX_FLAGS " -O2")
+    message(STATUS "Fortran and CXX optimization flags added: -O2")
 
 
 
@@ -425,9 +430,7 @@ target_include_directories(amgcbind PUBLIC ${INCDIR} ${MODDIR})
 target_link_libraries(amgcbind
   #PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
   #PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
-  PUBLIC amgprec psblas::util psblas::linsolve psblas::prec
-  psblas::ext psblas::cbind psblas::base)
-  #TODO  check actual libraries needed
+  PUBLIC amgprec psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base)  #TODO  check actual libraries needed
 
 
 

LICENSE

@@ -7,7 +7,7 @@
     (C) Copyright 2025  Salvatore Filippone
     (C) Copyright 2025  Pasqua D'Ambra
     (C) Copyright 2025  Fabio Durastante
-    
+   
     Redistribution and use in source and binary forms, with or without
     modification, are permitted provided that the following conditions
     are met:

Make.inc.in

@@ -71,7 +71,7 @@ EXTRALIBS=@EXTRA_LIBS@
 
 #
 AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
-#$(PSBCDEFINES) $(MUMPSFLAGS) 
+#$(PSBCDEFINES) $(MUMPSFLAGS)
 CDEFINES=$(AMGCDEFINES)
 AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
 FDEFINES=$(AMGFDEFINES)

Makefile

@@ -19,7 +19,7 @@ libdir:
 amgobjs: mods
 	cd amgprec && $(MAKE) objs
 
-cbnd: amgobjs
+cbnd: mods
 	cd cbind && $(MAKE)  objs
 
 install: all

amgprec/CMakeLists.txt

@@ -509,7 +509,6 @@ set(AMG_amgprec_source_files
   impl/smoother/amg_s_base_smoother_free.f90
   impl/smoother/amg_d_jac_smoother_clone.f90
   impl/smoother/amg_d_jac_smoother_apply_vect.f90
-  impl/smoother/amg_d_richards_smoother_impl.f90
   impl/smoother/amg_c_as_smoother_clear_data.f90
   impl/smoother/amg_s_poly_smoother_descr.f90
   impl/smoother/amg_z_as_smoother_cseti.f90
@@ -774,7 +773,6 @@ set(AMG_amgprec_source_files
   amg_prec_mod.f90
   amg_d_gs_solver.f90
   amg_d_jac_smoother.f90
-  amg_d_richards_smoother.f90
   amg_z_symdec_aggregator_mod.f90
   amg_s_gs_solver.f90
   amg_ainv_mod.f90

amgprec/Makefile

@@ -8,7 +8,7 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
 
 
 DMODOBJS=amg_d_prec_type.o \
-	amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o amg_d_richards_smoother.o \
+	amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
         amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
 	amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
 	amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
@@ -58,8 +58,7 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o  amg_prec_mod.o \
 	$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
 
 
-LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
-	amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
+LOCAL_MODS=$(MODOBJS:.o=$(.mod))
 LIBNAME=libamg_prec.a
 
 all: mods  objs impld
@@ -71,7 +70,7 @@ objs: mods impld
 impld: mods
 	cd impl && $(MAKE) 
 
-lib: objs
+lib: mods impld
 	cd impl && $(MAKE) lib
 	$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
 	$(RANLIB) $(HERE)/$(LIBNAME)
@@ -80,7 +79,7 @@ lib: objs
 
 $(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
 
-amg_base_prec_type.o: amg_config.h
+#amg_base_prec_type.o: amg_const.h
 amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o	: amg_base_prec_type.o
 amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
 amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
@@ -159,7 +158,7 @@ amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: am
 
 #amg_d_ilu_fact_mod.o: amg_base_prec_type.o  amg_d_base_solver_mod.o
 #amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
-amg_d_as_smoother.o amg_d_jac_smoother.o amg_d_richards_smoother.o: amg_d_base_smoother_mod.o
+amg_d_as_smoother.o amg_d_jac_smoother.o: amg_d_base_smoother_mod.o
 amg_d_jac_smoother.o: amg_d_diag_solver.o
 amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
 		amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \

amgprec/amg_base_prec_type.F90

@@ -84,7 +84,7 @@ module amg_base_prec_type
   character(len=*), parameter   :: amg_version_string_ = "1.2.0"
   integer(psb_ipk_), parameter  :: amg_version_major_  = 1
   integer(psb_ipk_), parameter  :: amg_version_minor_  = 2
-  integer(psb_ipk_), parameter  :: amg_patchlevel_     = 1
+  integer(psb_ipk_), parameter  :: amg_patchlevel_     = 0
 
   type amg_ml_parms
     integer(psb_ipk_) :: sweeps_pre, sweeps_post
@@ -216,8 +216,7 @@ module amg_base_prec_type
   integer(psb_ipk_), parameter :: amg_l1_gs_    = 7
   integer(psb_ipk_), parameter :: amg_l1_fbgs_  = 8
   integer(psb_ipk_), parameter :: amg_poly_     = 9
-  integer(psb_ipk_), parameter :: amg_richardson_ = 10
-  integer(psb_ipk_), parameter :: amg_max_prec_ = 10
+  integer(psb_ipk_), parameter :: amg_max_prec_ = 9
   !
   ! Constants for pre/post signaling. Now only used internally
   !
@@ -230,8 +229,7 @@ module amg_base_prec_type
   !
   ! Legal values for entry: amg_sub_solve_
   !
-  ! Keep this fixed so sub-solver numeric IDs remain stable.
-  integer(psb_ipk_), parameter :: amg_slv_delta_     = 10
+  integer(psb_ipk_), parameter :: amg_slv_delta_     = amg_max_prec_+1
   integer(psb_ipk_), parameter :: amg_f_none_        = amg_slv_delta_+0
   integer(psb_ipk_), parameter :: amg_diag_scale_    = amg_slv_delta_+1
   integer(psb_ipk_), parameter :: amg_l1_diag_scale_ = amg_slv_delta_+2
@@ -411,7 +409,7 @@ module amg_base_prec_type
        & 'none          ','Jacobi        ',&
        & 'L1-Jacobi     ','none          ','none          ',&
        & 'none          ','none          ','L1-GS         ',&
-      & 'L1-FBGS       ','Polynomial    ', 'Richards      ','Point Jacobi  ',&
+       & 'L1-FBGS       ','Polynomial    ','none          ','Point Jacobi  ',&
        & 'L1-Jacobi     ','Gauss-Seidel  ','ILU(n)        ',&
        & 'MILU(n)       ','ILU(t,n)      ',&
        & 'SuperLU       ','UMFPACK LU    ',&
@@ -577,8 +575,6 @@ contains
       val = amg_as_
     case('POLY')
       val = amg_poly_
-    case('RICHARDSON','RICHARDS')
-      val = amg_richardson_
     case('CHEB_4')
       val = amg_cheb_4_
     case('CHEB_4_OPT')
@@ -1206,8 +1202,6 @@ contains
       pr_to_str='BJAC'
     case(amg_as_)
       pr_to_str='AS'
-    case(amg_richardson_)
-      pr_to_str='RICHARDS'
     end select
 
   end function pr_to_str

amgprec/amg_c_ainv_solver.F90

@@ -103,7 +103,7 @@ module amg_c_ainv_solver
       Implicit None
 
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_ainv_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -225,7 +225,7 @@ module amg_c_ainv_solver
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_
       implicit none
-      type(psb_cspmat_type), intent(inout), target  :: a
+      type(psb_cspmat_type), intent(in), target   :: a
       integer(psb_ipk_), intent(in)               :: fillin,alg
       real(psb_spk_), intent(in)                  :: thresh
       type(psb_cspmat_type), intent(inout)        :: wmat, zmat

amgprec/amg_c_as_smoother.f90

@@ -230,7 +230,7 @@ module amg_c_as_smoother
            & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
            & psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target     :: a
+      type(psb_cspmat_type), intent(in), target        :: a
       Type(psb_desc_type), Intent(inout)                 :: desc_a 
       class(amg_c_as_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                     :: info

amgprec/amg_c_base_smoother_mod.f90

@@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target  :: a
+      type(psb_cspmat_type), intent(in), target     :: a
       Type(psb_desc_type), Intent(inout)              :: desc_a 
       class(amg_c_base_smoother_type), intent(inout) :: sm 
       integer(psb_ipk_), intent(out)                  :: info

amgprec/amg_c_base_solver_mod.f90

@@ -170,7 +170,7 @@ module amg_c_base_solver_mod
       Implicit None
       
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target          :: a
+      type(psb_cspmat_type), intent(in), target             :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_c_base_solver_type), intent(inout)          :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_c_diag_solver.f90

@@ -119,7 +119,7 @@ module amg_c_diag_solver
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_c_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info
@@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
       import :: psb_desc_type, psb_cspmat_type,  psb_c_base_sparse_mat, &
            & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
            & amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_c_l1_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_c_gs_solver.f90

@@ -181,7 +181,7 @@ module amg_c_gs_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_gs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -195,7 +195,7 @@ module amg_c_gs_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_bwgs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_id_solver.f90

@@ -123,7 +123,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_cspmat_type), intent(inout), target        :: a
+    type(psb_cspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_c_id_solver_type), intent(inout)          :: sv
     integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_ilu_solver.f90

@@ -144,7 +144,7 @@ module amg_c_ilu_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_ilu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_inner_mod.f90

@@ -56,7 +56,7 @@ module amg_c_inner_mod
            & psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
       import :: amg_cprec_type
       implicit none
-      type(psb_cspmat_type), intent(inout), target       :: a
+      type(psb_cspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       type(amg_cprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info

amgprec/amg_c_invk_solver.f90

@@ -94,7 +94,7 @@ module amg_c_invk_solver
       Implicit None
 
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_invk_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_invt_solver.f90

@@ -94,7 +94,7 @@ module amg_c_invt_solver
       Implicit None
 
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_invt_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_jac_smoother.f90

@@ -151,7 +151,7 @@ module amg_c_jac_smoother
       import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -274,7 +274,7 @@ module amg_c_jac_smoother
       import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_l1_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -345,7 +345,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_c_jac_solver.f90

@@ -143,7 +143,7 @@ module amg_c_jac_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -160,7 +160,7 @@ module amg_c_jac_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_l1_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_krm_solver.f90

@@ -174,7 +174,7 @@ module amg_c_krm_solver
            & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_c_krm_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_mumps_solver.F90

@@ -163,7 +163,7 @@ module amg_c_mumps_solver
       Implicit None
 
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_mumps_solver_type), intent(inout)       :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_c_prec_type.f90

@@ -311,7 +311,7 @@ module amg_c_prec_type
            & psb_c_base_sparse_mat, psb_c_base_vect_type, &
            & psb_i_base_vect_type, amg_cprec_type, psb_ipk_
       implicit none
-      type(psb_cspmat_type), intent(inout), target       :: a
+      type(psb_cspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_cprec_type), intent(inout), target       :: prec
       integer(psb_ipk_), intent(out)                       :: info
@@ -323,15 +323,14 @@ module amg_c_prec_type
   end interface amg_precbld
 
   interface amg_hierarchy_bld
-    subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
+    subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
       import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
            & amg_cprec_type, psb_ipk_
       implicit none
-      type(psb_cspmat_type), intent(inout), target       :: a
+      type(psb_cspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_cprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info
-      logical, intent(in), optional                        :: cpymat
       !      character, intent(in),optional             :: upd
     end subroutine amg_c_hierarchy_bld
   end interface amg_hierarchy_bld
@@ -636,11 +635,6 @@ contains
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free(info)
-        if (psb_errstatus_fatal()) then
-          info=psb_err_internal_error_
-          call psb_errpush(info,name)
-          goto 9999
-        end if
       end do
       deallocate(prec%precv,stat=info)
     end if
@@ -671,6 +665,10 @@ contains
       info = psb_err_internal_error_; goto 9999
     end if
 
+    !
+    ! In the internals, do FREE on components,
+    ! but do not deallocate them
+    !
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free_smoothers(info)
@@ -1008,7 +1006,7 @@ contains
     integer(psb_ipk_), intent(out)        :: info
     class(psb_c_base_vect_type), intent(in), optional  :: vmold
     !
-    ! In AMG the DESC optional argument is ignored, since
+    ! In MLD the DESC optional argument is ignored, since
     ! the necessary info is contained in the various entries of the
     ! PRECV component.
     type(psb_desc_type), intent(in), optional  :: desc

amgprec/amg_c_slu_solver.F90

@@ -124,7 +124,7 @@ module amg_c_slu_solver
       Implicit None
 
       ! Arguments
-      type(psb_cspmat_type), intent(inout), target        :: a
+      type(psb_cspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_c_slu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_config.h.in

@@ -17,8 +17,6 @@
 @CHAVEMUMPS@
 @CHAVEMUMPSMODULES@
 @CHAVEMUMPSINCLUDES@
-@CHAVEMUMPSVERSION@
-@CHAVEMUMPSVERSIONSTRING@
 @CXXMATCHBOXBIT@
 
 

amgprec/amg_d_ainv_solver.F90

@@ -103,7 +103,7 @@ module amg_d_ainv_solver
       Implicit None
 
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_ainv_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -225,7 +225,7 @@ module amg_d_ainv_solver
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_
       implicit none
-      type(psb_dspmat_type), intent(inout), target  :: a
+      type(psb_dspmat_type), intent(in), target   :: a
       integer(psb_ipk_), intent(in)               :: fillin,alg
       real(psb_dpk_), intent(in)                  :: thresh
       type(psb_dspmat_type), intent(inout)        :: wmat, zmat

amgprec/amg_d_as_smoother.f90

@@ -230,7 +230,7 @@ module amg_d_as_smoother
            & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
            & psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target     :: a
+      type(psb_dspmat_type), intent(in), target        :: a
       Type(psb_desc_type), Intent(inout)                 :: desc_a 
       class(amg_d_as_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                     :: info

amgprec/amg_d_base_smoother_mod.f90

@@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target  :: a
+      type(psb_dspmat_type), intent(in), target     :: a
       Type(psb_desc_type), Intent(inout)              :: desc_a 
       class(amg_d_base_smoother_type), intent(inout) :: sm 
       integer(psb_ipk_), intent(out)                  :: info

amgprec/amg_d_base_solver_mod.f90

@@ -170,7 +170,7 @@ module amg_d_base_solver_mod
       Implicit None
       
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target          :: a
+      type(psb_dspmat_type), intent(in), target             :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_d_base_solver_type), intent(inout)          :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_d_diag_solver.f90

@@ -119,7 +119,7 @@ module amg_d_diag_solver
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_d_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info
@@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
       import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
            & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
            & amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_d_l1_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_d_gs_solver.f90

@@ -181,7 +181,7 @@ module amg_d_gs_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_gs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -195,7 +195,7 @@ module amg_d_gs_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_bwgs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_id_solver.f90

@@ -123,7 +123,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_dspmat_type), intent(inout), target        :: a
+    type(psb_dspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_d_id_solver_type), intent(inout)          :: sv
     integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_ilu_solver.f90

@@ -144,7 +144,7 @@ module amg_d_ilu_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_ilu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_inner_mod.f90

@@ -56,7 +56,7 @@ module amg_d_inner_mod
            & psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       import :: amg_dprec_type
       implicit none
-      type(psb_dspmat_type), intent(inout), target       :: a
+      type(psb_dspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       type(amg_dprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info

amgprec/amg_d_invk_solver.f90

@@ -94,7 +94,7 @@ module amg_d_invk_solver
       Implicit None
 
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_invk_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_invt_solver.f90

@@ -94,7 +94,7 @@ module amg_d_invt_solver
       Implicit None
 
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_invt_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_jac_smoother.f90

@@ -151,7 +151,7 @@ module amg_d_jac_smoother
       import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -274,7 +274,7 @@ module amg_d_jac_smoother
       import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_l1_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -345,7 +345,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_d_jac_solver.f90

@@ -143,7 +143,7 @@ module amg_d_jac_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -160,7 +160,7 @@ module amg_d_jac_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_l1_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_krm_solver.f90

@@ -174,7 +174,7 @@ module amg_d_krm_solver
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_krm_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_mumps_solver.F90

@@ -163,7 +163,7 @@ module amg_d_mumps_solver
       Implicit None
 
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_mumps_solver_type), intent(inout)       :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -420,7 +420,7 @@ subroutine d_mumps_solver_cseti(sv,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-  select case(psb_toupper(trim(what)))
+  select case(psb_toupper(what))
 #if defined(AMG_HAVE_MUMPS)
   case('MUMPS_LOC_GLOB')
     sv%ipar(1) = val
@@ -466,7 +466,7 @@ subroutine d_mumps_solver_csetr(sv,what,val,info,idx)
   info = psb_success_
   call psb_erractionsave(err_act)
 
-  select case(psb_toupper(trim(what)))
+  select case(psb_toupper(what))
 #if defined(AMG_HAVE_MUMPS)
   case('MUMPS_RPAR_ENTRY')
     if(present(idx)) then 

amgprec/amg_d_poly_smoother.f90

@@ -140,7 +140,7 @@ module amg_d_poly_smoother
       import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
            & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_d_poly_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -279,7 +279,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_d_prec_type.f90

@@ -311,7 +311,7 @@ module amg_d_prec_type
            & psb_d_base_sparse_mat, psb_d_base_vect_type, &
            & psb_i_base_vect_type, amg_dprec_type, psb_ipk_
       implicit none
-      type(psb_dspmat_type), intent(inout), target       :: a
+      type(psb_dspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_dprec_type), intent(inout), target       :: prec
       integer(psb_ipk_), intent(out)                       :: info
@@ -323,15 +323,14 @@ module amg_d_prec_type
   end interface amg_precbld
 
   interface amg_hierarchy_bld
-    subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
+    subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
            & amg_dprec_type, psb_ipk_
       implicit none
-      type(psb_dspmat_type), intent(inout), target       :: a
+      type(psb_dspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_dprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info
-      logical, intent(in), optional                        :: cpymat
       !      character, intent(in),optional             :: upd
     end subroutine amg_d_hierarchy_bld
   end interface amg_hierarchy_bld
@@ -636,11 +635,6 @@ contains
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free(info)
-        if (psb_errstatus_fatal()) then
-          info=psb_err_internal_error_
-          call psb_errpush(info,name)
-          goto 9999
-        end if
       end do
       deallocate(prec%precv,stat=info)
     end if
@@ -671,6 +665,10 @@ contains
       info = psb_err_internal_error_; goto 9999
     end if
 
+    !
+    ! In the internals, do FREE on components,
+    ! but do not deallocate them
+    !
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free_smoothers(info)
@@ -1008,7 +1006,7 @@ contains
     integer(psb_ipk_), intent(out)        :: info
     class(psb_d_base_vect_type), intent(in), optional  :: vmold
     !
-    ! In AMG the DESC optional argument is ignored, since
+    ! In MLD the DESC optional argument is ignored, since
     ! the necessary info is contained in the various entries of the
     ! PRECV component.
     type(psb_desc_type), intent(in), optional  :: desc

amgprec/amg_d_richards_smoother.f90

@@ -1,365 +0,0 @@
-!
-!
-!                             AMG4PSBLAS version 1.0
-!    Algebraic Multigrid Package
-!               based on PSBLAS (Parallel Sparse BLAS version 3.7)
-!
-!    (C) Copyright 2021
-!
-!        Salvatore Filippone
-!        Pasqua D'Ambra
-!        Daniela di Serafino
-!
-!    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 AMG4PSBLAS group or the names of its contributors may
-!         not be used to endorse or promote products derived from this
-!         software without specific prior 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 AMG4PSBLAS 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.
-!
-!
-!
-! File: amg_d_richards_smoother.f90
-!
-! Module: amg_d_richards_smoother
-!
-!  This module defines:
-!    the amg_d_richards_smoother_type data structure containing the
-!    smoother for a preconditioned Richards iteration.
-!  The smoother applies the iterative method:
-!    x_{k+1} = x_k + omega * P^{-1} * (b - A * x_k)
-!  where P is a preconditioner (the solver component) acting on the global matrix A.
-!  This allows using distributed solvers like MUMPS on the full system.
-!
-module amg_d_richards_smoother
-
-  use amg_d_base_smoother_mod
-
-  type, extends(amg_d_base_smoother_type) :: amg_d_richards_smoother_type
-    ! The local solver component is inherited from the
-    ! parent type, but acts on the global matrix.
-    !    class(amg_d_base_solver_type), allocatable :: sv
-    !
-    type(psb_dspmat_type), pointer  :: pa => null()
-    integer(psb_lpk_)               :: global_nnz_tot
-    logical                         :: checkres
-    logical                         :: printres
-    integer(psb_ipk_)               :: checkiter
-    integer(psb_ipk_)               :: printiter
-    real(psb_dpk_)                  :: tol
-    real(psb_dpk_)                  :: omega
-  contains
-    procedure, pass(sm) :: apply_v => amg_d_richards_smoother_apply_vect
-    procedure, pass(sm) :: apply_a => amg_d_richards_smoother_apply
-    procedure, pass(sm) :: dump    => amg_d_richards_smoother_dmp
-    procedure, pass(sm) :: build   => amg_d_richards_smoother_bld
-    procedure, pass(sm) :: cnv     => amg_d_richards_smoother_cnv
-    procedure, pass(sm) :: clone   => amg_d_richards_smoother_clone
-    procedure, pass(sm) :: clone_settings => amg_d_richards_smoother_clone_settings
-    procedure, pass(sm) :: clear_data     => amg_d_richards_smoother_clear_data
-    procedure, pass(sm) :: free    => d_richards_smoother_free
-    procedure, pass(sm) :: cseti   => amg_d_richards_smoother_cseti
-    procedure, pass(sm) :: csetc   => amg_d_richards_smoother_csetc
-    procedure, pass(sm) :: csetr   => amg_d_richards_smoother_csetr
-    procedure, pass(sm) :: descr   => amg_d_richards_smoother_descr
-    procedure, pass(sm) :: sizeof  => d_richards_smoother_sizeof
-    procedure, pass(sm) :: default => d_richards_smoother_default
-    procedure, pass(sm) :: get_nzeros => d_richards_smoother_get_nzeros
-    procedure, pass(sm) :: get_wrksz => d_richards_smoother_get_wrksize
-    procedure, nopass   :: get_fmt    => d_richards_smoother_get_fmt
-    procedure, nopass   :: get_id     => d_richards_smoother_get_id
-  end type amg_d_richards_smoother_type
-
-  private :: d_richards_smoother_free, &
-       & d_richards_smoother_sizeof, d_richards_smoother_get_nzeros, &
-       & d_richards_smoother_get_fmt, d_richards_smoother_get_id, &
-       & d_richards_smoother_get_wrksize
-
-  interface
-    subroutine amg_d_richards_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,work,wv,info,init,initu)
-      import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_
-
-      type(psb_desc_type), intent(in)                 :: desc_data
-      class(amg_d_richards_smoother_type), intent(inout) :: sm
-      type(psb_d_vect_type),intent(inout)           :: x
-      type(psb_d_vect_type),intent(inout)           :: y
-      real(psb_dpk_),intent(in)                      :: alpha,beta
-      character(len=1),intent(in)                     :: trans
-      integer(psb_ipk_), intent(in)                   :: sweeps
-      real(psb_dpk_),target, intent(inout)           :: work(:)
-      type(psb_d_vect_type),intent(inout)           :: wv(:)
-      integer(psb_ipk_), intent(out)                  :: info
-      character, intent(in), optional                :: init
-      type(psb_d_vect_type),intent(inout), optional   :: initu
-    end subroutine amg_d_richards_smoother_apply_vect
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
-         & sweeps,work,info,init,initu)
-      import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
-           & psb_ipk_
-      type(psb_desc_type), intent(in)      :: desc_data
-      class(amg_d_richards_smoother_type), intent(inout) :: sm
-      real(psb_dpk_),intent(inout)         :: x(:)
-      real(psb_dpk_),intent(inout)         :: y(:)
-      real(psb_dpk_),intent(in)            :: alpha,beta
-      character(len=1),intent(in)           :: trans
-      integer(psb_ipk_), intent(in)         :: sweeps
-      real(psb_dpk_),target, intent(inout) :: work(:)
-      integer(psb_ipk_), intent(out)        :: info
-      character, intent(in), optional       :: init
-      real(psb_dpk_),intent(inout), optional :: initu(:)
-    end subroutine amg_d_richards_smoother_apply
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
-      import :: psb_desc_type, amg_d_richards_smoother_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      type(psb_dspmat_type), intent(inout), target        :: a
-      Type(psb_desc_type), Intent(inout)                  :: desc_a
-      class(amg_d_richards_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_d_base_sparse_mat), intent(in), optional :: amold
-      class(psb_d_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_d_richards_smoother_bld
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_cnv(sm,info,amold,vmold,imold)
-      import :: amg_d_richards_smoother_type, psb_dpk_, &
-           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
-           & psb_ipk_, psb_i_base_vect_type
-      class(amg_d_richards_smoother_type), intent(inout)       :: sm
-      integer(psb_ipk_), intent(out)                      :: info
-      class(psb_d_base_sparse_mat), intent(in), optional :: amold
-      class(psb_d_base_vect_type), intent(in), optional  :: vmold
-      class(psb_i_base_vect_type), intent(in), optional  :: imold
-    end subroutine amg_d_richards_smoother_cnv
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, &
-           & psb_ipk_
-      implicit none
-      class(amg_d_richards_smoother_type), intent(in) :: sm
-      type(psb_desc_type), intent(in)               :: desc
-      integer(psb_ipk_), intent(in)               :: level
-      integer(psb_ipk_), intent(out)              :: info
-      character(len=*), intent(in), optional :: prefix, head
-      logical, optional, intent(in)    :: smoother, solver, global_num
-    end subroutine amg_d_richards_smoother_dmp
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_clone(sm,smout,info)
-      import :: amg_d_richards_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_richards_smoother_type), intent(inout)               :: sm
-      class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_richards_smoother_clone
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_clone_settings(sm,smout,info)
-      import :: amg_d_richards_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_richards_smoother_type), intent(inout)  :: sm
-      class(amg_d_base_smoother_type), intent(inout) :: smout
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_richards_smoother_clone_settings
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_clear_data(sm,info)
-      import :: amg_d_richards_smoother_type, psb_dpk_, &
-           & amg_d_base_smoother_type, psb_ipk_
-      class(amg_d_richards_smoother_type), intent(inout)               :: sm
-      integer(psb_ipk_), intent(out)                :: info
-    end subroutine amg_d_richards_smoother_clear_data
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_descr(sm,info,iout,coarse,prefix)
-      import :: amg_d_richards_smoother_type, psb_ipk_
-      class(amg_d_richards_smoother_type), intent(in) :: sm
-      integer(psb_ipk_), intent(out)               :: info
-      integer(psb_ipk_), intent(in), optional      :: iout
-      logical, intent(in), optional                :: coarse
-      character(len=*), intent(in), optional       :: prefix
-    end subroutine amg_d_richards_smoother_descr
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_cseti(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_richards_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      integer(psb_ipk_), intent(in)                  :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_richards_smoother_cseti
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_csetc(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_richards_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      character(len=*), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_richards_smoother_csetc
-  end interface
-
-  interface
-    subroutine amg_d_richards_smoother_csetr(sm,what,val,info,idx)
-      import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
-           & psb_dpk_, amg_d_richards_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
-      implicit none
-      class(amg_d_richards_smoother_type), intent(inout) :: sm
-      character(len=*), intent(in)                   :: what
-      real(psb_dpk_), intent(in)                   :: val
-      integer(psb_ipk_), intent(out)                 :: info
-      integer(psb_ipk_), intent(in), optional        :: idx
-    end subroutine amg_d_richards_smoother_csetr
-  end interface
-
-contains
-
-  subroutine d_richards_smoother_free(sm,info)
-    Implicit None
-
-    ! Arguments
-    class(amg_d_richards_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_), intent(out)                  :: info
-    integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='d_richards_smoother_free'
-
-    call psb_erractionsave(err_act)
-    info = psb_success_
-
-    if (allocated(sm%sv)) then
-      call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
-      if (info /= psb_success_) then
-        info = psb_err_alloc_dealloc_
-        call psb_errpush(info,name)
-        goto 9999
-      end if
-    end if
-    sm%pa => null()
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 call psb_error_handler(err_act)
-    return
-  end subroutine d_richards_smoother_free
-
-  function d_richards_smoother_sizeof(sm) result(val)
-    implicit none
-    ! Arguments
-    class(amg_d_richards_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = psb_sizeof_lp
-    if (allocated(sm%sv)) val = val + sm%sv%sizeof()
-
-    return
-  end function d_richards_smoother_sizeof
-
-  subroutine d_richards_smoother_default(sm)
-    Implicit None
-
-    ! Arguments
-    class(amg_d_richards_smoother_type), intent(inout) :: sm
-
-    !
-    ! Default: Richards iteration with omega=1.0 and no residual check
-    !
-    sm%checkres = .false.
-    sm%printres = .false.
-    sm%checkiter = -1
-    sm%printiter = -1
-    sm%tol = 0
-    sm%omega = 1.0d0
-
-    if (allocated(sm%sv)) then
-      call sm%sv%default()
-    end if
-
-    return
-  end subroutine d_richards_smoother_default
-
-  function d_richards_smoother_get_nzeros(sm) result(val)
-    implicit none
-    ! Arguments
-    class(amg_d_richards_smoother_type), intent(in) :: sm
-    integer(psb_epk_) :: val
-    integer(psb_ipk_)        :: i
-
-    val = 0
-    if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
-
-    return
-  end function d_richards_smoother_get_nzeros
-
-  function d_richards_smoother_get_wrksize(sm) result(val)
-    implicit none
-    class(amg_d_richards_smoother_type), intent(inout) :: sm
-    integer(psb_ipk_)  :: val
-
-    ! apply_vect uses tx, ty, tz mapped to wv(1:3)
-    val = 3
-    if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
-
-  end function d_richards_smoother_get_wrksize
-
-  function d_richards_smoother_get_fmt() result(val)
-    implicit none
-    character(len=32)  :: val
-
-    val = "Richards smoother"
-  end function d_richards_smoother_get_fmt
-
-  function d_richards_smoother_get_id() result(val)
-    implicit none
-    integer(psb_ipk_)  :: val
-
-    val = amg_richardson_
-  end function d_richards_smoother_get_id
-
-end module amg_d_richards_smoother

amgprec/amg_d_slu_solver.F90

@@ -124,7 +124,7 @@ module amg_d_slu_solver
       Implicit None
 
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_slu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_d_sludist_solver.F90

@@ -259,7 +259,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_dspmat_type), intent(inout), target        :: a
+    type(psb_dspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_d_sludist_solver_type), intent(inout)     :: sv
     integer, intent(out)                                :: info

amgprec/amg_d_umf_solver.F90

@@ -163,7 +163,7 @@ module amg_d_umf_solver
       Implicit None
       
       ! Arguments
-      type(psb_dspmat_type), intent(inout), target        :: a
+      type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_d_umf_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_s_ainv_solver.F90

@@ -103,7 +103,7 @@ module amg_s_ainv_solver
       Implicit None
 
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_ainv_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -225,7 +225,7 @@ module amg_s_ainv_solver
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_
       implicit none
-      type(psb_sspmat_type), intent(inout), target  :: a
+      type(psb_sspmat_type), intent(in), target   :: a
       integer(psb_ipk_), intent(in)               :: fillin,alg
       real(psb_spk_), intent(in)                  :: thresh
       type(psb_sspmat_type), intent(inout)        :: wmat, zmat

amgprec/amg_s_as_smoother.f90

@@ -230,7 +230,7 @@ module amg_s_as_smoother
            & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
            & psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target     :: a
+      type(psb_sspmat_type), intent(in), target        :: a
       Type(psb_desc_type), Intent(inout)                 :: desc_a 
       class(amg_s_as_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                     :: info

amgprec/amg_s_base_smoother_mod.f90

@@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target  :: a
+      type(psb_sspmat_type), intent(in), target     :: a
       Type(psb_desc_type), Intent(inout)              :: desc_a 
       class(amg_s_base_smoother_type), intent(inout) :: sm 
       integer(psb_ipk_), intent(out)                  :: info

amgprec/amg_s_base_solver_mod.f90

@@ -170,7 +170,7 @@ module amg_s_base_solver_mod
       Implicit None
       
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target          :: a
+      type(psb_sspmat_type), intent(in), target             :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_s_base_solver_type), intent(inout)          :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_s_diag_solver.f90

@@ -119,7 +119,7 @@ module amg_s_diag_solver
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_s_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info
@@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
       import :: psb_desc_type, psb_sspmat_type,  psb_s_base_sparse_mat, &
            & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
            & amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_s_l1_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_s_gs_solver.f90

@@ -181,7 +181,7 @@ module amg_s_gs_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_gs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -195,7 +195,7 @@ module amg_s_gs_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_bwgs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_id_solver.f90

@@ -123,7 +123,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_sspmat_type), intent(inout), target        :: a
+    type(psb_sspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_s_id_solver_type), intent(inout)          :: sv
     integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_ilu_solver.f90

@@ -144,7 +144,7 @@ module amg_s_ilu_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_ilu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_inner_mod.f90

@@ -56,7 +56,7 @@ module amg_s_inner_mod
            & psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
       import :: amg_sprec_type
       implicit none
-      type(psb_sspmat_type), intent(inout), target       :: a
+      type(psb_sspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       type(amg_sprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info

amgprec/amg_s_invk_solver.f90

@@ -94,7 +94,7 @@ module amg_s_invk_solver
       Implicit None
 
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_invk_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_invt_solver.f90

@@ -94,7 +94,7 @@ module amg_s_invt_solver
       Implicit None
 
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_invt_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_jac_smoother.f90

@@ -151,7 +151,7 @@ module amg_s_jac_smoother
       import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -274,7 +274,7 @@ module amg_s_jac_smoother
       import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_l1_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -345,7 +345,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_s_jac_solver.f90

@@ -143,7 +143,7 @@ module amg_s_jac_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -160,7 +160,7 @@ module amg_s_jac_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_l1_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_krm_solver.f90

@@ -174,7 +174,7 @@ module amg_s_krm_solver
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_krm_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_mumps_solver.F90

@@ -163,7 +163,7 @@ module amg_s_mumps_solver
       Implicit None
 
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_mumps_solver_type), intent(inout)       :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_s_poly_smoother.f90

@@ -140,7 +140,7 @@ module amg_s_poly_smoother
       import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
            & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_s_poly_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -279,7 +279,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_s_prec_type.f90

@@ -311,7 +311,7 @@ module amg_s_prec_type
            & psb_s_base_sparse_mat, psb_s_base_vect_type, &
            & psb_i_base_vect_type, amg_sprec_type, psb_ipk_
       implicit none
-      type(psb_sspmat_type), intent(inout), target       :: a
+      type(psb_sspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_sprec_type), intent(inout), target       :: prec
       integer(psb_ipk_), intent(out)                       :: info
@@ -323,15 +323,14 @@ module amg_s_prec_type
   end interface amg_precbld
 
   interface amg_hierarchy_bld
-    subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
+    subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
       import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
            & amg_sprec_type, psb_ipk_
       implicit none
-      type(psb_sspmat_type), intent(inout), target       :: a
+      type(psb_sspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_sprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info
-      logical, intent(in), optional                        :: cpymat
       !      character, intent(in),optional             :: upd
     end subroutine amg_s_hierarchy_bld
   end interface amg_hierarchy_bld
@@ -636,11 +635,6 @@ contains
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free(info)
-        if (psb_errstatus_fatal()) then
-          info=psb_err_internal_error_
-          call psb_errpush(info,name)
-          goto 9999
-        end if
       end do
       deallocate(prec%precv,stat=info)
     end if
@@ -671,6 +665,10 @@ contains
       info = psb_err_internal_error_; goto 9999
     end if
 
+    !
+    ! In the internals, do FREE on components,
+    ! but do not deallocate them
+    !
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free_smoothers(info)
@@ -1008,7 +1006,7 @@ contains
     integer(psb_ipk_), intent(out)        :: info
     class(psb_s_base_vect_type), intent(in), optional  :: vmold
     !
-    ! In AMG the DESC optional argument is ignored, since
+    ! In MLD the DESC optional argument is ignored, since
     ! the necessary info is contained in the various entries of the
     ! PRECV component.
     type(psb_desc_type), intent(in), optional  :: desc

amgprec/amg_s_slu_solver.F90

@@ -124,7 +124,7 @@ module amg_s_slu_solver
       Implicit None
 
       ! Arguments
-      type(psb_sspmat_type), intent(inout), target        :: a
+      type(psb_sspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_s_slu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_ainv_solver.F90

@@ -103,7 +103,7 @@ module amg_z_ainv_solver
       Implicit None
 
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_ainv_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -225,7 +225,7 @@ module amg_z_ainv_solver
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, psb_ipk_
       implicit none
-      type(psb_zspmat_type), intent(inout), target  :: a
+      type(psb_zspmat_type), intent(in), target   :: a
       integer(psb_ipk_), intent(in)               :: fillin,alg
       real(psb_dpk_), intent(in)                  :: thresh
       type(psb_zspmat_type), intent(inout)        :: wmat, zmat

amgprec/amg_z_as_smoother.f90

@@ -230,7 +230,7 @@ module amg_z_as_smoother
            & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,&
            & psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target     :: a
+      type(psb_zspmat_type), intent(in), target        :: a
       Type(psb_desc_type), Intent(inout)                 :: desc_a 
       class(amg_z_as_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                     :: info

amgprec/amg_z_base_smoother_mod.f90

@@ -237,7 +237,7 @@ module amg_z_base_smoother_mod
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target  :: a
+      type(psb_zspmat_type), intent(in), target     :: a
       Type(psb_desc_type), Intent(inout)              :: desc_a 
       class(amg_z_base_smoother_type), intent(inout) :: sm 
       integer(psb_ipk_), intent(out)                  :: info

amgprec/amg_z_base_solver_mod.f90

@@ -170,7 +170,7 @@ module amg_z_base_solver_mod
       Implicit None
       
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target          :: a
+      type(psb_zspmat_type), intent(in), target             :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_z_base_solver_type), intent(inout)          :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_z_diag_solver.f90

@@ -119,7 +119,7 @@ module amg_z_diag_solver
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_z_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info
@@ -331,7 +331,7 @@ module amg_z_l1_diag_solver
       import :: psb_desc_type, psb_zspmat_type,  psb_z_base_sparse_mat, &
            & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
            & amg_z_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type      
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                    :: desc_a 
       class(amg_z_l1_diag_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/amg_z_gs_solver.f90

@@ -181,7 +181,7 @@ module amg_z_gs_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_gs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -195,7 +195,7 @@ module amg_z_gs_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_bwgs_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_id_solver.f90

@@ -123,7 +123,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_zspmat_type), intent(inout), target        :: a
+    type(psb_zspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_z_id_solver_type), intent(inout)          :: sv
     integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_ilu_solver.f90

@@ -144,7 +144,7 @@ module amg_z_ilu_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_ilu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_inner_mod.f90

@@ -56,7 +56,7 @@ module amg_z_inner_mod
            & psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
       import :: amg_zprec_type
       implicit none
-      type(psb_zspmat_type), intent(inout), target       :: a
+      type(psb_zspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       type(amg_zprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info

amgprec/amg_z_invk_solver.f90

@@ -94,7 +94,7 @@ module amg_z_invk_solver
       Implicit None
 
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_invk_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_invt_solver.f90

@@ -94,7 +94,7 @@ module amg_z_invt_solver
       Implicit None
 
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_invt_solver_type), intent(inout)        :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_jac_smoother.f90

@@ -151,7 +151,7 @@ module amg_z_jac_smoother
       import :: psb_desc_type, amg_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -274,7 +274,7 @@ module amg_z_jac_smoother
       import :: psb_desc_type, amg_z_l1_jac_smoother_type, psb_z_vect_type, &
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_l1_jac_smoother_type), intent(inout)       :: sm
       integer(psb_ipk_), intent(out)                      :: info
@@ -345,7 +345,6 @@ contains
 
     if (allocated(sm%sv)) then
       call sm%sv%free(info)
-      if (info == psb_success_) deallocate(sm%sv,stat=info)
       if (info /= psb_success_) then
         info = psb_err_alloc_dealloc_
         call psb_errpush(info,name)

amgprec/amg_z_jac_solver.f90

@@ -143,7 +143,7 @@ module amg_z_jac_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info
@@ -160,7 +160,7 @@ module amg_z_jac_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none 
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_l1_jac_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_krm_solver.f90

@@ -174,7 +174,7 @@ module amg_z_krm_solver
            & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
            & psb_ipk_, psb_i_base_vect_type
       implicit none
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a
       class(amg_z_krm_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_mumps_solver.F90

@@ -163,7 +163,7 @@ module amg_z_mumps_solver
       Implicit None
 
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_mumps_solver_type), intent(inout)       :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_prec_type.f90

@@ -311,7 +311,7 @@ module amg_z_prec_type
            & psb_z_base_sparse_mat, psb_z_base_vect_type, &
            & psb_i_base_vect_type, amg_zprec_type, psb_ipk_
       implicit none
-      type(psb_zspmat_type), intent(inout), target       :: a
+      type(psb_zspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_zprec_type), intent(inout), target       :: prec
       integer(psb_ipk_), intent(out)                       :: info
@@ -323,15 +323,14 @@ module amg_z_prec_type
   end interface amg_precbld
 
   interface amg_hierarchy_bld
-    subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat)
+    subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
       import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
            & amg_zprec_type, psb_ipk_
       implicit none
-      type(psb_zspmat_type), intent(inout), target       :: a
+      type(psb_zspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
       class(amg_zprec_type), intent(inout), target        :: prec
       integer(psb_ipk_), intent(out)                       :: info
-      logical, intent(in), optional                        :: cpymat
       !      character, intent(in),optional             :: upd
     end subroutine amg_z_hierarchy_bld
   end interface amg_hierarchy_bld
@@ -636,11 +635,6 @@ contains
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free(info)
-        if (psb_errstatus_fatal()) then
-          info=psb_err_internal_error_
-          call psb_errpush(info,name)
-          goto 9999
-        end if
       end do
       deallocate(prec%precv,stat=info)
     end if
@@ -671,6 +665,10 @@ contains
       info = psb_err_internal_error_; goto 9999
     end if
 
+    !
+    ! In the internals, do FREE on components,
+    ! but do not deallocate them
+    !
     if (allocated(prec%precv)) then
       do i=1,size(prec%precv)
         call prec%precv(i)%free_smoothers(info)
@@ -1008,7 +1006,7 @@ contains
     integer(psb_ipk_), intent(out)        :: info
     class(psb_z_base_vect_type), intent(in), optional  :: vmold
     !
-    ! In AMG the DESC optional argument is ignored, since
+    ! In MLD the DESC optional argument is ignored, since
     ! the necessary info is contained in the various entries of the
     ! PRECV component.
     type(psb_desc_type), intent(in), optional  :: desc

amgprec/amg_z_slu_solver.F90

@@ -124,7 +124,7 @@ module amg_z_slu_solver
       Implicit None
 
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_slu_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                      :: info

amgprec/amg_z_sludist_solver.F90

@@ -259,7 +259,7 @@ contains
     Implicit None
 
     ! Arguments
-    type(psb_zspmat_type), intent(inout), target        :: a
+    type(psb_zspmat_type), intent(in), target           :: a
     Type(psb_desc_type), Intent(inout)                  :: desc_a 
     class(amg_z_sludist_solver_type), intent(inout)     :: sv
     integer, intent(out)                                :: info

amgprec/amg_z_umf_solver.F90

@@ -163,7 +163,7 @@ module amg_z_umf_solver
       Implicit None
       
       ! Arguments
-      type(psb_zspmat_type), intent(inout), target        :: a
+      type(psb_zspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(inout)                  :: desc_a 
       class(amg_z_umf_solver_type), intent(inout)         :: sv
       integer(psb_ipk_), intent(out)                        :: info

amgprec/impl/aggregator/amg_caggrmat_minnrg_bld.f90

@@ -155,7 +155,7 @@ subroutine amg_caggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   debug_level = psb_get_debug_level()
 
   ctxt = desc_a%get_context()
-  icomm = ctxt%get_mpic()
+  icomm = desc_a%get_mpic()
 
   call psb_info(ctxt, me, np)
 

amgprec/impl/aggregator/amg_daggrmat_minnrg_bld.f90

@@ -155,7 +155,7 @@ subroutine amg_daggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   debug_level = psb_get_debug_level()
 
   ctxt = desc_a%get_context()
-  icomm = ctxt%get_mpic()
+  icomm = desc_a%get_mpic()
 
   call psb_info(ctxt, me, np)
 

amgprec/impl/aggregator/amg_saggrmat_minnrg_bld.f90

@@ -155,7 +155,7 @@ subroutine amg_saggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   debug_level = psb_get_debug_level()
 
   ctxt = desc_a%get_context()
-  icomm = ctxt%get_mpic()
+  icomm = desc_a%get_mpic()
 
   call psb_info(ctxt, me, np)
 

amgprec/impl/aggregator/amg_zaggrmat_minnrg_bld.f90

@@ -155,7 +155,7 @@ subroutine amg_zaggrmat_minnrg_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,&
   debug_level = psb_get_debug_level()
 
   ctxt = desc_a%get_context()
-  icomm = ctxt%get_mpic()
+  icomm = desc_a%get_mpic()
 
   call psb_info(ctxt, me, np)
 

amgprec/impl/amg_c_hierarchy_bld.F90

@@ -63,7 +63,7 @@
 !    info    -  integer, output.
 !               Error code.              
 !  
-subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
+subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
 
   use psb_base_mod
   use amg_c_inner_mod
@@ -72,11 +72,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
   Implicit None
 
   ! Arguments
-  type(psb_cspmat_type), intent(inout), target         :: a
+  type(psb_cspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   class(amg_cprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
-  logical, intent(in), optional                        :: cpymat
 
   ! Local Variables
   type(psb_ctxt_type) :: ctxt
@@ -91,11 +90,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
   type(amg_sml_parms)              :: medparms, coarseparms
   integer(psb_lpk_), allocatable   :: ilaggr(:), nlaggr(:)
   type(psb_lcspmat_type)            :: op_prol
-  type(amg_c_onelev_type), allocatable :: tprecv(:)
-  logical :: cpymat_
+  type(amg_c_onelev_type), allocatable :: tprecv(:)    
   integer(psb_ipk_)  :: debug_level, debug_unit
-  character(len=20)  :: name
-  character(len=40)  :: ch_err
+  character(len=20)  :: name, ch_err
   integer(psb_ipk_), save  :: idx_bldtp=-1, idx_matasb=-1
   logical, parameter :: do_timings=.false.
 
@@ -128,9 +125,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
     call psb_errpush(info,name)
     goto 9999
   end if
-  cpymat_ = .false.
-  if (present(cpymat)) cpymat_ = cpymat
-  
+
   !
   ! Check to ensure all procs have the same 
   !   
@@ -185,15 +180,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
     ! This is OK, since it may be called by the user even if there
     ! is only one level
     !
-    if (cpymat_) then
-      call a%clone(prec%precv(1)%ac,info)
-      call desc_a%clone(prec%precv(1)%desc_ac,info)
-      prec%precv(1)%base_a    => prec%precv(1)%ac
-      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-    else
-      prec%precv(1)%base_a    => a
-      prec%precv(1)%base_desc => desc_a
-    end if
+    prec%precv(1)%base_a    => a
+    prec%precv(1)%base_desc => desc_a
 
     call psb_erractionrestore(err_act)
     return
@@ -292,16 +280,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
   !
   ! Finest level first; create a GEN_BLOCK
   ! copy of the descriptor. 
-  !
-  if (cpymat_) then
-    call a%clone(prec%precv(1)%ac,info)
-    prec%precv(1)%base_a    => prec%precv(1)%ac
-  else
-    prec%precv(1)%base_a    => a
-  end if
+  ! 
+  prec%precv(1)%base_a    => a
   call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
   prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-  
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -334,10 +316,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
          & prec%precv(i-1)%base_desc,&
          & ilaggr,nlaggr,op_prol,prec%ag_data,info)
     if (do_timings) call psb_toc(idx_bldtp)
-    if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
+    if (info /= psb_success_) then 
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
 
@@ -366,10 +347,14 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
-        !
-        ! We are not gaining 
-        !
-        newsz = i-1
+        if (sizeratio > 1) then
+          newsz = i
+        else
+          !
+          ! We are not gaining 
+          !
+          newsz = i-1
+        end if
       end if
 
       if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
@@ -404,7 +389,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
         !
-        ! We are going back and revisit a previous level;
+        ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
         ilaggr = prec%precv(newsz)%linmap%iaggr
@@ -417,9 +402,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & ilaggr,nlaggr,op_prol,info)
       if (do_timings) call psb_toc(idx_matasb)      
       if (info /= 0) then 
-        write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
         call psb_errpush(psb_err_internal_error_,name,&
-             & a_err=ch_err)
+             & a_err='Mat asb')
         goto 9999
       endif
       exit array_build_loop
@@ -431,9 +415,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
       if (do_timings) call psb_toc(idx_matasb)      
     end if
     if (info /= psb_success_) then 
-      write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
     if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
@@ -465,9 +448,6 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
     iszv = newsz
     ! Fix the pointers, but the level 1 should
     ! be treated differently
-    if (.not.associated(prec%precv(1)%base_a,a)) then
-      prec%precv(1)%base_a => prec%precv(1)%ac
-    end if
     if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
       prec%precv(1)%base_desc => prec%precv(1)%desc_ac
     end if

amgprec/impl/amg_c_smoothers_bld.f90

@@ -101,8 +101,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   real(psb_spk_)     :: mnaggratio
   integer(psb_ipk_)   :: coarse_solve_id
   integer(psb_ipk_)   :: debug_level, debug_unit
-  character(len=20)   :: name
-  character(len=40)   :: ch_err
+  character(len=20)   :: name, ch_err
 
   info=psb_success_
   err=0
@@ -297,7 +296,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
 
     if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Error @ level ',i
+      write(ch_err,'(a,i7)') 'Error @ level',i
       call psb_errpush(psb_err_internal_error_,name,&
            & a_err=ch_err)
       goto 9999

amgprec/impl/amg_cfile_prec_descr.f90

@@ -88,7 +88,6 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
   integer(psb_ipk_)  :: iout_, root_, verbosity_
-  integer(psb_lpk_)  :: gl_nrows,gl_ncols,gl_nzeros
   character(1024)    :: prefix_
 
   info = psb_success_
@@ -123,12 +122,6 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
     if (root_ == -1) root_ = me
 
     if (verbosity_ >=0) then 
-      gl_nrows = prec%precv(1)%base_a%get_nrows()
-      gl_ncols = prec%precv(1)%base_a%get_ncols()
-      gl_nzeros = prec%precv(1)%base_a%get_nzeros()
-      call psb_sum(ctxt,gl_nrows)
-      call psb_sum(ctxt,gl_ncols)
-      call psb_sum(ctxt,gl_nzeros)
       !
       ! The preconditioner description is printed by processor psb_root_.
       ! This agrees with the fact that all the parameters defining the
@@ -148,11 +141,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix)
 
         write(iout_,*) 
         write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description'
-        write(iout_,*) 
-        write(iout_,*) trim(prefix_),' Base matrix      : ',&
-             & gl_nrows, gl_ncols, gl_nzeros
-        write(iout_,*)
-        
+
         if (nlev == 1) then
           !
           ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.

amgprec/impl/amg_cmlprec_bld.f90

@@ -85,7 +85,7 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   Implicit None
 
   ! Arguments
-  type(psb_cspmat_type), intent(inout), target       :: a
+  type(psb_cspmat_type),intent(in), target           :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   type(amg_cprec_type),intent(inout),target          :: p
   integer(psb_ipk_), intent(out)                       :: info

amgprec/impl/amg_cprecbld.f90

@@ -65,7 +65,7 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
   Implicit None
 
   ! Arguments
-  type(psb_cspmat_type),intent(inout), target        :: a
+  type(psb_cspmat_type),intent(in), target           :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   class(amg_cprec_type),intent(inout), target         :: prec
   integer(psb_ipk_), intent(out)                               :: info

amgprec/impl/amg_d_hierarchy_bld.F90

@@ -63,7 +63,7 @@
 !    info    -  integer, output.
 !               Error code.              
 !  
-subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
+subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
 
   use psb_base_mod
   use amg_d_inner_mod
@@ -72,11 +72,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
   Implicit None
 
   ! Arguments
-  type(psb_dspmat_type), intent(inout), target         :: a
+  type(psb_dspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   class(amg_dprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
-  logical, intent(in), optional                        :: cpymat
 
   ! Local Variables
   type(psb_ctxt_type) :: ctxt
@@ -91,11 +90,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
   type(amg_dml_parms)              :: medparms, coarseparms
   integer(psb_lpk_), allocatable   :: ilaggr(:), nlaggr(:)
   type(psb_ldspmat_type)            :: op_prol
-  type(amg_d_onelev_type), allocatable :: tprecv(:)
-  logical :: cpymat_
+  type(amg_d_onelev_type), allocatable :: tprecv(:)    
   integer(psb_ipk_)  :: debug_level, debug_unit
-  character(len=20)  :: name
-  character(len=40)  :: ch_err
+  character(len=20)  :: name, ch_err
   integer(psb_ipk_), save  :: idx_bldtp=-1, idx_matasb=-1
   logical, parameter :: do_timings=.false.
 
@@ -128,9 +125,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
     call psb_errpush(info,name)
     goto 9999
   end if
-  cpymat_ = .false.
-  if (present(cpymat)) cpymat_ = cpymat
-  
+
   !
   ! Check to ensure all procs have the same 
   !   
@@ -185,15 +180,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
     ! This is OK, since it may be called by the user even if there
     ! is only one level
     !
-    if (cpymat_) then
-      call a%clone(prec%precv(1)%ac,info)
-      call desc_a%clone(prec%precv(1)%desc_ac,info)
-      prec%precv(1)%base_a    => prec%precv(1)%ac
-      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-    else
-      prec%precv(1)%base_a    => a
-      prec%precv(1)%base_desc => desc_a
-    end if
+    prec%precv(1)%base_a    => a
+    prec%precv(1)%base_desc => desc_a
 
     call psb_erractionrestore(err_act)
     return
@@ -292,16 +280,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
   !
   ! Finest level first; create a GEN_BLOCK
   ! copy of the descriptor. 
-  !
-  if (cpymat_) then
-    call a%clone(prec%precv(1)%ac,info)
-    prec%precv(1)%base_a    => prec%precv(1)%ac
-  else
-    prec%precv(1)%base_a    => a
-  end if
+  ! 
+  prec%precv(1)%base_a    => a
   call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
   prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-  
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -334,10 +316,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
          & prec%precv(i-1)%base_desc,&
          & ilaggr,nlaggr,op_prol,prec%ag_data,info)
     if (do_timings) call psb_toc(idx_bldtp)
-    if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
+    if (info /= psb_success_) then 
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
 
@@ -366,10 +347,14 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
-        !
-        ! We are not gaining 
-        !
-        newsz = i-1
+        if (sizeratio > 1) then
+          newsz = i
+        else
+          !
+          ! We are not gaining 
+          !
+          newsz = i-1
+        end if
       end if
 
       if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
@@ -404,7 +389,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
         !
-        ! We are going back and revisit a previous level;
+        ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
         ilaggr = prec%precv(newsz)%linmap%iaggr
@@ -417,9 +402,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & ilaggr,nlaggr,op_prol,info)
       if (do_timings) call psb_toc(idx_matasb)      
       if (info /= 0) then 
-        write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
         call psb_errpush(psb_err_internal_error_,name,&
-             & a_err=ch_err)
+             & a_err='Mat asb')
         goto 9999
       endif
       exit array_build_loop
@@ -431,9 +415,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
       if (do_timings) call psb_toc(idx_matasb)      
     end if
     if (info /= psb_success_) then 
-      write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
     if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
@@ -465,9 +448,6 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
     iszv = newsz
     ! Fix the pointers, but the level 1 should
     ! be treated differently
-    if (.not.associated(prec%precv(1)%base_a,a)) then
-      prec%precv(1)%base_a => prec%precv(1)%ac
-    end if
     if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
       prec%precv(1)%base_desc => prec%precv(1)%desc_ac
     end if

amgprec/impl/amg_d_smoothers_bld.f90

@@ -101,8 +101,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   real(psb_dpk_)     :: mnaggratio
   integer(psb_ipk_)   :: coarse_solve_id
   integer(psb_ipk_)   :: debug_level, debug_unit
-  character(len=20)   :: name
-  character(len=40)   :: ch_err
+  character(len=20)   :: name, ch_err
 
   info=psb_success_
   err=0
@@ -297,7 +296,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
 
     if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Error @ level ',i
+      write(ch_err,'(a,i7)') 'Error @ level',i
       call psb_errpush(psb_err_internal_error_,name,&
            & a_err=ch_err)
       goto 9999

amgprec/impl/amg_dfile_prec_descr.f90

@@ -88,7 +88,6 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
   logical             :: is_symgs
   character(len=20), parameter :: name='amg_file_prec_descr'
   integer(psb_ipk_)  :: iout_, root_, verbosity_
-  integer(psb_lpk_)  :: gl_nrows,gl_ncols,gl_nzeros
   character(1024)    :: prefix_
 
   info = psb_success_
@@ -123,12 +122,6 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
     if (root_ == -1) root_ = me
 
     if (verbosity_ >=0) then 
-      gl_nrows = prec%precv(1)%base_a%get_nrows()
-      gl_ncols = prec%precv(1)%base_a%get_ncols()
-      gl_nzeros = prec%precv(1)%base_a%get_nzeros()
-      call psb_sum(ctxt,gl_nrows)
-      call psb_sum(ctxt,gl_ncols)
-      call psb_sum(ctxt,gl_nzeros)
       !
       ! The preconditioner description is printed by processor psb_root_.
       ! This agrees with the fact that all the parameters defining the
@@ -148,11 +141,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
 
         write(iout_,*) 
         write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description'
-        write(iout_,*) 
-        write(iout_,*) trim(prefix_),' Base matrix      : ',&
-             & gl_nrows, gl_ncols, gl_nzeros
-        write(iout_,*)
-        
+
         if (nlev == 1) then
           !
           ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel.

amgprec/impl/amg_dmlprec_bld.f90

@@ -85,7 +85,7 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   Implicit None
 
   ! Arguments
-  type(psb_dspmat_type), intent(inout), target       :: a
+  type(psb_dspmat_type),intent(in), target           :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   type(amg_dprec_type),intent(inout),target          :: p
   integer(psb_ipk_), intent(out)                       :: info

amgprec/impl/amg_dprecbld.f90

@@ -65,7 +65,7 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
   Implicit None
 
   ! Arguments
-  type(psb_dspmat_type),intent(inout), target        :: a
+  type(psb_dspmat_type),intent(in), target           :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   class(amg_dprec_type),intent(inout), target         :: prec
   integer(psb_ipk_), intent(out)                               :: info

amgprec/impl/amg_s_hierarchy_bld.F90

@@ -63,7 +63,7 @@
 !    info    -  integer, output.
 !               Error code.              
 !  
-subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
+subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
 
   use psb_base_mod
   use amg_s_inner_mod
@@ -72,11 +72,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
   Implicit None
 
   ! Arguments
-  type(psb_sspmat_type), intent(inout), target         :: a
+  type(psb_sspmat_type),intent(in), target             :: a
   type(psb_desc_type), intent(inout), target           :: desc_a
   class(amg_sprec_type),intent(inout),target           :: prec
   integer(psb_ipk_), intent(out)                       :: info
-  logical, intent(in), optional                        :: cpymat
 
   ! Local Variables
   type(psb_ctxt_type) :: ctxt
@@ -91,11 +90,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
   type(amg_sml_parms)              :: medparms, coarseparms
   integer(psb_lpk_), allocatable   :: ilaggr(:), nlaggr(:)
   type(psb_lsspmat_type)            :: op_prol
-  type(amg_s_onelev_type), allocatable :: tprecv(:)
-  logical :: cpymat_
+  type(amg_s_onelev_type), allocatable :: tprecv(:)    
   integer(psb_ipk_)  :: debug_level, debug_unit
-  character(len=20)  :: name
-  character(len=40)  :: ch_err
+  character(len=20)  :: name, ch_err
   integer(psb_ipk_), save  :: idx_bldtp=-1, idx_matasb=-1
   logical, parameter :: do_timings=.false.
 
@@ -128,9 +125,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
     call psb_errpush(info,name)
     goto 9999
   end if
-  cpymat_ = .false.
-  if (present(cpymat)) cpymat_ = cpymat
-  
+
   !
   ! Check to ensure all procs have the same 
   !   
@@ -185,15 +180,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
     ! This is OK, since it may be called by the user even if there
     ! is only one level
     !
-    if (cpymat_) then
-      call a%clone(prec%precv(1)%ac,info)
-      call desc_a%clone(prec%precv(1)%desc_ac,info)
-      prec%precv(1)%base_a    => prec%precv(1)%ac
-      prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-    else
-      prec%precv(1)%base_a    => a
-      prec%precv(1)%base_desc => desc_a
-    end if
+    prec%precv(1)%base_a    => a
+    prec%precv(1)%base_desc => desc_a
 
     call psb_erractionrestore(err_act)
     return
@@ -292,16 +280,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
   !
   ! Finest level first; create a GEN_BLOCK
   ! copy of the descriptor. 
-  !
-  if (cpymat_) then
-    call a%clone(prec%precv(1)%ac,info)
-    prec%precv(1)%base_a    => prec%precv(1)%ac
-  else
-    prec%precv(1)%base_a    => a
-  end if
+  ! 
+  prec%precv(1)%base_a    => a
   call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
   prec%precv(1)%base_desc => prec%precv(1)%desc_ac
-  
   newsz = 0
   array_build_loop: do i=2, iszv
     !
@@ -334,10 +316,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
          & prec%precv(i-1)%base_desc,&
          & ilaggr,nlaggr,op_prol,prec%ag_data,info)
     if (do_timings) call psb_toc(idx_bldtp)
-    if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Map bld fail @ level ',i
+    if (info /= psb_success_) then 
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
 
@@ -366,10 +347,14 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
 
     if (i>2) then
       if (sizeratio < mnaggratio) then
-        !
-        ! We are not gaining 
-        !
-        newsz = i-1
+        if (sizeratio > 1) then
+          newsz = i
+        else
+          !
+          ! We are not gaining 
+          !
+          newsz = i-1
+        end if
       end if
 
       if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then 
@@ -404,7 +389,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & coarse_sm,coarse_sm2,info)
       if (newsz < i) then
         !
-        ! We are going back and revisit a previous level;
+        ! We are going back and revisit a previous leve;
         ! recover the aggregation.
         !
         ilaggr = prec%precv(newsz)%linmap%iaggr
@@ -417,9 +402,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
            & ilaggr,nlaggr,op_prol,info)
       if (do_timings) call psb_toc(idx_matasb)      
       if (info /= 0) then 
-        write(ch_err,'(a,i7)') 'Mat asb fail @ level ',newsz
         call psb_errpush(psb_err_internal_error_,name,&
-             & a_err=ch_err)
+             & a_err='Mat asb')
         goto 9999
       endif
       exit array_build_loop
@@ -431,9 +415,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
       if (do_timings) call psb_toc(idx_matasb)      
     end if
     if (info /= psb_success_) then 
-      write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
       call psb_errpush(psb_err_internal_error_,name,&
-           & a_err=ch_err)
+           & a_err='Map build')
       goto 9999
     endif
     if (i<iszv) call prec%precv(i)%update_aggr(prec%precv(i+1),info)
@@ -465,9 +448,6 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
     iszv = newsz
     ! Fix the pointers, but the level 1 should
     ! be treated differently
-    if (.not.associated(prec%precv(1)%base_a,a)) then
-      prec%precv(1)%base_a => prec%precv(1)%ac
-    end if
     if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
       prec%precv(1)%base_desc => prec%precv(1)%desc_ac
     end if

amgprec/impl/amg_s_smoothers_bld.f90

@@ -101,8 +101,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   real(psb_spk_)     :: mnaggratio
   integer(psb_ipk_)   :: coarse_solve_id
   integer(psb_ipk_)   :: debug_level, debug_unit
-  character(len=20)   :: name
-  character(len=40)   :: ch_err
+  character(len=20)   :: name, ch_err
 
   info=psb_success_
   err=0
@@ -297,7 +296,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
     call prec%precv(i)%bld(info,amold=amold,vmold=vmold,imold=imold,ilv=i)
 
     if (info /= psb_success_) then
-      write(ch_err,'(a,i7)') 'Error @ level ',i
+      write(ch_err,'(a,i7)') 'Error @ level',i
       call psb_errpush(psb_err_internal_error_,name,&
            & a_err=ch_err)
       goto 9999