fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/mld_c_ilu_fact_mod.f90
    mlprec/mld_s_ilu_fact_mod.f90
    mlprec/mld_d_ilu_fact_mod.f90
    mlprec/impl/solver/mld_s_base_solver_dmp.f90
    mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90
    mlprec/impl/solver/mld_z_base_solver_check.f90
    mlprec/impl/solver/mld_d_ilu_solver_apply.f90
    mlprec/impl/solver/mld_d_base_solver_seti.f90
    mlprec/impl/solver/mld_z_base_solver_dmp.f90
    mlprec/impl/solver/mld_d_base_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_diag_solver_bld.f90
    mlprec/impl/solver/mld_z_base_solver_apply.f90
    mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90
    mlprec/impl/solver/mld_d_base_solver_setr.f90
    mlprec/impl/solver/mld_z_id_solver_apply_vect.f90
    mlprec/impl/solver/mld_d_ilu_solver_bld.f90
    mlprec/impl/solver/mld_z_diag_solver_bld.f90
    mlprec/impl/solver/mld_z_ilu_solver_dmp.f90
    mlprec/impl/solver/mld_c_id_solver_apply_vect.f90
    mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90
    mlprec/impl/solver/mld_c_base_solver_descr.f90
    mlprec/impl/solver/mld_c_base_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_id_solver_apply_vect.f90
    mlprec/impl/solver/mld_c_base_solver_check.f90
    mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_base_solver_descr.f90
    mlprec/impl/solver/mld_c_ilu_solver_bld.f90
    mlprec/impl/solver/mld_d_diag_solver_apply.f90
    mlprec/impl/solver/mld_c_base_solver_apply.f90
    mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_base_solver_apply_vect.f90
    mlprec/impl/solver/mld_d_id_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_base_solver_check.f90
    mlprec/impl/solver/mld_s_ilu_solver_bld.f90
    mlprec/impl/solver/mld_d_ilu_solver_dmp.f90
    mlprec/impl/solver/mld_c_base_solver_bld.f90
    mlprec/impl/solver/mld_d_base_solver_bld.f90
    mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90
    mlprec/impl/solver/mld_s_base_solver_apply.f90
    mlprec/impl/solver/mld_z_diag_solver_apply.f90
    mlprec/impl/solver/mld_z_base_solver_free.f90
    mlprec/impl/solver/mld_s_base_solver_bld.f90
    mlprec/impl/solver/mld_c_base_solver_free.f90
    mlprec/impl/solver/mld_z_base_solver_setc.f90
    mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90
    mlprec/impl/solver/mld_z_base_solver_bld.f90
    mlprec/impl/solver/mld_z_base_solver_seti.f90
    mlprec/impl/solver/mld_z_ilu_solver_apply.f90
    mlprec/impl/solver/mld_z_base_solver_apply_vect.f90
    mlprec/impl/solver/mld_c_base_solver_setc.f90
    mlprec/impl/solver/mld_c_ilu_solver_dmp.f90
    mlprec/impl/solver/mld_s_base_solver_free.f90
    mlprec/impl/solver/mld_d_base_solver_descr.f90
    mlprec/impl/solver/mld_c_base_solver_seti.f90
    mlprec/impl/solver/mld_c_ilu_solver_apply.f90
    mlprec/impl/solver/mld_z_base_solver_setr.f90
    mlprec/impl/solver/mld_c_id_solver_apply.f90
    mlprec/impl/solver/mld_z_ilu_solver_bld.f90
    mlprec/impl/solver/mld_d_id_solver_apply.f90
    mlprec/impl/solver/mld_c_base_solver_setr.f90
    mlprec/impl/solver/mld_s_base_solver_setc.f90
    mlprec/impl/solver/mld_d_base_solver_check.f90
    mlprec/impl/solver/mld_s_ilu_solver_dmp.f90
    mlprec/impl/solver/mld_c_diag_solver_apply.f90
    mlprec/impl/solver/mld_c_base_solver_dmp.f90
    mlprec/impl/solver/mld_d_base_solver_dmp.f90
    mlprec/impl/solver/mld_d_base_solver_free.f90
    mlprec/impl/solver/mld_s_ilu_solver_apply.f90
    mlprec/impl/solver/mld_s_base_solver_seti.f90
    mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90
    mlprec/impl/solver/mld_d_base_solver_apply.f90
    mlprec/impl/solver/mld_z_base_solver_descr.f90
    mlprec/impl/solver/mld_s_id_solver_apply.f90
    mlprec/impl/solver/mld_c_diag_solver_bld.f90
    mlprec/impl/solver/mld_d_diag_solver_bld.f90
    mlprec/impl/solver/mld_s_base_solver_setr.f90
    mlprec/impl/solver/mld_z_id_solver_apply.f90
    mlprec/impl/solver/mld_s_diag_solver_apply.f90
    mlprec/impl/solver/mld_d_base_solver_setc.f90
    mlprec/mld_z_ilu_fact_mod.f90

