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

psblas3:

Browse Source 
krylov/psb_cbicg.f90
 krylov/psb_ccg.f90
 krylov/psb_ccgs.f90
 krylov/psb_ccgstab.f90
 krylov/psb_ccgstabl.f90
 krylov/psb_crgmres.f90
 krylov/psb_dbicg.f90
 krylov/psb_dcg.F90
 krylov/psb_dcgs.f90
 krylov/psb_dcgstab.F90
 krylov/psb_dcgstabl.f90
 krylov/psb_drgmres.f90
 krylov/psb_krylov_mod.f90
 krylov/psb_sbicg.f90
 krylov/psb_scg.F90
 krylov/psb_scgs.f90
 krylov/psb_scgstab.F90
 krylov/psb_scgstabl.f90
 krylov/psb_srgmres.f90
 krylov/psb_zbicg.f90
 krylov/psb_zcg.F90
 krylov/psb_zcgs.f90
 krylov/psb_zcgstab.f90
 krylov/psb_zcgstabl.f90
 krylov/psb_zrgmres.f90
 prec/psb_prec_mod.f90
 prec/psb_prec_type.f90

First stab at getting PREC to work. Runs now, but still not completely
satisfactory.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 8bac54b124
commit 7007f4901a
27 changed files with 553 additions and 160 deletions
Show Stats Download Patch File Download Diff File

4
krylov/psb_cbicg.f90
Unescape Escape View File

