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/impl/mld_caggrmat_asb.f90
 mlprec/impl/mld_caggrmat_biz_asb.f90
 mlprec/impl/mld_caggrmat_minnrg_asb.f90
 mlprec/impl/mld_caggrmat_nosmth_asb.f90
 mlprec/impl/mld_caggrmat_smth_asb.f90
 mlprec/impl/mld_cilu0_fact.f90
 mlprec/impl/mld_ciluk_fact.f90
 mlprec/impl/mld_cilut_fact.f90
 mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_cmlprec_bld.f90
 mlprec/impl/mld_cprecaply.f90
 mlprec/impl/mld_cprecbld.f90
 mlprec/impl/mld_daggrmat_asb.f90
 mlprec/impl/mld_daggrmat_biz_asb.f90
 mlprec/impl/mld_daggrmat_minnrg_asb.f90
 mlprec/impl/mld_daggrmat_nosmth_asb.f90
 mlprec/impl/mld_daggrmat_smth_asb.f90
 mlprec/impl/mld_dilu0_fact.f90
 mlprec/impl/mld_diluk_fact.f90
 mlprec/impl/mld_dilut_fact.f90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_dmlprec_bld.f90
 mlprec/impl/mld_dprecaply.f90
 mlprec/impl/mld_dprecbld.f90
 mlprec/impl/mld_saggrmat_asb.f90
 mlprec/impl/mld_saggrmat_biz_asb.f90
 mlprec/impl/mld_saggrmat_minnrg_asb.f90
 mlprec/impl/mld_saggrmat_nosmth_asb.f90
 mlprec/impl/mld_saggrmat_smth_asb.f90
 mlprec/impl/mld_silu0_fact.f90
 mlprec/impl/mld_siluk_fact.f90
 mlprec/impl/mld_silut_fact.f90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_smlprec_bld.f90
 mlprec/impl/mld_sprecaply.f90
 mlprec/impl/mld_sprecbld.f90
 mlprec/impl/mld_zaggrmat_asb.f90
 mlprec/impl/mld_zaggrmat_biz_asb.f90
 mlprec/impl/mld_zaggrmat_minnrg_asb.f90
 mlprec/impl/mld_zaggrmat_nosmth_asb.f90
 mlprec/impl/mld_zaggrmat_smth_asb.f90
 mlprec/impl/mld_zilu0_fact.f90
 mlprec/impl/mld_ziluk_fact.f90
 mlprec/impl/mld_zilut_fact.f90
 mlprec/impl/mld_zmlprec_aply.f90
 mlprec/impl/mld_zmlprec_bld.f90
 mlprec/impl/mld_zprecaply.f90
 mlprec/impl/mld_zprecbld.f90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_as_smoother.f90
 mlprec/mld_c_base_smoother_mod.f90
 mlprec/mld_c_base_solver_mod.f90
 mlprec/mld_c_ilu_solver.f90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_as_smoother.f90
 mlprec/mld_d_base_smoother_mod.f90
 mlprec/mld_d_base_solver_mod.f90
 mlprec/mld_d_ilu_solver.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_as_smoother.f90
 mlprec/mld_s_base_smoother_mod.f90
 mlprec/mld_s_base_solver_mod.f90
 mlprec/mld_s_ilu_solver.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_as_smoother.f90
 mlprec/mld_z_base_smoother_mod.f90
 mlprec/mld_z_base_solver_mod.f90
 mlprec/mld_z_ilu_solver.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90

Long integer fixes.
stopcriterion
Salvatore Filippone 12 years ago
parent 68b0e5fc8b
commit df4f84e3ee
73 changed files with 700 additions and 674 deletions
Show Stats Download Patch File Download Diff File

2
mlprec/impl/mld_caggrmat_asb.f90
Unescape Escape View File

@ -118,7 +118,7 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
type(psb_c_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl,ntaggr, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
character(len=20) :: name
name='mld_aggrmat_asb'

2
mlprec/impl/mld_caggrmat_biz_asb.f90
Unescape Escape View File

@ -95,7 +95,7 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_cspmat_type) :: am3, am4
type(psb_c_coo_sparse_mat) :: tmpcoo

4
mlprec/impl/mld_caggrmat_minnrg_asb.f90
Unescape Escape View File

@ -116,7 +116,7 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act
integer(psb_mpik_) :: ictxt,np,me, icomm
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_cspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_cspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -688,7 +688,7 @@ contains
subroutine local_dump(me,mat,name,header)
type(psb_cspmat_type), intent(in) :: mat
integer(psb_mpik_), intent(in) :: me
integer(psb_ipk_), intent(in) :: me
character(len=*), intent(in) :: name
character(len=*), intent(in) :: header
character(len=80) :: filename

2
mlprec/impl/mld_caggrmat_nosmth_asb.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_c_coo_sparse_mat) :: ac_coo, acoo

2
mlprec/impl/mld_caggrmat_smth_asb.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_cspmat_type) :: am3, am4
type(psb_c_coo_sparse_mat) :: tmpcoo

59
mlprec/impl/mld_cilu0_fact.f90
Unescape Escape View File

@ -107,19 +107,19 @@ subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck, upd)
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
complex(psb_spk_), intent(inout) :: d(:)
integer, intent(out) :: info
complex(psb_spk_), intent(inout) :: d(:)
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
character, intent(in), optional :: upd
! Local variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_cspmat_type), pointer :: blck_
type(psb_c_csr_sparse_mat) :: ll, uu
character :: upd_
type(psb_c_csr_sparse_mat) :: ll, uu
character :: upd_
character(len=20) :: name, ch_err
name='mld_cilu0_fact'
@ -133,7 +133,7 @@ subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck, upd)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -292,20 +292,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_cspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_spk_), intent(inout) :: lval(:),uval(:),d(:)
character, intent(in) :: upd
! Local variables
integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer :: ma,mb
integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer(psb_ipk_) :: ma,mb
complex(psb_spk_) :: dia,temp
integer, parameter :: nrb=16
integer(psb_ipk_), parameter :: nrb=16
type(psb_c_coo_sparse_mat) :: trw
integer :: int_err(5)
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name, ch_err
name='mld_cilu0_factint'
@ -320,11 +320,12 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/ione,ialg,izero,izero,izero/))
goto 9999
end select
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_all'
@ -351,14 +352,14 @@ contains
! Copy the i-th local row of the matrix, stored in a,
! into lval/d(i)/uval
!
call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,&
call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
else
!
! Copy the i-th local row of the matrix, stored in b
! (as (i-ma)-th row), into lval/d(i)/uval
!
call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,&
call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
endif
@ -437,7 +438,7 @@ contains
!
! Check the pivot size
!
if (abs(dia) < d_epstol) then
if (abs(dia) < s_epstol) then
!
! Too small pivot: unstable factorization
!
@ -463,7 +464,8 @@ contains
else
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if
@ -564,14 +566,14 @@ contains
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jd,jmin,jmax
integer, intent(inout) :: ktrw,l1,l2
integer, intent(inout) :: lja(:), uja(:)
complex(psb_spk_), intent(inout) :: lval(:), uval(:), dia
integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,l1,l2
integer(psb_ipk_), intent(inout) :: lja(:), uja(:)
complex(psb_spk_), intent(inout) :: lval(:), uval(:), dia
character, intent(in) :: upd
! Local variables
integer :: k,j,info,irb, nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,info,irb, nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
@ -650,7 +652,8 @@ contains
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if

94
mlprec/impl/mld_ciluk_fact.f90
Unescape Escape View File