Finished fixes for long integers on lib build side.
stopcriterion
Salvatore Filippone 12 years ago
parent bb63339295
commit 0d9cbcb083
80 changed files with 980 additions and 792 deletions
Show Stats Download Patch File Download Diff File

10
mlprec/impl/solver/mld_c_base_solver_apply.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_c_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

14
mlprec/impl/solver/mld_c_base_solver_apply_vect.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply_vect use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_c_base_solver_bld.f90
Unescape Escape View File

@ -43,16 +43,16 @@ subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
Implicit None Implicit None
! Arguments ! 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 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 character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld' character(len=20) :: name='d_base_solver_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

4
mlprec/impl/solver/mld_c_base_solver_check.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_c_base_solver_check(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check' character(len=20) :: name='d_base_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_c_base_solver_descr.f90
Unescape Escape View File

@ -43,15 +43,13 @@ subroutine mld_c_base_solver_descr(sv,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_c_base_solver_descr' character(len=20), parameter :: name='mld_c_base_solver_descr'
integer :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_c_base_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp
implicit none implicit none
class(mld_c_base_solver_type), intent(in) :: sv class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

4
mlprec/impl/solver/mld_c_base_solver_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_c_base_solver_free(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free' character(len=20) :: name='d_base_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_c_base_solver_setc.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_c_base_solver_setc(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc' character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_c_base_solver_seti.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_c_base_solver_seti(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti' character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing. ! Correct action here is doing nothing.

8
mlprec/impl/solver/mld_c_base_solver_setr.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_c_base_solver_setr(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr' character(len=20) :: name='d_base_solver_setr'

8
mlprec/impl/solver/mld_c_diag_solver_apply.f90
Unescape Escape View File

@ -46,13 +46,13 @@ subroutine mld_c_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), intent(inout) :: y(:) complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_diag_solver_apply' character(len=20) :: name='c_diag_solver_apply'

20
mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_apply_vect use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y type(psb_c_vect_type), intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_diag_solver_apply' character(len=20) :: name='c_diag_solver_apply'
@ -73,12 +73,14 @@ subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
n_col = desc_data%get_local_cols() n_col = desc_data%get_local_cols()
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv)) then if (.not.allocated(sv%dv)) then

15
mlprec/impl/solver/mld_c_diag_solver_bld.f90
Unescape Escape View File

@ -45,18 +45,18 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_diag_solver_type), intent(inout) :: sv class(mld_c_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_diag_solver_bld', ch_err character(len=20) :: name='c_diag_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +111,8 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
else else
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='Allocate sv%dv')
goto 9999 goto 9999
end if end if

72
mlprec/impl/solver/mld_c_id_solver_apply.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(in) :: sv class(mld_c_id_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_id_solver_apply' character(len=20) :: name='c_id_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_c_id_solver_apply end subroutine mld_c_id_solver_apply

72
mlprec/impl/solver/mld_c_id_solver_apply_vect.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(inout) :: sv class(mld_c_id_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_id_solver_apply_vect' character(len=20) :: name='c_id_solver_apply_vect'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_c_id_solver_apply_vect end subroutine mld_c_id_solver_apply_vect

22
mlprec/impl/solver/mld_c_ilu_solver_apply.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
complex(psb_spk_),intent(inout) :: x(:) complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_ilu_solver_apply' character(len=20) :: name='c_ilu_solver_apply'
@ -80,7 +80,8 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -89,7 +90,8 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -114,14 +116,16 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif

31
mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -41,19 +41,19 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
use psb_base_mod use psb_base_mod
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply_vect use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
type(psb_c_vect_type) :: wv, wv1 type(psb_c_vect_type) :: wv, wv1
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_ilu_solver_apply' character(len=20) :: name='c_ilu_solver_apply'
@ -77,12 +77,14 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv%v)) then if (.not.allocated(sv%dv%v)) then
@ -111,7 +113,8 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)') & a_err='complex(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -144,14 +147,16 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call wv%free(info) call wv%free(info)

21
mlprec/impl/solver/mld_c_ilu_solver_bld.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$ !!$
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)
use psb_base_mod use psb_base_mod
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_bld use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_bld
@ -46,18 +45,18 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_ilu_solver_type), intent(inout) :: sv class(mld_c_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
!!$ complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) !!$ complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_ilu_solver_bld', ch_err character(len=20) :: name='c_ilu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +110,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0:) case(0:)
@ -134,7 +133,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0) case(0)
! Fill-in 0 ! Fill-in 0
@ -166,7 +165,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! If we end up here, something was wrong up in the call chain. ! If we end up here, something was wrong up in the call chain.
info = psb_err_input_value_invalid_i_ info = psb_err_input_value_invalid_i_
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/3,sv%fact_type,0,0,0/)) & i_err=(/ithree,sv%fact_type,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -175,7 +174,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! For the time being just throw an error. ! For the time being just throw an error.
info = 31 info = 31
call psb_errpush(info, name,& call psb_errpush(info, name,&
& i_err=(/3,0,0,0,0/),a_err=upd) & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd)
goto 9999 goto 9999
! !

12
mlprec/impl/solver/mld_c_ilu_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp
implicit none implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

10
mlprec/impl/solver/mld_d_base_solver_apply.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_d_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

14
mlprec/impl/solver/mld_d_base_solver_apply_vect.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply_vect use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_d_base_solver_bld.f90
Unescape Escape View File

@ -43,16 +43,16 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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 class(mld_d_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld' character(len=20) :: name='d_base_solver_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

4
mlprec/impl/solver/mld_d_base_solver_check.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_d_base_solver_check(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check' character(len=20) :: name='d_base_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_d_base_solver_descr.f90
Unescape Escape View File

@ -43,15 +43,13 @@ subroutine mld_d_base_solver_descr(sv,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_d_base_solver_descr' character(len=20), parameter :: name='mld_d_base_solver_descr'
integer :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_d_base_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp
implicit none implicit none
class(mld_d_base_solver_type), intent(in) :: sv class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

4
mlprec/impl/solver/mld_d_base_solver_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_d_base_solver_free(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free' character(len=20) :: name='d_base_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_d_base_solver_setc.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_d_base_solver_setc(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc' character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_d_base_solver_seti.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_d_base_solver_seti(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti' character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing. ! Correct action here is doing nothing.

8
mlprec/impl/solver/mld_d_base_solver_setr.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_d_base_solver_setr(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr' character(len=20) :: name='d_base_solver_setr'

8
mlprec/impl/solver/mld_d_diag_solver_apply.f90
Unescape Escape View File

@ -46,13 +46,13 @@ subroutine mld_d_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_diag_solver_apply' character(len=20) :: name='d_diag_solver_apply'

20
mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_apply_vect use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(inout) :: sv
type(psb_d_vect_type), intent(inout) :: x type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y type(psb_d_vect_type), intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_diag_solver_apply' character(len=20) :: name='d_diag_solver_apply'
@ -73,12 +73,14 @@ subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
n_col = desc_data%get_local_cols() n_col = desc_data%get_local_cols()
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv)) then if (.not.allocated(sv%dv)) then

15
mlprec/impl/solver/mld_d_diag_solver_bld.f90
Unescape Escape View File

@ -45,18 +45,18 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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 class(mld_d_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_diag_solver_bld', ch_err character(len=20) :: name='d_diag_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +111,8 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
else else
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='Allocate sv%dv')
goto 9999 goto 9999
end if end if

72
mlprec/impl/solver/mld_d_id_solver_apply.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(in) :: sv class(mld_d_id_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_id_solver_apply' character(len=20) :: name='d_id_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_d_id_solver_apply end subroutine mld_d_id_solver_apply

72
mlprec/impl/solver/mld_d_id_solver_apply_vect.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(inout) :: sv class(mld_d_id_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_id_solver_apply_vect' character(len=20) :: name='d_id_solver_apply_vect'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_d_id_solver_apply_vect end subroutine mld_d_id_solver_apply_vect

22
mlprec/impl/solver/mld_d_ilu_solver_apply.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
real(psb_dpk_),intent(inout) :: x(:) real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_ilu_solver_apply' character(len=20) :: name='d_ilu_solver_apply'
@ -80,7 +80,8 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -89,7 +90,8 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -114,14 +116,16 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif

31
mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -41,19 +41,19 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
use psb_base_mod use psb_base_mod
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply_vect use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_d_ilu_solver_type), intent(inout) :: sv class(mld_d_ilu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: wv, wv1 type(psb_d_vect_type) :: wv, wv1
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_ilu_solver_apply' character(len=20) :: name='d_ilu_solver_apply'
@ -77,12 +77,14 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv%v)) then if (.not.allocated(sv%dv%v)) then
@ -111,7 +113,8 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)') & a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -144,14 +147,16 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call wv%free(info) call wv%free(info)

21
mlprec/impl/solver/mld_d_ilu_solver_bld.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$ !!$
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)
use psb_base_mod use psb_base_mod
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_bld use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_bld
@ -46,18 +45,18 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a 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 class(mld_d_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
!!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) !!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_ilu_solver_bld', ch_err character(len=20) :: name='d_ilu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +110,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0:) case(0:)
@ -134,7 +133,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0) case(0)
! Fill-in 0 ! Fill-in 0
@ -166,7 +165,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! If we end up here, something was wrong up in the call chain. ! If we end up here, something was wrong up in the call chain.
info = psb_err_input_value_invalid_i_ info = psb_err_input_value_invalid_i_
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/3,sv%fact_type,0,0,0/)) & i_err=(/ithree,sv%fact_type,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -175,7 +174,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! For the time being just throw an error. ! For the time being just throw an error.
info = 31 info = 31
call psb_errpush(info, name,& call psb_errpush(info, name,&
& i_err=(/3,0,0,0,0/),a_err=upd) & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd)
goto 9999 goto 9999
! !

12
mlprec/impl/solver/mld_d_ilu_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp
implicit none implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

10
mlprec/impl/solver/mld_s_base_solver_apply.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_s_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

14
mlprec/impl/solver/mld_s_base_solver_apply_vect.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply_vect use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_s_base_solver_bld.f90
Unescape Escape View File

@ -43,16 +43,16 @@ subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
Implicit None Implicit None
! Arguments ! 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 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 character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld' character(len=20) :: name='d_base_solver_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

4
mlprec/impl/solver/mld_s_base_solver_check.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_s_base_solver_check(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check' character(len=20) :: name='d_base_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_s_base_solver_descr.f90
Unescape Escape View File

@ -43,15 +43,13 @@ subroutine mld_s_base_solver_descr(sv,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_s_base_solver_descr' character(len=20), parameter :: name='mld_s_base_solver_descr'
integer :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_s_base_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp
implicit none implicit none
class(mld_s_base_solver_type), intent(in) :: sv class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

4
mlprec/impl/solver/mld_s_base_solver_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_s_base_solver_free(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free' character(len=20) :: name='d_base_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_s_base_solver_setc.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_s_base_solver_setc(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc' character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_s_base_solver_seti.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_s_base_solver_seti(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti' character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing. ! Correct action here is doing nothing.

8
mlprec/impl/solver/mld_s_base_solver_setr.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_s_base_solver_setr(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr' character(len=20) :: name='d_base_solver_setr'

8
mlprec/impl/solver/mld_s_diag_solver_apply.f90
Unescape Escape View File

@ -46,13 +46,13 @@ subroutine mld_s_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_diag_solver_apply' character(len=20) :: name='s_diag_solver_apply'

20
mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_apply_vect use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y type(psb_s_vect_type), intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_diag_solver_apply' character(len=20) :: name='s_diag_solver_apply'
@ -73,12 +73,14 @@ subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
n_col = desc_data%get_local_cols() n_col = desc_data%get_local_cols()
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv)) then if (.not.allocated(sv%dv)) then

15
mlprec/impl/solver/mld_s_diag_solver_bld.f90
Unescape Escape View File

@ -45,18 +45,18 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_diag_solver_type), intent(inout) :: sv class(mld_s_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_diag_solver_bld', ch_err character(len=20) :: name='s_diag_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +111,8 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
else else
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='Allocate sv%dv')
goto 9999 goto 9999
end if end if

72
mlprec/impl/solver/mld_s_id_solver_apply.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(in) :: sv class(mld_s_id_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_id_solver_apply' character(len=20) :: name='s_id_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_s_id_solver_apply end subroutine mld_s_id_solver_apply

72
mlprec/impl/solver/mld_s_id_solver_apply_vect.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(inout) :: sv class(mld_s_id_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_id_solver_apply_vect' character(len=20) :: name='s_id_solver_apply_vect'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_s_id_solver_apply_vect end subroutine mld_s_id_solver_apply_vect

22
mlprec/impl/solver/mld_s_ilu_solver_apply.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
real(psb_spk_),intent(inout) :: x(:) real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_ilu_solver_apply' character(len=20) :: name='s_ilu_solver_apply'
@ -80,7 +80,8 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -89,7 +90,8 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -114,14 +116,16 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif

31
mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -41,19 +41,19 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
use psb_base_mod use psb_base_mod
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply_vect use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:) real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: wv, wv1 type(psb_s_vect_type) :: wv, wv1
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_ilu_solver_apply' character(len=20) :: name='s_ilu_solver_apply'
@ -77,12 +77,14 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv%v)) then if (.not.allocated(sv%dv%v)) then
@ -111,7 +113,8 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)') & a_err='real(psb_spk_)')
goto 9999 goto 9999
end if end if
@ -144,14 +147,16 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call wv%free(info) call wv%free(info)

21
mlprec/impl/solver/mld_s_ilu_solver_bld.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$ !!$
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)
use psb_base_mod use psb_base_mod
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_bld use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_bld
@ -46,18 +45,18 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_ilu_solver_type), intent(inout) :: sv class(mld_s_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
!!$ real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) !!$ real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_ilu_solver_bld', ch_err character(len=20) :: name='s_ilu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +110,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0:) case(0:)
@ -134,7 +133,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0) case(0)
! Fill-in 0 ! Fill-in 0
@ -166,7 +165,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! If we end up here, something was wrong up in the call chain. ! If we end up here, something was wrong up in the call chain.
info = psb_err_input_value_invalid_i_ info = psb_err_input_value_invalid_i_
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/3,sv%fact_type,0,0,0/)) & i_err=(/ithree,sv%fact_type,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -175,7 +174,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! For the time being just throw an error. ! For the time being just throw an error.
info = 31 info = 31
call psb_errpush(info, name,& call psb_errpush(info, name,&
& i_err=(/3,0,0,0,0/),a_err=upd) & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd)
goto 9999 goto 9999
! !

12
mlprec/impl/solver/mld_s_ilu_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp
implicit none implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

10
mlprec/impl/solver/mld_z_base_solver_apply.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_z_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

14
mlprec/impl/solver/mld_z_base_solver_apply_vect.f90
Unescape Escape View File

@ -41,17 +41,17 @@ subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply_vect use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply' character(len=20) :: name='d_base_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_z_base_solver_bld.f90
Unescape Escape View File

@ -43,16 +43,16 @@ subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
Implicit None Implicit None
! Arguments ! 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 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 character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld' character(len=20) :: name='d_base_solver_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

4
mlprec/impl/solver/mld_z_base_solver_check.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_z_base_solver_check(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check' character(len=20) :: name='d_base_solver_check'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_z_base_solver_descr.f90
Unescape Escape View File

@ -43,15 +43,13 @@ subroutine mld_z_base_solver_descr(sv,info,iout,coarse)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer, intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse logical, intent(in), optional :: coarse
! Local variables ! Local variables
integer :: err_act integer(psb_ipk_) :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_base_solver_descr' character(len=20), parameter :: name='mld_z_base_solver_descr'
integer :: iout_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

10
mlprec/impl/solver/mld_z_base_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp
implicit none implicit none
class(mld_z_base_solver_type), intent(in) :: sv class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

4
mlprec/impl/solver/mld_z_base_solver_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_z_base_solver_free(sv,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free' character(len=20) :: name='d_base_solver_free'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_z_base_solver_setc.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_z_base_solver_setc(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act, ival Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc' character(len=20) :: name='d_base_solver_setc'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

8
mlprec/impl/solver/mld_z_base_solver_seti.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_z_base_solver_seti(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
integer, intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti' character(len=20) :: name='d_base_solver_seti'
! Correct action here is doing nothing. ! Correct action here is doing nothing.

8
mlprec/impl/solver/mld_z_base_solver_setr.f90
Unescape Escape View File

@ -43,10 +43,10 @@ subroutine mld_z_base_solver_setr(sv,what,val,info)
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
Integer :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_setr' character(len=20) :: name='d_base_solver_setr'

8
mlprec/impl/solver/mld_z_diag_solver_apply.f90
Unescape Escape View File

@ -46,13 +46,13 @@ subroutine mld_z_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(inout) :: y(:) complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_diag_solver_apply' character(len=20) :: name='z_diag_solver_apply'

20
mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
use psb_base_mod use psb_base_mod
use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_apply_vect use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
type(psb_z_vect_type), intent(inout) :: y type(psb_z_vect_type), intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_diag_solver_apply' character(len=20) :: name='z_diag_solver_apply'
@ -73,12 +73,14 @@ subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
n_col = desc_data%get_local_cols() n_col = desc_data%get_local_cols()
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv)) then if (.not.allocated(sv%dv)) then

15
mlprec/impl/solver/mld_z_diag_solver_bld.f90
Unescape Escape View File

@ -45,18 +45,18 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_diag_solver_type), intent(inout) :: sv class(mld_z_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_diag_solver_bld', ch_err character(len=20) :: name='z_diag_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +111,8 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
else else
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='Allocate sv%dv')
goto 9999 goto 9999
end if end if

72
mlprec/impl/solver/mld_z_id_solver_apply.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(in) :: sv class(mld_z_id_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_id_solver_apply' character(len=20) :: name='z_id_solver_apply'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_z_id_solver_apply end subroutine mld_z_id_solver_apply

72
mlprec/impl/solver/mld_z_id_solver_apply_vect.f90
Unescape Escape View File

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(inout) :: sv class(mld_z_id_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_id_solver_apply_vect' character(len=20) :: name='z_id_solver_apply_vect'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)
case('N') case('N')
case('T') case('T')
case('C') case('C')
case default case default
call psb_errpush(psb_err_iarg_invalid_i_,name) call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 goto 9999
end select end select
call psb_geaxpby(alpha,x,beta,y,desc_data,info) call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
call psb_error() call psb_error()
return
end if
return return
end if
return
end subroutine mld_z_id_solver_apply_vect end subroutine mld_z_id_solver_apply_vect

22
mlprec/impl/solver/mld_z_ilu_solver_apply.f90
Unescape Escape View File

@ -41,18 +41,18 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod use psb_base_mod
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(inout) :: x(:) complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_ilu_solver_apply' character(len=20) :: name='z_ilu_solver_apply'
@ -80,7 +80,8 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(aux(4*n_col),stat=info) allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -89,7 +90,8 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
allocate(ww(n_col),aux(4*n_col),stat=info) allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -114,14 +116,16 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif

31
mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -41,19 +41,19 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
use psb_base_mod use psb_base_mod
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply_vect use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:) complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col integer(psb_ipk_) :: n_row,n_col
type(psb_z_vect_type) :: wv, wv1 type(psb_z_vect_type) :: wv, wv1
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_ilu_solver_apply' character(len=20) :: name='z_ilu_solver_apply'
@ -77,12 +77,14 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (x%get_nrows() < n_row) then if (x%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/itwo,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (y%get_nrows() < n_row) then if (y%get_nrows() < n_row) then
info = 36 info = 36
call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) call psb_errpush(info,name,&
& i_err=(/ithree,n_row,izero,izero,izero/))
goto 9999 goto 9999
end if end if
if (.not.allocated(sv%dv%v)) then if (.not.allocated(sv%dv%v)) then
@ -111,7 +113,8 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)') & a_err='complex(psb_dpk_)')
goto 9999 goto 9999
end if end if
@ -144,14 +147,16 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in
& trans=trans_,scale='U',choice=psb_none_,work=aux) & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid TRANS in ILU subsolve')
goto 9999 goto 9999
end select end select
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call wv%free(info) call wv%free(info)