@ -255,8 +255,8 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),'iteration: ',itx
call psb_precaply(prec,r,z,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,rt,zt,desc_a,info,trans='c',work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(rt,zt,desc_a,info,trans='c',work=aux)
rho_old = rho
rho = psb_gedot(rt,z,desc_a,info)

2
krylov/psb_ccg.f90
Unescape Escape View File

@ -215,7 +215,7 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
it = it + 1
itx = itx + 1
call psb_precaply(prec,r,z,desc_a,info,work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
rho_old = rho
rho = psb_gedot(r,z,desc_a,info)

4
krylov/psb_ccgs.f90
Unescape Escape View File

@ -250,7 +250,7 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(cone,uv,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(cone,a,f,czero,v,desc_a,info,&
& work=aux)
@ -275,7 +275,7 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(cone,uv,czero,s,desc_a,info)
if (info == 0) call psb_geaxpby(cone,q,cone,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_geaxpby(alpha,z,cone,x,desc_a,info)

4
krylov/psb_ccgstab.f90
Unescape Escape View File

@ -256,7 +256,7 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(cone,r,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(cone,a,f,czero,v,desc_a,info,&
& work=aux)
@ -281,7 +281,7 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
call psb_geaxpby(cone,r,czero,s,desc_a,info)
if (info == 0) call psb_geaxpby(-alpha,v,cone,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_spmm(cone,a,z,czero,t,desc_a,info,&
& work=aux)

6
krylov/psb_ccgstabl.f90
Unescape Escape View File

@ -254,7 +254,7 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(cone,b,czero,r,desc_a,info)
if (info == 0) call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,r,desc_a,info)
if (info == 0) call prec%apply(r,desc_a,info)
if (info == 0) call psb_geaxpby(cone,r,czero,rt0,desc_a,info)
if (info == 0) call psb_geaxpby(cone,r,czero,rh(:,0),desc_a,info)
@ -306,7 +306,7 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(cone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info)
call psb_spmm(cone,a,uh(:,j),czero,uh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,uh(:,j+1),desc_a,info)
call prec%apply(uh(:,j+1),desc_a,info)
gamma(j) = psb_gedot(uh(:,j+1),rt0,desc_a,info)
@ -325,7 +325,7 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(alpha,uh(:,0),cone,x,desc_a,info)
call psb_spmm(cone,a,rh(:,j),czero,rh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,rh(:,j+1),desc_a,info)
call prec%apply(rh(:,j+1),desc_a,info)
enddo

8
krylov/psb_crgmres.f90
Unescape Escape View File

@ -330,7 +330,7 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
inner: Do i=1,nl
itx = itx + 1
call psb_precaply(prec,v(:,i),w1,desc_a,info)
call prec%apply(v(:,i),w1,desc_a,info)
Call psb_spmm(cone,a,w1,czero,w,desc_a,info,work=aux)
!
@ -366,7 +366,7 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rst(k),v(:,k),cone,xt,desc_a,info)
end do
call psb_precaply(prec,xt,desc_a,info)
call prec%apply(xt,desc_a,info)
call psb_geaxpby(cone,x,cone,xt,desc_a,info)
call psb_geaxpby(cone,b,czero,w1,desc_a,info)
call psb_spmm(-cone,a,xt,cone,w1,desc_a,info,work=aux)
@ -402,7 +402,7 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rs(k),v(:,k),cone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(cone,w,cone,x,desc_a,info)
end if
@ -429,7 +429,7 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, nl
call psb_geaxpby(rs(k),v(:,k),cone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(cone,w,cone,x,desc_a,info)
end if

18
krylov/psb_dbicg.f90
Unescape Escape View File

@ -102,13 +102,13 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
type(psb_d_sparse_mat), intent(in) :: a
class(psb_dprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace, istop
integer, optional, intent(out) :: iter
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace, istop
integer, optional, intent(out) :: iter
real(psb_dpk_), optional, intent(out) :: err
!!$ local data
real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:)
@ -254,8 +254,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),'iteration: ',itx
call psb_precaply(prec,r,z,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,rt,zt,desc_a,info,trans='t',work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(rt,zt,desc_a,info,trans='t',work=aux)
rho_old = rho
rho = psb_gedot(rt,z,desc_a,info)

2
krylov/psb_dcg.F90
Unescape Escape View File

@ -231,7 +231,7 @@ subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond)
it = it + 1
itx = itx + 1
call psb_precaply(prec,r,z,desc_a,info,work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
rho_old = rho
rho = psb_gedot(r,z,desc_a,info)

4
krylov/psb_dcgs.f90
Unescape Escape View File

@ -251,7 +251,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(done,uv,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(done,a,f,dzero,v,desc_a,info,&
& work=aux)
@ -276,7 +276,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(done,uv,dzero,s,desc_a,info)
if (info == 0) call psb_geaxpby(done,q,done,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_geaxpby(alpha,z,done,x,desc_a,info)

4
krylov/psb_dcgstab.F90
Unescape Escape View File

@ -289,7 +289,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifctb, 0, "st PREC" )
#endif
call psb_precaply(prec,p,f,desc_a,info,work=aux)
call prec%apply(p,f,desc_a,info,work=aux)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifcte, 0, "ed PREC" )
imerr = MPE_Log_event( immb, 0, "st SPMM" )
@ -320,7 +320,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifctb, 0, "st PREC" )
#endif
call psb_precaply(prec,s,z,desc_a,info,work=aux)
call prec%apply(s,z,desc_a,info,work=aux)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifcte, 0, "ed PREC" )

6
krylov/psb_dcgstabl.f90
Unescape Escape View File

@ -253,7 +253,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(done,b,dzero,r,desc_a,info)
if (info == 0) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,r,desc_a,info)
if (info == 0) call prec%apply(r,desc_a,info)
if (info == 0) call psb_geaxpby(done,r,dzero,rt0,desc_a,info)
if (info == 0) call psb_geaxpby(done,r,dzero,rh(:,0),desc_a,info)
@ -305,7 +305,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(done,rh(:,0:j),-beta,uh(:,0:j),desc_a,info)
call psb_spmm(done,a,uh(:,j),dzero,uh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,uh(:,j+1),desc_a,info)
call prec%apply(uh(:,j+1),desc_a,info)
gamma(j) = psb_gedot(uh(:,j+1),rt0,desc_a,info)
@ -324,7 +324,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(alpha,uh(:,0),done,x,desc_a,info)
call psb_spmm(done,a,rh(:,j),dzero,rh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,rh(:,j+1),desc_a,info)
call prec%apply(rh(:,j+1),desc_a,info)
enddo

8
krylov/psb_drgmres.f90
Unescape Escape View File

@ -330,7 +330,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
inner: Do i=1,nl
itx = itx + 1
call psb_precaply(prec,v(:,i),w1,desc_a,info)
call prec%apply(v(:,i),w1,desc_a,info)
call psb_spmm(done,a,w1,dzero,w,desc_a,info,work=aux)
!
@ -365,7 +365,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rst(k),v(:,k),done,xt,desc_a,info)
end do
call psb_precaply(prec,xt,desc_a,info)
call prec%apply(xt,desc_a,info)
call psb_geaxpby(done,x,done,xt,desc_a,info)
call psb_geaxpby(done,b,dzero,w1,desc_a,info)
call psb_spmm(-done,a,xt,done,w1,desc_a,info,work=aux)
@ -401,7 +401,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rs(k),v(:,k),done,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(done,w,done,x,desc_a,info)
end if
@ -428,7 +428,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, nl
call psb_geaxpby(rs(k),v(:,k),done,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(done,w,done,x,desc_a,info)
end if

18
krylov/psb_krylov_mod.f90
Unescape Escape View File

@ -497,20 +497,20 @@ contains
use psb_base_mod
use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type
character(len=*) :: method
character(len=*) :: method
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
integer, intent(out) :: info
Integer, Optional, Intent(in) :: itmax, itrace, irst,istop
Integer, Optional, Intent(out) :: iter
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
integer, intent(out) :: info
Integer, Optional, Intent(in) :: itmax, itrace, irst,istop
Integer, Optional, Intent(out) :: iter
Real(psb_spk_), Optional, Intent(out) :: err,cond
integer :: ictxt,me,np,err_act
character(len=20) :: name
character(len=20) :: name
info = 0
name = 'psb_krylov'

4
krylov/psb_sbicg.f90
Unescape Escape View File

@ -256,8 +256,8 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),'iteration: ',itx
call psb_precaply(prec,r,z,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,rt,zt,desc_a,info,trans='t',work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(rt,zt,desc_a,info,trans='t',work=aux)
rho_old = rho
rho = psb_gedot(rt,z,desc_a,info)

2
krylov/psb_scg.F90
Unescape Escape View File

@ -231,7 +231,7 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond)
it = it + 1
itx = itx + 1
call psb_precaply(prec,r,z,desc_a,info,work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
rho_old = rho
rho = psb_gedot(r,z,desc_a,info)

4
krylov/psb_scgs.f90
Unescape Escape View File

@ -252,7 +252,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(sone,uv,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(sone,a,f,szero,v,desc_a,info,&
& work=aux)
@ -277,7 +277,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(sone,uv,szero,s,desc_a,info)
if (info == 0) call psb_geaxpby(sone,q,sone,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_geaxpby(alpha,z,sone,x,desc_a,info)

4
krylov/psb_scgstab.F90
Unescape Escape View File

@ -290,7 +290,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifctb, 0, "st PREC" )
#endif
call psb_precaply(prec,p,f,desc_a,info,work=aux)
call prec%apply(p,f,desc_a,info,work=aux)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifcte, 0, "ed PREC" )
imerr = MPE_Log_event( immb, 0, "st SPMM" )
@ -321,7 +321,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifctb, 0, "st PREC" )
#endif
call psb_precaply(prec,s,z,desc_a,info,work=aux)
call prec%apply(s,z,desc_a,info,work=aux)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( ifcte, 0, "ed PREC" )

6
krylov/psb_scgstabl.f90
Unescape Escape View File

@ -254,7 +254,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(sone,b,szero,r,desc_a,info)
if (info == 0) call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,r,desc_a,info)
if (info == 0) call prec%apply(r,desc_a,info)
if (info == 0) call psb_geaxpby(sone,r,szero,rt0,desc_a,info)
if (info == 0) call psb_geaxpby(sone,r,szero,rh(:,0),desc_a,info)
@ -306,7 +306,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(sone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info)
call psb_spmm(sone,a,uh(:,j),szero,uh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,uh(:,j+1),desc_a,info)
call prec%apply(uh(:,j+1),desc_a,info)
gamma(j) = psb_gedot(uh(:,j+1),rt0,desc_a,info)
@ -325,7 +325,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(alpha,uh(:,0),sone,x,desc_a,info)
call psb_spmm(sone,a,rh(:,j),szero,rh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,rh(:,j+1),desc_a,info)
call prec%apply(rh(:,j+1),desc_a,info)
enddo