@ -104,17 +104,17 @@ subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck)
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
integer, intent(out) :: info
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(:)
! Local Variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_cspmat_type), pointer :: blck_
type(psb_c_csr_sparse_mat) :: ll, uu
type(psb_c_csr_sparse_mat) :: ll, uu
character(len=20) :: name, ch_err
name='mld_ciluk_fact'
@ -128,7 +128,7 @@ subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -278,21 +278,21 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
type(psb_cspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg
type(psb_cspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_spk_), intent(inout) :: d(:)
! Local variables
integer :: ma,mb,i, ktrw,err_act,nidx, m
integer, allocatable :: uplevs(:), rowlevs(:),idxs(:)
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -304,12 +304,14 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/itwo,ialg,izero,izero,izero/))
goto 9999
end select
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
@ -321,7 +323,7 @@ contains
! Allocate a temporary buffer for the iluk_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -369,13 +371,13 @@ contains
!
! Copy into trw the i-th local row of the matrix, stored in a
!
call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info)
else
!
! Copy into trw the i-th local row of the matrix, stored in b
! (as (i-ma)-th row)
!
call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info)
endif
! Do an elimination step on the current row. It turns out we only
@ -397,7 +399,7 @@ contains
end do
!
! And we're sone, so deallocate the memory
! And we're done, so deallocate the memory
!
deallocate(uplevs,rowlevs,row,stat=info)
if (info /= psb_success_) then
@ -476,7 +478,7 @@ contains
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, sone by psb_init_heap inside this
! to retain its allocation, done by psb_init_heap inside this
! routine.
! ktrw - integer, input/output.
! The index identifying the last entry taken from the
@ -496,17 +498,17 @@ contains
implicit none
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jmin,jmax
integer, intent(inout) :: ktrw,info
integer, intent(inout) :: rowlevs(:)
complex(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
! Local variables
integer :: k,j,irb,err_act,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,err_act,nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
@ -644,7 +646,7 @@ contains
! examined during the elimination step.This will be used by
! by the routine iluk_copyout.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, sone by this routine.
! to retain its allocation, done by this routine.
!
subroutine iluk_fact(fill_in,i,row,rowlevs,heap,d,uja,uirp,uval,uplevs,nidx,idxs,info)
@ -653,16 +655,16 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i, fill_in
integer, intent(inout) :: nidx,info
integer, intent(inout) :: rowlevs(:)
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:),uplevs(:)
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:)
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local variables
integer :: k,j,lrwk,jj,lastk, iret
integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret
complex(psb_spk_) :: rwk
info = psb_success_
@ -829,15 +831,15 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg, i, m, nidx
integer, intent(inout) :: l1, l2, info
integer, intent(inout) :: rowlevs(:), idxs(:)
integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
complex(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx
integer(psb_ipk_), intent(inout) :: l1, l2, info
integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:)
integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
complex(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:)
complex(psb_spk_), intent(inout) :: row(:), d(:)
! Local variables
integer :: j,isz,err_act,int_err(5),idxp
integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
@ -940,7 +942,7 @@ contains
!
! Check the pivot size
!
if (abs(d(i)) < d_epstol) then
if (abs(d(i)) < s_epstol) then
!
! Too small pivot: unstable factorization
!

87
mlprec/impl/mld_cilut_fact.f90
Unescape Escape View File

@ -100,16 +100,16 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
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(:)
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
! Local Variables
integer :: l1, l2, m, err_act, iscale_
integer(psb_ipk_) :: l1, l2, m, err_act, iscale_
type(psb_cspmat_type), pointer :: blck_
type(psb_c_csr_sparse_mat) :: ll, uu
@ -122,7 +122,8 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
!
@ -132,7 +133,7 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -154,7 +155,7 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
scale = sone/scale
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/))
call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/))
goto 9999
end select
@ -296,20 +297,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_cspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_spk_), intent(inout) :: d(:)
real(psb_spk_), intent(in), optional :: scale
integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_cspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_spk_), intent(inout) :: d(:)
real(psb_spk_), intent(in), optional :: scale
! Local Variables
integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_spk_) :: nrmi
real(psb_spk_) :: weight
integer, allocatable :: idxs(:)
integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw
@ -328,7 +329,7 @@ contains
!
! Allocate a temporary buffer for the ilut_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -371,10 +372,10 @@ contains
!
d(i) = czero
if (i<=ma) then
call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
else
call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
endif
@ -520,15 +521,15 @@ contains
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight
integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd
integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
real(psb_spk_) :: dmaxup
real(psb_spk_), external :: dnrm2
character(len=20), parameter :: name='mld_cilut_factint'
@ -716,19 +717,19 @@ contains
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret
complex(psb_spk_) :: rwk
info = psb_success_
call psb_ensure_size(200,idxs,info)
call psb_ensure_size(200*ione,idxs,info)
if (info /= psb_success_) return
nidx = 0
lastk = -1
@ -902,20 +903,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer(psb_ipk_), intent(in) :: idxs(:)
integer(psb_ipk_), intent(inout) :: l1,l2, info
integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
real(psb_spk_), intent(in) :: thres,nrmi
complex(psb_spk_),allocatable, intent(inout) :: uval(:), lval(:)
complex(psb_spk_), intent(inout) :: row(:), d(:)
! Local variables
complex(psb_spk_),allocatable :: xw(:)
integer, allocatable :: xwid(:), indx(:)
integer(psb_ipk_), allocatable :: xwid(:), indx(:)
complex(psb_spk_) :: witem
integer :: widx
integer :: k,isz,err_act,int_err(5),idxp, nz
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_scomplex_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
@ -939,7 +940,7 @@ contains
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),&
call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if

8
mlprec/impl/mld_cmlprec_aply.f90
Unescape Escape View File

@ -325,7 +325,7 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
@ -416,7 +416,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
@ -877,7 +877,7 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act
character(len=20) :: name
character :: trans_
@ -993,7 +993,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps

2
mlprec/impl/mld_cmlprec_bld.f90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold)
! Local Variables
type(mld_cprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

8
mlprec/impl/mld_cprecaply.f90
Unescape Escape View File

@ -90,7 +90,7 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -221,7 +221,7 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
complex(psb_spk_), pointer :: WW(:), w1(:)
character(len=20) :: name
@ -290,7 +290,7 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -395,7 +395,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_
type(psb_c_vect_type) :: ww
complex(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name

4
mlprec/impl/mld_cprecbld.f90
Unescape Escape View File

@ -76,8 +76,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
!!$ character, intent(in), optional :: upd
! Local Variables
type(mld_cprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
type(mld_cprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

2
mlprec/impl/mld_daggrmat_asb.f90
Unescape Escape View File

@ -118,7 +118,7 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
type(psb_d_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl,ntaggr, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
character(len=20) :: name
name='mld_aggrmat_asb'

2
mlprec/impl/mld_daggrmat_biz_asb.f90
Unescape Escape View File

@ -95,7 +95,7 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_dspmat_type) :: am3, am4
type(psb_d_coo_sparse_mat) :: tmpcoo

4
mlprec/impl/mld_daggrmat_minnrg_asb.f90
Unescape Escape View File

@ -116,7 +116,7 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act
integer(psb_mpik_) :: ictxt,np,me, icomm
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_dspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_dspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -688,7 +688,7 @@ contains
subroutine local_dump(me,mat,name,header)
type(psb_dspmat_type), intent(in) :: mat
integer(psb_mpik_), intent(in) :: me
integer(psb_ipk_), intent(in) :: me
character(len=*), intent(in) :: name
character(len=*), intent(in) :: header
character(len=80) :: filename

2
mlprec/impl/mld_daggrmat_nosmth_asb.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_d_coo_sparse_mat) :: ac_coo, acoo

2
mlprec/impl/mld_daggrmat_smth_asb.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_dspmat_type) :: am3, am4
type(psb_d_coo_sparse_mat) :: tmpcoo

73
mlprec/impl/mld_dilu0_fact.f90
Unescape Escape View File

@ -62,7 +62,7 @@
! u (U factor, except its diagonal) and d (diagonal of U).
!
! This implementation of ILU(0)/MILU(0) is faster than the implementation in
! mld_diluk_fct (the latter routine performs the more general ILU(k)/MILU(k)).
! mld_ziluk_fct (the latter routine performs the more general ILU(k)/MILU(k)).
!
!
! Arguments:
@ -107,19 +107,19 @@ subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck, upd)
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
real(psb_dpk_), intent(inout) :: d(:)
integer, intent(out) :: info
real(psb_dpk_), intent(inout) :: d(:)
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
character, intent(in), optional :: upd
! Local variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_dspmat_type), pointer :: blck_
type(psb_d_csr_sparse_mat) :: ll, uu
character :: upd_
type(psb_d_csr_sparse_mat) :: ll, uu
character :: upd_
character(len=20) :: name, ch_err
name='mld_dilu0_fact'
@ -133,7 +133,7 @@ subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck, upd)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -261,19 +261,19 @@ contains
! d - real(psb_dpk_), dimension(:), output.
! The inverse of the diagonal entries of the U factor in the
! incomplete factorization.
! lval - real(psb_dpk_), dimension(:), input/output.
! lval - real(psb_dpk_), dimension(:), input/output.
! The entries of U are stored according to the CSR format.
! The L factor in the incomplete factorization.
! lja - integer, dimension(:), input/output.
! lja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the L factor,
! according to the CSR storage format.
! lirp - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the L factor in lval, according to the CSR storage format.
! uval - real(psb_dpk_), dimension(:), input/output.
! uval - real(psb_dpk_), dimension(:), input/output.
! The U factor in the incomplete factorization.
! The entries of U are stored according to the CSR format.
! uja - integer, dimension(:), input/output.
! uja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the U factor,
! according to the CSR storage format.
! uirp - integer, dimension(:), input/output.
@ -292,20 +292,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: ialg
type(psb_dspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:)
integer(psb_ipk_), intent(in) :: ialg
type(psb_dspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:)
character, intent(in) :: upd
! Local variables
integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer :: ma,mb
integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer(psb_ipk_) :: ma,mb
real(psb_dpk_) :: dia,temp
integer, parameter :: nrb=16
integer(psb_ipk_), parameter :: nrb=16
type(psb_d_coo_sparse_mat) :: trw
integer :: int_err(5)
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name, ch_err
name='mld_dilu0_factint'
@ -320,11 +320,12 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/ione,ialg,izero,izero,izero/))
goto 9999
end select
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_all'
@ -344,21 +345,21 @@ contains
!
do i = 1, m
d(i) = dzero
d(i) = dzero
if (i <= ma) then
!
! Copy the i-th local row of the matrix, stored in a,
! into lval/d(i)/uval
!
call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,&
call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
else
!
! Copy the i-th local row of the matrix, stored in b
! (as (i-ma)-th row), into lval/d(i)/uval
!
call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,&
call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
endif
@ -463,7 +464,8 @@ contains
else
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if
@ -564,14 +566,14 @@ contains
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jd,jmin,jmax
integer, intent(inout) :: ktrw,l1,l2
integer, intent(inout) :: lja(:), uja(:)
real(psb_dpk_), intent(inout) :: lval(:), uval(:), dia
integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,l1,l2
integer(psb_ipk_), intent(inout) :: lja(:), uja(:)
real(psb_dpk_), intent(inout) :: lval(:), uval(:), dia
character, intent(in) :: upd
! Local variables
integer :: k,j,info,irb, nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,info,irb, nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
@ -650,7 +652,8 @@ contains
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if

