From 05a910d78ed78764839b905f617f46334a485ef2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 27 Oct 2011 11:36:34 +0000 Subject: [PATCH] mld2p4-2: Start work on vect --- mlprec/mld_d_diag_solver.f90 | 16 +++++++------- mlprec/mld_d_id_solver.f90 | 16 +++++++------- mlprec/mld_d_ilu_solver.f90 | 18 ++++++++-------- mlprec/mld_d_prec_type.f90 | 38 ++++++++++++++++++++++++++++++++- mlprec/mld_d_slu_solver.f90 | 16 +++++++------- mlprec/mld_d_sludist_solver.f90 | 16 +++++++------- mlprec/mld_d_umf_solver.f90 | 16 +++++++------- 7 files changed, 86 insertions(+), 50 deletions(-) diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 865438e9..7b44be86 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -50,14 +50,14 @@ module mld_d_diag_solver type, extends(mld_d_base_solver_type) :: mld_d_diag_solver_type real(psb_dpk_), allocatable :: d(:) contains - procedure, pass(sv) :: build => d_diag_solver_bld - procedure, pass(sv) :: apply => d_diag_solver_apply - procedure, pass(sv) :: free => d_diag_solver_free - procedure, pass(sv) :: seti => d_diag_solver_seti - procedure, pass(sv) :: setc => d_diag_solver_setc - procedure, pass(sv) :: setr => d_diag_solver_setr - procedure, pass(sv) :: descr => d_diag_solver_descr - procedure, pass(sv) :: sizeof => d_diag_solver_sizeof + procedure, pass(sv) :: build => d_diag_solver_bld + procedure, pass(sv) :: apply_a => d_diag_solver_apply + procedure, pass(sv) :: free => d_diag_solver_free + procedure, pass(sv) :: seti => d_diag_solver_seti + procedure, pass(sv) :: setc => d_diag_solver_setc + procedure, pass(sv) :: setr => d_diag_solver_setr + procedure, pass(sv) :: descr => d_diag_solver_descr + procedure, pass(sv) :: sizeof => d_diag_solver_sizeof end type mld_d_diag_solver_type diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90 index c0be65dc..64c46400 100644 --- a/mlprec/mld_d_id_solver.f90 +++ b/mlprec/mld_d_id_solver.f90 @@ -49,14 +49,14 @@ module mld_d_id_solver type, extends(mld_d_base_solver_type) :: mld_d_id_solver_type contains - procedure, pass(sv) :: build => d_id_solver_bld - procedure, pass(sv) :: apply => d_id_solver_apply - procedure, pass(sv) :: free => d_id_solver_free - procedure, pass(sv) :: seti => d_id_solver_seti - procedure, pass(sv) :: setc => d_id_solver_setc - procedure, pass(sv) :: setr => d_id_solver_setr - procedure, pass(sv) :: descr => d_id_solver_descr - procedure, pass(sv) :: sizeof => d_id_solver_sizeof + procedure, pass(sv) :: build => d_id_solver_bld + procedure, pass(sv) :: apply_a => d_id_solver_apply + procedure, pass(sv) :: free => d_id_solver_free + procedure, pass(sv) :: seti => d_id_solver_seti + procedure, pass(sv) :: setc => d_id_solver_setc + procedure, pass(sv) :: setr => d_id_solver_setr + procedure, pass(sv) :: descr => d_id_solver_descr + procedure, pass(sv) :: sizeof => d_id_solver_sizeof end type mld_d_id_solver_type diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 27aa187a..1f17bb69 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -54,15 +54,15 @@ module mld_d_ilu_solver integer :: fact_type, fill_in real(psb_dpk_) :: thresh contains - procedure, pass(sv) :: dump => d_ilu_solver_dmp - procedure, pass(sv) :: build => d_ilu_solver_bld - procedure, pass(sv) :: apply => d_ilu_solver_apply - procedure, pass(sv) :: free => d_ilu_solver_free - procedure, pass(sv) :: seti => d_ilu_solver_seti - procedure, pass(sv) :: setc => d_ilu_solver_setc - procedure, pass(sv) :: setr => d_ilu_solver_setr - procedure, pass(sv) :: descr => d_ilu_solver_descr - procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof + procedure, pass(sv) :: dump => d_ilu_solver_dmp + procedure, pass(sv) :: build => d_ilu_solver_bld + procedure, pass(sv) :: apply_a => d_ilu_solver_apply + procedure, pass(sv) :: free => d_ilu_solver_free + procedure, pass(sv) :: seti => d_ilu_solver_seti + procedure, pass(sv) :: setc => d_ilu_solver_setc + procedure, pass(sv) :: setr => d_ilu_solver_setr + procedure, pass(sv) :: descr => d_ilu_solver_descr + procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof procedure, pass(sv) :: default => d_ilu_solver_default end type mld_d_ilu_solver_type diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 0f2660ef..000bf1df 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -180,7 +180,9 @@ module mld_d_prec_type procedure, pass(sv) :: check => d_base_solver_check procedure, pass(sv) :: dump => d_base_solver_dmp procedure, pass(sv) :: build => d_base_solver_bld - procedure, pass(sv) :: apply => d_base_solver_apply + procedure, pass(sv) :: apply_v => d_base_solver_apply_vect + procedure, pass(sv) :: apply_a => d_base_solver_apply + generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => d_base_solver_free procedure, pass(sv) :: seti => d_base_solver_seti procedure, pass(sv) :: setc => d_base_solver_setc @@ -1021,6 +1023,40 @@ contains end subroutine d_base_solver_apply + + subroutine d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + use psb_base_mod + type(psb_desc_type), intent(in) :: desc_data + class(mld_d_base_solver_type), intent(in) :: sv + type(psb_d_vect_type),intent(inout) :: x + type(psb_d_vect_type),intent(inout) :: y + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='d_base_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_err_missing_override_method_ + call psb_errpush(info,name) + 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 d_base_solver_apply_vect + subroutine d_base_solver_bld(a,desc_a,sv,upd,info,b,mold) use psb_base_mod diff --git a/mlprec/mld_d_slu_solver.f90 b/mlprec/mld_d_slu_solver.f90 index fb48a78e..45032a07 100644 --- a/mlprec/mld_d_slu_solver.f90 +++ b/mlprec/mld_d_slu_solver.f90 @@ -52,14 +52,14 @@ module mld_d_slu_solver type(c_ptr) :: lufactors=c_null_ptr integer(c_long_long) :: symbsize=0, numsize=0 contains - procedure, pass(sv) :: build => d_slu_solver_bld - procedure, pass(sv) :: apply => d_slu_solver_apply - procedure, pass(sv) :: free => d_slu_solver_free - procedure, pass(sv) :: seti => d_slu_solver_seti - procedure, pass(sv) :: setc => d_slu_solver_setc - procedure, pass(sv) :: setr => d_slu_solver_setr - procedure, pass(sv) :: descr => d_slu_solver_descr - procedure, pass(sv) :: sizeof => d_slu_solver_sizeof + procedure, pass(sv) :: build => d_slu_solver_bld + procedure, pass(sv) :: apply_a => d_slu_solver_apply + procedure, pass(sv) :: free => d_slu_solver_free + procedure, pass(sv) :: seti => d_slu_solver_seti + procedure, pass(sv) :: setc => d_slu_solver_setc + procedure, pass(sv) :: setr => d_slu_solver_setr + procedure, pass(sv) :: descr => d_slu_solver_descr + procedure, pass(sv) :: sizeof => d_slu_solver_sizeof end type mld_d_slu_solver_type diff --git a/mlprec/mld_d_sludist_solver.f90 b/mlprec/mld_d_sludist_solver.f90 index 1a8ba670..cae8bcd4 100644 --- a/mlprec/mld_d_sludist_solver.f90 +++ b/mlprec/mld_d_sludist_solver.f90 @@ -52,14 +52,14 @@ module mld_d_sludist_solver type(c_ptr) :: lufactors=c_null_ptr integer(c_long_long) :: symbsize=0, numsize=0 contains - procedure, pass(sv) :: build => d_sludist_solver_bld - procedure, pass(sv) :: apply => d_sludist_solver_apply - procedure, pass(sv) :: free => d_sludist_solver_free - procedure, pass(sv) :: seti => d_sludist_solver_seti - procedure, pass(sv) :: setc => d_sludist_solver_setc - procedure, pass(sv) :: setr => d_sludist_solver_setr - procedure, pass(sv) :: descr => d_sludist_solver_descr - procedure, pass(sv) :: sizeof => d_sludist_solver_sizeof + procedure, pass(sv) :: build => d_sludist_solver_bld + procedure, pass(sv) :: apply_a => d_sludist_solver_apply + procedure, pass(sv) :: free => d_sludist_solver_free + procedure, pass(sv) :: seti => d_sludist_solver_seti + procedure, pass(sv) :: setc => d_sludist_solver_setc + procedure, pass(sv) :: setr => d_sludist_solver_setr + procedure, pass(sv) :: descr => d_sludist_solver_descr + procedure, pass(sv) :: sizeof => d_sludist_solver_sizeof end type mld_d_sludist_solver_type diff --git a/mlprec/mld_d_umf_solver.f90 b/mlprec/mld_d_umf_solver.f90 index 769cb693..26d98ae3 100644 --- a/mlprec/mld_d_umf_solver.f90 +++ b/mlprec/mld_d_umf_solver.f90 @@ -52,14 +52,14 @@ module mld_d_umf_solver type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr integer(c_long_long) :: symbsize=0, numsize=0 contains - procedure, pass(sv) :: build => d_umf_solver_bld - procedure, pass(sv) :: apply => d_umf_solver_apply - procedure, pass(sv) :: free => d_umf_solver_free - procedure, pass(sv) :: seti => d_umf_solver_seti - procedure, pass(sv) :: setc => d_umf_solver_setc - procedure, pass(sv) :: setr => d_umf_solver_setr - procedure, pass(sv) :: descr => d_umf_solver_descr - procedure, pass(sv) :: sizeof => d_umf_solver_sizeof + procedure, pass(sv) :: build => d_umf_solver_bld + procedure, pass(sv) :: apply_a => d_umf_solver_apply + procedure, pass(sv) :: free => d_umf_solver_free + procedure, pass(sv) :: seti => d_umf_solver_seti + procedure, pass(sv) :: setc => d_umf_solver_setc + procedure, pass(sv) :: setr => d_umf_solver_setr + procedure, pass(sv) :: descr => d_umf_solver_descr + procedure, pass(sv) :: sizeof => d_umf_solver_sizeof end type mld_d_umf_solver_type