8
krylov/psb_srgmres.f90
Unescape Escape View File

@ -330,7 +330,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
inner: Do i=1,nl
itx = itx + 1
call psb_precaply(prec,v(:,i),w1,desc_a,info)
call prec%apply(v(:,i),w1,desc_a,info)
call psb_spmm(sone,a,w1,szero,w,desc_a,info,work=aux)
!
@ -366,7 +366,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rst(k),v(:,k),sone,xt,desc_a,info)
end do
call psb_precaply(prec,xt,desc_a,info)
call prec%apply(xt,desc_a,info)
call psb_geaxpby(sone,x,sone,xt,desc_a,info)
call psb_geaxpby(sone,b,szero,w1,desc_a,info)
call psb_spmm(-sone,a,xt,sone,w1,desc_a,info,work=aux)
@ -414,7 +414,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rs(k),v(:,k),sone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(sone,w,sone,x,desc_a,info)
end if
@ -444,7 +444,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, nl
call psb_geaxpby(rs(k),v(:,k),sone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(sone,w,sone,x,desc_a,info)
end if

4
krylov/psb_zbicg.f90
Unescape Escape View File

@ -254,8 +254,8 @@ subroutine psb_zbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),'iteration: ',itx
call psb_precaply(prec,r,z,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,rt,zt,desc_a,info,trans='c',work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(rt,zt,desc_a,info,trans='c',work=aux)
rho_old = rho
rho = psb_gedot(rt,z,desc_a,info)

2
krylov/psb_zcg.F90
Unescape Escape View File

@ -214,7 +214,7 @@ subroutine psb_zcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
it = it + 1
itx = itx + 1
call psb_precaply(prec,r,z,desc_a,info,work=aux)
call prec%apply(r,z,desc_a,info,work=aux)
rho_old = rho
rho = psb_gedot(r,z,desc_a,info)

4
krylov/psb_zcgs.f90
Unescape Escape View File

@ -249,7 +249,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(zone,uv,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(zone,a,f,zzero,v,desc_a,info,&
& work=aux)
@ -274,7 +274,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(zone,uv,zzero,s,desc_a,info)
if (info == 0) call psb_geaxpby(zone,q,zone,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_geaxpby(alpha,z,zone,x,desc_a,info)

4
krylov/psb_zcgstab.f90
Unescape Escape View File

@ -255,7 +255,7 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
if (info == 0) call psb_geaxpby(zone,r,beta,p,desc_a,info)
end if
if (info == 0) call psb_precaply(prec,p,f,desc_a,info,work=aux)
if (info == 0) call prec%apply(p,f,desc_a,info,work=aux)
if (info == 0) call psb_spmm(zone,a,f,zzero,v,desc_a,info,&
& work=aux)
@ -280,7 +280,7 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
call psb_geaxpby(zone,r,zzero,s,desc_a,info)
if (info == 0) call psb_geaxpby(-alpha,v,zone,s,desc_a,info)
if (info == 0) call psb_precaply(prec,s,z,desc_a,info,work=aux)
if (info == 0) call prec%apply(s,z,desc_a,info,work=aux)
if (info == 0) call psb_spmm(zone,a,z,zzero,t,desc_a,info,&
& work=aux)

6
krylov/psb_zcgstabl.f90
Unescape Escape View File

@ -253,7 +253,7 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(zone,b,zzero,r,desc_a,info)
if (info == 0) call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux)
if (info == 0) call psb_precaply(prec,r,desc_a,info)
if (info == 0) call prec%apply(r,desc_a,info)
if (info == 0) call psb_geaxpby(zone,r,zzero,rt0,desc_a,info)
if (info == 0) call psb_geaxpby(zone,r,zzero,rh(:,0),desc_a,info)
@ -305,7 +305,7 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(zone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info)
call psb_spmm(zone,a,uh(:,j),zzero,uh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,uh(:,j+1),desc_a,info)
call prec%apply(uh(:,j+1),desc_a,info)
gamma(j) = psb_gedot(uh(:,j+1),rt0,desc_a,info)
@ -324,7 +324,7 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
call psb_geaxpby(alpha,uh(:,0),zone,x,desc_a,info)
call psb_spmm(zone,a,rh(:,j),zzero,rh(:,j+1),desc_a,info,work=aux)
call psb_precaply(prec,rh(:,j+1),desc_a,info)
call prec%apply(rh(:,j+1),desc_a,info)
enddo

8
krylov/psb_zrgmres.f90
Unescape Escape View File

@ -330,7 +330,7 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
inner: Do i=1,nl
itx = itx + 1
call psb_precaply(prec,v(:,i),w1,desc_a,info)
call prec%apply(v(:,i),w1,desc_a,info)
Call psb_spmm(zone,a,w1,zzero,w,desc_a,info,work=aux)
!
@ -366,7 +366,7 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rst(k),v(:,k),zone,xt,desc_a,info)
end do
call psb_precaply(prec,xt,desc_a,info)
call prec%apply(xt,desc_a,info)
call psb_geaxpby(zone,x,zone,xt,desc_a,info)
call psb_geaxpby(zone,b,zzero,w1,desc_a,info)
call psb_spmm(-zone,a,xt,zone,w1,desc_a,info,work=aux)
@ -402,7 +402,7 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, i
call psb_geaxpby(rs(k),v(:,k),zone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(zone,w,zone,x,desc_a,info)
end if
@ -429,7 +429,7 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
do k=1, nl
call psb_geaxpby(rs(k),v(:,k),zone,w1,desc_a,info)
end do
call psb_precaply(prec,w1,w,desc_a,info)
call prec%apply(w1,w,desc_a,info)
call psb_geaxpby(zone,w,zone,x,desc_a,info)
end if

168
prec/psb_prec_mod.f90
Unescape Escape View File

@ -181,90 +181,90 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_zprecsetd
end interface
interface psb_precaply
subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_sprc_aply
subroutine psb_sprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_sprc_aply1
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_dprc_aply
subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_dprc_aply1
subroutine psb_cprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_cprc_aply
subroutine psb_cprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_cprc_aply1
subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_zprc_aply
subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_zprc_aply1
end interface
!!$
!!$
!!$ interface psb_precaply
!!$ subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work)
!!$ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
!!$ use psb_prec_type, only : psb_sprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_sprec_type), intent(in) :: prec
!!$ real(psb_spk_),intent(in) :: x(:)
!!$ real(psb_spk_),intent(inout) :: y(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ real(psb_spk_),intent(inout), optional, target :: work(:)
!!$ end subroutine psb_sprc_aply
!!$ subroutine psb_sprc_aply1(prec,x,desc_data,info,trans)
!!$ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
!!$ use psb_prec_type, only : psb_sprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_sprec_type), intent(in) :: prec
!!$ real(psb_spk_),intent(inout) :: x(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ end subroutine psb_sprc_aply1
!!$ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work)
!!$ use psb_base_mod, only : psb_desc_type, psb_dpk_
!!$ use psb_prec_type, only : psb_dprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_dprec_type), intent(in) :: prec
!!$ real(psb_dpk_),intent(in) :: x(:)
!!$ real(psb_dpk_),intent(inout) :: y(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ real(psb_dpk_),intent(inout), optional, target :: work(:)
!!$ end subroutine psb_dprc_aply
!!$ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
!!$ use psb_base_mod, only : psb_desc_type, psb_dpk_
!!$ use psb_prec_type, only : psb_dprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_dprec_type), intent(in) :: prec
!!$ real(psb_dpk_),intent(inout) :: x(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ end subroutine psb_dprc_aply1
!!$ subroutine psb_cprc_aply(prec,x,y,desc_data,info,trans,work)
!!$ use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
!!$ use psb_prec_type, only : psb_cprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_cprec_type), intent(in) :: prec
!!$ complex(psb_spk_),intent(in) :: x(:)
!!$ complex(psb_spk_),intent(inout) :: y(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ complex(psb_spk_),intent(inout), optional, target :: work(:)
!!$ end subroutine psb_cprc_aply
!!$ subroutine psb_cprc_aply1(prec,x,desc_data,info,trans)
!!$ use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
!!$ use psb_prec_type, only : psb_cprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_cprec_type), intent(in) :: prec
!!$ complex(psb_spk_),intent(inout) :: x(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ end subroutine psb_cprc_aply1
!!$ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work)
!!$ use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
!!$ use psb_prec_type, only : psb_zprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_zprec_type), intent(in) :: prec
!!$ complex(psb_dpk_),intent(in) :: x(:)
!!$ complex(psb_dpk_),intent(inout) :: y(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ complex(psb_dpk_),intent(inout), optional, target :: work(:)
!!$ end subroutine psb_zprc_aply
!!$ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
!!$ use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
!!$ use psb_prec_type, only : psb_zprec_type
!!$ type(psb_desc_type),intent(in) :: desc_data
!!$ type(psb_zprec_type), intent(in) :: prec
!!$ complex(psb_dpk_),intent(inout) :: x(:)
!!$ integer, intent(out) :: info
!!$ character(len=1), optional :: trans
!!$ end subroutine psb_zprc_aply1
!!$ end interface
interface psb_bjac_aply

401
prec/psb_prec_type.f90
Unescape Escape View File

@ -71,7 +71,11 @@ module psb_prec_type
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec
integer :: prec
contains
procedure, pass(prec) :: s_apply2v
procedure, pass(prec) :: s_apply1v
generic, public :: apply => s_apply2v, s_apply1v
end type psb_sprec_type
type psb_dprec_type
@ -81,7 +85,11 @@ module psb_prec_type
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec
integer :: prec
contains
procedure, pass(prec) :: d_apply2v
procedure, pass(prec) :: d_apply1v
generic, public :: apply => d_apply2v, d_apply1v
end type psb_dprec_type
type psb_cprec_type
@ -91,7 +99,11 @@ module psb_prec_type
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec
integer :: prec
contains
procedure, pass(prec) :: c_apply2v
procedure, pass(prec) :: c_apply1v
generic, public :: apply => c_apply2v, c_apply1v
end type psb_cprec_type
@ -102,7 +114,11 @@ module psb_prec_type
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec
integer :: prec
contains
procedure, pass(prec) :: z_apply2v
procedure, pass(prec) :: z_apply1v
generic, public :: apply => z_apply2v, z_apply1v
end type psb_zprec_type
@ -136,8 +152,98 @@ module psb_prec_type
& psb_cprec_sizeof, psb_zprec_sizeof
end interface
interface psb_precaply
subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_spk_
import psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_sprc_aply
subroutine psb_sprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_spk_
import psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_sprc_aply1
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_dpk_
import psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_dprc_aply
subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_dpk_
import psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_dprc_aply1
subroutine psb_cprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_spk_
import psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_cprc_aply
subroutine psb_cprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_spk_
import psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_cprc_aply1
subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_dpk_
import psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_zprc_aply
subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_dpk_
import psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
end subroutine psb_zprc_aply1
end interface
contains
subroutine psb_file_prec_descr(p,iout)
type(psb_dprec_type), intent(in) :: p
integer, intent(in), optional :: iout
@ -310,6 +416,7 @@ contains
end subroutine psb_dcheck_def
subroutine psb_s_precfree(p,info)
use psb_base_mod
type(psb_sprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: me, err_act,i
@ -377,6 +484,7 @@ contains
end subroutine psb_nullify_sprec
subroutine psb_d_precfree(p,info)
use psb_base_mod
type(psb_dprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: me, err_act,i
@ -444,6 +552,7 @@ contains
end subroutine psb_nullify_dprec
subroutine psb_c_precfree(p,info)
use psb_base_mod
type(psb_cprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: err_act,i
@ -502,6 +611,7 @@ contains
end subroutine psb_nullify_cprec
subroutine psb_z_precfree(p,info)
use psb_base_mod
type(psb_zprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: err_act,i
@ -580,6 +690,7 @@ contains
function psb_dprec_sizeof(prec) result(val)
use psb_base_mod
type(psb_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -599,6 +710,7 @@ contains
end function psb_dprec_sizeof
function psb_sprec_sizeof(prec) result(val)
use psb_base_mod
type(psb_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -619,6 +731,7 @@ contains
end function psb_sprec_sizeof
function psb_zprec_sizeof(prec) result(val)
use psb_base_mod
type(psb_zprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -639,6 +752,7 @@ contains
end function psb_zprec_sizeof
function psb_cprec_sizeof(prec) result(val)
use psb_base_mod
type(psb_cprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -659,4 +773,283 @@ contains
end function psb_cprec_sizeof
subroutine s_apply2v(prec,x,y,desc_data,info,trans,work)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
character(len=20) :: name='s_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_sprec_type)
call psb_precaply(prec,x,y,desc_data,info,trans,work)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine s_apply2v
subroutine s_apply1v(prec,x,desc_data,info,trans)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_sprec_type), intent(in) :: prec
real(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
character(len=20) :: name='s_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_sprec_type)
call psb_precaply(prec,x,desc_data,info,trans)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine s_apply1v
subroutine d_apply2v(prec,x,y,desc_data,info,trans,work)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_dprec_type)
call psb_precaply(prec,x,y,desc_data,info,trans,work)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine d_apply2v
subroutine d_apply1v(prec,x,desc_data,info,trans)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_dprec_type), intent(in) :: prec
real(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
character(len=20) :: name='d_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_dprec_type)
call psb_precaply(prec,x,desc_data,info,trans)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine d_apply1v
subroutine c_apply2v(prec,x,y,desc_data,info,trans,work)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_spk_),intent(inout), optional, target :: work(:)
Integer :: err_act
character(len=20) :: name='s_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_cprec_type)
call psb_precaply(prec,x,y,desc_data,info,trans,work)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine c_apply2v
subroutine c_apply1v(prec,x,desc_data,info,trans)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_cprec_type), intent(in) :: prec
complex(psb_spk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
character(len=20) :: name='c_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_cprec_type)
call psb_precaply(prec,x,desc_data,info,trans)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine c_apply1v
subroutine z_apply2v(prec,x,y,desc_data,info,trans,work)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(psb_dpk_),intent(inout), optional, target :: work(:)
Integer :: err_act
character(len=20) :: name='z_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_zprec_type)
call psb_precaply(prec,x,y,desc_data,info,trans,work)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine z_apply2v
subroutine z_apply1v(prec,x,desc_data,info,trans)
use psb_base_mod
type(psb_desc_type),intent(in) :: desc_data
class(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_),intent(inout) :: x(:)
integer, intent(out) :: info
character(len=1), optional :: trans
Integer :: err_act
character(len=20) :: name='z_prec_apply'
call psb_erractionsave(err_act)
select type(prec)
type is (psb_zprec_type)
call psb_precaply(prec,x,desc_data,info,trans)
class default
info = 700
call psb_errpush(info,name)
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine z_apply1v
end module psb_prec_type

Write Preview
Loading…
Cancel
Save