98
mlprec/impl/mld_diluk_fact.f90
Unescape Escape View File

@ -104,17 +104,17 @@ subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck)
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
integer, intent(out) :: info
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(:)
! Local Variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_dspmat_type), pointer :: blck_
type(psb_d_csr_sparse_mat) :: ll, uu
type(psb_d_csr_sparse_mat) :: ll, uu
character(len=20) :: name, ch_err
name='mld_diluk_fact'
@ -128,7 +128,7 @@ subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -242,7 +242,7 @@ contains
! distributed matrix, that have been retrieved by mld_as_bld
! to build an Additive Schwarz base preconditioner with overlap
! greater than 0. If the overlap is 0 or the matrix has been reordered
! (see mld_fact_bld), then b does not contain any row.
! (see mld_fact_bld), then b does not contain any row.
! d - real(psb_dpk_), dimension(:), output.
! The inverse of the diagonal entries of the U factor in the incomplete
! factorization.
@ -254,10 +254,10 @@ contains
! lia2 - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the L factor in laspk, according to the CSR storage format.
! uval - real(psb_dpk_), dimension(:), input/output.
! uval - real(psb_dpk_), dimension(:), input/output.
! The U factor in the incomplete factorization.
! The entries of U are stored according to the CSR format.
! uja - integer, dimension(:), input/output.
! uja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the U factor,
! according to the CSR storage format.
! uirp - integer, dimension(:), input/output.
@ -278,21 +278,21 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
type(psb_dspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg
type(psb_dspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_dpk_), intent(inout) :: d(:)
! Local variables
integer :: ma,mb,i, ktrw,err_act,nidx, m
integer, allocatable :: uplevs(:), rowlevs(:),idxs(:)
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err
type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -304,12 +304,14 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/itwo,ialg,izero,izero,izero/))
goto 9999
end select
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
@ -321,7 +323,7 @@ contains
! Allocate a temporary buffer for the iluk_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -369,13 +371,13 @@ contains
!
! Copy into trw the i-th local row of the matrix, stored in a
!
call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info)
else
!
! Copy into trw the i-th local row of the matrix, stored in b
! (as (i-ma)-th row)
!
call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info)
endif
! Do an elimination step on the current row. It turns out we only
@ -496,17 +498,17 @@ contains
implicit none
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jmin,jmax
integer, intent(inout) :: ktrw,info
integer, intent(inout) :: rowlevs(:)
real(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
! Local variables
integer :: k,j,irb,err_act,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,err_act,nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
@ -653,17 +655,17 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i, fill_in
integer, intent(inout) :: nidx,info
integer, intent(inout) :: rowlevs(:)
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:),uplevs(:)
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:)
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local variables
integer :: k,j,lrwk,jj,lastk, iret
real(psb_dpk_) :: rwk
integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret
real(psb_dpk_) :: rwk
info = psb_success_
if (.not.allocated(idxs)) then
@ -813,7 +815,7 @@ contains
! uirp - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the U factor copied in uval row by row (see
! mld_dilu_fctint), according to the CSR storage format.
! mld_zilu_fctint), according to the CSR storage format.
! uval - real(psb_dpk_), dimension(:), input/output.
! The array where the entries of the row corresponding to the
! U factor are copied.
@ -829,15 +831,15 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg, i, m, nidx
integer, intent(inout) :: l1, l2, info
integer, intent(inout) :: rowlevs(:), idxs(:)
integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
real(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:)
real(psb_dpk_), intent(inout) :: row(:), d(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx
integer(psb_ipk_), intent(inout) :: l1, l2, info
integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:)
integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
real(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:)
real(psb_dpk_), intent(inout) :: row(:), d(:)
! Local variables
integer :: j,isz,err_act,int_err(5),idxp
integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err

132
mlprec/impl/mld_dilut_fact.f90
Unescape Escape View File