21
mlprec/impl/solver/mld_z_ilu_solver_bld.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$ !!$
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)
use psb_base_mod use psb_base_mod
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_bld use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_bld
@ -46,18 +45,18 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! Arguments ! 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 Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_ilu_solver_type), intent(inout) :: sv class(mld_z_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
! Local variables ! Local variables
integer :: n_row,n_col, nrow_a, nztota integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
!!$ complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) !!$ complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_ilu_solver_bld', ch_err character(len=20) :: name='z_ilu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -111,7 +110,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0:) case(0:)
@ -134,7 +133,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1) case(:-1)
! Error: fill-in <= -1 ! Error: fill-in <= -1
call psb_errpush(psb_err_input_value_invalid_i_,& call psb_errpush(psb_err_input_value_invalid_i_,&
& name,i_err=(/3,sv%fill_in,0,0,0/)) & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/))
goto 9999 goto 9999
case(0) case(0)
! Fill-in 0 ! Fill-in 0
@ -166,7 +165,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! If we end up here, something was wrong up in the call chain. ! If we end up here, something was wrong up in the call chain.
info = psb_err_input_value_invalid_i_ info = psb_err_input_value_invalid_i_
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/3,sv%fact_type,0,0,0/)) & i_err=(/ithree,sv%fact_type,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -175,7 +174,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! For the time being just throw an error. ! For the time being just throw an error.
info = 31 info = 31
call psb_errpush(info, name,& call psb_errpush(info, name,&
& i_err=(/3,0,0,0,0/),a_err=upd) & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd)
goto 9999 goto 9999
! !

12
mlprec/impl/solver/mld_z_ilu_solver_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp
implicit none implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level integer(psb_ipk_), intent(in) :: ictxt,level
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
logical :: solver_ logical :: solver_

80
mlprec/mld_c_ilu_fact_mod.f90
Unescape Escape View File

@ -1,43 +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
!!$
!!$ 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.
!!$
!!$
module mld_c_ilu_fact_mod module mld_c_ilu_fact_mod
use mld_c_base_solver_mod use mld_c_base_solver_mod
interface mld_ilu0_fact interface mld_ilu0_fact
subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck,upd) subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_cspmat_type, psb_spk_ import psb_cspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: ialg integer(psb_ipk_), intent(in) :: ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u type(psb_cspmat_type),intent(inout) :: l,u
type(psb_cspmat_type),intent(in), optional, target :: blck type(psb_cspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd character, intent(in), optional :: upd
complex(psb_spk_), intent(inout) :: d(:) complex(psb_spk_), intent(inout) :: d(:)
end subroutine mld_cilu0_fact end subroutine mld_cilu0_fact
end interface end interface
interface mld_iluk_fact interface mld_iluk_fact
subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck) subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_cspmat_type, psb_spk_ import psb_cspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: fill_in,ialg integer(psb_ipk_), intent(in) :: fill_in,ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u type(psb_cspmat_type),intent(inout) :: l,u
type(psb_cspmat_type),intent(in), optional, target :: blck type(psb_cspmat_type),intent(in), optional, target :: blck
complex(psb_spk_), intent(inout) :: d(:) complex(psb_spk_), intent(inout) :: d(:)
end subroutine mld_ciluk_fact end subroutine mld_ciluk_fact
end interface end interface
interface mld_ilut_fact interface mld_ilut_fact
subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_cspmat_type, psb_spk_ import psb_cspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: fill_in integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u type(psb_cspmat_type),intent(inout) :: l,u
complex(psb_spk_), intent(inout) :: d(:) complex(psb_spk_), intent(inout) :: d(:)
type(psb_cspmat_type),intent(in), optional, target :: blck type(psb_cspmat_type),intent(in), optional, target :: blck
integer, intent(in), optional :: iscale integer(psb_ipk_), intent(in), optional :: iscale
end subroutine mld_cilut_fact end subroutine mld_cilut_fact
end interface end interface

