Updated prologs for Krylov subspace methods.

psblas3-type-indexed
Salvatore Filippone 17 years ago
parent ea8ff0d764
commit 07790aab16

@ -60,21 +60,36 @@
! This subroutine implements the BiCG method. ! This subroutine implements the BiCG method.
! !
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,& ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
&itmax,iter,err, itrace,istop) ! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
!
subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none
@ -168,11 +183,11 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (info == 0) call psb_geall(wwrk,desc_a,info,n=9) if (info == 0) call psb_geall(wwrk,desc_a,info,n=9)
if (info == 0) call psb_geasb(wwrk,desc_a,info) if (info == 0) call psb_geasb(wwrk,desc_a,info)
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
ch_err='psb_asb' ch_err='psb_asb'
err=info err=info
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
q => wwrk(:,1) q => wwrk(:,1)
@ -198,21 +213,21 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
end if end if
itx = 0 itx = 0
if (istop_ == 1) then if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info) ani = psb_spnrmi(a,desc_a,info)
bni = psb_geamax(b,desc_a,info) bni = psb_geamax(b,desc_a,info)
else if (istop_ == 2) then else if (istop_ == 2) then
bn2 = psb_genrm2(b,desc_a,info) bn2 = psb_genrm2(b,desc_a,info)
endif endif
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
err=info err=info
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
restart: do restart: do
!!$ !!$
!!$ r0 = b-ax0 !!$ r0 = b-ax0
@ -224,9 +239,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
if (debug) write(0,*) me,' Done spmm',info if (debug) write(0,*) me,' Done spmm',info
if (info == 0) call psb_geaxpby(done,r,dzero,rt,desc_a,info) if (info == 0) call psb_geaxpby(done,r,dzero,rt,desc_a,info)
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
rho = dzero rho = dzero
@ -238,9 +253,9 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
rni = psb_genrm2(r,desc_a,info) rni = psb_genrm2(r,desc_a,info)
endif endif
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
if (istop_ == 1) then if (istop_ == 1) then
@ -251,11 +266,11 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
endif endif
if(info.ne.0) then if(info.ne.0) then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
if (rerr<=eps) then if (rerr<=eps) then
exit restart exit restart
end if end if
@ -336,7 +351,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
If (itrace_ > 0) then If (itrace_ > 0) then
if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr if (me == 0) write(*,'(a,i4,3(2x,es10.4))') 'bicg: ',itx,rerr
end If end If
if (present(err)) err=rerr if (present(err)) err=rerr
if (present(iter)) iter = itx if (present(iter)) iter = itx
if (rerr>eps) then if (rerr>eps) then
@ -352,8 +367,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
call psb_restore_coher(ictxt,isvch) call psb_restore_coher(ictxt,isvch)
if(info/=0) then if(info/=0) then
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -362,8 +377,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if
return return

@ -59,22 +59,38 @@
! Subroutine: psb_dcg ! Subroutine: psb_dcg
! This subroutine implements the Conjugate Gradient method. ! This subroutine implements the Conjugate Gradient method.
! !
!
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,& ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
&itmax,iter,err, itrace, istop) ! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
!
Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none

@ -56,20 +56,39 @@
! File: psb_dcgs.f90 ! File: psb_dcgs.f90
! !
! Subroutine: psb_dcgs ! Subroutine: psb_dcgs
! Implements the Conjugate Gradient Squared method.
!
! !
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A. !
! prec - type(<psb_prec_type>). The data structure containing the preconditioner. ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
! b - real,dimension(:). The right hand side. ! prec - type(<psb_dprec_type>) Input: preconditioner
! x - real,dimension(:). The vector of unknowns. ! b - real,dimension(:) Input: vector containing the
! eps - real. The error tolerance. ! right hand side B
! desc_a - type(<psb_desc_type>). The communication descriptor. ! x - real,dimension(:) Input/Output: vector containing the
! info - integer. Return code ! initial guess and final solution X.
! itmax - integer(optional). The maximum number of iterations. ! eps - real Input: Stopping tolerance; the iteration is
! iter - integer(optional). The number of iterations performed. ! stopped when the error estimate
! err - real(optional). The error on return. ! |err| <= eps
! itrace - integer(optional). The unit to write messages onto. ! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! istop - integer(optional). The stopping criterium. ! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
!
! !
Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,& Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)