@ -100,16 +100,16 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
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(:)
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
! Local Variables
integer :: l1, l2, m, err_act, iscale_
integer(psb_ipk_) :: l1, l2, m, err_act, iscale_
type(psb_dspmat_type), pointer :: blck_
type(psb_d_csr_sparse_mat) :: ll, uu
@ -122,7 +122,8 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
!
@ -132,7 +133,7 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -148,13 +149,13 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
select case(iscale_)
case(mld_ilu_scale_none_)
scale = done
scale = sone
case(mld_ilu_scale_maxval_)
scale = max(a%maxval(),blck_%maxval())
scale = done/scale
scale = sone/scale
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/))
call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/))
goto 9999
end select
@ -296,19 +297,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_dspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_dpk_), intent(inout) :: d(:)
real(psb_dpk_), intent(in), optional :: scale
integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_dspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_dpk_), intent(inout) :: d(:)
real(psb_dpk_), intent(in), optional :: scale
! Local Variables
integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_dpk_) :: nrmi, weight
integer, allocatable :: idxs(:)
integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_dpk_) :: nrmi
real(psb_dpk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw
@ -327,7 +329,7 @@ contains
!
! Allocate a temporary buffer for the ilut_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -352,8 +354,8 @@ contains
goto 9999
end if
row(:) = dzero
weight = done
row(:) = czero
weight = sone
if (present(scale)) weight = abs(scale)
!
! Cycle over the matrix rows
@ -368,12 +370,12 @@ contains
! the lowest index, but we also need to insert new items, and the heap
! allows to do both in log time.
!
d(i) = dzero
d(i) = czero
if (i<=ma) then
call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
else
call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
endif
@ -399,12 +401,12 @@ contains
!
! Adjust diagonal accounting for scale factor
!
if (weight /= done) then
if (weight /= sone) then
d(1:m) = d(1:m)*weight
end if
!
! And we're done, so deallocate the memory
! And we're sone, so deallocate the memory
!
deallocate(row,idxs,stat=info)
if (info /= psb_success_) then
@ -500,7 +502,7 @@ contains
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, done by psb_init_heap inside this
! to retain its allocation, sone by psb_init_heap inside this
! routine.
! ktrw - integer, input/output.
! The index identifying the last entry taken from the
@ -519,14 +521,15 @@ contains
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi,row(:)
real(psb_dpk_), intent(in) :: weight
integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd
integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi
real(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
real(psb_dpk_) :: dmaxup
real(psb_dpk_), external :: dnrm2
character(len=20), parameter :: name='mld_dilut_factint'
@ -552,8 +555,8 @@ contains
nlw = 0
nup = 0
jmaxup = 0
dmaxup = dzero
nrmi = dzero
dmaxup = szero
nrmi = szero
select type (aa=> a%a)
type is (psb_d_csr_sparse_mat)
@ -618,7 +621,6 @@ contains
row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
nup = nup + 1
@ -705,7 +707,7 @@ contains
! examined during the elimination step.This will be used by
! by the routine ilut_copyout.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, done by this routine.
! to retain its allocation, sone by this routine.
!
subroutine ilut_fact(thres,i,nrmi,row,heap,d,uja,uirp,uval,nidx,idxs,info)
@ -715,19 +717,19 @@ contains
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret
real(psb_dpk_) :: rwk
info = psb_success_
call psb_ensure_size(200,idxs,info)
call psb_ensure_size(200*ione,idxs,info)
if (info /= psb_success_) return
nidx = 0
lastk = -1
@ -757,7 +759,7 @@ contains
!
! Drop the entry.
!
row(k) = dzero
row(k) = czero
cycle
else
!
@ -779,7 +781,7 @@ contains
!
! Drop the entry.
!
row(j) = dzero
row(j) = czero
else
!
! Do the insertion.
@ -901,24 +903,24 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer(psb_ipk_), intent(in) :: idxs(:)
integer(psb_ipk_), intent(inout) :: l1,l2, info
integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_),allocatable, intent(inout) :: uval(:), lval(:)
real(psb_dpk_), intent(inout) :: row(:), d(:)
! Local variables
real(psb_dpk_),allocatable :: xw(:)
integer, allocatable :: xwid(:), indx(:)
real(psb_dpk_) :: witem
integer :: widx
integer :: k,isz,err_act,int_err(5),idxp, nz
type(psb_double_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
real(psb_dpk_),allocatable :: xw(:)
integer(psb_ipk_), allocatable :: xwid(:), indx(:)
real(psb_dpk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_dreal_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -938,7 +940,7 @@ contains
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),&
call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -1061,7 +1063,7 @@ contains
!
! Compute 1/pivot
!
d(i) = done/d(i)
d(i) = cone/d(i)
end if
end if
end if
@ -1171,7 +1173,7 @@ contains
! Set row to zero
!
do idxp=1,nidx
row(idxs(idxp)) = dzero
row(idxs(idxp)) = czero
end do
!

8
mlprec/impl/mld_dmlprec_aply.f90
Unescape Escape View File

@ -325,7 +325,7 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
@ -416,7 +416,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
@ -877,7 +877,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act
character(len=20) :: name
character :: trans_
@ -993,7 +993,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps

2
mlprec/impl/mld_dmlprec_bld.f90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
! Local Variables
type(mld_dprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

8
mlprec/impl/mld_dprecaply.f90
Unescape Escape View File

@ -90,7 +90,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -221,7 +221,7 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
real(psb_dpk_), pointer :: WW(:), w1(:)
character(len=20) :: name
@ -290,7 +290,7 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -395,7 +395,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_
type(psb_d_vect_type) :: ww
real(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name

4
mlprec/impl/mld_dprecbld.f90
Unescape Escape View File

@ -76,8 +76,8 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
!!$ character, intent(in), optional :: upd
! Local Variables
type(mld_dprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
type(mld_dprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

2
mlprec/impl/mld_saggrmat_asb.f90
Unescape Escape View File

@ -118,7 +118,7 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
type(psb_s_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl,ntaggr, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
character(len=20) :: name
name='mld_aggrmat_asb'

2
mlprec/impl/mld_saggrmat_biz_asb.f90
Unescape Escape View File

@ -95,7 +95,7 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_sspmat_type) :: am3, am4
type(psb_s_coo_sparse_mat) :: tmpcoo

4
mlprec/impl/mld_saggrmat_minnrg_asb.f90
Unescape Escape View File

@ -116,7 +116,7 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act
integer(psb_mpik_) :: ictxt,np,me, icomm
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_sspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_sspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -688,7 +688,7 @@ contains
subroutine local_dump(me,mat,name,header)
type(psb_sspmat_type), intent(in) :: mat
integer(psb_mpik_), intent(in) :: me
integer(psb_ipk_), intent(in) :: me
character(len=*), intent(in) :: name
character(len=*), intent(in) :: header
character(len=80) :: filename

2
mlprec/impl/mld_saggrmat_nosmth_asb.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_s_coo_sparse_mat) :: ac_coo, acoo

2
mlprec/impl/mld_saggrmat_smth_asb.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_sspmat_type) :: am3, am4
type(psb_s_coo_sparse_mat) :: tmpcoo

73
mlprec/impl/mld_silu0_fact.f90
Unescape Escape View File

@ -62,7 +62,7 @@
! u (U factor, except its diagonal) and d (diagonal of U).
!
! This implementation of ILU(0)/MILU(0) is faster than the implementation in
! mld_diluk_fct (the latter routine performs the more general ILU(k)/MILU(k)).
! mld_ziluk_fct (the latter routine performs the more general ILU(k)/MILU(k)).
!
!
! Arguments:
@ -107,19 +107,19 @@ subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck, upd)
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_sspmat_type),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u
real(psb_spk_), intent(inout) :: d(:)
integer, intent(out) :: info
real(psb_spk_), intent(inout) :: d(:)
integer(psb_ipk_), intent(out) :: info
type(psb_sspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
character, intent(in), optional :: upd
! Local variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_sspmat_type), pointer :: blck_
type(psb_s_csr_sparse_mat) :: ll, uu
character :: upd_
type(psb_s_csr_sparse_mat) :: ll, uu
character :: upd_
character(len=20) :: name, ch_err
name='mld_silu0_fact'
@ -133,7 +133,7 @@ subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck, upd)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -261,19 +261,19 @@ contains
! d - real(psb_spk_), dimension(:), output.
! The inverse of the diagonal entries of the U factor in the
! incomplete factorization.
! lval - real(psb_spk_), dimension(:), input/output.
! lval - real(psb_spk_), dimension(:), input/output.
! The entries of U are stored according to the CSR format.
! The L factor in the incomplete factorization.
! lja - integer, dimension(:), input/output.
! lja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the L factor,
! according to the CSR storage format.
! lirp - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the L factor in lval, according to the CSR storage format.
! uval - real(psb_spk_), dimension(:), input/output.
! uval - real(psb_spk_), dimension(:), input/output.
! The U factor in the incomplete factorization.
! The entries of U are stored according to the CSR format.
! uja - integer, dimension(:), input/output.
! uja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the U factor,
! according to the CSR storage format.
! uirp - integer, dimension(:), input/output.
@ -292,20 +292,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: ialg
type(psb_sspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_spk_), intent(inout) :: lval(:),uval(:),d(:)
integer(psb_ipk_), intent(in) :: ialg
type(psb_sspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_spk_), intent(inout) :: lval(:),uval(:),d(:)
character, intent(in) :: upd
! Local variables
integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer :: ma,mb
integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer(psb_ipk_) :: ma,mb
real(psb_spk_) :: dia,temp
integer, parameter :: nrb=16
integer(psb_ipk_), parameter :: nrb=16
type(psb_s_coo_sparse_mat) :: trw
integer :: int_err(5)
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name, ch_err
name='mld_silu0_factint'
@ -320,11 +320,12 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/ione,ialg,izero,izero,izero/))
goto 9999
end select
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_all'
@ -344,21 +345,21 @@ contains
!
do i = 1, m
d(i) = szero
d(i) = szero
if (i <= ma) then
!
! Copy the i-th local row of the matrix, stored in a,
! into lval/d(i)/uval
!
call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,&
call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
else
!
! Copy the i-th local row of the matrix, stored in b
! (as (i-ma)-th row), into lval/d(i)/uval
!
call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,&
call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
endif
@ -463,7 +464,8 @@ contains
else
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if
@ -564,14 +566,14 @@ contains
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jd,jmin,jmax
integer, intent(inout) :: ktrw,l1,l2
integer, intent(inout) :: lja(:), uja(:)
real(psb_spk_), intent(inout) :: lval(:), uval(:), dia
integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,l1,l2
integer(psb_ipk_), intent(inout) :: lja(:), uja(:)
real(psb_spk_), intent(inout) :: lval(:), uval(:), dia
character, intent(in) :: upd
! Local variables
integer :: k,j,info,irb, nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,info,irb, nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
@ -650,7 +652,8 @@ contains
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if

