From c455d31d18273257c8c514b2f691c5fb1c8ef451 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 18 Nov 2009 11:32:58 +0000 Subject: [PATCH] First steps towards a new implementation. --- mlprec/mld_d_prec_type.f90 | 158 +++++++++++++++++++++++++++++++++---- 1 file changed, 144 insertions(+), 14 deletions(-) diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 882d5a32..3e5d600c 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -1,10 +1,10 @@ !!$ !!$ -!!$ MLD2P4 version 1.1 +!!$ MLD2P4 version 2.0 !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package -!!$ based on PSBLAS (Parallel Sparse BLAS version 2.3.1) +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) !!$ -!!$ (C) Copyright 2008,2009 +!!$ (C) Copyright 2008,2009, 2010 !!$ !!$ Salvatore Filippone University of Rome Tor Vergata !!$ Alfredo Buttari University of Rome Tor Vergata @@ -176,20 +176,21 @@ module mld_d_prec_type ! type mld_d_base_solver_type -!!$ contains -!!$ procedure, pass(sv) :: build => d_base_solver_bld -!!$ procedure, pass(sv) :: apply => d_base_solver_apply + contains + procedure, pass(sv) :: build => d_base_solver_bld + procedure, pass(sv) :: apply => d_base_solver_apply + procedure, pass(sv) :: apply => d_base_solver_free end type mld_d_base_solver_type - type mld_d_base_smoother_type + type mld_d_base_smoother_type class(mld_d_base_solver_type), allocatable :: sv contains procedure, pass(sm) :: build => d_base_smoother_bld procedure, pass(sm) :: apply => d_base_smoother_apply + procedure, pass(sm) :: apply => d_base_smoother_free end type mld_d_base_smoother_type type, extends(psb_d_base_prec_type) :: mld_dbaseprec_type - class(mld_d_base_smoother_type), allocatable :: sm type(psb_d_sparse_mat), allocatable :: av(:) real(psb_dpk_), allocatable :: d(:) type(psb_desc_type) :: desc_data @@ -199,6 +200,7 @@ module mld_d_prec_type end type mld_dbaseprec_type type mld_donelev_type + class(mld_d_base_smoother_type), allocatable :: sm type(mld_dbaseprec_type) :: prec integer, allocatable :: iprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:) @@ -642,8 +644,6 @@ contains end subroutine mld_dprec_free - - subroutine d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,work,info) use psb_base_mod type(psb_desc_type), intent(in) :: desc_data @@ -686,8 +686,7 @@ contains ! Arguments type(psb_d_sparse_mat), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_d_base_smoother_type), intent(in) :: sm - + class(mld_d_base_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer, intent(out) :: info Integer :: err_act @@ -711,6 +710,137 @@ contains return end subroutine d_base_smoother_bld + + subroutine d_base_smoother_free(sm,info) + + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_d_base_smother_type), intent(inout) :: sm + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='d_base_smoother_free' + + call psb_erractionsave(err_act) + + info = 700 + 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_smoother_free + + + subroutine d_base_solver_apply(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 + real(psb_dpk_),intent(in) :: x(:) + real(psb_dpk_),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 = 700 + 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 + + subroutine d_base_solver_bld(a,desc_a,sv,upd,info) + + use psb_base_mod + + Implicit None + + ! Arguments + type(psb_d_sparse_mat), 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, intent(out) :: info + Integer :: err_act + character(len=20) :: name='d_base_solver_bld' + + call psb_erractionsave(err_act) + + info = 700 + 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_bld + + + subroutine d_base_solver_free(sv,info) + + use psb_base_mod + + Implicit None + + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='d_base_solver_free' + + call psb_erractionsave(err_act) + + info = 700 + 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_free + + subroutine mld_d_apply2v(prec,x,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -728,7 +858,7 @@ contains select type(prec) type is (mld_dprec_type) call mld_precaply(prec,x,y,desc_data,info,trans,work) - class default + class default info = 700 call psb_errpush(info,name) goto 9999 @@ -762,7 +892,7 @@ contains select type(prec) type is (mld_dprec_type) call mld_precaply(prec,x,desc_data,info,trans) - class default + class default info = 700 call psb_errpush(info,name) goto 9999