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

First sweep of changes from Pasqua/Daniela.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent f4c609a3e6
commit 8ab6c53536
9 changed files with 44 additions and 42 deletions
Show Stats Download Patch File Download Diff File

10
prec/psb_dgen_precaply.f90
Unescape Escape View File

@ -28,7 +28,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
!
! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a basic preconditioner stored in prec
@ -95,7 +95,7 @@ subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
case(diagsc_)
case(diag_)
if (size(work) >= size(x)) then
ww => work
@ -119,7 +119,7 @@ subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
end if
case(bja_)
case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then
@ -130,7 +130,7 @@ subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',&
& min_prec_,noprec_,diagsc_,bja_
& min_prec_,noprec_,diag_,bjac_
end select
call psb_erractionrestore(err_act)
@ -145,5 +145,5 @@ subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
return
end subroutine psb_dgen_precaply
end subroutine psb_dgprec_aply

8
prec/psb_dprc_aply.f90
Unescape Escape View File

@ -48,8 +48,8 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name
interface psb_gen_precaply
subroutine psb_dgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
interface psb_gprec_aply
subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
@ -59,7 +59,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dgen_precaply
end subroutine psb_dgprec_aply
end interface
name='psb_prc_aply'
@ -86,7 +86,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
end if
call psb_gen_precaply(done,prec,x,dzero,y,desc_data,trans_,work_,info)
call psb_gprec_aply(done,prec,x,dzero,y,desc_data,trans_,work_,info)
if (present(work)) then
else

6
prec/psb_dprecbld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
!
call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_prec)
& diag_,is_legal_prec)
call psb_nullify_desc(p%desc_data)
@ -125,7 +125,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
goto 9999
end if
case (diagsc_)
case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld'
@ -136,7 +136,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
goto 9999
end if
case (bja_)
case (bjac_)
call psb_check_def(p%iprcparm(iren_),'renumbering',&
& renum_none_,is_legal_renum)

8
prec/psb_dprecset.f90
Unescape Escape View File