104
mlprec/impl/mld_siluk_fact.f90
Unescape Escape View File

@ -104,17 +104,17 @@ subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck)
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
integer, intent(out) :: info
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(:)
! Local Variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_sspmat_type), pointer :: blck_
type(psb_s_csr_sparse_mat) :: ll, uu
type(psb_s_csr_sparse_mat) :: ll, uu
character(len=20) :: name, ch_err
name='mld_siluk_fact'
@ -128,7 +128,7 @@ subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -242,7 +242,7 @@ contains
! distributed matrix, that have been retrieved by mld_as_bld
! to build an Additive Schwarz base preconditioner with overlap
! greater than 0. If the overlap is 0 or the matrix has been reordered
! (see mld_fact_bld), then b does not contain any row.
! (see mld_fact_bld), then b does not contain any row.
! d - real(psb_spk_), dimension(:), output.
! The inverse of the diagonal entries of the U factor in the incomplete
! factorization.
@ -254,10 +254,10 @@ contains
! lia2 - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the L factor in laspk, according to the CSR storage format.
! uval - real(psb_spk_), dimension(:), input/output.
! uval - real(psb_spk_), dimension(:), input/output.
! The U factor in the incomplete factorization.
! The entries of U are stored according to the CSR format.
! uja - integer, dimension(:), input/output.
! uja - integer, dimension(:), input/output.
! The column indices of the nonzero entries of the U factor,
! according to the CSR storage format.
! uirp - integer, dimension(:), input/output.
@ -278,21 +278,21 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
type(psb_sspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg
type(psb_sspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_spk_), intent(inout) :: d(:)
! Local variables
integer :: ma,mb,i, ktrw,err_act,nidx, m
integer, allocatable :: uplevs(:), rowlevs(:),idxs(:)
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err
type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -304,12 +304,14 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/itwo,ialg,izero,izero,izero/))
goto 9999
end select
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
@ -321,7 +323,7 @@ contains
! Allocate a temporary buffer for the iluk_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -369,13 +371,13 @@ contains
!
! Copy into trw the i-th local row of the matrix, stored in a
!
call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info)
else
!
! Copy into trw the i-th local row of the matrix, stored in b
! (as (i-ma)-th row)
!
call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info)
endif
! Do an elimination step on the current row. It turns out we only
@ -397,7 +399,7 @@ contains
end do
!
! And we're sone, so deallocate the memory
! And we're done, so deallocate the memory
!
deallocate(uplevs,rowlevs,row,stat=info)
if (info /= psb_success_) then
@ -476,7 +478,7 @@ contains
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, sone by psb_init_heap inside this
! to retain its allocation, done by psb_init_heap inside this
! routine.
! ktrw - integer, input/output.
! The index identifying the last entry taken from the
@ -496,17 +498,17 @@ contains
implicit none
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jmin,jmax
integer, intent(inout) :: ktrw,info
integer, intent(inout) :: rowlevs(:)
real(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
! Local variables
integer :: k,j,irb,err_act,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,err_act,nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
@ -644,7 +646,7 @@ contains
! examined during the elimination step.This will be used by
! by the routine iluk_copyout.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, sone by this routine.
! to retain its allocation, done by this routine.
!
subroutine iluk_fact(fill_in,i,row,rowlevs,heap,d,uja,uirp,uval,uplevs,nidx,idxs,info)
@ -653,17 +655,17 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i, fill_in
integer, intent(inout) :: nidx,info
integer, intent(inout) :: rowlevs(:)
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:),uplevs(:)
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:)
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local variables
integer :: k,j,lrwk,jj,lastk, iret
real(psb_spk_) :: rwk
integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret
real(psb_spk_) :: rwk
info = psb_success_
if (.not.allocated(idxs)) then
@ -813,7 +815,7 @@ contains
! uirp - integer, dimension(:), input/output.
! The indices identifying the first nonzero entry of each row
! of the U factor copied in uval row by row (see
! mld_dilu_fctint), according to the CSR storage format.
! mld_zilu_fctint), according to the CSR storage format.
! uval - real(psb_spk_), dimension(:), input/output.
! The array where the entries of the row corresponding to the
! U factor are copied.
@ -829,15 +831,15 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg, i, m, nidx
integer, intent(inout) :: l1, l2, info
integer, intent(inout) :: rowlevs(:), idxs(:)
integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
real(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:)
real(psb_spk_), intent(inout) :: row(:), d(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx
integer(psb_ipk_), intent(inout) :: l1, l2, info
integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:)
integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
real(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:)
real(psb_spk_), intent(inout) :: row(:), d(:)
! Local variables
integer :: j,isz,err_act,int_err(5),idxp
integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err

118
mlprec/impl/mld_silut_fact.f90
Unescape Escape View File