@ -56,24 +56,41 @@
! File: psb_dcgstab.f90 ! File: psb_dcgstab.f90
! !
! Subroutine: psb_dcgstab ! Subroutine: psb_dcgstab
! This subroutine implements the CG Stabilized method. ! This subroutine implements the BiCG Stabilized method.
!
! !
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
&itmax,iter,err,itrace, istop) ! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
!
!
Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
Implicit None Implicit None

@ -63,23 +63,43 @@
! File: psb_dcgstabl.f90 ! File: psb_dcgstabl.f90
! !
! Subroutine: psb_dcgstabl ! Subroutine: psb_dcgstabl
! Implements the BICGSTAB(L) method
!
! !
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,& ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
&itmax,iter,err,itrace,irst,istop) ! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! irst - integer(optional) Input: restart parameter L
!
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
!
!
Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none

@ -70,23 +70,39 @@
! This subroutine implements the restarted GMRES method with right ! This subroutine implements the restarted GMRES method with right
! preconditioning. ! preconditioning.
! !
!
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! irst - integer(optional). The restart value.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,& ! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
&itmax,iter,err,itrace,irst,istop) ! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! irst - integer(optional) Input: restart parameter
!
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none

@ -36,72 +36,72 @@ Module psb_krylov_mod
end interface end interface
interface psb_cg interface psb_cg
subroutine psb_dcg(a,prec,b,x,eps,& subroutine psb_dcg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)), intent(in) :: b(:) real(kind(1.d0)), intent(in) :: b(:)
real(kind(1.d0)), intent(inout) :: x(:) real(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(in) :: eps real(kind(1.d0)), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec type(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_dcg end subroutine psb_dcg
end interface end interface
interface psb_bicg interface psb_bicg
subroutine psb_dbicg(a,prec,b,x,eps,& subroutine psb_dbicg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)), intent(in) :: b(:) real(kind(1.d0)), intent(in) :: b(:)
real(kind(1.d0)), intent(inout) :: x(:) real(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(in) :: eps real(kind(1.d0)), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec type(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_dbicg end subroutine psb_dbicg
end interface end interface
interface psb_bicgstab interface psb_bicgstab
subroutine psb_dcgstab(a,prec,b,x,eps,& subroutine psb_dcgstab(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(kind(1.d0)), intent(in) :: b(:) real(kind(1.d0)), intent(in) :: b(:)
real(kind(1.d0)), intent(inout) :: x(:) real(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(in) :: eps real(kind(1.d0)), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec type(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_dcgstab end subroutine psb_dcgstab
subroutine psb_zcgstab(a,prec,b,x,eps,& subroutine psb_zcgstab(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)), intent(in) :: b(:) complex(kind(1.d0)), intent(in) :: b(:)
complex(kind(1.d0)), intent(inout) :: x(:) complex(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(in) :: eps real(kind(1.d0)), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec type(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_zcgstab end subroutine psb_zcgstab
end interface end interface
interface psb_bicgstabl interface psb_bicgstabl
@ -171,25 +171,70 @@ Module psb_krylov_mod
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_dcgs end subroutine psb_dcgs
subroutine psb_zcgs(a,prec,b,x,eps,& subroutine psb_zcgs(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(kind(1.d0)), intent(in) :: b(:) complex(kind(1.d0)), intent(in) :: b(:)
complex(kind(1.d0)), intent(inout) :: x(:) complex(kind(1.d0)), intent(inout) :: x(:)
real(kind(1.d0)), intent(in) :: eps real(kind(1.d0)), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec type(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter integer, optional, intent(out) :: iter
real(kind(1.d0)), optional, intent(out) :: err real(kind(1.d0)), optional, intent(out) :: err
end subroutine psb_zcgs end subroutine psb_zcgs
end interface end interface
contains
contains
!
! File: psb_krylov_mod.f90
!
! Subroutine: psb_dkrylov
!
! Front-end for the Krylov subspace iterations, real version
!
! Arguments:
!
! methd - character The specific method; can take the values:
! CG
! CGS
! BICG
! BICGSTAB
! BICGSTABL
! RGMRES
!
! a - type(<psb_dspmat_type>) Input: sparse matrix containing A.
! prec - type(<psb_dprec_type>) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! irst - integer(optional) Input: restart parameter for RGMRES and
! BICGSTAB(L) methods
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,& Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop) &itmax,iter,err,itrace,irst,istop)
@ -218,53 +263,96 @@ contains
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case(toupper(method)) select case(toupper(method))
case('CG') case('CG')
call psb_cg(a,prec,b,x,eps,desc_a,info,& call psb_cg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
case('CGS') case('CGS')
call psb_cgs(a,prec,b,x,eps,desc_a,info,& call psb_cgs(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
case('BICG') case('BICG')
call psb_bicg(a,prec,b,x,eps,desc_a,info,& call psb_bicg(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
case('BICGSTAB') case('BICGSTAB')
call psb_bicgstab(a,prec,b,x,eps,desc_a,info,& call psb_bicgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
case('RGMRES') case('RGMRES')
call psb_rgmres(a,prec,b,x,eps,desc_a,info,& call psb_rgmres(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop) &itmax,iter,err,itrace,irst,istop)
case('BICGSTABL') case('BICGSTABL')
call psb_bicgstabl(a,prec,b,x,eps,desc_a,info,& call psb_bicgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop) &itmax,iter,err,itrace,irst,istop)
case default case default
if (me==0) write(0,*) 'Warning: Unknown method ',method,& if (me==0) write(0,*) 'Warning: Unknown method ',method,&
& ' in PSB_KRYLOV, defaulting to BiCGSTAB' & ' in PSB_KRYLOV, defaulting to BiCGSTAB'
call psb_bicgstab(a,prec,b,x,eps,desc_a,info,& call psb_bicgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
end select end select
if(info/=0) then if(info/=0) then
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
end subroutine psb_dkrylov end subroutine psb_dkrylov
!
! File: psb_krylov_mod.f90
!
! Subroutine: psb_zkrylov
!
! Front-end for the Krylov subspace iterations, complexversion
!
! Arguments:
!
! methd - character The specific method; can take the values:
! CGS
! BICGSTAB
! RGMRES
!
! a - type(<psb_zspmat_type>) Input: sparse matrix containing A.
! prec - type(<psb_zprec_type>) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! irst - integer(optional) Input: restart parameter for RGMRES and
! BICGSTAB(L) methods
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,& Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop) &itmax,iter,err,itrace,irst,istop)
use psb_base_mod use psb_base_mod
@ -290,9 +378,9 @@ contains
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case(toupper(method)) select case(toupper(method))
!!$ case('CG') !!$ case('CG')
@ -300,7 +388,7 @@ contains
!!$ &itmax,iter,err,itrace,istop) !!$ &itmax,iter,err,itrace,istop)
case('CGS') case('CGS')
call psb_cgs(a,prec,b,x,eps,desc_a,info,& call psb_cgs(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
!!$ case('BICG') !!$ case('BICG')
!!$ call psb_bicg(a,prec,b,x,eps,desc_a,info,& !!$ call psb_bicg(a,prec,b,x,eps,desc_a,info,&
!!$ &itmax,iter,err,itrace,istop) !!$ &itmax,iter,err,itrace,istop)
@ -317,24 +405,24 @@ contains
if (me==0) write(0,*) 'Warning: Unknown method ',method,& if (me==0) write(0,*) 'Warning: Unknown method ',method,&
& ' in PSB_KRYLOV, defaulting to BiCGSTAB' & ' in PSB_KRYLOV, defaulting to BiCGSTAB'
call psb_bicgstab(a,prec,b,x,eps,desc_a,info,& call psb_bicgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
end select end select
if(info/=0) then if(info/=0) then
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt) call psb_error(ictxt)
return return
end if end if
end subroutine psb_zkrylov end subroutine psb_zkrylov

@ -56,23 +56,43 @@
! File: psb_zcgs.f90 ! File: psb_zcgs.f90
! !
! Subroutine: psb_zcgs ! Subroutine: psb_zcgs
! ! Implements the Conjugate Gradient Squared method.
!
! Arguments: ! Arguments:
! a - type(<psb_zspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,& ! methd - character The specific method; can take the values:
&itmax,iter,err,itrace,istop) ! CGS
! BICGSTAB
! RGMRES
!
! a - type(<psb_zspmat_type>) Input: sparse matrix containing A.
! prec - type(<psb_zprec_type>) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none
@ -123,17 +143,17 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Else Else
istop_ = 1 istop_ = 1
Endif Endif
! !
! istop_ = 1: normwise backward error, infinity norm ! istop_ = 1: normwise backward error, infinity norm
! istop_ = 2: ||r||/||b|| norm 2 ! istop_ = 2: ||r||/||b|| norm 2
! !
!!$ !!$
!!$ If ((prec%prec < 0).Or.(prec%prec > 6) ) Then !!$ If ((prec%prec < 0).Or.(prec%prec > 6) ) Then
!!$ Write(0,*) 'f90_cgstab: invalid iprec',prec%prec !!$ Write(0,*) 'f90_cgstab: invalid iprec',prec%prec
!!$ If (Present(ierr)) ierr=-1 !!$ If (Present(ierr)) ierr=-1
!!$ Return !!$ Return
!!$ Endif !!$ Endif
if ((istop_ < 1 ).or.(istop_ > 2 ) ) then if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
write(0,*) 'psb_cgs: invalid istop',istop_ write(0,*) 'psb_cgs: invalid istop',istop_
info=5001 info=5001
@ -161,9 +181,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11) if (info == 0) Call psb_geall(wwrk,desc_a,info,n=11)
if (info == 0) Call psb_geasb(wwrk,desc_a,info) if (info == 0) Call psb_geasb(wwrk,desc_a,info)
if (info.ne.0) Then if (info.ne.0) Then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
End If End If
q => wwrk(:,1) q => wwrk(:,1)
@ -186,14 +206,14 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Endif Endif
If (Present(itrace)) Then If (Present(itrace)) Then
itrace_ = itrace itrace_ = itrace
Else Else
itrace_ = 0 itrace_ = 0
End If End If
! Ensure global coherence for convergence checks. ! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch) call psb_set_coher(ictxt,isvch)
itx = 0 itx = 0
if (istop_ == 1) then if (istop_ == 1) then
@ -203,9 +223,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
bn2 = psb_genrm2(b,desc_a,info) bn2 = psb_genrm2(b,desc_a,info)
endif endif
if(info/=0)then if(info/=0)then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
restart: Do restart: Do
@ -218,11 +238,11 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) Call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux)
Call psb_geaxpby(zone,r,zzero,rt,desc_a,info) Call psb_geaxpby(zone,r,zzero,rt,desc_a,info)
if(info/=0)then if(info/=0)then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
rho = zzero rho = zzero
If (debug) Write(*,*) 'on entry to amax: b: ',Size(b) If (debug) Write(*,*) 'on entry to amax: b: ',Size(b)
@ -235,11 +255,11 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
rerr = rni/bn2 rerr = rni/bn2
endif endif
if(info/=0)then if(info/=0)then
info=4011 info=4011
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
@ -255,7 +275,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
rho_old = rho rho_old = rho
rho = psb_gedot(rt,r,desc_a,info) rho = psb_gedot(rt,r,desc_a,info)
If (rho==zzero) Then If (rho==zzero) Then
If (debug) Write(0,*) 'cgs iteration breakdown r',rho If (debug) Write(0,*) 'cgs iteration breakdown r',rho
Exit iteration Exit iteration
Endif Endif
@ -278,27 +298,27 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
sigma = psb_gedot(rt,v,desc_a,info) sigma = psb_gedot(rt,v,desc_a,info)
If (sigma==zzero) Then If (sigma==zzero) Then
If (debug) Write(0,*) 'cgs iteration breakdown s1', sigma If (debug) Write(0,*) 'cgs iteration breakdown s1', sigma
Exit iteration Exit iteration
Endif Endif
alpha = rho/sigma alpha = rho/sigma
Call psb_geaxpby(zone,uv,zzero,q,desc_a,info) Call psb_geaxpby(zone,uv,zzero,q,desc_a,info)
Call psb_geaxpby(-alpha,v,zone,q,desc_a,info) Call psb_geaxpby(-alpha,v,zone,q,desc_a,info)
Call psb_geaxpby(zone,uv,zzero,s,desc_a,info) Call psb_geaxpby(zone,uv,zzero,s,desc_a,info)
Call psb_geaxpby(zone,q,zone,s,desc_a,info) Call psb_geaxpby(zone,q,zone,s,desc_a,info)
Call psb_precaply(prec,s,z,desc_a,info,work=aux) Call psb_precaply(prec,s,z,desc_a,info,work=aux)
Call psb_geaxpby(alpha,z,zone,x,desc_a,info) Call psb_geaxpby(alpha,z,zone,x,desc_a,info)
Call psb_spmm(zone,a,z,zzero,qt,desc_a,info,& Call psb_spmm(zone,a,z,zzero,qt,desc_a,info,&
& work=aux) & work=aux)
Call psb_geaxpby(-alpha,qt,zone,r,desc_a,info) Call psb_geaxpby(-alpha,qt,zone,r,desc_a,info)
if (istop_ == 1) then if (istop_ == 1) then
rni = psb_geamax(r,desc_a,info) rni = psb_geamax(r,desc_a,info)
xni = psb_geamax(x,desc_a,info) xni = psb_geamax(x,desc_a,info)
@ -317,7 +337,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
if ((mod(itx,itrace_)==0).and.(me == 0))& if ((mod(itx,itrace_)==0).and.(me == 0))&
& write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr & write(*,'(a,i4,3(2x,es10.4))') 'cgs: ',itx,rerr
end If end If
End Do iteration End Do iteration
End Do restart End Do restart
If (itrace_ > 0) then If (itrace_ > 0) then
@ -338,8 +358,8 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
call psb_restore_coher(ictxt,isvch) call psb_restore_coher(ictxt,isvch)
if(info/=0) then if(info/=0) then
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -348,8 +368,8 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then if (err_act.eq.psb_act_abort_) then
call psb_error() call psb_error()
return return
end if end if
return return

@ -56,25 +56,44 @@
! File: psb_zcgstab.f90 ! File: psb_zcgstab.f90
! !
! Subroutine: psb_zcgstab ! Subroutine: psb_zcgstab
! This subroutine implements the CG Stabilized method. ! This subroutine implements the BiCG Stabilized method.
! !
!
! Arguments: ! Arguments:
! a - type(<psb_zspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the
! preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,& ! methd - character The specific method; can take the values:
&itmax,iter,err,itrace, istop) ! CGS
! BICGSTAB
! RGMRES
!
! a - type(<psb_zspmat_type>) Input: sparse matrix containing A.
! prec - type(<psb_zprec_type>) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
Implicit None Implicit None

@ -71,22 +71,42 @@
! preconditioning. ! preconditioning.
! !
! Arguments: ! Arguments:
! a - type(<psb_dspmat_type>). The sparse matrix containing A.
! prec - type(<psb_prec_type>). The data structure containing the preconditioner.
! b - real,dimension(:). The right hand side.
! x - real,dimension(:). The vector of unknowns.
! eps - real. The error tolerance.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code
! itmax - integer(optional). The maximum number of iterations.
! iter - integer(optional). The number of iterations performed.
! err - real(optional). The error on return.
! itrace - integer(optional). The unit to write messages onto.
! irst - integer(optional). The restart value.
! istop - integer(optional). The stopping criterium.
! !
Subroutine psb_zgmresr(a,prec,b,x,eps,desc_a,info,& ! methd - character The specific method; can take the values:
& itmax,iter,err,itrace,irst,istop) ! CGS
! BICGSTAB
! RGMRES
!
! a - type(<psb_zspmat_type>) Input: sparse matrix containing A.
! prec - type(<psb_zprec_type>) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
! initial guess and final solution X.
! eps - real Input: Stopping tolerance; the iteration is
! stopped when the error estimate
! |err| <= eps
! desc_a - type(<psb_desc_type>). Input: The communication descriptor.
! info - integer. Output: Return code
!
! itmax - integer(optional) Input: maximum number of iterations to be
! performed.
! iter - integer(optional) Output: how many iterations have been
! performed.
! err - real (optional) Output: error estimate on exit
! itrace - integer(optional) Input: print an informational message
! with the error estimate every itrace
! iterations
! irst - integer(optional) Input: restart parameter
!
! istop - integer(optional) Input: stopping criterion, or how
! to estimate the error.
! 1: err = |r|/|b|
! 2: err = |r|/(|a||x|+|b|)
! where r is the (preconditioned, recursive
! estimate of) residual
!
Subroutine psb_zgmresr(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
implicit none implicit none

Loading…
Cancel
Save