@ -59,16 +59,16 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv)
p%iprcparm(iren_) = 0
p%iprcparm(jac_sweeps_) = 1
case ('DIAG','DIAGSC')
case ('DIAG')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = diagsc_
p%iprcparm(p_type_) = diag_
p%iprcparm(f_type_) = f_none_
p%iprcparm(iren_) = 0
p%iprcparm(jac_sweeps_) = 1
case ('BJA','ILU')
case ('BJAC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = bja_
p%iprcparm(p_type_) = bjac_
p%iprcparm(f_type_) = f_ilu_n_
p%iprcparm(iren_) = 0
p%iprcparm(ilu_fill_in_) = 0

22
prec/psb_prec_type.f90
Unescape Escape View File

@ -38,7 +38,7 @@ module psb_prec_type
! Reduces size of .mod file.
use psb_base_mod, only : psb_dspmat_type, psb_zspmat_type, psb_desc_type
integer, parameter :: min_prec_=0, noprec_=0, diagsc_=1, bja_=2,&
integer, parameter :: min_prec_=0, noprec_=0, diag_=1, bjac_=2,&
& max_prec_=2
! Entries in iprcparm: preconditioner type, factorization type,
@ -124,9 +124,9 @@ contains
select case(p%iprcparm(p_type_))
case(noprec_)
write(iout,*) 'No preconditioning'
case(diagsc_)
case(diag_)
write(iout,*) 'Diagonal scaling'
case(bja_)
case(bjac_)
write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_))
end select
@ -141,9 +141,9 @@ contains
select case(p%iprcparm(p_type_))
case(noprec_)
write(iout,*) 'No preconditioning'
case(diagsc_)
case(diag_)
write(iout,*) 'Diagonal scaling'
case(bja_)
case(bjac_)
write(iout,*) 'Block Jacobi with: ',&
& fact_names(p%iprcparm(f_type_))
end select
@ -154,7 +154,7 @@ contains
integer, intent(in) :: ip
logical :: is_legal_prec
is_legal_prec = ((ip>=noprec_).and.(ip<=bja_))
is_legal_prec = ((ip>=noprec_).and.(ip<=bjac_))
return
end function is_legal_prec
function is_legal_renum(ip)
@ -221,6 +221,7 @@ contains
end subroutine psb_dcheck_def
subroutine psb_d_precfree(p,info)
use psb_base_mod
type(psb_dprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: ictxt,me, np,err_act,i
@ -293,6 +294,7 @@ contains
end subroutine psb_nullify_dprec
subroutine psb_z_precfree(p,info)
use psb_base_mod
type(psb_zprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: ictxt,me, np,err_act,i
@ -364,10 +366,10 @@ contains
select case(iprec)
case(noprec_)
pr_to_str='NOPREC'
case(diagsc_)
pr_to_str='DIAGSC'
case(bja_)
pr_to_str='BJA'
case(diag_)
pr_to_str='DIAG'
case(bjac_)
pr_to_str='BJAC'
case default
pr_to_str='???'
end select

10
prec/psb_zgen_precaply.f90
Unescape Escape View File

@ -28,7 +28,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
!
! Compute Y <- beta*Y + alpha*K^-1 X
! where K is a a basic preconditioner stored in prec
@ -95,7 +95,7 @@ subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
case(diagsc_)
case(diag_)
if (size(work) >= size(x)) then
ww => work
@ -119,7 +119,7 @@ subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
end if
case(bja_)
case(bjac_)
call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
if(info.ne.0) then
@ -130,7 +130,7 @@ subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case default
write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',&
& min_prec_,noprec_,diagsc_,bja_
& min_prec_,noprec_,diag_,bjac_
end select
call psb_erractionrestore(err_act)
@ -145,5 +145,5 @@ subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
end if
return
end subroutine psb_zgen_precaply
end subroutine psb_zgprec_aply

8
prec/psb_zprc_aply.f90
Unescape Escape View File

@ -48,8 +48,8 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
logical,parameter :: debug=.false., debugprt=.false.
character(len=20) :: name
interface psb_gen_precaply
subroutine psb_zgen_precaply(alpha,prec,x,beta,y,desc_data,trans,work,info)
interface psb_gprec_aply
subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
@ -59,7 +59,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
character(len=1) :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zgen_precaply
end subroutine psb_zgprec_aply
end interface
name='psb_prc_aply'
@ -86,7 +86,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
end if
call psb_gen_precaply(zone,prec,x,zzero,y,desc_data,trans_, work_,info)
call psb_gprec_aply(zone,prec,x,zzero,y,desc_data,trans_, work_,info)
if (present(work)) then
else

6
prec/psb_zprecbld.f90
Unescape Escape View File

@ -114,7 +114,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
!
call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_prec)
& diag_,is_legal_prec)
call psb_nullify_desc(p%desc_data)
@ -129,7 +129,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
goto 9999
end if
case (diagsc_)
case (diag_)
call psb_diagsc_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_diagsc_bld'
@ -140,7 +140,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
goto 9999
end if
case (bja_)
case (bjac_)
call psb_check_def(p%iprcparm(iren_),'renumbering',&
& renum_none_,is_legal_renum)

8
prec/psb_zprecset.f90
Unescape Escape View File

@ -60,16 +60,16 @@ subroutine psb_zprecset(p,ptype,info,iv,rs,rv)
p%iprcparm(iren_) = 0
p%iprcparm(jac_sweeps_) = 1
case ('DIAG','DIAGSC')
case ('DIAG')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = diagsc_
p%iprcparm(p_type_) = diag_
p%iprcparm(f_type_) = f_none_
p%iprcparm(iren_) = 0
p%iprcparm(jac_sweeps_) = 1
case ('BJA','ILU')
case ('BJAC')
p%iprcparm(:) = 0
p%iprcparm(p_type_) = bja_
p%iprcparm(p_type_) = bjac_
p%iprcparm(f_type_) = f_ilu_n_
p%iprcparm(iren_) = 0
p%iprcparm(ilu_fill_in_) = 0

Write Preview
Loading…
Cancel
Save