@ -95,22 +95,21 @@
subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
use psb_base_mod
use mld_base_prec_type
use mld_s_ilu_fact_mod, mld_protect_name => mld_silut_fact
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
integer, intent(out) :: info
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(:)
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
! Local Variables
integer :: l1, l2, m, err_act, iscale_
integer(psb_ipk_) :: l1, l2, m, err_act, iscale_
type(psb_sspmat_type), pointer :: blck_
type(psb_s_csr_sparse_mat) :: ll, uu
@ -123,7 +122,8 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
!
@ -133,7 +133,7 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -155,7 +155,7 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
scale = sone/scale
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/))
call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/))
goto 9999
end select
@ -297,19 +297,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_sspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_spk_), intent(inout) :: d(:)
real(psb_spk_), intent(in), optional :: scale
integer(psb_ipk_), intent(in) :: fill_in
real(psb_spk_), intent(in) :: thres
type(psb_sspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:)
real(psb_spk_), intent(inout) :: d(:)
real(psb_spk_), intent(in), optional :: scale
! Local Variables
integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_spk_) :: nrmi, weight
integer, allocatable :: idxs(:)
integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_spk_) :: nrmi
real(psb_spk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw
@ -328,7 +329,7 @@ contains
!
! Allocate a temporary buffer for the ilut_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -353,7 +354,7 @@ contains
goto 9999
end if
row(:) = szero
row(:) = czero
weight = sone
if (present(scale)) weight = abs(scale)
!
@ -369,12 +370,12 @@ contains
! the lowest index, but we also need to insert new items, and the heap
! allows to do both in log time.
!
d(i) = szero
d(i) = czero
if (i<=ma) then
call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
else
call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
endif
@ -520,14 +521,15 @@ contains
implicit none
type(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi,row(:)
real(psb_spk_), intent(in) :: weight
integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd
integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_spk_), intent(inout) :: nrmi
real(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
real(psb_spk_) :: dmaxup
real(psb_spk_), external :: dnrm2
character(len=20), parameter :: name='mld_silut_factint'
@ -597,7 +599,7 @@ contains
! rows are copied one by one into the array row, through successive
! calls to ilut_copyin.
!
if ((mod(i,nrb) == 1).or.(nrb == 1)) then
irb = min(m-i+1,nrb)
call aa%csget(i,i+irb-1,trw,info)
@ -608,7 +610,7 @@ contains
end if
ktrw=1
end if
kin = ktrw
nz = trw%get_nzeros()
do
@ -715,19 +717,19 @@ contains
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret
real(psb_spk_) :: rwk
info = psb_success_
call psb_ensure_size(200,idxs,info)
call psb_ensure_size(200*ione,idxs,info)
if (info /= psb_success_) return
nidx = 0
lastk = -1
@ -757,7 +759,7 @@ contains
!
! Drop the entry.
!
row(k) = szero
row(k) = czero
cycle
else
!
@ -779,7 +781,7 @@ contains
!
! Drop the entry.
!
row(j) = szero
row(j) = czero
else
!
! Do the insertion.
@ -901,24 +903,24 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer(psb_ipk_), intent(in) :: idxs(:)
integer(psb_ipk_), intent(inout) :: l1,l2, info
integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_),allocatable, intent(inout) :: uval(:), lval(:)
real(psb_spk_), intent(inout) :: row(:), d(:)
! Local variables
real(psb_spk_),allocatable :: xw(:)
integer, allocatable :: xwid(:), indx(:)
real(psb_spk_) :: witem
integer :: widx
integer :: k,isz,err_act,int_err(5),idxp, nz
type(psb_real_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
real(psb_spk_),allocatable :: xw(:)
integer(psb_ipk_), allocatable :: xwid(:), indx(:)
real(psb_spk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_sreal_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -938,7 +940,7 @@ contains
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),&
call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -1061,7 +1063,7 @@ contains
!
! Compute 1/pivot
!
d(i) = sone/d(i)
d(i) = cone/d(i)
end if
end if
end if
@ -1171,7 +1173,7 @@ contains
! Set row to zero
!
do idxp=1,nidx
row(idxs(idxp)) = szero
row(idxs(idxp)) = czero
end do
!

8
mlprec/impl/mld_smlprec_aply.f90
Unescape Escape View File

@ -325,7 +325,7 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
@ -416,7 +416,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
@ -877,7 +877,7 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act
character(len=20) :: name
character :: trans_
@ -993,7 +993,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps

2
mlprec/impl/mld_smlprec_bld.f90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold)
! Local Variables
type(mld_sprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

8
mlprec/impl/mld_sprecaply.f90
Unescape Escape View File

@ -90,7 +90,7 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -221,7 +221,7 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
real(psb_spk_), pointer :: WW(:), w1(:)
character(len=20) :: name
@ -290,7 +290,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -395,7 +395,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_
type(psb_s_vect_type) :: ww
real(psb_spk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name

4
mlprec/impl/mld_sprecbld.f90
Unescape Escape View File

@ -76,8 +76,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
!!$ character, intent(in), optional :: upd
! Local Variables
type(mld_sprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
type(mld_sprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

2
mlprec/impl/mld_zaggrmat_asb.f90
Unescape Escape View File

@ -118,7 +118,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
type(psb_z_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl,ntaggr, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
character(len=20) :: name
name='mld_aggrmat_asb'

2
mlprec/impl/mld_zaggrmat_biz_asb.f90
Unescape Escape View File

@ -95,7 +95,7 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_zspmat_type) :: am3, am4
type(psb_z_coo_sparse_mat) :: tmpcoo

4
mlprec/impl/mld_zaggrmat_minnrg_asb.f90
Unescape Escape View File

@ -116,7 +116,7 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
integer(psb_ipk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act
integer(psb_mpik_) :: ictxt,np,me, icomm
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_zspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_zspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -688,7 +688,7 @@ contains
subroutine local_dump(me,mat,name,header)
type(psb_zspmat_type), intent(in) :: mat
integer(psb_mpik_), intent(in) :: me
integer(psb_ipk_), intent(in) :: me
character(len=*), intent(in) :: name
character(len=*), intent(in) :: header
character(len=80) :: filename

2
mlprec/impl/mld_zaggrmat_nosmth_asb.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_z_coo_sparse_mat) :: ac_coo, acoo

2
mlprec/impl/mld_zaggrmat_smth_asb.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_mpik_) ::ictxt, np, me
integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name
type(psb_zspmat_type) :: am3, am4
type(psb_z_coo_sparse_mat) :: tmpcoo

57
mlprec/impl/mld_zilu0_fact.f90
Unescape Escape View File

@ -107,19 +107,19 @@ subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck, upd)
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
complex(psb_dpk_), intent(inout) :: d(:)
integer, intent(out) :: info
complex(psb_dpk_), intent(inout) :: d(:)
integer(psb_ipk_), intent(out) :: info
type(psb_zspmat_type),intent(in), optional, target :: blck
character, intent(in), optional :: upd
character, intent(in), optional :: upd
! Local variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_zspmat_type), pointer :: blck_
type(psb_z_csr_sparse_mat) :: ll, uu
character :: upd_
type(psb_z_csr_sparse_mat) :: ll, uu
character :: upd_
character(len=20) :: name, ch_err
name='mld_zilu0_fact'
@ -133,7 +133,7 @@ subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck, upd)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -292,20 +292,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: ialg
integer(psb_ipk_), intent(in) :: ialg
type(psb_zspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:)
character, intent(in) :: upd
! Local variables
integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer :: ma,mb
integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m
integer(psb_ipk_) :: ma,mb
complex(psb_dpk_) :: dia,temp
integer, parameter :: nrb=16
integer(psb_ipk_), parameter :: nrb=16
type(psb_z_coo_sparse_mat) :: trw
integer :: int_err(5)
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name, ch_err
name='mld_zilu0_factint'
@ -320,11 +320,12 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/ione,ialg,izero,izero,izero/))
goto 9999
end select
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_sp_all'
@ -351,14 +352,14 @@ contains
! Copy the i-th local row of the matrix, stored in a,
! into lval/d(i)/uval
!
call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,&
call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
else
!
! Copy the i-th local row of the matrix, stored in b
! (as (i-ma)-th row), into lval/d(i)/uval
!
call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,&
call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,&
& d(i),l2,uja,uval,ktrw,trw,upd)
endif
@ -463,7 +464,8 @@ contains
else
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if
@ -564,14 +566,14 @@ contains
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_z_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jd,jmin,jmax
integer, intent(inout) :: ktrw,l1,l2
integer, intent(inout) :: lja(:), uja(:)
complex(psb_dpk_), intent(inout) :: lval(:), uval(:), dia
integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,l1,l2
integer(psb_ipk_), intent(inout) :: lja(:), uja(:)
complex(psb_dpk_), intent(inout) :: lval(:), uval(:), dia
character, intent(in) :: upd
! Local variables
integer :: k,j,info,irb, nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,info,irb, nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
@ -650,7 +652,8 @@ contains
write(0,*) 'Update not implemented '
info = 31
call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd)
call psb_errpush(info,name,&
& i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd)
goto 9999
end if

86
mlprec/impl/mld_ziluk_fact.f90
Unescape Escape View File

@ -104,17 +104,17 @@ subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck)
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
integer, intent(out) :: info
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(:)
! Local Variables
integer :: l1, l2, m, err_act
integer(psb_ipk_) :: l1, l2, m, err_act
type(psb_zspmat_type), pointer :: blck_
type(psb_z_csr_sparse_mat) :: ll, uu
type(psb_z_csr_sparse_mat) :: ll, uu
character(len=20) :: name, ch_err
name='mld_ziluk_fact'
@ -128,7 +128,7 @@ subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -278,21 +278,21 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg
type(psb_zspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg
type(psb_zspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_dpk_), intent(inout) :: d(:)
! Local variables
integer :: ma,mb,i, ktrw,err_act,nidx, m
integer, allocatable :: uplevs(:), rowlevs(:),idxs(:)
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err
type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
@ -304,12 +304,14 @@ contains
! Ok
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/itwo,ialg,izero,izero,izero/))
goto 9999
end select
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
@ -321,7 +323,7 @@ contains
! Allocate a temporary buffer for the iluk_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -369,13 +371,13 @@ contains
!
! Copy into trw the i-th local row of the matrix, stored in a
!
call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info)
else
!
! Copy into trw the i-th local row of the matrix, stored in b
! (as (i-ma)-th row)
!
call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info)
call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info)
endif
! Do an elimination step on the current row. It turns out we only
@ -496,17 +498,17 @@ contains
implicit none
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(in) :: a
type(psb_z_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i,m,jmin,jmax
integer, intent(inout) :: ktrw,info
integer, intent(inout) :: rowlevs(:)
complex(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
! Local variables
integer :: k,j,irb,err_act,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,err_act,nz
integer(psb_ipk_), parameter :: nrb=40
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
@ -653,16 +655,16 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i, fill_in
integer, intent(inout) :: nidx,info
integer, intent(inout) :: rowlevs(:)
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:),uplevs(:)
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
type(psb_int_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:)
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local variables
integer :: k,j,lrwk,jj,lastk, iret
integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret
complex(psb_dpk_) :: rwk
info = psb_success_
@ -829,15 +831,15 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in, ialg, i, m, nidx
integer, intent(inout) :: l1, l2, info
integer, intent(inout) :: rowlevs(:), idxs(:)
integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
complex(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:)
integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx
integer(psb_ipk_), intent(inout) :: l1, l2, info
integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:)
integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:)
complex(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:)
complex(psb_dpk_), intent(inout) :: row(:), d(:)
! Local variables
integer :: j,isz,err_act,int_err(5),idxp
integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err

