From 4ee40c157719dd1c16499d824c8c1002893cb953 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 7 Aug 2013 15:00:04 +0000 Subject: [PATCH 02/10] mld2p4-299: mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_dprecbld.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_zmlprec_bld.f90 mlprec/impl/mld_zprecbld.f90 mlprec/impl/smoother/mld_c_as_smoother_bld.f90 mlprec/impl/smoother/mld_c_base_smoother_bld.f90 mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 mlprec/impl/smoother/mld_d_as_smoother_bld.f90 mlprec/impl/smoother/mld_d_base_smoother_bld.f90 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 mlprec/impl/smoother/mld_s_as_smoother_bld.f90 mlprec/impl/smoother/mld_s_base_smoother_bld.f90 mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 mlprec/impl/smoother/mld_z_as_smoother_bld.f90 mlprec/impl/smoother/mld_z_base_smoother_bld.f90 mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_inner_mod.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_prec_mod.f90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_inner_mod.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_prec_mod.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_inner_mod.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_prec_mod.f90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_inner_mod.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_prec_mod.f90 Interface fixes intent of DESC_A in multiple places. --- mlprec/impl/mld_cmlprec_bld.f90 | 2 +- mlprec/impl/mld_cprecbld.f90 | 2 +- mlprec/impl/mld_dmlprec_bld.f90 | 2 +- mlprec/impl/mld_dprecbld.f90 | 2 +- mlprec/impl/mld_smlprec_bld.f90 | 2 +- mlprec/impl/mld_sprecbld.f90 | 2 +- mlprec/impl/mld_zmlprec_bld.f90 | 2 +- mlprec/impl/mld_zprecbld.f90 | 2 +- mlprec/impl/smoother/mld_c_as_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_c_base_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_d_as_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_d_base_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_s_as_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_s_base_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_z_as_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_z_base_smoother_bld.f90 | 2 +- mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 | 2 +- mlprec/mld_c_as_smoother.f90 | 2 +- mlprec/mld_c_base_smoother_mod.f90 | 2 +- mlprec/mld_c_inner_mod.f90 | 2 +- mlprec/mld_c_jac_smoother.f90 | 2 +- mlprec/mld_c_prec_mod.f90 | 2 +- mlprec/mld_d_as_smoother.f90 | 2 +- mlprec/mld_d_base_smoother_mod.f90 | 2 +- mlprec/mld_d_inner_mod.f90 | 2 +- mlprec/mld_d_jac_smoother.f90 | 2 +- mlprec/mld_d_prec_mod.f90 | 2 +- mlprec/mld_d_prec_type.f90 | 1 + mlprec/mld_s_as_smoother.f90 | 2 +- mlprec/mld_s_base_smoother_mod.f90 | 2 +- mlprec/mld_s_inner_mod.f90 | 2 +- mlprec/mld_s_jac_smoother.f90 | 2 +- mlprec/mld_s_prec_mod.f90 | 2 +- mlprec/mld_z_as_smoother.f90 | 2 +- mlprec/mld_z_base_smoother_mod.f90 | 2 +- mlprec/mld_z_inner_mod.f90 | 2 +- mlprec/mld_z_jac_smoother.f90 | 2 +- mlprec/mld_z_prec_mod.f90 | 2 +- 41 files changed, 41 insertions(+), 40 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index 8e6de5ef..8a468317 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -84,7 +84,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_cspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_cprec_type),intent(inout),target :: p integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index bef79cb4..bac8b1b5 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -68,7 +68,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_cspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_cprec_type),intent(inout), target :: p integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 015f9666..f408d49d 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -84,7 +84,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_dspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_dprec_type),intent(inout),target :: p integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index c6361833..1e1de152 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -68,7 +68,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_dspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_dprec_type),intent(inout), target :: p integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index ce4004d4..7de96428 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -84,7 +84,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_sspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_sprec_type),intent(inout),target :: p integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index d59e3f0b..5a74525e 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -68,7 +68,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_sspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_sprec_type),intent(inout), target :: p integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index ded6d796..62d58a1d 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -84,7 +84,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_zspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_zprec_type),intent(inout),target :: p integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 7491280e..98fbf73c 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -68,7 +68,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold) ! Arguments type(psb_zspmat_type),intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_zprec_type),intent(inout), target :: p integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 index 4b662dce..2245df25 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 index 882196c0..c66cf9bc 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 index c676b08b..0334c10a 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 @@ -45,7 +45,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 index ed1eeab5..93d3c9d9 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 index 63aef74a..1b669a2c 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index e8999afa..641d64ba 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -45,7 +45,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 index df97fe24..14287add 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 index 4b422cd9..c1aef016 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 index e500f1d6..c399dce9 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 @@ -45,7 +45,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 index 0af96dd6..95164793 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 index a5645bdb..3722d0d6 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 @@ -44,7 +44,7 @@ subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 index d2140904..8e9eb03f 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 @@ -45,7 +45,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index e1dcabc9..5428359d 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -135,7 +135,7 @@ module mld_c_as_smoother & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_ implicit none type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index 63ce0f88..ed154f17 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -250,7 +250,7 @@ module mld_c_base_smoother_mod & mld_c_base_smoother_type, psb_ipk_ ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index ca58b326..27dd4e1e 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -54,7 +54,7 @@ module mld_c_inner_mod use mld_c_prec_type, only : mld_cprec_type implicit none type(psb_cspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_cprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index c6ea1489..f3e3be73 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -109,7 +109,7 @@ module mld_c_jac_smoother import :: psb_desc_type, mld_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_ type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_c_prec_mod.f90 b/mlprec/mld_c_prec_mod.f90 index 1bd37114..39422657 100644 --- a/mlprec/mld_c_prec_mod.f90 +++ b/mlprec/mld_c_prec_mod.f90 @@ -78,7 +78,7 @@ module mld_c_prec_mod & mld_cprec_type, psb_ipk_ implicit none type(psb_cspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_cprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 02e1d4f2..34287249 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -135,7 +135,7 @@ module mld_d_as_smoother & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_ implicit none type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 396c25cf..8c0de52d 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -250,7 +250,7 @@ module mld_d_base_smoother_mod & mld_d_base_smoother_type, psb_ipk_ ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index 8ce853ae..0c3d8169 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -54,7 +54,7 @@ module mld_d_inner_mod use mld_d_prec_type, only : mld_dprec_type implicit none type(psb_dspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_dprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index fb487df9..90dacb89 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -109,7 +109,7 @@ module mld_d_jac_smoother import :: psb_desc_type, mld_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_ type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_d_prec_mod.f90 b/mlprec/mld_d_prec_mod.f90 index 2bfffb90..e637f428 100644 --- a/mlprec/mld_d_prec_mod.f90 +++ b/mlprec/mld_d_prec_mod.f90 @@ -78,7 +78,7 @@ module mld_d_prec_mod & mld_dprec_type, psb_ipk_ implicit none type(psb_dspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_dprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index b7fae6d4..2f724157 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -439,6 +439,7 @@ contains root_ = psb_root_ end if if (root_ == -1) root_ = me + ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index 64dc566a..287c1bec 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -135,7 +135,7 @@ module mld_s_as_smoother & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_ implicit none type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 270f7dea..688b7004 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -250,7 +250,7 @@ module mld_s_base_smoother_mod & mld_s_base_smoother_type, psb_ipk_ ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 3810de04..5e5b74e9 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -54,7 +54,7 @@ module mld_s_inner_mod use mld_s_prec_type, only : mld_sprec_type implicit none type(psb_sspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_sprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 43b73a5e..f404d1f0 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -109,7 +109,7 @@ module mld_s_jac_smoother import :: psb_desc_type, mld_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_ type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_s_prec_mod.f90 b/mlprec/mld_s_prec_mod.f90 index f400df64..5ee8876d 100644 --- a/mlprec/mld_s_prec_mod.f90 +++ b/mlprec/mld_s_prec_mod.f90 @@ -78,7 +78,7 @@ module mld_s_prec_mod & mld_sprec_type, psb_ipk_ implicit none type(psb_sspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_sprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 3cdceb85..d6c969e8 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -135,7 +135,7 @@ module mld_z_as_smoother & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_ implicit none type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index d03a4836..b6956c22 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -250,7 +250,7 @@ module mld_z_base_smoother_mod & mld_z_base_smoother_type, psb_ipk_ ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index e2aa5e76..eeb96c36 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -54,7 +54,7 @@ module mld_z_inner_mod use mld_z_prec_type, only : mld_zprec_type implicit none type(psb_zspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_zprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index 61246a3d..e0115f4d 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -109,7 +109,7 @@ module mld_z_jac_smoother import :: psb_desc_type, mld_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_ type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_z_prec_mod.f90 b/mlprec/mld_z_prec_mod.f90 index 33b82755..3f46f420 100644 --- a/mlprec/mld_z_prec_mod.f90 +++ b/mlprec/mld_z_prec_mod.f90 @@ -78,7 +78,7 @@ module mld_z_prec_mod & mld_zprec_type, psb_ipk_ implicit none type(psb_zspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(inout), target :: desc_a type(mld_zprec_type), intent(inout), target :: prec integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold From 1ffd9b9f7d9fd318daac260d593a50d7aab832d3 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 28 Aug 2013 13:26:15 +0000 Subject: [PATCH 03/10] mld2p4-299: mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_z_ilu_solver.f90 Silly bug: missing psb_toupper in cset[ir] --- mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 | 2 +- mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 | 2 +- mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 | 2 +- mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 | 2 +- mlprec/mld_c_ilu_solver.f90 | 4 ++-- mlprec/mld_d_ilu_solver.f90 | 4 ++-- mlprec/mld_s_ilu_solver.f90 | 4 ++-- mlprec/mld_z_ilu_solver.f90 | 4 ++-- 8 files changed, 12 insertions(+), 12 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 index 1066ec90..64ffc92e 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 @@ -53,7 +53,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info) info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_OVR') sm%novr = val case('SUB_RESTR') diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 index 37c162aa..34ac1760 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 @@ -53,7 +53,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info) info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_OVR') sm%novr = val case('SUB_RESTR') diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 index 05277aea..1fb99c12 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 @@ -53,7 +53,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info) info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_OVR') sm%novr = val case('SUB_RESTR') diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 index f137d62e..abd6ba16 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 @@ -53,7 +53,7 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info) info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_OVR') sm%novr = val case('SUB_RESTR') diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 5018cdc8..f3cc98c4 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -350,7 +350,7 @@ contains info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_SOLVE') sv%fact_type = val case('SUB_FILLIN') @@ -425,7 +425,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - select case(what) + select case(psb_toupper(what)) case('SUB_ILUTHRS') sv%thresh = val case default diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 4e45fed5..9a4aa7eb 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -350,7 +350,7 @@ contains info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_SOLVE') sv%fact_type = val case('SUB_FILLIN') @@ -425,7 +425,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - select case(what) + select case(psb_toupper(what)) case('SUB_ILUTHRS') sv%thresh = val case default diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index 68297ee7..bd096437 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -350,7 +350,7 @@ contains info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_SOLVE') sv%fact_type = val case('SUB_FILLIN') @@ -425,7 +425,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - select case(what) + select case(psb_toupper(what)) case('SUB_ILUTHRS') sv%thresh = val case default diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 9b87f37d..1a41baf4 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -350,7 +350,7 @@ contains info = psb_success_ call psb_erractionsave(err_act) - select case(what) + select case(psb_toupper(what)) case('SUB_SOLVE') sv%fact_type = val case('SUB_FILLIN') @@ -425,7 +425,7 @@ contains call psb_erractionsave(err_act) info = psb_success_ - select case(what) + select case(psb_toupper(what)) case('SUB_ILUTHRS') sv%thresh = val case default From 21e38e140c3c4b8ab2342d38b4629f994046fbf9 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 31 Aug 2013 12:14:44 +0000 Subject: [PATCH 04/10] mld2p4-299: Check for new descriptor integer vectors. Will need to revise the errors in mlprecaply --- mlprec/impl/mld_daggrmat_asb.f90 | 5 ++++- mlprec/impl/mld_dmlprec_aply.f90 | 32 ++++++++++++++++++++++----- mlprec/impl/mld_dmlprec_bld.f90 | 20 ++++++++++++++++- mlprec/impl/mld_dprecbld.f90 | 37 ++++++++++++++++---------------- mlprec/mld_base_prec_type.F90 | 2 +- mlprec/mld_d_inner_mod.f90 | 5 +++-- mlprec/mld_d_prec_mod.f90 | 5 +++-- 7 files changed, 76 insertions(+), 30 deletions(-) diff --git a/mlprec/impl/mld_daggrmat_asb.f90 b/mlprec/impl/mld_daggrmat_asb.f90 index eae29e93..57533916 100644 --- a/mlprec/impl/mld_daggrmat_asb.f90 +++ b/mlprec/impl/mld_daggrmat_asb.f90 @@ -259,7 +259,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) ! op_restr => PR^T i.e. restriction operator ! op_prol => PR i.e. prolongation operator ! - +!!$ write(0,*) 'allocated DSC_AC ',allocated(p%desc_ac%v_halo_index%v),& +!!$ & allocated(p%desc_ac%v_ext_index%v),& +!!$ & allocated(p%desc_ac%v_ovrlap_index%v),& +!!$ &allocated(p%desc_ac%v_ovr_mst_idx%v) p%map = psb_linmap(psb_map_aggr_,desc_a,& & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) if (info == psb_success_) call op_prol%free() diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 5333f556..d79f23f0 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -362,7 +362,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) - if (info /= psb_success_) then + if (info /= psb_success_) then + write(0,*) 'Allocation Error at level ',0 info=psb_err_alloc_request_ call psb_errpush(info,name,& & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& @@ -446,6 +447,7 @@ contains & mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then + write(0,*) 'Allocation Error at level',level, nc2l info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') @@ -522,7 +524,7 @@ contains call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,& & dzero,mlprec_wrk(level)%x2l,& & p%precv(level)%map,info,work=work) - +!!$ write(0,*) 'inner_ml map_x2y :',level,info if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during restriction') @@ -534,14 +536,23 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & dzero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if ! ! Compute the residual ! @@ -926,6 +937,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ + write(0,*) 'Allocation Error at level ',0 call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 @@ -1089,7 +1101,7 @@ contains call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,& & dzero,mlprec_wrk(level)%vx2l,& & p%precv(level)%map,info,work=work) - +!!$ write(0,*) 'inner_ml map_x2y :',level,info if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during restriction') @@ -1101,6 +1113,11 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if if (info /= psb_success_) goto 9999 ! ! Apply the prolongator @@ -1108,6 +1125,11 @@ contains call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if if (info /= psb_success_) goto 9999 ! ! Compute the residual diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index f408d49d..dfa16fc9 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -175,7 +175,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) endif - +!!$ write(0,*) 'DMLPRECBLD: CASIZE ',casize if (casize>0) then ! ! New strategy to build according to coarse size. @@ -291,6 +291,11 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) current => newnode ! First do a move_alloc. ! This handles the AC, DESC_AC and MAP fields +!!$ associate(this=>current%item%map) +!!$ if (i>1) write(0,*) 'List realloc loop input:',i,& +!!$ & allocated(this%p_desc_X%v_halo_index%v),& +!!$ & allocated(this%p_desc_Y%v_halo_index%v) +!!$ end associate if (info == psb_success_) & & call mld_move_alloc(current%item,p%precv(i),info) ! Now set the smoother/solver parts. @@ -320,6 +325,11 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc end if +!!$ associate(this =>p%precv(i)%map) +!!$ if (i>1) write(0,*) 'List realloc loop output:',i,& +!!$ & allocated(this%p_desc_X%v_halo_index%v),& +!!$ & allocated(this%p_desc_Y%v_halo_index%v) +!!$ end associate newnode => current%next deallocate(current) @@ -501,6 +511,14 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info + +!!$ associate(this =>p%precv(i)%map) +!!$ if (i>1) write(0,*) 'After sm build at level:',i,& +!!$ & allocated(this%p_desc_X%v_halo_index%v),& +!!$ & allocated(this%p_desc_Y%v_halo_index%v) +!!$ end associate + + end do diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 1e1de152..c3efec5c 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -58,7 +58,7 @@ ! info - integer, output. ! Error code. ! -subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) +subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_d_inner_mod @@ -73,6 +73,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) 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 !!$ character, intent(in), optional :: upd ! Local Variables @@ -164,22 +165,22 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if - - call p%precv(1)%check(info) - if (info /= psb_success_) then - write(0,*) ' Smoother check error',info - call psb_errpush(psb_err_internal_error_,name,& - & a_err='One level preconditioner check.') - goto 9999 - endif - - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='One level preconditioner build.') - goto 9999 - endif - + + call p%precv(1)%check(info) + if (info /= psb_success_) then + write(0,*) ' Smoother check error',info + call psb_errpush(psb_err_internal_error_,name,& + & a_err='One level preconditioner check.') + goto 9999 + endif + + call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='One level preconditioner build.') + goto 9999 + endif + ! ! Number of levels > 1 ! @@ -188,7 +189,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) ! Build the multilevel preconditioner ! call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) - + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Multilevel preconditioner build.') diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index f6de2cd4..b85daffc 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -65,7 +65,7 @@ module mld_base_prec_type ! use psb_const_mod use psb_base_mod, only :& - & psb_desc_type,& + & psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,& & psb_ipk_, psb_dpk_, psb_spk_, psb_long_int_k_, & & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, & & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,& diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index 0c3d8169..e6d165e4 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -48,8 +48,8 @@ module mld_d_inner_mod use mld_d_prec_type interface mld_mlprec_bld - subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold) - use psb_base_mod, only : psb_dspmat_type, psb_desc_type, & + subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) + use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_ use mld_d_prec_type, only : mld_dprec_type implicit none @@ -59,6 +59,7 @@ module mld_d_inner_mod 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 !!$ character, intent(in),optional :: upd end subroutine mld_dmlprec_bld end interface mld_mlprec_bld diff --git a/mlprec/mld_d_prec_mod.f90 b/mlprec/mld_d_prec_mod.f90 index e637f428..03232ff9 100644 --- a/mlprec/mld_d_prec_mod.f90 +++ b/mlprec/mld_d_prec_mod.f90 @@ -72,10 +72,10 @@ module mld_d_prec_mod !!$ interface mld_inner_precset interface mld_precbld - subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold) + subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & psb_d_base_sparse_mat, psb_d_base_vect_type, & - & mld_dprec_type, psb_ipk_ + & psb_i_base_vect_type, mld_dprec_type, psb_ipk_ implicit none type(psb_dspmat_type), intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a @@ -83,6 +83,7 @@ module mld_d_prec_mod 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 !!$ character, intent(in),optional :: upd end subroutine mld_dprecbld end interface From 3d6537ed217b3c77d34881e90982740be33c1fad Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 31 Aug 2013 15:24:22 +0000 Subject: [PATCH 05/10] mld2p4-299 Fixes for integer vecors in DESC (even inside maps) Added imold to interface. Implementation is still incomplete. --- mlprec/impl/mld_cmlprec_aply.f90 | 83 ++++++++++++++++++++++++----- mlprec/impl/mld_cmlprec_bld.f90 | 3 +- mlprec/impl/mld_cprecbld.f90 | 3 +- mlprec/impl/mld_dmlprec_aply.f90 | 89 ++++++++++++++++++++++---------- mlprec/impl/mld_dmlprec_bld.f90 | 23 ++------- mlprec/impl/mld_dprecbld.f90 | 34 ++++++------ mlprec/impl/mld_smlprec_aply.f90 | 83 ++++++++++++++++++++++++----- mlprec/impl/mld_smlprec_bld.f90 | 3 +- mlprec/impl/mld_sprecbld.f90 | 3 +- mlprec/impl/mld_zmlprec_aply.f90 | 83 ++++++++++++++++++++++++----- mlprec/impl/mld_zmlprec_bld.f90 | 3 +- mlprec/impl/mld_zprecbld.f90 | 3 +- mlprec/mld_c_inner_mod.f90 | 5 +- mlprec/mld_c_prec_mod.f90 | 5 +- mlprec/mld_s_inner_mod.f90 | 5 +- mlprec/mld_s_prec_mod.f90 | 5 +- mlprec/mld_z_inner_mod.f90 | 5 +- mlprec/mld_z_prec_mod.f90 | 5 +- tests/pdegen/runs/ppde.inp | 4 +- 19 files changed, 320 insertions(+), 127 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index eeb9d199..8d9efc9d 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -488,18 +488,26 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & cone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -534,14 +542,23 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & czero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if ! ! Compute the residual ! @@ -608,13 +625,25 @@ contains & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & cone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -669,12 +698,23 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & cone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -700,14 +740,24 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & czero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! @@ -788,6 +838,11 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! @@ -796,10 +851,10 @@ contains call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,& & cone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index 8a468317..adcf6aae 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -74,7 +74,7 @@ ! ! ! -subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold) +subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_c_inner_mod, mld_protect_name => mld_cmlprec_bld @@ -89,6 +89,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index bac8b1b5..61ced362 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -58,7 +58,7 @@ ! info - integer, output. ! Error code. ! -subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold) +subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_c_inner_mod @@ -73,6 +73,7 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index d79f23f0..2af6eb64 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -362,8 +362,7 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) - if (info /= psb_success_) then - write(0,*) 'Allocation Error at level ',0 + if (info /= psb_success_) then info=psb_err_alloc_request_ call psb_errpush(info,name,& & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),& @@ -447,7 +446,6 @@ contains & mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then - write(0,*) 'Allocation Error at level',level, nc2l info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') @@ -490,18 +488,26 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & done,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -524,7 +530,7 @@ contains call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,& & dzero,mlprec_wrk(level)%x2l,& & p%precv(level)%map,info,work=work) -!!$ write(0,*) 'inner_ml map_x2y :',level,info + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during restriction') @@ -619,13 +625,25 @@ contains & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & done,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -680,12 +698,23 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & done,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -711,14 +740,24 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & dzero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! @@ -799,6 +838,11 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! @@ -807,10 +851,10 @@ contains call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,& & done,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if @@ -937,7 +981,6 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) if (psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - write(0,*) 'Allocation Error at level ',0 call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 @@ -1101,7 +1144,7 @@ contains call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,& & dzero,mlprec_wrk(level)%vx2l,& & p%precv(level)%map,info,work=work) -!!$ write(0,*) 'inner_ml map_x2y :',level,info + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Error during restriction') @@ -1113,11 +1156,6 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if if (info /= psb_success_) goto 9999 ! ! Apply the prolongator @@ -1125,11 +1163,6 @@ contains call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 - end if if (info /= psb_success_) goto 9999 ! ! Compute the residual diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index dfa16fc9..16641ff4 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -74,7 +74,7 @@ ! ! ! -subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) +subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_d_inner_mod, mld_protect_name => mld_dmlprec_bld @@ -89,6 +89,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) 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 !!$ character, intent(in), optional :: upd ! Local Variables @@ -175,7 +176,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) endif -!!$ write(0,*) 'DMLPRECBLD: CASIZE ',casize + if (casize>0) then ! ! New strategy to build according to coarse size. @@ -291,11 +292,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) current => newnode ! First do a move_alloc. ! This handles the AC, DESC_AC and MAP fields -!!$ associate(this=>current%item%map) -!!$ if (i>1) write(0,*) 'List realloc loop input:',i,& -!!$ & allocated(this%p_desc_X%v_halo_index%v),& -!!$ & allocated(this%p_desc_Y%v_halo_index%v) -!!$ end associate if (info == psb_success_) & & call mld_move_alloc(current%item,p%precv(i),info) ! Now set the smoother/solver parts. @@ -325,11 +321,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc end if -!!$ associate(this =>p%precv(i)%map) -!!$ if (i>1) write(0,*) 'List realloc loop output:',i,& -!!$ & allocated(this%p_desc_X%v_halo_index%v),& -!!$ & allocated(this%p_desc_Y%v_halo_index%v) -!!$ end associate newnode => current%next deallocate(current) @@ -511,14 +502,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info - -!!$ associate(this =>p%precv(i)%map) -!!$ if (i>1) write(0,*) 'After sm build at level:',i,& -!!$ & allocated(this%p_desc_X%v_halo_index%v),& -!!$ & allocated(this%p_desc_Y%v_halo_index%v) -!!$ end associate - - end do diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index c3efec5c..938b3277 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -165,22 +165,22 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if - - call p%precv(1)%check(info) - if (info /= psb_success_) then - write(0,*) ' Smoother check error',info - call psb_errpush(psb_err_internal_error_,name,& - & a_err='One level preconditioner check.') - goto 9999 - endif - - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='One level preconditioner build.') - goto 9999 - endif - + + call p%precv(1)%check(info) + if (info /= psb_success_) then + write(0,*) ' Smoother check error',info + call psb_errpush(psb_err_internal_error_,name,& + & a_err='One level preconditioner check.') + goto 9999 + endif + + call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='One level preconditioner build.') + goto 9999 + endif + ! ! Number of levels > 1 ! @@ -189,7 +189,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) ! Build the multilevel preconditioner ! call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) - + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Multilevel preconditioner build.') diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index b5ef086e..4351316d 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -488,18 +488,26 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & sone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -534,14 +542,23 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & szero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if ! ! Compute the residual ! @@ -608,13 +625,25 @@ contains & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & sone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -669,12 +698,23 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & sone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -700,14 +740,24 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & szero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! @@ -788,6 +838,11 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! @@ -796,10 +851,10 @@ contains call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,& & sone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index 7de96428..205c13e5 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -74,7 +74,7 @@ ! ! ! -subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold) +subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_s_inner_mod, mld_protect_name => mld_smlprec_bld @@ -89,6 +89,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index 5a74525e..5b3c5d33 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -58,7 +58,7 @@ ! info - integer, output. ! Error code. ! -subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold) +subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_s_inner_mod @@ -73,6 +73,7 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index a02962f6..a674656d 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -488,18 +488,26 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -534,14 +542,23 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zzero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if ! ! Compute the residual ! @@ -608,13 +625,25 @@ contains & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -669,12 +698,23 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) if (info /= psb_success_) goto 9999 call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -700,14 +740,24 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zzero,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! @@ -788,6 +838,11 @@ contains & p%precv(level)%base_desc,info,work=work,trans=trans) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if ! @@ -796,10 +851,10 @@ contains call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,& & zone,mlprec_wrk(level)%y2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index 62d58a1d..e66a4917 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -74,7 +74,7 @@ ! ! ! -subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold) +subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_z_inner_mod, mld_protect_name => mld_zmlprec_bld @@ -89,6 +89,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 98fbf73c..1cda521f 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -58,7 +58,7 @@ ! info - integer, output. ! Error code. ! -subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold) +subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) use psb_base_mod use mld_z_inner_mod @@ -73,6 +73,7 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in), optional :: upd ! Local Variables diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index 27dd4e1e..4b1c4530 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -48,8 +48,8 @@ module mld_c_inner_mod use mld_c_prec_type interface mld_mlprec_bld - subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold) - use psb_base_mod, only : psb_cspmat_type, psb_desc_type, & + subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) + use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ use mld_c_prec_type, only : mld_cprec_type implicit none @@ -59,6 +59,7 @@ module mld_c_inner_mod integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_cmlprec_bld end interface mld_mlprec_bld diff --git a/mlprec/mld_c_prec_mod.f90 b/mlprec/mld_c_prec_mod.f90 index 39422657..28c3550a 100644 --- a/mlprec/mld_c_prec_mod.f90 +++ b/mlprec/mld_c_prec_mod.f90 @@ -72,10 +72,10 @@ module mld_c_prec_mod !!$ interface mld_inner_precset interface mld_precbld - subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold) + subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & psb_c_base_sparse_mat, psb_c_base_vect_type, & - & mld_cprec_type, psb_ipk_ + & psb_i_base_vect_type, mld_cprec_type, psb_ipk_ implicit none type(psb_cspmat_type), intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a @@ -83,6 +83,7 @@ module mld_c_prec_mod integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_cprecbld end interface diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 5e5b74e9..4991bc83 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -48,8 +48,8 @@ module mld_s_inner_mod use mld_s_prec_type interface mld_mlprec_bld - subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold) - use psb_base_mod, only : psb_sspmat_type, psb_desc_type, & + subroutine mld_smlprec_bld(a,desc_a,prec,info, amold, vmold,imold) + use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ use mld_s_prec_type, only : mld_sprec_type implicit none @@ -59,6 +59,7 @@ module mld_s_inner_mod integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_smlprec_bld end interface mld_mlprec_bld diff --git a/mlprec/mld_s_prec_mod.f90 b/mlprec/mld_s_prec_mod.f90 index 5ee8876d..468f7525 100644 --- a/mlprec/mld_s_prec_mod.f90 +++ b/mlprec/mld_s_prec_mod.f90 @@ -72,10 +72,10 @@ module mld_s_prec_mod !!$ interface mld_inner_precset interface mld_precbld - subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold) + subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & psb_s_base_sparse_mat, psb_s_base_vect_type, & - & mld_sprec_type, psb_ipk_ + & psb_i_base_vect_type, mld_sprec_type, psb_ipk_ implicit none type(psb_sspmat_type), intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a @@ -83,6 +83,7 @@ module mld_s_prec_mod integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_sprecbld end interface diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index eeb96c36..d42d950e 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -48,8 +48,8 @@ module mld_z_inner_mod use mld_z_prec_type interface mld_mlprec_bld - subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold) - use psb_base_mod, only : psb_zspmat_type, psb_desc_type, & + subroutine mld_zmlprec_bld(a,desc_a,prec,info, amold, vmold,imold) + use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ use mld_z_prec_type, only : mld_zprec_type implicit none @@ -59,6 +59,7 @@ module mld_z_inner_mod integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_zmlprec_bld end interface mld_mlprec_bld diff --git a/mlprec/mld_z_prec_mod.f90 b/mlprec/mld_z_prec_mod.f90 index 3f46f420..dd409a59 100644 --- a/mlprec/mld_z_prec_mod.f90 +++ b/mlprec/mld_z_prec_mod.f90 @@ -72,10 +72,10 @@ module mld_z_prec_mod !!$ interface mld_inner_precset interface mld_precbld - subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold) + subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & psb_z_base_sparse_mat, psb_z_base_vect_type, & - & mld_zprec_type, psb_ipk_ + & psb_i_base_vect_type, mld_zprec_type, psb_ipk_ implicit none type(psb_zspmat_type), intent(in), target :: a type(psb_desc_type), intent(inout), target :: desc_a @@ -83,6 +83,7 @@ module mld_z_prec_mod integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold !!$ character, intent(in),optional :: upd end subroutine mld_zprecbld end interface diff --git a/tests/pdegen/runs/ppde.inp b/tests/pdegen/runs/ppde.inp index ed156384..35add26d 100644 --- a/tests/pdegen/runs/ppde.inp +++ b/tests/pdegen/runs/ppde.inp @@ -7,8 +7,8 @@ CSR ! Storage format CSR COO JAD 30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS 3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars) -ML ! Preconditioner NONE JACOBI BJAC AS ML -1 ! Number of overlap layers for AS preconditioner at finest level +AS ! Preconditioner NONE JACOBI BJAC AS ML +2 ! Number of overlap layers for AS preconditioner at finest level HALO ! Restriction operator NONE HALO NONE ! Prolongation operator NONE SUM AVG ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU From 665c72474ad4b038470f11e7e94f81a757e52ec4 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 2 Sep 2013 15:10:37 +0000 Subject: [PATCH 06/10] --- mlprec/impl/level/Makefile | 1 + mlprec/impl/level/mld_d_base_onelev_cnv.f90 | 63 +++++++++++ mlprec/impl/mld_dmlprec_bld.f90 | 7 +- mlprec/impl/mld_dprecbld.f90 | 6 +- mlprec/impl/smoother/Makefile | 3 + .../impl/smoother/mld_d_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_d_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_d_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_d_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_d_jac_smoother_bld.f90 | 3 +- .../impl/smoother/mld_d_jac_smoother_cnv.f90 | 91 ++++++++++++++++ mlprec/impl/solver/Makefile | 3 + mlprec/impl/solver/mld_d_base_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_d_diag_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_diag_solver_cnv.f90 | 83 ++++++++++++++ mlprec/impl/solver/mld_d_ilu_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 | 83 ++++++++++++++ mlprec/mld_d_as_smoother.f90 | 26 ++++- mlprec/mld_d_base_smoother_mod.f90 | 27 ++++- mlprec/mld_d_base_solver_mod.f90 | 29 +++-- mlprec/mld_d_diag_solver.f90 | 28 +++-- mlprec/mld_d_id_solver.f90 | 3 +- mlprec/mld_d_ilu_solver.f90 | 21 +++- mlprec/mld_d_jac_smoother.f90 | 26 ++++- mlprec/mld_d_onelev_mod.f90 | 17 ++- mlprec/mld_d_slu_solver.F90 | 3 +- mlprec/mld_d_sludist_solver.F90 | 3 +- mlprec/mld_d_umf_solver.F90 | 3 +- 29 files changed, 751 insertions(+), 42 deletions(-) create mode 100644 mlprec/impl/level/mld_d_base_onelev_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index aa1ddb72..4964e210 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -18,6 +18,7 @@ mld_c_base_onelev_csetc.o \ mld_c_base_onelev_cseti.o \ mld_c_base_onelev_csetr.o \ mld_d_base_onelev_check.o \ +mld_d_base_onelev_cnv.o \ mld_d_base_onelev_descr.o \ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ diff --git a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 new file mode 100644 index 00000000..fdbef138 --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 @@ -0,0 +1,63 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cnv + implicit none + + class(mld_d_onelev_type), intent(inout) :: lv + 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 + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + +end subroutine mld_d_base_onelev_cnv diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 16641ff4..2bd905fa 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -487,11 +487,12 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + call p%precv(i)%cnv(info,amold=amold,imold=imold) +!!$ call psb_map_cscnv(p%precv(i)%map,info,mold=amold) +!!$ call p%precv(i)%ac%cscnv(info,mold=amold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 938b3277..61fa7092 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index 8237f66d..f2536eda 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -43,6 +43,7 @@ mld_d_as_smoother_apply_vect.o \ mld_d_as_smoother_bld.o \ mld_d_as_smoother_check.o \ mld_d_as_smoother_clone.o \ +mld_d_as_smoother_cnv.o \ mld_d_as_smoother_csetc.o \ mld_d_as_smoother_cseti.o \ mld_d_as_smoother_csetr.o \ @@ -56,6 +57,7 @@ mld_d_base_smoother_apply_vect.o \ mld_d_base_smoother_bld.o \ mld_d_base_smoother_check.o \ mld_d_base_smoother_clone.o \ +mld_d_base_smoother_cnv.o \ mld_d_base_smoother_csetc.o \ mld_d_base_smoother_cseti.o \ mld_d_base_smoother_csetr.o \ @@ -69,6 +71,7 @@ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ mld_d_jac_smoother_clone.o \ +mld_d_jac_smoother_cnv.o \ mld_s_as_smoother_apply.o \ mld_s_as_smoother_apply_vect.o \ mld_s_as_smoother_bld.o \ diff --git a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 index 93d3c9d9..9e848d3a 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 ! Local variables type(psb_dspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 new file mode 100644 index 00000000..c9bd4c3b --- /dev/null +++ b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_d_as_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 + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (info == psb_success_) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_as_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 index 1b669a2c..cfb0642c 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 new file mode 100644 index 00000000..3822f40a --- /dev/null +++ b/mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_base_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_d_base_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 + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index 641d64ba..d3e2d954 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_diag_solver @@ -51,6 +51,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 new file mode 100644 index 00000000..5fccdd13 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_diag_solver + use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_d_jac_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 + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine mld_d_jac_smoother_cnv diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 2ebf3afc..31de5a20 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -38,6 +38,7 @@ mld_d_base_solver_apply_vect.o \ mld_d_base_solver_bld.o \ mld_d_base_solver_check.o \ mld_d_base_solver_clone.o \ +mld_d_base_solver_cnv.o \ mld_d_base_solver_csetc.o \ mld_d_base_solver_cseti.o \ mld_d_base_solver_csetr.o \ @@ -51,6 +52,7 @@ mld_d_diag_solver_apply.o \ mld_d_diag_solver_apply_vect.o \ mld_d_diag_solver_bld.o \ mld_d_diag_solver_clone.o \ +mld_d_diag_solver_cnv.o \ mld_d_id_solver_apply.o \ mld_d_id_solver_apply_vect.o \ mld_d_id_solver_clone.o \ @@ -58,6 +60,7 @@ mld_d_ilu_solver_apply.o \ mld_d_ilu_solver_apply_vect.o \ mld_d_ilu_solver_bld.o \ mld_d_ilu_solver_clone.o \ +mld_d_ilu_solver_cnv.o \ mld_d_ilu_solver_dmp.o \ mld_s_base_solver_apply.o \ mld_s_base_solver_apply_vect.o \ diff --git a/mlprec/impl/solver/mld_d_base_solver_bld.f90 b/mlprec/impl/solver/mld_d_base_solver_bld.f90 index e259eb88..27433aea 100644 --- a/mlprec/impl/solver/mld_d_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_bld @@ -50,6 +50,7 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) type(psb_dspmat_type), intent(in), target, optional :: b 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 integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_d_base_solver_cnv.f90 b/mlprec/impl/solver/mld_d_base_solver_cnv.f90 new file mode 100644 index 00000000..6076bf39 --- /dev/null +++ b/mlprec/impl/solver/mld_d_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_base_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_cnv + Implicit None + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + 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 + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_solver_cnv diff --git a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 index 815c991f..2a84af95 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_bld @@ -52,6 +52,7 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 new file mode 100644 index 00000000..7b844756 --- /dev/null +++ b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 @@ -0,0 +1,83 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_d_diag_solver_type), intent(inout) :: sv + 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 + ! Local variables + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + + 9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine mld_d_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 index 7da0aa70..44eb017d 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_bld @@ -52,6 +52,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 new file mode 100644 index 00000000..1cb3166c --- /dev/null +++ b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 @@ -0,0 +1,83 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_d_ilu_solver_type), intent(inout) :: sv + 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 + ! Local variables + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota +!!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_ilu_solver_cnv diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 34287249..1bc2fce9 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_d_as_smoother procedure, pass(sm) :: check => mld_d_as_smoother_check procedure, pass(sm) :: dump => mld_d_as_smoother_dmp procedure, pass(sm) :: build => mld_d_as_smoother_bld + procedure, pass(sm) :: cnv => mld_d_as_smoother_cnv procedure, pass(sm) :: clone => mld_d_as_smoother_clone procedure, pass(sm) :: apply_v => mld_d_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_as_smoother_apply @@ -95,7 +96,8 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -129,10 +131,11 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, & - & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -141,9 +144,24 @@ module mld_d_as_smoother 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 mld_d_as_smoother_bld end interface - + + interface + subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & + & mld_d_as_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_d_as_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 mld_d_as_smoother_cnv + end interface + interface subroutine mld_d_as_smoother_seti(sm,what,val,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 8c0de52d..c3482ba6 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_d_base_smoother_mod use mld_d_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_long_int_k_,& - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, psb_dpk_ + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, psb_dpk_,& + & psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_d_base_smoother_mod procedure, pass(sm) :: dump => mld_d_base_smoother_dmp procedure, pass(sm) :: clone => mld_d_base_smoother_clone procedure, pass(sm) :: build => mld_d_base_smoother_bld + procedure, pass(sm) :: cnv => mld_d_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_d_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_d_base_smoother_mod interface - subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_ @@ -244,10 +247,11 @@ module mld_d_base_smoother_mod end interface interface - subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,& + & amold,vmold,imold) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ + & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +260,24 @@ module mld_d_base_smoother_mod 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 mld_d_base_smoother_bld end interface + interface + subroutine mld_d_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & + & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_d_base_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 mld_d_base_smoother_cnv + end interface + interface subroutine mld_d_base_smoother_free(sm,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 3731d143..a394e5a8 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_d_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_dspmat_type, & - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat,& + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_d_base_solver_mod procedure, pass(sv) :: dump => mld_d_base_solver_dmp procedure, pass(sv) :: clone => mld_d_base_solver_clone procedure, pass(sv) :: build => mld_d_base_solver_bld + procedure, pass(sv) :: cnv => mld_d_base_solver_cnv procedure, pass(sv) :: apply_v => mld_d_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,39 @@ module mld_d_base_solver_mod end interface interface - subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ + & mld_d_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 mld_d_base_solver_bld end interface + interface + subroutine mld_d_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & + & mld_d_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + 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 mld_d_base_solver_cnv + end interface + interface subroutine mld_d_base_solver_check(sv,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 089ea2c4..48a76ed7 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_d_diag_solver real(psb_dpk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_d_diag_solver_bld + procedure, pass(sv) :: cnv => mld_d_diag_solver_cnv procedure, pass(sv) :: clone => mld_d_diag_solver_clone procedure, pass(sv) :: apply_v => mld_d_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_diag_solver_apply @@ -69,7 +70,8 @@ module mld_d_diag_solver interface - subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_diag_solver_type, psb_ipk_ @@ -101,20 +103,34 @@ module mld_d_diag_solver end interface interface - subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_diag_solver_type, psb_ipk_ + & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 mld_d_diag_solver_bld end interface + + interface + subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_desc_type, psb_d_base_sparse_mat, & + & psb_d_base_vect_type, psb_dpk_, & + & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_d_diag_solver_type), intent(inout) :: sv + 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 mld_d_diag_solver_cnv + end interface interface subroutine mld_d_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90 index e93ec10f..2f896e8f 100644 --- a/mlprec/mld_d_id_solver.f90 +++ b/mlprec/mld_d_id_solver.f90 @@ -112,7 +112,7 @@ module mld_d_id_solver contains - subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None @@ -125,6 +125,7 @@ contains type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 9a4aa7eb..19267f92 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_d_ilu_solver procedure, pass(sv) :: dump => mld_d_ilu_solver_dmp procedure, pass(sv) :: clone => mld_d_ilu_solver_clone procedure, pass(sv) :: build => mld_d_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_d_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_d_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_ilu_solver_apply procedure, pass(sv) :: free => d_ilu_solver_free @@ -126,9 +127,10 @@ module mld_d_ilu_solver end interface interface - subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, & - & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_ + & 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(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a @@ -138,8 +140,23 @@ module mld_d_ilu_solver type(psb_dspmat_type), intent(in), target, optional :: b 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 mld_d_ilu_solver_bld end interface + + interface + subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_desc_type, mld_d_ilu_solver_type, psb_dpk_, & + & psb_d_base_sparse_mat, psb_d_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_d_ilu_solver_type), intent(inout) :: sv + 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 mld_d_ilu_solver_cnv + end interface interface subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index 90dacb89..bcf40c9f 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -56,6 +56,7 @@ module mld_d_jac_smoother contains procedure, pass(sm) :: build => mld_d_jac_smoother_bld procedure, pass(sm) :: clone => mld_d_jac_smoother_clone + procedure, pass(sm) :: cnv => mld_d_jac_smoother_cnv procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_jac_smoother_apply procedure, pass(sm) :: free => d_jac_smoother_free @@ -72,7 +73,8 @@ module mld_d_jac_smoother interface - subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, mld_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_ @@ -89,7 +91,8 @@ module mld_d_jac_smoother end interface interface - subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, mld_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_ type(psb_desc_type), intent(in) :: desc_data @@ -105,9 +108,10 @@ module mld_d_jac_smoother end interface interface - subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_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_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm @@ -115,9 +119,23 @@ module mld_d_jac_smoother 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 mld_d_jac_smoother_bld end interface + interface + subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_desc_type, mld_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 + class(mld_d_jac_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 mld_d_jac_smoother_cnv + end interface + interface subroutine mld_d_jac_smoother_clone(sm,smout,info) import :: mld_d_jac_smoother_type, psb_dpk_, & diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index d4474890..cf045f46 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -57,7 +57,8 @@ module mld_d_onelev_mod use mld_base_prec_type use mld_d_base_smoother_mod use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type + & psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_,& + & psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_d_onelev_mod type(psb_dlinmap_type) :: map contains procedure, pass(lv) :: clone => d_base_onelev_clone + procedure, pass(lv) :: cnv => mld_d_base_onelev_cnv procedure, pass(lv) :: descr => mld_d_base_onelev_descr procedure, pass(lv) :: default => d_base_onelev_default procedure, pass(lv) :: free => mld_d_base_onelev_free @@ -170,6 +172,19 @@ module mld_d_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_d_base_onelev_descr end interface + + interface + subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_d_onelev_type, psb_d_base_vect_type, psb_dpk_, & + & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_d_onelev_type), intent(inout) :: lv + 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 mld_d_base_onelev_cnv + end interface interface subroutine mld_d_base_onelev_free(lv,info) diff --git a/mlprec/mld_d_slu_solver.F90 b/mlprec/mld_d_slu_solver.F90 index 0c9b1dbb..cc615d25 100644 --- a/mlprec/mld_d_slu_solver.F90 +++ b/mlprec/mld_d_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine d_slu_solver_apply_vect - subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_d_sludist_solver.F90 b/mlprec/mld_d_sludist_solver.F90 index fbe501d1..f55004bf 100644 --- a/mlprec/mld_d_sludist_solver.F90 +++ b/mlprec/mld_d_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine d_sludist_solver_apply_vect - subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_d_umf_solver.F90 b/mlprec/mld_d_umf_solver.F90 index 16c12044..70235bd6 100644 --- a/mlprec/mld_d_umf_solver.F90 +++ b/mlprec/mld_d_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine d_umf_solver_apply_vect - subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_dspmat_type), intent(in), target, optional :: b 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csc_sparse_mat) :: acsc From b784aae5cc70a95c6146bb1549ce1bfd73ad099b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 2 Sep 2013 16:33:45 +0000 Subject: [PATCH 07/10] mld2p4-299 mlprec/impl/level/Makefile mlprec/impl/level/mld_c_base_onelev_cnv.f90 mlprec/impl/level/mld_d_base_onelev_cnv.f90 mlprec/impl/level/mld_s_base_onelev_cnv.f90 mlprec/impl/level/mld_z_base_onelev_cnv.f90 mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_zmlprec_bld.f90 mlprec/impl/mld_zprecbld.f90 mlprec/impl/smoother/Makefile mlprec/impl/smoother/mld_c_as_smoother_bld.f90 mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 mlprec/impl/smoother/mld_c_base_smoother_bld.f90 mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 mlprec/impl/smoother/mld_s_as_smoother_bld.f90 mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 mlprec/impl/smoother/mld_s_base_smoother_bld.f90 mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 mlprec/impl/smoother/mld_z_as_smoother_bld.f90 mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 mlprec/impl/smoother/mld_z_base_smoother_bld.f90 mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 mlprec/impl/solver/Makefile mlprec/impl/solver/mld_c_base_solver_bld.f90 mlprec/impl/solver/mld_c_base_solver_cnv.f90 mlprec/impl/solver/mld_c_diag_solver_bld.f90 mlprec/impl/solver/mld_c_diag_solver_cnv.f90 mlprec/impl/solver/mld_c_ilu_solver_bld.f90 mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 mlprec/impl/solver/mld_d_base_solver_bld.f90 mlprec/impl/solver/mld_d_diag_solver_bld.f90 mlprec/impl/solver/mld_d_diag_solver_cnv.f90 mlprec/impl/solver/mld_d_ilu_solver_bld.f90 mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 mlprec/impl/solver/mld_s_base_solver_bld.f90 mlprec/impl/solver/mld_s_base_solver_cnv.f90 mlprec/impl/solver/mld_s_diag_solver_bld.f90 mlprec/impl/solver/mld_s_diag_solver_cnv.f90 mlprec/impl/solver/mld_s_ilu_solver_bld.f90 mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 mlprec/impl/solver/mld_z_base_solver_bld.f90 mlprec/impl/solver/mld_z_base_solver_cnv.f90 mlprec/impl/solver/mld_z_diag_solver_bld.f90 mlprec/impl/solver/mld_z_diag_solver_cnv.f90 mlprec/impl/solver/mld_z_ilu_solver_bld.f90 mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_diag_solver.f90 mlprec/mld_c_id_solver.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_slu_solver.F90 mlprec/mld_c_sludist_solver.F90 mlprec/mld_c_umf_solver.F90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_diag_solver.f90 mlprec/mld_d_id_solver.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_diag_solver.f90 mlprec/mld_s_id_solver.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_slu_solver.F90 mlprec/mld_s_sludist_solver.F90 mlprec/mld_s_umf_solver.F90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90 mlprec/mld_z_diag_solver.f90 mlprec/mld_z_id_solver.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_slu_solver.F90 mlprec/mld_z_sludist_solver.F90 mlprec/mld_z_umf_solver.F90 Adjustments for IMOLD, BLD and CNV methods. --- mlprec/impl/level/Makefile | 30 +++--- mlprec/impl/level/mld_c_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/level/mld_d_base_onelev_cnv.f90 | 19 ++-- mlprec/impl/level/mld_s_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/level/mld_z_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/mld_cmlprec_bld.f90 | 7 +- mlprec/impl/mld_cprecbld.f90 | 6 +- mlprec/impl/mld_dmlprec_bld.f90 | 6 +- mlprec/impl/mld_smlprec_bld.f90 | 7 +- mlprec/impl/mld_sprecbld.f90 | 6 +- mlprec/impl/mld_zmlprec_bld.f90 | 7 +- mlprec/impl/mld_zprecbld.f90 | 6 +- mlprec/impl/smoother/Makefile | 13 ++- .../impl/smoother/mld_c_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_c_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_c_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_c_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_c_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_c_jac_smoother_cnv.f90 | 91 ++++++++++++++++ .../impl/smoother/mld_d_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_d_jac_smoother_bld.f90 | 6 +- .../impl/smoother/mld_s_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_s_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_s_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_s_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_s_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_s_jac_smoother_cnv.f90 | 91 ++++++++++++++++ .../impl/smoother/mld_z_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_z_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_z_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_z_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_z_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_z_jac_smoother_cnv.f90 | 91 ++++++++++++++++ mlprec/impl/solver/Makefile | 11 +- mlprec/impl/solver/mld_c_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_c_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_c_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_d_base_solver_bld.f90 | 6 +- mlprec/impl/solver/mld_d_diag_solver_bld.f90 | 8 +- mlprec/impl/solver/mld_d_diag_solver_cnv.f90 | 8 +- mlprec/impl/solver/mld_d_ilu_solver_bld.f90 | 8 +- mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 | 6 +- mlprec/impl/solver/mld_s_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_s_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_s_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_z_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_z_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_z_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/mld_c_as_smoother.f90 | 35 ++++-- mlprec/mld_c_base_smoother_mod.f90 | 25 ++++- mlprec/mld_c_base_solver_mod.f90 | 42 +++++--- mlprec/mld_c_diag_solver.f90 | 21 +++- mlprec/mld_c_id_solver.f90 | 9 +- mlprec/mld_c_ilu_solver.f90 | 27 ++++- mlprec/mld_c_jac_smoother.f90 | 36 +++++-- mlprec/mld_c_onelev_mod.f90 | 21 +++- mlprec/mld_c_slu_solver.F90 | 3 +- mlprec/mld_c_sludist_solver.F90 | 3 +- mlprec/mld_c_umf_solver.F90 | 3 +- mlprec/mld_d_as_smoother.f90 | 31 +++--- mlprec/mld_d_base_smoother_mod.f90 | 12 +-- mlprec/mld_d_base_solver_mod.f90 | 41 +++---- mlprec/mld_d_diag_solver.f90 | 13 ++- mlprec/mld_d_id_solver.f90 | 8 +- mlprec/mld_d_ilu_solver.f90 | 14 +-- mlprec/mld_d_jac_smoother.f90 | 26 ++--- mlprec/mld_d_onelev_mod.f90 | 8 +- mlprec/mld_s_as_smoother.f90 | 35 ++++-- mlprec/mld_s_base_smoother_mod.f90 | 25 ++++- mlprec/mld_s_base_solver_mod.f90 | 42 +++++--- mlprec/mld_s_diag_solver.f90 | 21 +++- mlprec/mld_s_id_solver.f90 | 9 +- mlprec/mld_s_ilu_solver.f90 | 27 ++++- mlprec/mld_s_jac_smoother.f90 | 36 +++++-- mlprec/mld_s_onelev_mod.f90 | 21 +++- mlprec/mld_s_slu_solver.F90 | 3 +- mlprec/mld_s_sludist_solver.F90 | 3 +- mlprec/mld_s_umf_solver.F90 | 3 +- mlprec/mld_z_as_smoother.f90 | 35 ++++-- mlprec/mld_z_base_smoother_mod.f90 | 25 ++++- mlprec/mld_z_base_solver_mod.f90 | 42 +++++--- mlprec/mld_z_diag_solver.f90 | 21 +++- mlprec/mld_z_id_solver.f90 | 9 +- mlprec/mld_z_ilu_solver.f90 | 27 ++++- mlprec/mld_z_jac_smoother.f90 | 36 +++++-- mlprec/mld_z_onelev_mod.f90 | 21 +++- mlprec/mld_z_slu_solver.F90 | 3 +- mlprec/mld_z_sludist_solver.F90 | 3 +- mlprec/mld_z_umf_solver.F90 | 3 +- 98 files changed, 2465 insertions(+), 349 deletions(-) create mode 100644 mlprec/impl/level/mld_c_base_onelev_cnv.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_cnv.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index 4964e210..d90f44aa 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -8,46 +8,49 @@ FINCLUDES=$(FMFLAG)../.. $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBINCDIR) $(FMFLAG)$(PSB OBJS=mld_c_base_onelev_check.o \ +mld_c_base_onelev_cnv.o \ +mld_c_base_onelev_csetc.o \ +mld_c_base_onelev_cseti.o \ +mld_c_base_onelev_csetr.o \ mld_c_base_onelev_descr.o \ mld_c_base_onelev_dump.o \ mld_c_base_onelev_free.o \ mld_c_base_onelev_setc.o \ mld_c_base_onelev_seti.o \ mld_c_base_onelev_setr.o \ -mld_c_base_onelev_csetc.o \ -mld_c_base_onelev_cseti.o \ -mld_c_base_onelev_csetr.o \ mld_d_base_onelev_check.o \ mld_d_base_onelev_cnv.o \ +mld_d_base_onelev_csetc.o \ +mld_d_base_onelev_cseti.o \ +mld_d_base_onelev_csetr.o \ mld_d_base_onelev_descr.o \ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ mld_d_base_onelev_setc.o \ mld_d_base_onelev_seti.o \ mld_d_base_onelev_setr.o \ -mld_d_base_onelev_csetc.o \ -mld_d_base_onelev_cseti.o \ -mld_d_base_onelev_csetr.o \ mld_s_base_onelev_check.o \ +mld_s_base_onelev_cnv.o \ +mld_s_base_onelev_csetc.o \ +mld_s_base_onelev_cseti.o \ +mld_s_base_onelev_csetr.o \ mld_s_base_onelev_descr.o \ mld_s_base_onelev_dump.o \ mld_s_base_onelev_free.o \ mld_s_base_onelev_setc.o \ mld_s_base_onelev_seti.o \ mld_s_base_onelev_setr.o \ -mld_s_base_onelev_csetc.o \ -mld_s_base_onelev_cseti.o \ -mld_s_base_onelev_csetr.o \ mld_z_base_onelev_check.o \ +mld_z_base_onelev_cnv.o \ +mld_z_base_onelev_csetc.o \ +mld_z_base_onelev_cseti.o \ +mld_z_base_onelev_csetr.o \ mld_z_base_onelev_descr.o \ mld_z_base_onelev_dump.o \ mld_z_base_onelev_free.o \ mld_z_base_onelev_setc.o \ mld_z_base_onelev_seti.o \ -mld_z_base_onelev_setr.o \ -mld_z_base_onelev_csetc.o \ -mld_z_base_onelev_cseti.o \ -mld_z_base_onelev_csetr.o +mld_z_base_onelev_setr.o LIBNAME=libmld_prec.a @@ -64,4 +67,3 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) - diff --git a/mlprec/impl/level/mld_c_base_onelev_cnv.f90 b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 new file mode 100644 index 00000000..d53268af --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_base_onelev_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_cnv + implicit none + + class(mld_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_c_base_onelev_cnv diff --git a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 index fdbef138..324ecb6b 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 @@ -51,13 +51,14 @@ subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) integer(psb_ipk_) :: i info = psb_success_ - - if (allocated(lv%sm)) & - & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) - if (info == psb_success_) & - & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) - call lv%map%cnv(info,mold=amold,imold=imold) - + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if end subroutine mld_d_base_onelev_cnv diff --git a/mlprec/impl/level/mld_s_base_onelev_cnv.f90 b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 new file mode 100644 index 00000000..efa0c3a6 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_base_onelev_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_cnv + implicit none + + class(mld_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_s_base_onelev_cnv diff --git a/mlprec/impl/level/mld_z_base_onelev_cnv.f90 b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 new file mode 100644 index 00000000..25f0f7f1 --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_base_onelev_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_cnv + implicit none + + class(mld_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_z_base_onelev_cnv diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index adcf6aae..e3eb13bc 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index 61ced362..e1207f44 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 2bd905fa..0b176021 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -489,10 +489,8 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call p%precv(i)%cnv(info,amold=amold,imold=imold) -!!$ call psb_map_cscnv(p%precv(i)%map,info,mold=amold) -!!$ call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index 205c13e5..9f3b59df 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index 5b3c5d33..b16d13c2 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index e66a4917..e54559fc 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 1cda521f..d7976e40 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index f2536eda..49429c8d 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -12,6 +12,7 @@ mld_c_as_smoother_apply_vect.o \ mld_c_as_smoother_bld.o \ mld_c_as_smoother_check.o \ mld_c_as_smoother_clone.o \ +mld_c_as_smoother_cnv.o \ mld_c_as_smoother_csetc.o \ mld_c_as_smoother_cseti.o \ mld_c_as_smoother_csetr.o \ @@ -25,6 +26,7 @@ mld_c_base_smoother_apply_vect.o \ mld_c_base_smoother_bld.o \ mld_c_base_smoother_check.o \ mld_c_base_smoother_clone.o \ +mld_c_base_smoother_cnv.o \ mld_c_base_smoother_csetc.o \ mld_c_base_smoother_cseti.o \ mld_c_base_smoother_csetr.o \ @@ -38,6 +40,7 @@ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ mld_c_jac_smoother_clone.o \ +mld_c_jac_smoother_cnv.o \ mld_d_as_smoother_apply.o \ mld_d_as_smoother_apply_vect.o \ mld_d_as_smoother_bld.o \ @@ -77,6 +80,7 @@ mld_s_as_smoother_apply_vect.o \ mld_s_as_smoother_bld.o \ mld_s_as_smoother_check.o \ mld_s_as_smoother_clone.o \ +mld_s_as_smoother_cnv.o \ mld_s_as_smoother_csetc.o \ mld_s_as_smoother_cseti.o \ mld_s_as_smoother_csetr.o \ @@ -90,6 +94,7 @@ mld_s_base_smoother_apply_vect.o \ mld_s_base_smoother_bld.o \ mld_s_base_smoother_check.o \ mld_s_base_smoother_clone.o \ +mld_s_base_smoother_cnv.o \ mld_s_base_smoother_csetc.o \ mld_s_base_smoother_cseti.o \ mld_s_base_smoother_csetr.o \ @@ -103,11 +108,13 @@ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ mld_s_jac_smoother_clone.o \ +mld_s_jac_smoother_cnv.o \ mld_z_as_smoother_apply.o \ mld_z_as_smoother_apply_vect.o \ mld_z_as_smoother_bld.o \ mld_z_as_smoother_check.o \ mld_z_as_smoother_clone.o \ +mld_z_as_smoother_cnv.o \ mld_z_as_smoother_csetc.o \ mld_z_as_smoother_cseti.o \ mld_z_as_smoother_csetr.o \ @@ -121,6 +128,7 @@ mld_z_base_smoother_apply_vect.o \ mld_z_base_smoother_bld.o \ mld_z_base_smoother_check.o \ mld_z_base_smoother_clone.o \ +mld_z_base_smoother_cnv.o \ mld_z_base_smoother_csetc.o \ mld_z_base_smoother_cseti.o \ mld_z_base_smoother_csetr.o \ @@ -133,8 +141,8 @@ mld_z_base_smoother_setr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o \ -mld_z_jac_smoother_clone.o - +mld_z_jac_smoother_clone.o \ +mld_z_jac_smoother_cnv.o LIBNAME=libmld_prec.a @@ -153,4 +161,3 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) - diff --git a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 index 2245df25..737a56d5 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 new file mode 100644 index 00000000..8ea42b1d --- /dev/null +++ b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_as_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_as_smoother_cnv diff --git a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 index c66cf9bc..ef172c2b 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='c_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 new file mode 100644 index 00000000..5669803c --- /dev/null +++ b/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_base_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_smoother_cnv diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 index 0334c10a..80383ab2 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_diag_solver @@ -45,12 +45,13 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 new file mode 100644 index 00000000..75c266e6 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_diag_solver + use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine mld_c_jac_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 index c9bd4c3b..5d872dce 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 @@ -66,7 +66,7 @@ subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),' start' - if (info == psb_success_) & + if (allocated(sm%sv)) & & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) if (info == psb_success_) then diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index d3e2d954..89c19d82 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -45,10 +45,10 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + 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 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 index 14287add..3ed6ea3a 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 new file mode 100644 index 00000000..bdec52d6 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_as_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_as_smoother_cnv diff --git a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 index c1aef016..65a55ece 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='s_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 new file mode 100644 index 00000000..779596d6 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_base_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_smoother_cnv diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 index c399dce9..7dd86148 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_diag_solver @@ -45,12 +45,13 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 new file mode 100644 index 00000000..009f901e --- /dev/null +++ b/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_diag_solver + use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine mld_s_jac_smoother_cnv diff --git a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 index 95164793..e7a26e68 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 new file mode 100644 index 00000000..f0e4c5ab --- /dev/null +++ b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_as_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_as_smoother_cnv diff --git a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 index 3722d0d6..c36adf89 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='z_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 new file mode 100644 index 00000000..65837751 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_base_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_smoother_cnv diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 index 8e9eb03f..52ae6f08 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_diag_solver @@ -45,12 +45,13 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 new file mode 100644 index 00000000..3f1a957c --- /dev/null +++ b/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_diag_solver + use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine mld_z_jac_smoother_cnv diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 31de5a20..27e6723d 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -12,6 +12,7 @@ mld_c_base_solver_apply_vect.o \ mld_c_base_solver_bld.o \ mld_c_base_solver_check.o \ mld_c_base_solver_clone.o \ +mld_c_base_solver_cnv.o \ mld_c_base_solver_csetc.o \ mld_c_base_solver_cseti.o \ mld_c_base_solver_csetr.o \ @@ -25,6 +26,7 @@ mld_c_diag_solver_apply.o \ mld_c_diag_solver_apply_vect.o \ mld_c_diag_solver_bld.o \ mld_c_diag_solver_clone.o \ +mld_c_diag_solver_cnv.o \ mld_c_id_solver_apply.o \ mld_c_id_solver_apply_vect.o \ mld_c_id_solver_clone.o \ @@ -32,6 +34,7 @@ mld_c_ilu_solver_apply.o \ mld_c_ilu_solver_apply_vect.o \ mld_c_ilu_solver_bld.o \ mld_c_ilu_solver_clone.o \ +mld_c_ilu_solver_cnv.o \ mld_c_ilu_solver_dmp.o \ mld_d_base_solver_apply.o \ mld_d_base_solver_apply_vect.o \ @@ -67,6 +70,7 @@ mld_s_base_solver_apply_vect.o \ mld_s_base_solver_bld.o \ mld_s_base_solver_check.o \ mld_s_base_solver_clone.o \ +mld_s_base_solver_cnv.o \ mld_s_base_solver_csetc.o \ mld_s_base_solver_cseti.o \ mld_s_base_solver_csetr.o \ @@ -80,6 +84,7 @@ mld_s_diag_solver_apply.o \ mld_s_diag_solver_apply_vect.o \ mld_s_diag_solver_bld.o \ mld_s_diag_solver_clone.o \ +mld_s_diag_solver_cnv.o \ mld_s_id_solver_apply.o \ mld_s_id_solver_apply_vect.o \ mld_s_id_solver_clone.o \ @@ -87,12 +92,14 @@ mld_s_ilu_solver_apply.o \ mld_s_ilu_solver_apply_vect.o \ mld_s_ilu_solver_bld.o \ mld_s_ilu_solver_clone.o \ +mld_s_ilu_solver_cnv.o \ mld_s_ilu_solver_dmp.o \ mld_z_base_solver_apply.o \ mld_z_base_solver_apply_vect.o \ mld_z_base_solver_bld.o \ mld_z_base_solver_check.o \ mld_z_base_solver_clone.o \ +mld_z_base_solver_cnv.o \ mld_z_base_solver_csetc.o \ mld_z_base_solver_cseti.o \ mld_z_base_solver_csetr.o \ @@ -106,6 +113,7 @@ mld_z_diag_solver_apply.o \ mld_z_diag_solver_apply_vect.o \ mld_z_diag_solver_bld.o \ mld_z_diag_solver_clone.o \ +mld_z_diag_solver_cnv.o \ mld_z_id_solver_apply.o \ mld_z_id_solver_apply_vect.o \ mld_z_id_solver_clone.o \ @@ -113,7 +121,8 @@ mld_z_ilu_solver_apply.o \ mld_z_ilu_solver_apply_vect.o \ mld_z_ilu_solver_bld.o \ mld_z_ilu_solver_clone.o \ -mld_z_ilu_solver_dmp.o +mld_z_ilu_solver_cnv.o \ +mld_z_ilu_solver_dmp.o LIBNAME=libmld_prec.a diff --git a/mlprec/impl/solver/mld_c_base_solver_bld.f90 b/mlprec/impl/solver/mld_c_base_solver_bld.f90 index 101c0f83..ea09f2c1 100644 --- a/mlprec/impl/solver/mld_c_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_bld Implicit None ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_c_base_solver_cnv.f90 b/mlprec/impl/solver/mld_c_base_solver_cnv.f90 new file mode 100644 index 00000000..3f61bc80 --- /dev/null +++ b/mlprec/impl/solver/mld_c_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_base_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_cnv + Implicit None + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_solver_cnv diff --git a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 index 81297e46..0ad16a00 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_c_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_c_diag_solver_cnv.f90 new file mode 100644 index 00000000..22f973e2 --- /dev/null +++ b/mlprec/impl/solver/mld_c_diag_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_c_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + + 9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine mld_c_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 index e4ce481e..70db6e43 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 new file mode 100644 index 00000000..a4e60463 --- /dev/null +++ b/mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_c_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_c_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_ilu_solver_cnv diff --git a/mlprec/impl/solver/mld_d_base_solver_bld.f90 b/mlprec/impl/solver/mld_d_base_solver_bld.f90 index 27433aea..d90c0417 100644 --- a/mlprec/impl/solver/mld_d_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_bld.f90 @@ -43,10 +43,10 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold diff --git a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 index 2a84af95..cf7ef28c 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 @@ -45,14 +45,14 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 index 7b844756..9d7cea47 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 @@ -50,9 +50,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables - integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota - real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: err_act, debug_unit, debug_level character(len=20) :: name='d_diag_solver_cnv', ch_err info=psb_success_ @@ -60,7 +58,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' start' + & write(debug_unit,*) trim(name),' start' if (allocated(sv%dv)) then @@ -68,7 +66,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) end if if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' end' + & write(debug_unit,*) trim(name),' end' call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 index 44eb017d..62340845 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 @@ -45,14 +45,14 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 index 1cb3166c..531bbe2b 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 @@ -50,9 +50,7 @@ subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables - integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota -!!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: err_act, debug_unit, debug_level character(len=20) :: name='d_ilu_solver_cnv', ch_err info=psb_success_ @@ -68,7 +66,7 @@ subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) end if if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' end' + & write(debug_unit,*) trim(name),' end' call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/solver/mld_s_base_solver_bld.f90 b/mlprec/impl/solver/mld_s_base_solver_bld.f90 index 3742352f..f211daf9 100644 --- a/mlprec/impl/solver/mld_s_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_bld Implicit None ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_s_base_solver_cnv.f90 b/mlprec/impl/solver/mld_s_base_solver_cnv.f90 new file mode 100644 index 00000000..bb24ea08 --- /dev/null +++ b/mlprec/impl/solver/mld_s_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_base_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_cnv + Implicit None + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_solver_cnv diff --git a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 index 9b9db3a9..b3ab0c4d 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_s_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_s_diag_solver_cnv.f90 new file mode 100644 index 00000000..fbcae73f --- /dev/null +++ b/mlprec/impl/solver/mld_s_diag_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_s_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + + 9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine mld_s_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 index 42147c72..23788d67 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 new file mode 100644 index 00000000..f6f0f6c6 --- /dev/null +++ b/mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_s_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_s_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_ilu_solver_cnv diff --git a/mlprec/impl/solver/mld_z_base_solver_bld.f90 b/mlprec/impl/solver/mld_z_base_solver_bld.f90 index 65a593c4..eb38916e 100644 --- a/mlprec/impl/solver/mld_z_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_bld Implicit None ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_z_base_solver_cnv.f90 b/mlprec/impl/solver/mld_z_base_solver_cnv.f90 new file mode 100644 index 00000000..01c15785 --- /dev/null +++ b/mlprec/impl/solver/mld_z_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_base_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_cnv + Implicit None + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_solver_cnv diff --git a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 index 1aabba32..70099cf9 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_z_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_z_diag_solver_cnv.f90 new file mode 100644 index 00000000..090dfee3 --- /dev/null +++ b/mlprec/impl/solver/mld_z_diag_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_z_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + + 9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine mld_z_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 index 645d6a54..5194d27e 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 new file mode 100644 index 00000000..8a351f43 --- /dev/null +++ b/mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012,2013 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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 MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mld_z_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_z_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_ilu_solver_cnv diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 5428359d..00d2dfad 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_c_as_smoother procedure, pass(sm) :: check => mld_c_as_smoother_check procedure, pass(sm) :: dump => mld_c_as_smoother_dmp procedure, pass(sm) :: build => mld_c_as_smoother_bld + procedure, pass(sm) :: cnv => mld_c_as_smoother_cnv procedure, pass(sm) :: clone => mld_c_as_smoother_clone procedure, pass(sm) :: apply_v => mld_c_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_as_smoother_apply @@ -95,9 +96,11 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_c_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_c_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, & - & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_c_as_smoother_type), intent(inout) :: sm + class(mld_c_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_as_smoother_bld end interface + interface + subroutine mld_c_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_c_base_vect_type, & + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, & + & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_c_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_as_smoother_cnv + end interface + interface subroutine mld_c_as_smoother_seti(sm,what,val,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index ed154f17..ec6f5958 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_c_base_smoother_mod use mld_c_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_long_int_k_,& - & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, psb_spk_ + & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, & + & psb_spk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_c_base_smoother_mod procedure, pass(sm) :: dump => mld_c_base_smoother_dmp procedure, pass(sm) :: clone => mld_c_base_smoother_clone procedure, pass(sm) :: build => mld_c_base_smoother_bld + procedure, pass(sm) :: cnv => mld_c_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_c_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_c_base_smoother_mod interface - subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_smoother_type, psb_ipk_ @@ -244,10 +247,10 @@ module mld_c_base_smoother_mod end interface interface - subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ + & mld_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_c_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_base_smoother_bld end interface + interface + subroutine mld_c_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_smoother_cnv + end interface + interface subroutine mld_c_base_smoother_free(sm,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 5762113c..e8722500 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_c_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_cspmat_type, & - & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat + & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_c_base_solver_mod procedure, pass(sv) :: dump => mld_c_base_solver_dmp procedure, pass(sv) :: clone => mld_c_base_solver_clone procedure, pass(sv) :: build => mld_c_base_solver_bld + procedure, pass(sv) :: cnv => mld_c_base_solver_cnv procedure, pass(sv) :: apply_v => mld_c_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_c_base_solver_mod end interface interface - subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ + & mld_c_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_cspmat_type), intent(in), target :: a + type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_cspmat_type), intent(in), target, optional :: b - class(psb_c_base_sparse_mat), intent(in), optional :: amold - class(psb_c_base_vect_type), intent(in), optional :: vmold + type(psb_cspmat_type), intent(in), target, optional :: b + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_base_solver_bld end interface + interface + subroutine mld_c_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_solver_cnv + end interface + interface subroutine mld_c_base_solver_check(sv,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_c_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_c_base_solver_mod & mld_c_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90 index f0e551b1..47205ccb 100644 --- a/mlprec/mld_c_diag_solver.f90 +++ b/mlprec/mld_c_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_c_diag_solver complex(psb_spk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_c_diag_solver_bld + procedure, pass(sv) :: cnv => mld_c_diag_solver_cnv procedure, pass(sv) :: clone => mld_c_diag_solver_clone procedure, pass(sv) :: apply_v => mld_c_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_diag_solver_apply @@ -69,7 +70,8 @@ module mld_c_diag_solver interface - subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_c_diag_solver end interface interface - subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_diag_solver_type, psb_ipk_ + & mld_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_c_diag_solver type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_diag_solver_bld end interface + + interface + subroutine mld_c_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_c_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_diag_solver_cnv + end interface interface subroutine mld_c_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_c_id_solver.f90 b/mlprec/mld_c_id_solver.f90 index 8b3e1fd0..a2562fa0 100644 --- a/mlprec/mld_c_id_solver.f90 +++ b/mlprec/mld_c_id_solver.f90 @@ -112,19 +112,20 @@ module mld_c_id_solver contains - subroutine c_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index f3cc98c4..271c3d67 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_c_ilu_solver procedure, pass(sv) :: dump => mld_c_ilu_solver_dmp procedure, pass(sv) :: clone => mld_c_ilu_solver_clone procedure, pass(sv) :: build => mld_c_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_c_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_c_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_ilu_solver_apply procedure, pass(sv) :: free => c_ilu_solver_free @@ -126,20 +127,36 @@ module mld_c_ilu_solver end interface interface - subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, & - & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ + & 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(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_ilu_solver_bld end interface + + interface + subroutine mld_c_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_c_ilu_solver_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_c_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_ilu_solver_cnv + end interface interface subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index f3e3be73..c8ad338c 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_c_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_c_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_c_jac_smoother_cnv procedure, pass(sm) :: clone => mld_c_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_c_jac_smoother interface - subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_c_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_c_jac_smoother end interface interface - subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_c_jac_smoother_type), intent(inout) :: sm complex(psb_spk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_c_jac_smoother end interface interface - subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_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_ - type(psb_cspmat_type), intent(in), target :: a + & 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(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_c_jac_smoother_type), intent(inout) :: sm + class(mld_c_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_jac_smoother_bld end interface + interface + subroutine mld_c_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_c_jac_smoother_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_c_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_jac_smoother_cnv + end interface + interface subroutine mld_c_jac_smoother_clone(sm,smout,info) import :: mld_c_jac_smoother_type, psb_spk_, & diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index ff05b488..02f9206e 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_c_onelev_mod use mld_base_prec_type use mld_c_base_smoother_mod - use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, & + & psb_c_base_vect_type, psb_clinmap_type, psb_spk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_c_onelev_mod type(psb_clinmap_type) :: map contains procedure, pass(lv) :: clone => c_base_onelev_clone + procedure, pass(lv) :: cnv => mld_c_base_onelev_cnv procedure, pass(lv) :: descr => mld_c_base_onelev_descr procedure, pass(lv) :: default => c_base_onelev_default procedure, pass(lv) :: free => mld_c_base_onelev_free @@ -170,7 +172,20 @@ module mld_c_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_c_base_onelev_descr end interface - + + interface + subroutine mld_c_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_c_onelev_type, psb_c_base_vect_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_onelev_cnv + end interface + interface subroutine mld_c_base_onelev_free(lv,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_slu_solver.F90 b/mlprec/mld_c_slu_solver.F90 index 80c8b53b..91826127 100644 --- a/mlprec/mld_c_slu_solver.F90 +++ b/mlprec/mld_c_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine c_slu_solver_apply_vect - subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_c_sludist_solver.F90 b/mlprec/mld_c_sludist_solver.F90 index fac53f56..03d75921 100644 --- a/mlprec/mld_c_sludist_solver.F90 +++ b/mlprec/mld_c_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine c_sludist_solver_apply_vect - subroutine c_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_c_umf_solver.F90 b/mlprec/mld_c_umf_solver.F90 index 15a3a1b8..065be919 100644 --- a/mlprec/mld_c_umf_solver.F90 +++ b/mlprec/mld_c_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine c_umf_solver_apply_vect - subroutine c_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csc_sparse_mat) :: acsc diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 1bc2fce9..e2c03c84 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -97,9 +97,10 @@ module mld_d_as_smoother interface subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + & trans,sweeps,work,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_d_as_smoother_type), intent(inout) :: sm @@ -114,9 +115,11 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_d_as_smoother_type), intent(inout) :: sm @@ -139,7 +142,7 @@ module mld_d_as_smoother implicit none type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_d_as_smoother_type), intent(inout) :: sm + class(mld_d_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold @@ -147,21 +150,21 @@ module mld_d_as_smoother class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_as_smoother_bld end interface - - interface + + interface subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_as_smoother_type, psb_ipk_, psb_i_base_vect_type - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(out) :: info + import :: psb_d_base_vect_type, & + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, & + & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_d_as_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 mld_d_as_smoother_cnv end interface - + interface subroutine mld_d_as_smoother_seti(sm,what,val,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index c3482ba6..b531aacf 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -55,8 +55,8 @@ module mld_d_base_smoother_mod use mld_d_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_long_int_k_,& - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, psb_dpk_,& - & psb_i_base_vect_type + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, & + & psb_dpk_, psb_i_base_vect_type ! ! @@ -124,7 +124,7 @@ module mld_d_base_smoother_mod interface - subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& & trans,sweeps,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & @@ -247,8 +247,7 @@ module mld_d_base_smoother_mod end interface interface - subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,& - & amold,vmold,imold) + subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type @@ -266,8 +265,7 @@ module mld_d_base_smoother_mod interface subroutine mld_d_base_smoother_cnv(sm,info,amold,vmold,imold) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments class(mld_d_base_smoother_type), intent(inout) :: sm diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index a394e5a8..d69a8df5 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -55,7 +55,7 @@ module mld_d_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_dspmat_type, & - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat,& + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, & & psb_i_base_vect_type ! ! @@ -156,15 +156,15 @@ module mld_d_base_solver_mod Implicit None ! Arguments - type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a - class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info - type(psb_dspmat_type), intent(in), target, optional :: b - 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 + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(mld_d_base_solver_type), intent(inout) :: sv + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type), intent(in), target, optional :: b + 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 mld_d_base_solver_bld end interface @@ -172,13 +172,14 @@ module mld_d_base_solver_mod subroutine mld_d_base_solver_cnv(sv,info,amold,vmold,imold) import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_, psb_i_base_vect_type - Implicit None + Implicit None + ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - 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 + class(mld_d_base_solver_type), intent(inout) :: sv + 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 mld_d_base_solver_cnv end interface @@ -190,7 +191,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_d_base_solver_check end interface @@ -203,7 +204,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -218,7 +219,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -232,7 +233,7 @@ module mld_d_base_solver_mod & mld_d_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 48a76ed7..19aa31f7 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -70,7 +70,7 @@ module mld_d_diag_solver interface - subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& & trans,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & @@ -108,10 +108,10 @@ module mld_d_diag_solver & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold @@ -121,11 +121,10 @@ module mld_d_diag_solver interface subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) - import :: psb_desc_type, psb_d_base_sparse_mat, & - & psb_d_base_vect_type, psb_dpk_, & + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type class(mld_d_diag_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(out) :: info + 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 diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90 index 2f896e8f..20ff7b28 100644 --- a/mlprec/mld_d_id_solver.f90 +++ b/mlprec/mld_d_id_solver.f90 @@ -118,14 +118,14 @@ contains ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 19267f92..65769912 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -133,28 +133,28 @@ module mld_d_ilu_solver & psb_ipk_, psb_i_base_vect_type implicit none type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b 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 + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_ilu_solver_bld end interface interface subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) - import :: psb_desc_type, mld_d_ilu_solver_type, psb_dpk_, & + import :: mld_d_ilu_solver_type, psb_dpk_, & & psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_ipk_, psb_i_base_vect_type implicit none class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(out) :: info + 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 + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_ilu_solver_cnv end interface diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index bcf40c9f..3f52618b 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -55,8 +55,8 @@ module mld_d_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_d_jac_smoother_bld - procedure, pass(sm) :: clone => mld_d_jac_smoother_clone procedure, pass(sm) :: cnv => mld_d_jac_smoother_cnv + procedure, pass(sm) :: clone => mld_d_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_jac_smoother_apply procedure, pass(sm) :: free => d_jac_smoother_free @@ -73,10 +73,11 @@ module mld_d_jac_smoother interface - subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_d_jac_smoother_type), intent(inout) :: sm @@ -91,10 +92,11 @@ module mld_d_jac_smoother end interface interface - subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_d_jac_smoother_type), intent(inout) :: sm real(psb_dpk_),intent(inout) :: x(:) @@ -112,9 +114,9 @@ module mld_d_jac_smoother import :: psb_desc_type, mld_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(in), target :: a + type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_d_jac_smoother_type), intent(inout) :: sm + class(mld_d_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold @@ -125,10 +127,10 @@ module mld_d_jac_smoother interface subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold) - import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & - & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& + import :: mld_d_jac_smoother_type, psb_dpk_, & + & psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_ipk_, psb_i_base_vect_type - class(mld_d_jac_smoother_type), intent(inout) :: sm + class(mld_d_jac_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 diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index cf045f46..9e5cc0c1 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -56,9 +56,9 @@ module mld_d_onelev_mod use mld_base_prec_type use mld_d_base_smoother_mod - use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_,& - & psb_desc_type, psb_i_base_vect_type + use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, & + & psb_d_base_vect_type, psb_dlinmap_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -185,7 +185,7 @@ module mld_d_onelev_mod class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_base_onelev_cnv end interface - + interface subroutine mld_d_base_onelev_free(lv,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index 287c1bec..fd49a067 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_s_as_smoother procedure, pass(sm) :: check => mld_s_as_smoother_check procedure, pass(sm) :: dump => mld_s_as_smoother_dmp procedure, pass(sm) :: build => mld_s_as_smoother_bld + procedure, pass(sm) :: cnv => mld_s_as_smoother_cnv procedure, pass(sm) :: clone => mld_s_as_smoother_clone procedure, pass(sm) :: apply_v => mld_s_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_as_smoother_apply @@ -95,9 +96,11 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_s_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_s_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, & - & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_s_as_smoother_type), intent(inout) :: sm + class(mld_s_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_as_smoother_bld end interface + interface + subroutine mld_s_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_s_base_vect_type, & + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, & + & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_s_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_as_smoother_cnv + end interface + interface subroutine mld_s_as_smoother_seti(sm,what,val,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 688b7004..d5db07a3 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_s_base_smoother_mod use mld_s_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_long_int_k_,& - & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, psb_spk_ + & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, & + & psb_spk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_s_base_smoother_mod procedure, pass(sm) :: dump => mld_s_base_smoother_dmp procedure, pass(sm) :: clone => mld_s_base_smoother_clone procedure, pass(sm) :: build => mld_s_base_smoother_bld + procedure, pass(sm) :: cnv => mld_s_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_s_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_s_base_smoother_mod interface - subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_smoother_type, psb_ipk_ @@ -244,10 +247,10 @@ module mld_s_base_smoother_mod end interface interface - subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ + & mld_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_s_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_base_smoother_bld end interface + interface + subroutine mld_s_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_smoother_cnv + end interface + interface subroutine mld_s_base_smoother_free(sm,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index a2226e53..82b966f6 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_s_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_sspmat_type, & - & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat + & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_s_base_solver_mod procedure, pass(sv) :: dump => mld_s_base_solver_dmp procedure, pass(sv) :: clone => mld_s_base_solver_clone procedure, pass(sv) :: build => mld_s_base_solver_bld + procedure, pass(sv) :: cnv => mld_s_base_solver_cnv procedure, pass(sv) :: apply_v => mld_s_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_s_base_solver_mod end interface interface - subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ + & mld_s_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_sspmat_type), intent(in), target :: a + type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_sspmat_type), intent(in), target, optional :: b - class(psb_s_base_sparse_mat), intent(in), optional :: amold - class(psb_s_base_vect_type), intent(in), optional :: vmold + type(psb_sspmat_type), intent(in), target, optional :: b + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_base_solver_bld end interface + interface + subroutine mld_s_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_solver_cnv + end interface + interface subroutine mld_s_base_solver_check(sv,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_s_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_s_base_solver_mod & mld_s_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_s_diag_solver.f90 b/mlprec/mld_s_diag_solver.f90 index 8f7d239b..5dc6ac70 100644 --- a/mlprec/mld_s_diag_solver.f90 +++ b/mlprec/mld_s_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_s_diag_solver real(psb_spk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_s_diag_solver_bld + procedure, pass(sv) :: cnv => mld_s_diag_solver_cnv procedure, pass(sv) :: clone => mld_s_diag_solver_clone procedure, pass(sv) :: apply_v => mld_s_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_diag_solver_apply @@ -69,7 +70,8 @@ module mld_s_diag_solver interface - subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_s_diag_solver end interface interface - subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_diag_solver_type, psb_ipk_ + & mld_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_s_diag_solver type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_diag_solver_bld end interface + + interface + subroutine mld_s_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_s_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_diag_solver_cnv + end interface interface subroutine mld_s_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_s_id_solver.f90 b/mlprec/mld_s_id_solver.f90 index 72bed12c..79543bae 100644 --- a/mlprec/mld_s_id_solver.f90 +++ b/mlprec/mld_s_id_solver.f90 @@ -112,19 +112,20 @@ module mld_s_id_solver contains - subroutine s_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index bd096437..84e1090b 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_s_ilu_solver procedure, pass(sv) :: dump => mld_s_ilu_solver_dmp procedure, pass(sv) :: clone => mld_s_ilu_solver_clone procedure, pass(sv) :: build => mld_s_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_s_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_s_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_ilu_solver_apply procedure, pass(sv) :: free => s_ilu_solver_free @@ -126,20 +127,36 @@ module mld_s_ilu_solver end interface interface - subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, & - & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ + & 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(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_ilu_solver_bld end interface + + interface + subroutine mld_s_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_s_ilu_solver_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_s_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_ilu_solver_cnv + end interface interface subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index f404d1f0..8f463c9c 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_s_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_s_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_s_jac_smoother_cnv procedure, pass(sm) :: clone => mld_s_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_s_jac_smoother interface - subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_s_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_s_jac_smoother end interface interface - subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_s_jac_smoother_type), intent(inout) :: sm real(psb_spk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_s_jac_smoother end interface interface - subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_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_ - type(psb_sspmat_type), intent(in), target :: a + & 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(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_s_jac_smoother_type), intent(inout) :: sm + class(mld_s_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_jac_smoother_bld end interface + interface + subroutine mld_s_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_s_jac_smoother_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_s_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_jac_smoother_cnv + end interface + interface subroutine mld_s_jac_smoother_clone(sm,smout,info) import :: mld_s_jac_smoother_type, psb_spk_, & diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index d5f06e37..17b835e5 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_s_onelev_mod use mld_base_prec_type use mld_s_base_smoother_mod - use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, & + & psb_s_base_vect_type, psb_slinmap_type, psb_spk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_s_onelev_mod type(psb_slinmap_type) :: map contains procedure, pass(lv) :: clone => s_base_onelev_clone + procedure, pass(lv) :: cnv => mld_s_base_onelev_cnv procedure, pass(lv) :: descr => mld_s_base_onelev_descr procedure, pass(lv) :: default => s_base_onelev_default procedure, pass(lv) :: free => mld_s_base_onelev_free @@ -170,7 +172,20 @@ module mld_s_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_s_base_onelev_descr end interface - + + interface + subroutine mld_s_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_s_onelev_type, psb_s_base_vect_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_onelev_cnv + end interface + interface subroutine mld_s_base_onelev_free(lv,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_slu_solver.F90 b/mlprec/mld_s_slu_solver.F90 index 21f7457a..be116171 100644 --- a/mlprec/mld_s_slu_solver.F90 +++ b/mlprec/mld_s_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine s_slu_solver_apply_vect - subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_s_sludist_solver.F90 b/mlprec/mld_s_sludist_solver.F90 index 5808c716..3c6441ea 100644 --- a/mlprec/mld_s_sludist_solver.F90 +++ b/mlprec/mld_s_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine s_sludist_solver_apply_vect - subroutine s_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_s_umf_solver.F90 b/mlprec/mld_s_umf_solver.F90 index 1cf3a41c..7d860fd1 100644 --- a/mlprec/mld_s_umf_solver.F90 +++ b/mlprec/mld_s_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine s_umf_solver_apply_vect - subroutine s_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csc_sparse_mat) :: acsc diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index d6c969e8..001a9a57 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_z_as_smoother procedure, pass(sm) :: check => mld_z_as_smoother_check procedure, pass(sm) :: dump => mld_z_as_smoother_dmp procedure, pass(sm) :: build => mld_z_as_smoother_bld + procedure, pass(sm) :: cnv => mld_z_as_smoother_cnv procedure, pass(sm) :: clone => mld_z_as_smoother_clone procedure, pass(sm) :: apply_v => mld_z_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_as_smoother_apply @@ -95,9 +96,11 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_z_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_z_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, & - & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_z_as_smoother_type), intent(inout) :: sm + class(mld_z_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_as_smoother_bld end interface + interface + subroutine mld_z_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_z_base_vect_type, & + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, & + & psb_z_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_z_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_as_smoother_cnv + end interface + interface subroutine mld_z_as_smoother_seti(sm,what,val,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index b6956c22..554f002c 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_z_base_smoother_mod use mld_z_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_long_int_k_,& - & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, psb_dpk_ + & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, & + & psb_dpk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_z_base_smoother_mod procedure, pass(sm) :: dump => mld_z_base_smoother_dmp procedure, pass(sm) :: clone => mld_z_base_smoother_clone procedure, pass(sm) :: build => mld_z_base_smoother_bld + procedure, pass(sm) :: cnv => mld_z_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_z_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_z_base_smoother_mod interface - subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_smoother_type, psb_ipk_ @@ -244,10 +247,10 @@ module mld_z_base_smoother_mod end interface interface - subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ + & mld_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_z_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_base_smoother_bld end interface + interface + subroutine mld_z_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_smoother_cnv + end interface + interface subroutine mld_z_base_smoother_free(sm,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index e4841d0a..d8b362bb 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_z_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_zspmat_type, & - & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat + & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_z_base_solver_mod procedure, pass(sv) :: dump => mld_z_base_solver_dmp procedure, pass(sv) :: clone => mld_z_base_solver_clone procedure, pass(sv) :: build => mld_z_base_solver_bld + procedure, pass(sv) :: cnv => mld_z_base_solver_cnv procedure, pass(sv) :: apply_v => mld_z_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_z_base_solver_mod end interface interface - subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ + & mld_z_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_zspmat_type), intent(in), target :: a + type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_zspmat_type), intent(in), target, optional :: b - class(psb_z_base_sparse_mat), intent(in), optional :: amold - class(psb_z_base_vect_type), intent(in), optional :: vmold + type(psb_zspmat_type), intent(in), target, optional :: b + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_base_solver_bld end interface + interface + subroutine mld_z_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_solver_cnv + end interface + interface subroutine mld_z_base_solver_check(sv,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_z_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_z_base_solver_mod & mld_z_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info diff --git a/mlprec/mld_z_diag_solver.f90 b/mlprec/mld_z_diag_solver.f90 index 982b2545..413e1287 100644 --- a/mlprec/mld_z_diag_solver.f90 +++ b/mlprec/mld_z_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_z_diag_solver complex(psb_dpk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_z_diag_solver_bld + procedure, pass(sv) :: cnv => mld_z_diag_solver_cnv procedure, pass(sv) :: clone => mld_z_diag_solver_clone procedure, pass(sv) :: apply_v => mld_z_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_diag_solver_apply @@ -69,7 +70,8 @@ module mld_z_diag_solver interface - subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_z_diag_solver end interface interface - subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_diag_solver_type, psb_ipk_ + & mld_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_z_diag_solver type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_diag_solver_bld end interface + + interface + subroutine mld_z_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_z_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_diag_solver_cnv + end interface interface subroutine mld_z_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_z_id_solver.f90 b/mlprec/mld_z_id_solver.f90 index fc0d45c5..4d03a38d 100644 --- a/mlprec/mld_z_id_solver.f90 +++ b/mlprec/mld_z_id_solver.f90 @@ -112,19 +112,20 @@ module mld_z_id_solver contains - subroutine z_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 1a41baf4..e03bef96 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_z_ilu_solver procedure, pass(sv) :: dump => mld_z_ilu_solver_dmp procedure, pass(sv) :: clone => mld_z_ilu_solver_clone procedure, pass(sv) :: build => mld_z_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_z_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_z_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_ilu_solver_apply procedure, pass(sv) :: free => z_ilu_solver_free @@ -126,20 +127,36 @@ module mld_z_ilu_solver end interface interface - subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, & - & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ + & 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(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_ilu_solver_bld end interface + + interface + subroutine mld_z_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_z_ilu_solver_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_z_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_ilu_solver_cnv + end interface interface subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index e0115f4d..14dd97ae 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_z_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_z_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_z_jac_smoother_cnv procedure, pass(sm) :: clone => mld_z_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_z_jac_smoother interface - subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_z_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_z_jac_smoother end interface interface - subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_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_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_z_jac_smoother_type), intent(inout) :: sm complex(psb_dpk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_z_jac_smoother end interface interface - subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_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_ - type(psb_zspmat_type), intent(in), target :: a + & 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(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_z_jac_smoother_type), intent(inout) :: sm + class(mld_z_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_jac_smoother_bld end interface + interface + subroutine mld_z_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_z_jac_smoother_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_z_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_jac_smoother_cnv + end interface + interface subroutine mld_z_jac_smoother_clone(sm,smout,info) import :: mld_z_jac_smoother_type, psb_dpk_, & diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index d8987fcf..638cbd5e 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_z_onelev_mod use mld_base_prec_type use mld_z_base_smoother_mod - use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, & + & psb_z_base_vect_type, psb_zlinmap_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_z_onelev_mod type(psb_zlinmap_type) :: map contains procedure, pass(lv) :: clone => z_base_onelev_clone + procedure, pass(lv) :: cnv => mld_z_base_onelev_cnv procedure, pass(lv) :: descr => mld_z_base_onelev_descr procedure, pass(lv) :: default => z_base_onelev_default procedure, pass(lv) :: free => mld_z_base_onelev_free @@ -170,7 +172,20 @@ module mld_z_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_z_base_onelev_descr end interface - + + interface + subroutine mld_z_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_z_onelev_type, psb_z_base_vect_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_onelev_cnv + end interface + interface subroutine mld_z_base_onelev_free(lv,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_slu_solver.F90 b/mlprec/mld_z_slu_solver.F90 index 95f834ee..f4f5ea84 100644 --- a/mlprec/mld_z_slu_solver.F90 +++ b/mlprec/mld_z_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine z_slu_solver_apply_vect - subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_z_sludist_solver.F90 b/mlprec/mld_z_sludist_solver.F90 index e5c2c0c5..462dc32e 100644 --- a/mlprec/mld_z_sludist_solver.F90 +++ b/mlprec/mld_z_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine z_sludist_solver_apply_vect - subroutine z_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_z_umf_solver.F90 b/mlprec/mld_z_umf_solver.F90 index d9352cf4..f2ac8aaa 100644 --- a/mlprec/mld_z_umf_solver.F90 +++ b/mlprec/mld_z_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine z_umf_solver_apply_vect - subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csc_sparse_mat) :: acsc From 4ce70dde600e26e55965e8b9aa99d65b69dfba38 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 3 Sep 2013 17:20:32 +0000 Subject: [PATCH 08/10] mld2p4-299 mlprec/impl/mld_cmlprec_aply.f90 mlprec/impl/mld_dmlprec_aply.f90 mlprec/impl/mld_smlprec_aply.f90 mlprec/impl/mld_zmlprec_aply.f90 More detailed error handling inside MLPRECAPLY. --- mlprec/impl/mld_cmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_dmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_smlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- mlprec/impl/mld_zmlprec_aply.f90 | 255 ++++++++++++++++++++++++++----- 4 files changed, 876 insertions(+), 144 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 8d9efc9d..9d4a8bce 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%ty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & cone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & czero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & czero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(cone,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) call psb_spmm(-cone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,& & cone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & cone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 2af6eb64..25d9fa94 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%ty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & done,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & dzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(done,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,& & done,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & done,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 4351316d..1be38732 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%ty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & sone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & szero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & szero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(sone,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) call psb_spmm(-sone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,& & sone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & sone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index a674656d..1930e8e1 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -488,7 +488,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) @@ -565,13 +569,22 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps @@ -579,7 +592,12 @@ contains & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -615,8 +633,12 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! @@ -624,7 +646,12 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -687,7 +714,11 @@ contains & p%precv(level)%base_desc, trans,& & sweeps,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) @@ -764,19 +795,35 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case default @@ -827,6 +874,11 @@ contains & mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -836,6 +888,11 @@ contains if (info == psb_success_) call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%ty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info /= psb_success_) then @@ -864,6 +921,11 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,& & zone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -878,10 +940,10 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if - + endif case default @@ -1109,19 +1171,32 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - - if (info /= psb_success_) goto 9999 if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1156,35 +1231,60 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_post call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + end if case('T','C') @@ -1219,8 +1319,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1229,14 +1333,28 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if end if @@ -1279,8 +1397,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if - if (info /= psb_success_) goto 9999 ! ! Compute the residual (at all levels but the coarsest one) @@ -1289,14 +1411,29 @@ contains call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + end if @@ -1322,33 +1459,58 @@ contains if (level < nlev) then call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator ! call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zzero,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + ! ! Compute the residual ! call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,& & work=work,trans=trans) - if (info /= psb_success_) goto 9999 + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if + sweeps = p%precv(level)%parms%sweeps_pre call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if else sweeps = p%precv(level)%parms%sweeps call p%precv(level)%sm%apply(zone,& & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if end if case default @@ -1391,6 +1553,12 @@ contains & mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc, trans,& & sweeps,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during smoother_apply') + goto 9999 + end if + ! ! Compute the residual (at all levels but the coarsest one) ! and call recursively @@ -1404,9 +1572,19 @@ contains if (info == psb_success_) call psb_spmm(-zone,p%precv(level)%base_a,& & mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vty,& & p%precv(level)%base_desc,info,work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) - + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + ! ! Apply the prolongator @@ -1414,19 +1592,24 @@ contains call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,& & zone,mlprec_wrk(level)%vy2l,& & p%precv(level+1)%map,info,work=work) - - if (info /= psb_success_ ) then + + if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') + & a_err='Error during prolongation') goto 9999 end if - + ! ! Compute the residual ! call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,& & zone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,& & work=work,trans=trans) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during residue') + goto 9999 + end if ! ! Apply the base preconditioner ! @@ -1441,7 +1624,7 @@ contains & sweeps,work,info) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error: residual/baseprec_aply') + & a_err='Error during smoother_apply') goto 9999 end if From 220b2b28e205f0fb1975a8659ff84110dc3f3d96 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 5 Sep 2013 09:06:14 +0000 Subject: [PATCH 09/10] mld2p4-299 mlprec/impl/mld_dmlprec_aply.f90 mlprec/impl/mld_dprecbld.f90 Error check fixes. To be done properly across the board. --- mlprec/impl/mld_dmlprec_aply.f90 | 20 ++++++++++---------- mlprec/impl/mld_dprecbld.f90 | 4 ++-- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 25d9fa94..cad84da9 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -1031,19 +1031,19 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) call psb_geasb(mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,& & scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vy2l,& + if (info == 0) call psb_geasb(mlprec_wrk(level)%vy2l,& & p%precv(level)%base_desc,info,& & scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vtx,& + if (info == 0) call psb_geasb(mlprec_wrk(level)%vtx,& & p%precv(level)%base_desc,info,& & scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vty,& + if (info == 0) call psb_geasb(mlprec_wrk(level)%vty,& & p%precv(level)%base_desc,info,& & scratch=.true.,mold=x%v) - if (psb_errstatus_fatal()) then + if ((info/=0).or.psb_errstatus_fatal()) then nc2l = p%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& + call psb_errpush(info,name,i_err=(/4*nc2l,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -1065,11 +1065,11 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,& & p%precv(level)%base_desc,info) do level = 1, nlev - call mlprec_wrk(level)%vx2l%free(info) - call mlprec_wrk(level)%vy2l%free(info) - call mlprec_wrk(level)%vtx%free(info) - call mlprec_wrk(level)%vty%free(info) - if (psb_errstatus_fatal()) then + if (info == 0) call mlprec_wrk(level)%vx2l%free(info) + if (info == 0) call mlprec_wrk(level)%vy2l%free(info) + if (info == 0) call mlprec_wrk(level)%vtx%free(info) + if (info == 0) call mlprec_wrk(level)%vty%free(info) + if ((info /= 0).or.psb_errstatus_fatal()) then info=psb_err_alloc_request_ nc2l = p%precv(level)%base_desc%get_local_cols() call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),& diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 61fa7092..b0e22eae 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -176,7 +176,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) call p%precv(1)%sm%build(a,desc_a,upd_,info,& & amold=amold,vmold=vmold,imold=imold) - if (info /= psb_success_) then + if ((info /= psb_success_).or.psb_errstatus_fatal()) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') goto 9999 @@ -192,7 +192,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) call mld_mlprec_bld(a,desc_a,p,info,& & amold=amold,vmold=vmold,imold=imold) - if (info /= psb_success_) then + if ((info /= psb_success_).or.psb_errstatus_fatal()) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Multilevel preconditioner build.') goto 9999 From cac4f4f32b0f3679dd902bb019ef2b9ee296502c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 6 Sep 2013 20:46:12 +0000 Subject: [PATCH 10/10] Fixed extra write --- mlprec/impl/mld_dmlprec_aply.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index cad84da9..bbbdb6b1 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -1028,6 +1028,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 do level = 1, nlev +!!$ write(0,*) me, 'Allocating MLPREC_WRK at level ',level call psb_geasb(mlprec_wrk(level)%vx2l,& & p%precv(level)%base_desc,info,& & scratch=.true.,mold=x%v) @@ -1065,6 +1066,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,& & p%precv(level)%base_desc,info) do level = 1, nlev +!!$ write(0,*) me, 'Freeing MLPREC_WRK at level ',level if (info == 0) call mlprec_wrk(level)%vx2l%free(info) if (info == 0) call mlprec_wrk(level)%vy2l%free(info) if (info == 0) call mlprec_wrk(level)%vtx%free(info) @@ -1214,6 +1216,7 @@ contains select case (trans_) case('N') +!!$ write(0,*) me,' Applying POST at level ',level if (level > 1) then ! Apply the restriction call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,& @@ -1286,7 +1289,7 @@ contains end if end if - +!!$ write(0,*) me,' Done POST at level ',level case('T','C') ! Post-smoothing transpose is pre-smoothing