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 14 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 mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply
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
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
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(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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 mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply_vect
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
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
Integer :: err_act
character(len=20) :: name='d_base_solver_bld'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld'
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
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check'
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
! Arguments
class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_c_base_solver_descr'
integer :: iout_
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
implicit none
class(mld_c_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free'
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
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
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
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! 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
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
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) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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 mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_apply_vect
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
type(psb_c_vect_type), intent(inout) :: x
type(psb_c_vect_type), intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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()
if (x%get_nrows() < n_row) then
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_diag_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_diag_solver_bld', ch_err
info=psb_success_
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
call sv%dv%bld(sv%d)
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
end if

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

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

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

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='c_id_solver_apply_vect'
use psb_base_mod
use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_id_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
call psb_erractionsave(err_act)
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='c_id_solver_apply_vect'
info = psb_success_
call psb_erractionsave(err_act)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
info = psb_success_
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
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 mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply
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
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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)
if (info /= psb_success_) then
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_)')
goto 9999
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)
if (info /= psb_success_) then
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_)')
goto 9999
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,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
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
end select
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
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 mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply_vect
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
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
type(psb_c_vect_type) :: wv, wv1
integer(psb_ipk_) :: n_row,n_col
type(psb_c_vect_type) :: wv, wv1
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(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
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
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_)')
goto 9999
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)
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
end select
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
endif
call wv%free(info)

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

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
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
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_ilu_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_ilu_solver_bld', ch_err
info=psb_success_
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)
! Error: fill-in <= -1
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
case(0:)
@ -134,7 +133,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1)
! Error: fill-in <= -1
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
case(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.
info = psb_err_input_value_invalid_i_
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
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.
info = 31
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
!

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
implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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 mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply
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
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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 mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply_vect
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
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
Integer :: err_act
character(len=20) :: name='d_base_solver_bld'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld'
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
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check'
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
! Arguments
class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_d_base_solver_descr'
integer :: iout_
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
implicit none
class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free'
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
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
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
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! 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
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
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) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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 mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_apply_vect
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
type(psb_d_vect_type), intent(inout) :: x
type(psb_d_vect_type), intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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()
if (x%get_nrows() < n_row) then
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_diag_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_diag_solver_bld', ch_err
info=psb_success_
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
call sv%dv%bld(sv%d)
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
end if

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

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

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

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='d_id_solver_apply_vect'
use psb_base_mod
use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_id_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
call psb_erractionsave(err_act)
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='d_id_solver_apply_vect'
info = psb_success_
call psb_erractionsave(err_act)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
info = psb_success_
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
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 mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply
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
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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)
if (info /= psb_success_) then
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_)')
goto 9999
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)
if (info /= psb_success_) then
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_)')
goto 9999
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,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
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
end select
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
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 mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply_vect
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
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
type(psb_d_vect_type) :: wv, wv1
integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: wv, wv1
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(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
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
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_)')
goto 9999
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)
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
end select
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
endif
call wv%free(info)

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

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
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
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_ilu_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_ilu_solver_bld', ch_err
info=psb_success_
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)
! Error: fill-in <= -1
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
case(0:)
@ -134,7 +133,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1)
! Error: fill-in <= -1
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
case(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.
info = psb_err_input_value_invalid_i_
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
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.
info = 31
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
!

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
implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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 mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply
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
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
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(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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 mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply_vect
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
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
Integer :: err_act
character(len=20) :: name='d_base_solver_bld'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld'
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
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check'
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
! Arguments
class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_s_base_solver_descr'
integer :: iout_
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
implicit none
class(mld_s_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free'
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
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
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
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! 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
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
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) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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 mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_apply_vect
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
type(psb_s_vect_type), intent(inout) :: x
type(psb_s_vect_type), intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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()
if (x%get_nrows() < n_row) then
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_diag_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_diag_solver_bld', ch_err
info=psb_success_
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
call sv%dv%bld(sv%d)
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
end if

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

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

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

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='s_id_solver_apply_vect'
use psb_base_mod
use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_id_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
call psb_erractionsave(err_act)
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='s_id_solver_apply_vect'
info = psb_success_
call psb_erractionsave(err_act)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
info = psb_success_
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
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 mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply
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
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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)
if (info /= psb_success_) then
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_)')
goto 9999
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)
if (info /= psb_success_) then
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_)')
goto 9999
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,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
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
end select
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
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 mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply_vect
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
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
type(psb_s_vect_type) :: wv, wv1
integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: wv, wv1
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(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
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
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_)')
goto 9999
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)
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
end select
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
endif
call wv%free(info)

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

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
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
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type), intent(in), target, optional :: b
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_ilu_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_ilu_solver_bld', ch_err
info=psb_success_
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)
! Error: fill-in <= -1
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
case(0:)
@ -134,7 +133,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1)
! Error: fill-in <= -1
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
case(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.
info = psb_err_input_value_invalid_i_
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
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.
info = 31
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
!

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
implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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 mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply
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
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
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(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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 mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply_vect
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
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_base_solver_apply'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
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
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_base_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
Integer :: err_act
character(len=20) :: name='d_base_solver_bld'
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld'
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
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_check'
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
! Arguments
class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
logical, intent(in), optional :: coarse
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
logical, intent(in), optional :: coarse
! Local variables
integer :: err_act
integer :: ictxt, me, np
integer(psb_ipk_) :: err_act
character(len=20), parameter :: name='mld_z_base_solver_descr'
integer :: iout_
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
implicit none
class(mld_z_base_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_free'
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
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act, ival
character(len=20) :: name='d_base_solver_setc'
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
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_seti'
! 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
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
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) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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 mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_apply_vect
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
type(psb_z_vect_type), intent(inout) :: x
type(psb_z_vect_type), intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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()
if (x%get_nrows() < n_row) then
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_diag_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_diag_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_diag_solver_bld', ch_err
info=psb_success_
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
call sv%dv%bld(sv%d)
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
end if

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

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

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

@ -36,50 +36,50 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_id_solver_apply_vect'
use psb_base_mod
use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_id_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
call psb_erractionsave(err_act)
integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_id_solver_apply_vect'
info = psb_success_
call psb_erractionsave(err_act)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
info = psb_success_
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T')
case('C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
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 mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply
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
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
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(:)
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(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
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)
if (info /= psb_success_) then
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_)')
goto 9999
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)
if (info /= psb_success_) then
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_)')
goto 9999
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,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
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
end select
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
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 mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply_vect
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
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
type(psb_z_vect_type) :: wv, wv1
integer(psb_ipk_) :: n_row,n_col
type(psb_z_vect_type) :: wv, wv1
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(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
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
end if
if (y%get_nrows() < n_row) then
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
end if
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
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_)')
goto 9999
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)
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
end select
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
endif
call wv%free(info)

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

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
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
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_ilu_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
! 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(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_ilu_solver_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_ilu_solver_bld', ch_err
info=psb_success_
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)
! Error: fill-in <= -1
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
case(0:)
@ -134,7 +133,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
case(:-1)
! Error: fill-in <= -1
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
case(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.
info = psb_err_input_value_invalid_i_
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
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.
info = 31
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
!

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
implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: solver
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
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
use mld_c_base_solver_mod
interface mld_ilu0_fact
subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_cspmat_type, psb_spk_
integer, intent(in) :: ialg
integer, intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
import psb_cspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: ialg
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
type(psb_cspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
complex(psb_spk_), intent(inout) :: d(:)
character, intent(in), optional :: upd
complex(psb_spk_), intent(inout) :: d(:)
end subroutine mld_cilu0_fact
end interface
interface mld_iluk_fact
subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_cspmat_type, psb_spk_
integer, intent(in) :: fill_in,ialg
integer, intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
import psb_cspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in,ialg
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
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 interface
interface mld_ilut_fact
subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_cspmat_type, psb_spk_
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
complex(psb_spk_), intent(inout) :: d(:)
import psb_cspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
complex(psb_spk_), intent(inout) :: d(:)
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 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
use mld_d_base_solver_mod
interface mld_ilu0_fact
subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_dspmat_type, psb_dpk_
integer, intent(in) :: ialg
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
import psb_dspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: ialg
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
real(psb_dpk_), intent(inout) :: d(:)
character, intent(in), optional :: upd
real(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_dilu0_fact
end interface
interface mld_iluk_fact
subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_dspmat_type, psb_dpk_
integer, intent(in) :: fill_in,ialg
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
import psb_dspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in,ialg
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
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 interface
interface mld_ilut_fact
subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_dspmat_type, psb_dpk_
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
real(psb_dpk_), intent(inout) :: d(:)
import psb_dspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
real(psb_dpk_), intent(inout) :: d(:)
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 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
use mld_s_base_solver_mod
interface mld_ilu0_fact
subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_sspmat_type, psb_spk_
integer, intent(in) :: ialg
integer, intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
import psb_sspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: ialg
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
type(psb_sspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
real(psb_spk_), intent(inout) :: d(:)
character, intent(in), optional :: upd
real(psb_spk_), intent(inout) :: d(:)
end subroutine mld_silu0_fact
end interface
interface mld_iluk_fact
subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_sspmat_type, psb_spk_
integer, intent(in) :: fill_in,ialg
integer, intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
import psb_sspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in,ialg
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
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 interface
interface mld_ilut_fact
subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_sspmat_type, psb_spk_
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
real(psb_spk_), intent(inout) :: d(:)
import psb_sspmat_type, psb_spk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
real(psb_spk_), intent(inout) :: d(:)
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 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
use mld_z_base_solver_mod
interface mld_ilu0_fact
subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck,upd)
import psb_zspmat_type, psb_dpk_
integer, intent(in) :: ialg
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
import psb_zspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: ialg
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
complex(psb_dpk_), intent(inout) :: d(:)
character, intent(in), optional :: upd
complex(psb_dpk_), intent(inout) :: d(:)
end subroutine mld_zilu0_fact
end interface
interface mld_iluk_fact
subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck)
import psb_zspmat_type, psb_dpk_
integer, intent(in) :: fill_in,ialg
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
import psb_zspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in,ialg
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
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 interface
interface mld_ilut_fact
subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
import psb_zspmat_type, psb_dpk_
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
complex(psb_dpk_), intent(inout) :: d(:)
import psb_zspmat_type, psb_dpk_, psb_ipk_
integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
complex(psb_dpk_), intent(inout) :: d(:)
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 interface

Write Preview
Loading…
Cancel
Save