139
mlprec/impl/mld_zilut_fact.f90
Unescape Escape View File

@ -100,16 +100,16 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
integer, intent(out) :: info
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(:)
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
! Local Variables
integer :: l1, l2, m, err_act, iscale_
integer(psb_ipk_) :: l1, l2, m, err_act, iscale_
type(psb_zspmat_type), pointer :: blck_
type(psb_z_csr_sparse_mat) :: ll, uu
@ -122,7 +122,8 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
if (fill_in < 0) then
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/))
call psb_errpush(info,name, &
& i_err=(/ione,fill_in,izero,izero,izero/))
goto 9999
end if
!
@ -132,7 +133,7 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
blck_ => blck
else
allocate(blck_,stat=info)
if (info == psb_success_) call blck_%csall(0,0,info,1)
if (info == psb_success_) call blck_%csall(izero,izero,info,ione)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='csall'
@ -148,13 +149,13 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale)
select case(iscale_)
case(mld_ilu_scale_none_)
scale = done
scale = sone
case(mld_ilu_scale_maxval_)
scale = max(a%maxval(),blck_%maxval())
scale = done/scale
scale = sone/scale
case default
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/))
call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/))
goto 9999
end select
@ -296,20 +297,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_zspmat_type),intent(in) :: a,b
integer,intent(inout) :: l1,l2,info
integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_dpk_), intent(inout) :: d(:)
real(psb_dpk_), intent(in), optional :: scale
integer(psb_ipk_), intent(in) :: fill_in
real(psb_dpk_), intent(in) :: thres
type(psb_zspmat_type),intent(in) :: a,b
integer(psb_ipk_),intent(inout) :: l1,l2,info
integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:)
complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:)
complex(psb_dpk_), intent(inout) :: d(:)
real(psb_dpk_), intent(in), optional :: scale
! Local Variables
integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m
real(psb_dpk_) :: nrmi
real(psb_dpk_) :: weight
integer, allocatable :: idxs(:)
integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw
@ -328,7 +329,7 @@ contains
!
! Allocate a temporary buffer for the ilut_copyin function
!
call trw%allocate(0,0,1)
call trw%allocate(izero,izero,ione)
if (info == psb_success_) call psb_ensure_size(m+1,lirp,info)
if (info == psb_success_) call psb_ensure_size(m+1,uirp,info)
@ -353,8 +354,8 @@ contains
goto 9999
end if
row(:) = zzero
weight = done
row(:) = czero
weight = sone
if (present(scale)) weight = abs(scale)
!
! Cycle over the matrix rows
@ -369,12 +370,12 @@ contains
! the lowest index, but we also need to insert new items, and the heap
! allows to do both in log time.
!
d(i) = zzero
d(i) = czero
if (i<=ma) then
call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
else
call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,&
call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,&
& row,heap,ktrw,trw,info)
endif
@ -400,12 +401,12 @@ contains
!
! Adjust diagonal accounting for scale factor
!
if (weight /= done) then
if (weight /= sone) then
d(1:m) = d(1:m)*weight
end if
!
! And we're done, so deallocate the memory
! And we're sone, so deallocate the memory
!
deallocate(row,idxs,stat=info)
if (info /= psb_success_) then
@ -501,7 +502,7 @@ contains
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, done by psb_init_heap inside this
! to retain its allocation, sone by psb_init_heap inside this
! routine.
! ktrw - integer, input/output.
! The index identifying the last entry taken from the
@ -520,15 +521,15 @@ contains
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_z_coo_sparse_mat), intent(inout) :: trw
integer, intent(in) :: i, m,jmin,jmax,jd
integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight
integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd
integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info
real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
integer :: k,j,irb,kin,nz
integer, parameter :: nrb=40
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
real(psb_dpk_) :: dmaxup
real(psb_dpk_), external :: dnrm2
character(len=20), parameter :: name='mld_zilut_factint'
@ -554,8 +555,8 @@ contains
nlw = 0
nup = 0
jmaxup = 0
dmaxup = dzero
nrmi = dzero
dmaxup = szero
nrmi = szero
select type (aa=> a%a)
type is (psb_z_csr_sparse_mat)
@ -584,20 +585,20 @@ contains
call psb_errpush(info,name,a_err='psb_insert_heap')
goto 9999
end if
nz = aa%irp(i+1) - aa%irp(i)
nrmi = weight*dnrm2(nz,aa%val(aa%irp(i)),ione)
class default
!
! Otherwise use psb_sp_getblk, slower but able (in principle) of
! handling any format. In this case, a block of rows is extracted
! instead of a single row, for performance reasons, and these
! rows are copied one by one into the array row, through successive
! calls to ilut_copyin.
!
class default
!
! Otherwise use psb_sp_getblk, slower but able (in principle) of
! handling any format. In this case, a block of rows is extracted
! instead of a single row, for performance reasons, and these
! rows are copied one by one into the array row, through successive
! calls to ilut_copyin.
!
if ((mod(i,nrb) == 1).or.(nrb == 1)) then
irb = min(m-i+1,nrb)
@ -706,7 +707,7 @@ contains
! examined during the elimination step.This will be used by
! by the routine ilut_copyout.
! Note: this argument is intent(inout) and not only intent(out)
! to retain its allocation, done by this routine.
! to retain its allocation, sone by this routine.
!
subroutine ilut_fact(thres,i,nrmi,row,heap,d,uja,uirp,uval,nidx,idxs,info)
@ -716,19 +717,19 @@ contains
! Arguments
type(psb_int_heap), intent(inout) :: heap
integer, intent(in) :: i
integer, intent(inout) :: nidx,info
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
integer, allocatable, intent(inout) :: idxs(:)
integer, intent(inout) :: uja(:),uirp(:)
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret
complex(psb_dpk_) :: rwk
info = psb_success_
call psb_ensure_size(200,idxs,info)
call psb_ensure_size(200*ione,idxs,info)
if (info /= psb_success_) return
nidx = 0
lastk = -1
@ -758,7 +759,7 @@ contains
!
! Drop the entry.
!
row(k) = zzero
row(k) = czero
cycle
else
!
@ -780,7 +781,7 @@ contains
!
! Drop the entry.
!
row(j) = zzero
row(j) = czero
else
!
! Do the insertion.
@ -902,20 +903,20 @@ contains
implicit none
! Arguments
integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer, intent(in) :: idxs(:)
integer, intent(inout) :: l1,l2, info
integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup
integer(psb_ipk_), intent(in) :: idxs(:)
integer(psb_ipk_), intent(inout) :: l1,l2, info
integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:)
real(psb_dpk_), intent(in) :: thres,nrmi
complex(psb_dpk_),allocatable, intent(inout) :: uval(:), lval(:)
complex(psb_dpk_), intent(inout) :: row(:), d(:)
! Local variables
complex(psb_dpk_),allocatable :: xw(:)
integer, allocatable :: xwid(:), indx(:)
integer(psb_ipk_), allocatable :: xwid(:), indx(:)
complex(psb_dpk_) :: witem
integer :: widx
integer :: k,isz,err_act,int_err(5),idxp, nz
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_dcomplex_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
@ -939,7 +940,7 @@ contains
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),&
call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -1062,7 +1063,7 @@ contains
!
! Compute 1/pivot
!
d(i) = zone/d(i)
d(i) = cone/d(i)
end if
end if
end if
@ -1172,7 +1173,7 @@ contains
! Set row to zero
!
do idxp=1,nidx
row(idxs(idxp)) = zzero
row(idxs(idxp)) = czero
end do
!