80
mlprec/mld_d_ilu_fact_mod.f90
Unescape Escape View File

@ -1,43 +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
!!$
!!$ 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.
!!$
!!$
module mld_d_ilu_fact_mod module mld_d_ilu_fact_mod
use mld_d_base_solver_mod use mld_d_base_solver_mod
interface mld_ilu0_fact interface mld_ilu0_fact
subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck,upd) subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_dspmat_type, psb_dpk_ import psb_dspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: ialg integer(psb_ipk_), intent(in) :: ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck type(psb_dspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd character, intent(in), optional :: upd
real(psb_dpk_), intent(inout) :: d(:) real(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_dilu0_fact end subroutine mld_dilu0_fact
end interface end interface
interface mld_iluk_fact interface mld_iluk_fact
subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck) subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_dspmat_type, psb_dpk_ import psb_dspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: fill_in,ialg integer(psb_ipk_), intent(in) :: fill_in,ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck type(psb_dspmat_type),intent(in), optional, target :: blck
real(psb_dpk_), intent(inout) :: d(:) real(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_diluk_fact end subroutine mld_diluk_fact
end interface end interface
interface mld_ilut_fact interface mld_ilut_fact
subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_dspmat_type, psb_dpk_ import psb_dspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: fill_in integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(inout) :: l,u
real(psb_dpk_), intent(inout) :: d(:) real(psb_dpk_), intent(inout) :: d(:)
type(psb_dspmat_type),intent(in), optional, target :: blck type(psb_dspmat_type),intent(in), optional, target :: blck
integer, intent(in), optional :: iscale integer(psb_ipk_), intent(in), optional :: iscale
end subroutine mld_dilut_fact end subroutine mld_dilut_fact
end interface end interface

80
mlprec/mld_s_ilu_fact_mod.f90
Unescape Escape View File

@ -1,43 +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
!!$
!!$ 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.
!!$
!!$
module mld_s_ilu_fact_mod module mld_s_ilu_fact_mod
use mld_s_base_solver_mod use mld_s_base_solver_mod
interface mld_ilu0_fact interface mld_ilu0_fact
subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck,upd) subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_sspmat_type, psb_spk_ import psb_sspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: ialg integer(psb_ipk_), intent(in) :: ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u type(psb_sspmat_type),intent(inout) :: l,u
type(psb_sspmat_type),intent(in), optional, target :: blck type(psb_sspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd character, intent(in), optional :: upd
real(psb_spk_), intent(inout) :: d(:) real(psb_spk_), intent(inout) :: d(:)
end subroutine mld_silu0_fact end subroutine mld_silu0_fact
end interface end interface
interface mld_iluk_fact interface mld_iluk_fact
subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck) subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_sspmat_type, psb_spk_ import psb_sspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: fill_in,ialg integer(psb_ipk_), intent(in) :: fill_in,ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u type(psb_sspmat_type),intent(inout) :: l,u
type(psb_sspmat_type),intent(in), optional, target :: blck type(psb_sspmat_type),intent(in), optional, target :: blck
real(psb_spk_), intent(inout) :: d(:) real(psb_spk_), intent(inout) :: d(:)
end subroutine mld_siluk_fact end subroutine mld_siluk_fact
end interface end interface
interface mld_ilut_fact interface mld_ilut_fact
subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_sspmat_type, psb_spk_ import psb_sspmat_type, psb_spk_, psb_ipk_
integer, intent(in) :: fill_in integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u type(psb_sspmat_type),intent(inout) :: l,u
real(psb_spk_), intent(inout) :: d(:) real(psb_spk_), intent(inout) :: d(:)
type(psb_sspmat_type),intent(in), optional, target :: blck type(psb_sspmat_type),intent(in), optional, target :: blck
integer, intent(in), optional :: iscale integer(psb_ipk_), intent(in), optional :: iscale
end subroutine mld_silut_fact end subroutine mld_silut_fact
end interface end interface

80
mlprec/mld_z_ilu_fact_mod.f90
Unescape Escape View File

@ -1,43 +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
!!$
!!$ 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.
!!$
!!$
module mld_z_ilu_fact_mod module mld_z_ilu_fact_mod
use mld_z_base_solver_mod use mld_z_base_solver_mod
interface mld_ilu0_fact interface mld_ilu0_fact
subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck,upd) subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_zspmat_type, psb_dpk_ import psb_zspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: ialg integer(psb_ipk_), intent(in) :: ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck type(psb_zspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd character, intent(in), optional :: upd
complex(psb_dpk_), intent(inout) :: d(:) complex(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_zilu0_fact end subroutine mld_zilu0_fact
end interface end interface
interface mld_iluk_fact interface mld_iluk_fact
subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck) subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_zspmat_type, psb_dpk_ import psb_zspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: fill_in,ialg integer(psb_ipk_), intent(in) :: fill_in,ialg
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck type(psb_zspmat_type),intent(in), optional, target :: blck
complex(psb_dpk_), intent(inout) :: d(:) complex(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_ziluk_fact end subroutine mld_ziluk_fact
end interface end interface
interface mld_ilut_fact interface mld_ilut_fact
subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_zspmat_type, psb_dpk_ import psb_zspmat_type, psb_dpk_, psb_ipk_
integer, intent(in) :: fill_in integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u type(psb_zspmat_type),intent(inout) :: l,u
complex(psb_dpk_), intent(inout) :: d(:) complex(psb_dpk_), intent(inout) :: d(:)
type(psb_zspmat_type),intent(in), optional, target :: blck type(psb_zspmat_type),intent(in), optional, target :: blck
integer, intent(in), optional :: iscale integer(psb_ipk_), intent(in), optional :: iscale
end subroutine mld_zilut_fact end subroutine mld_zilut_fact
end interface end interface

Write Preview
Loading…
Cancel
Save