8
mlprec/impl/mld_zmlprec_aply.f90
Unescape Escape View File

@ -325,7 +325,7 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
@ -416,7 +416,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
@ -877,7 +877,7 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act
character(len=20) :: name
character :: trans_
@ -993,7 +993,7 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, nr2l,nc2l,err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps

2
mlprec/impl/mld_zmlprec_bld.f90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold)
! Local Variables
type(mld_zprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

8
mlprec/impl/mld_zprecaply.f90
Unescape Escape View File

@ -90,7 +90,7 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -221,7 +221,7 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
complex(psb_dpk_), pointer :: WW(:), w1(:)
character(len=20) :: name
@ -290,7 +290,7 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name
@ -395,7 +395,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
character :: trans_
type(psb_z_vect_type) :: ww
complex(psb_dpk_), pointer :: work_(:)
integer(psb_mpik_) :: ictxt,np,me
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz
character(len=20) :: name

4
mlprec/impl/mld_zprecbld.f90
Unescape Escape View File

@ -76,8 +76,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
!!$ character, intent(in), optional :: upd
! Local Variables
type(mld_zprec_type) :: t_prec
integer(psb_mpik_) :: ictxt, me,np
type(mld_zprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)

14
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -66,7 +66,7 @@ module mld_base_prec_type
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type,&
& psb_ipk_, psb_mpik_, psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_ipk_, psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
& psb_sizeof_int, psb_sizeof_long_int, psb_sizeof_sp, psb_sizeof_dp, psb_sizeof,&
@ -917,9 +917,9 @@ contains
subroutine mld_ml_bcast(ictxt,dat,root)
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
type(mld_ml_parms), intent(inout) :: dat
integer(psb_mpik_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%sweeps,root)
call psb_bcast(ictxt,dat%sweeps_pre,root)
@ -939,9 +939,9 @@ contains
subroutine mld_sml_bcast(ictxt,dat,root)
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
type(mld_sml_parms), intent(inout) :: dat
integer(psb_mpik_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)
@ -950,9 +950,9 @@ contains
subroutine mld_dml_bcast(ictxt,dat,root)
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
type(mld_dml_parms), intent(inout) :: dat
integer(psb_mpik_), intent(in), optional :: root
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%mld_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)

4
mlprec/mld_c_as_smoother.f90
Unescape Escape View File

@ -190,10 +190,10 @@ module mld_c_as_smoother
subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_c_as_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_c_base_smoother_mod.f90
Unescape Escape View File

@ -243,9 +243,9 @@ module mld_c_base_smoother_mod
subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_, psb_mpik_
& mld_c_base_smoother_type, psb_ipk_
class(mld_c_base_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -249,10 +249,10 @@ module mld_c_base_solver_mod
subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_, psb_mpik_
& mld_c_base_solver_type, psb_ipk_
implicit none
class(mld_c_base_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_c_ilu_solver.f90
Unescape Escape View File

@ -139,10 +139,10 @@ module mld_c_ilu_solver
subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_c_ilu_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

2
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_c_onelev_mod
use mld_base_prec_type
use mld_c_base_smoother_mod
use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
& psb_clinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.

8
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_c_prec_type
!
type, extends(psb_cprec_type) :: mld_cprec_type
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero
type(mld_c_onelev_type), allocatable :: precv(:)
@ -218,7 +218,7 @@ contains
class(mld_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
num = -done
@ -271,7 +271,7 @@ contains
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -560,7 +560,7 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_

4
mlprec/mld_d_as_smoother.f90
Unescape Escape View File

@ -190,10 +190,10 @@ module mld_d_as_smoother
subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_d_base_smoother_mod.f90
Unescape Escape View File

@ -243,9 +243,9 @@ module mld_d_base_smoother_mod
subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_, psb_mpik_
& mld_d_base_smoother_type, psb_ipk_
class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -249,10 +249,10 @@ module mld_d_base_solver_mod
subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_, psb_mpik_
& mld_d_base_solver_type, psb_ipk_
implicit none
class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_d_ilu_solver.f90
Unescape Escape View File

@ -139,10 +139,10 @@ module mld_d_ilu_solver
subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

2
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_d_onelev_mod
use mld_base_prec_type
use mld_d_base_smoother_mod
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
& psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.

8
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_d_prec_type
!
type, extends(psb_dprec_type) :: mld_dprec_type
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero
type(mld_d_onelev_type), allocatable :: precv(:)
@ -218,7 +218,7 @@ contains
class(mld_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
num = -done
@ -271,7 +271,7 @@ contains
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -560,7 +560,7 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_

4
mlprec/mld_s_as_smoother.f90
Unescape Escape View File

@ -190,10 +190,10 @@ module mld_s_as_smoother
subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_s_as_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_s_base_smoother_mod.f90
Unescape Escape View File

@ -243,9 +243,9 @@ module mld_s_base_smoother_mod
subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_, psb_mpik_
& mld_s_base_smoother_type, psb_ipk_
class(mld_s_base_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -249,10 +249,10 @@ module mld_s_base_solver_mod
subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_, psb_mpik_
& mld_s_base_solver_type, psb_ipk_
implicit none
class(mld_s_base_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_s_ilu_solver.f90
Unescape Escape View File

@ -139,10 +139,10 @@ module mld_s_ilu_solver
subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_s_ilu_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

2
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_s_onelev_mod
use mld_base_prec_type
use mld_s_base_smoother_mod
use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
& psb_slinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.

8
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_s_prec_type
!
type, extends(psb_sprec_type) :: mld_sprec_type
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_spk_) :: op_complexity=szero
type(mld_s_onelev_type), allocatable :: precv(:)
@ -218,7 +218,7 @@ contains
class(mld_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num,den
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
num = -done
@ -271,7 +271,7 @@ contains
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -560,7 +560,7 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_

4
mlprec/mld_z_as_smoother.f90
Unescape Escape View File

@ -190,10 +190,10 @@ module mld_z_as_smoother
subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_z_as_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_z_base_smoother_mod.f90
Unescape Escape View File

@ -243,9 +243,9 @@ module mld_z_base_smoother_mod
subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_, psb_mpik_
& mld_z_base_smoother_type, psb_ipk_
class(mld_z_base_smoother_type), intent(in) :: sm
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -249,10 +249,10 @@ module mld_z_base_solver_mod
subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_, psb_mpik_
& mld_z_base_solver_type, psb_ipk_
implicit none
class(mld_z_base_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

4
mlprec/mld_z_ilu_solver.f90
Unescape Escape View File

@ -139,10 +139,10 @@ module mld_z_ilu_solver
subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, &
& psb_ipk_, psb_mpik_
& psb_ipk_
implicit none
class(mld_z_ilu_solver_type), intent(in) :: sv
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head

2
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -57,7 +57,7 @@ module mld_z_onelev_mod
use mld_base_prec_type
use mld_z_base_smoother_mod
use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type
& psb_zlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type
!
!
! Type: mld_Tonelev_type.

8
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -80,7 +80,7 @@ module mld_z_prec_type
!
type, extends(psb_zprec_type) :: mld_zprec_type
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: coarse_aggr_size
real(psb_dpk_) :: op_complexity=dzero
type(mld_z_onelev_type), allocatable :: precv(:)
@ -218,7 +218,7 @@ contains
class(mld_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num,den
integer(psb_mpik_) :: ictxt
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
num = -done
@ -271,7 +271,7 @@ contains
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_mpik_) :: ictxt, me, np
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -560,7 +560,7 @@ contains
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_mpik_) :: icontxt,iam, np
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_

Write Preview
Loading…
Cancel
Save