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

Added WV to solver apply_vect interface.

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 4564e1e4ba
commit 2481fec23d
72 changed files with 290 additions and 346 deletions
Show Stats Download Patch File Download Diff File

10
mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!
! Shortcut: in this case there is nothing else to be done.
!
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -145,14 +145,14 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(cone,ww,czero,ty,sm%desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(cone,ww,czero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Z')
case('Y')
call psb_geaxpby(cone,y,czero,ty,desc_data,info)
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-cone,sm%nd,ty,cone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(cone,ww,czero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,ww,czero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -164,7 +164,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-cone,sm%nd,ty,cone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(cone,ww,czero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,ww,czero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -191,7 +191,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(cone,ww,czero,ty,sm%desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,ww,czero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Y')
if (info /= psb_success_) exit
if (info == 0) call sm%apply_prol(ty,trans_,aux,info)

2
mlprec/impl/smoother/mld_c_base_smoother_apply_vect.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine mld_c_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
else
if (allocated(sm%sv)) then
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info,init=init, initu=initu)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,wv,info,init=init, initu=initu)
else
info = 1121
endif

10
mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
! if .not.sv%is_iterative, there's no need to pass init
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
@ -138,13 +138,13 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(cone,x,czero,ty,desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(cone,x,czero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
case('Y')
call psb_geaxpby(cone,x,czero,tx,desc_data,info)
call psb_geaxpby(cone,y,czero,ty,desc_data,info)
call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -155,7 +155,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_geaxpby(cone,x,czero,tx,desc_data,info)
call psb_geaxpby(cone,initu,czero,ty,desc_data,info)
call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -174,7 +174,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
if (info /= psb_success_) exit
end do

10
mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!
! Shortcut: in this case there is nothing else to be done.
!
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -145,14 +145,14 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(done,ww,dzero,ty,sm%desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(done,ww,dzero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Z')
case('Y')
call psb_geaxpby(done,y,dzero,ty,desc_data,info)
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-done,sm%nd,ty,done,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(done,ww,dzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,ww,dzero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -164,7 +164,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-done,sm%nd,ty,done,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(done,ww,dzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,ww,dzero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -191,7 +191,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(done,ww,dzero,ty,sm%desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,ww,dzero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Y')
if (info /= psb_success_) exit
if (info == 0) call sm%apply_prol(ty,trans_,aux,info)

2
mlprec/impl/smoother/mld_d_base_smoother_apply_vect.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine mld_d_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
else
if (allocated(sm%sv)) then
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info,init=init, initu=initu)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,wv,info,init=init, initu=initu)
else
info = 1121
endif

10
mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
! if .not.sv%is_iterative, there's no need to pass init
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
@ -138,13 +138,13 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(done,x,dzero,ty,desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(done,x,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
case('Y')
call psb_geaxpby(done,x,dzero,tx,desc_data,info)
call psb_geaxpby(done,y,dzero,ty,desc_data,info)
call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -155,7 +155,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_geaxpby(done,x,dzero,tx,desc_data,info)
call psb_geaxpby(done,initu,dzero,ty,desc_data,info)
call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -174,7 +174,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
if (info /= psb_success_) exit
end do

10
mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!
! Shortcut: in this case there is nothing else to be done.
!
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -145,14 +145,14 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(sone,ww,szero,ty,sm%desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(sone,ww,szero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Z')
case('Y')
call psb_geaxpby(sone,y,szero,ty,desc_data,info)
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-sone,sm%nd,ty,sone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(sone,ww,szero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,ww,szero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -164,7 +164,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-sone,sm%nd,ty,sone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(sone,ww,szero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,ww,szero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -191,7 +191,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(sone,ww,szero,ty,sm%desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,ww,szero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Y')
if (info /= psb_success_) exit
if (info == 0) call sm%apply_prol(ty,trans_,aux,info)

2
mlprec/impl/smoother/mld_s_base_smoother_apply_vect.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine mld_s_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
else
if (allocated(sm%sv)) then
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info,init=init, initu=initu)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,wv,info,init=init, initu=initu)
else
info = 1121
endif

10
mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
! if .not.sv%is_iterative, there's no need to pass init
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
@ -138,13 +138,13 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(sone,x,szero,ty,desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(sone,x,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
case('Y')
call psb_geaxpby(sone,x,szero,tx,desc_data,info)
call psb_geaxpby(sone,y,szero,ty,desc_data,info)
call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -155,7 +155,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_geaxpby(sone,x,szero,tx,desc_data,info)
call psb_geaxpby(sone,initu,szero,ty,desc_data,info)
call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -174,7 +174,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
if (info /= psb_success_) exit
end do

10
mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!
! Shortcut: in this case there is nothing else to be done.
!
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@ -145,14 +145,14 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(zone,ww,zzero,ty,sm%desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(zone,ww,zzero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Z')
case('Y')
call psb_geaxpby(zone,y,zzero,ty,desc_data,info)
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-zone,sm%nd,ty,zone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(zone,ww,zzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,ww,zzero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -164,7 +164,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info == 0) call sm%apply_restr(ty,trans_,aux,info)
if (info == 0) call psb_spmm(-zone,sm%nd,ty,zone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
call sm%sv%apply(zone,ww,zzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,ww,zzero,ty,desc_data,trans_,aux,wv(4:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -191,7 +191,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(zone,ww,zzero,ty,sm%desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,ww,zzero,ty,sm%desc_data,trans_,aux,wv(4:),info,init='Y')
if (info /= psb_success_) exit
if (info == 0) call sm%apply_prol(ty,trans_,aux,info)

2
mlprec/impl/smoother/mld_z_base_smoother_apply_vect.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine mld_z_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
else
if (allocated(sm%sv)) then
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info,init=init, initu=initu)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,wv,info,init=init, initu=initu)
else
info = 1121
endif

10
mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
! if .not.sv%is_iterative, there's no need to pass init
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,wv,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
@ -138,13 +138,13 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_)
case('Z')
call sm%sv%apply(zone,x,zzero,ty,desc_data,trans_,aux,info,init='Z')
call sm%sv%apply(zone,x,zzero,ty,desc_data,trans_,aux,wv(3:),info,init='Z')
case('Y')
call psb_geaxpby(zone,x,zzero,tx,desc_data,info)
call psb_geaxpby(zone,y,zzero,ty,desc_data,info)
call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case('U')
if (.not.present(initu)) then
@ -155,7 +155,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
call psb_geaxpby(zone,x,zzero,tx,desc_data,info)
call psb_geaxpby(zone,initu,zzero,ty,desc_data,info)
call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_)
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
case default
call psb_errpush(psb_err_internal_error_,name,&
@ -174,7 +174,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
if (info /= psb_success_) exit
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,info,init='Y')
call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,wv(3:),info,init='Y')
if (info /= psb_success_) exit
end do

3
mlprec/impl/solver/mld_c_base_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_c_bwgs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_gs_solver, mld_protect_name => mld_c_bwgs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_c_vect_type) :: wv, xit
type(psb_c_vect_type) :: tw, xit
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(cone,x,czero,wv,desc_data,info)
call psb_geaxpby(cone,x,czero,tw,desc_data,info)
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-cone,sv%l,xit,cone,wv,desc_data,info,doswap=.false.)
call psb_spsm(cone,sv%u,wv,czero,xit,desc_data,info)
call psb_spmm(-cone,sv%l,xit,cone,tw,desc_data,info,doswap=.false.)
call psb_spsm(cone,sv%u,tw,czero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(cone,sv%dv,wv,czero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

3
mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_c_gs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_gs_solver, mld_protect_name => mld_c_gs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_c_vect_type) :: wv, xit
type(psb_c_vect_type) :: tw, xit
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(cone,x,czero,wv,desc_data,info)
call psb_geaxpby(cone,x,czero,tw,desc_data,info)
! Update with U. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-cone,sv%u,xit,cone,wv,desc_data,info,doswap=.false.)
call psb_spsm(cone,sv%l,wv,czero,xit,desc_data,info)
call psb_spmm(-cone,sv%u,xit,cone,tw,desc_data,info,doswap=.false.)
call psb_spsm(cone,sv%l,tw,czero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(cone,sv%dv,wv,czero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

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

@ -36,7 +36,7 @@
!
!
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

27
mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col
type(psb_c_vect_type) :: wv, wv1
type(psb_c_vect_type) :: tw, tw1
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
@ -124,31 +125,31 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.)
select case(trans_)
case('N')
call psb_spsm(cone,sv%l,x,czero,wv,desc_data,info,&
call psb_spsm(cone,sv%l,x,czero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%u,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%u,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_, work=aux)
case('T')
call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
call psb_spsm(cone,sv%u,x,czero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case('C')
call psb_spsm(cone,sv%u,x,czero,wv,desc_data,info,&
call psb_spsm(cone,sv%u,x,czero,tw,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
call wv1%mlt(cone,sv%dv,wv,czero,info,conjgx=trans_)
call tw1%mlt(cone,sv%dv,tw,czero,info,conjgx=trans_)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw1,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
@ -164,8 +165,8 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call wv1%free(info)
call tw%free(info)
call tw1%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then
else

5
mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -40,7 +40,7 @@
!
!
subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_c_mumps_solver
implicit none
@ -49,8 +49,9 @@ subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

3
mlprec/impl/solver/mld_d_base_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_d_bwgs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_gs_solver, mld_protect_name => mld_d_bwgs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_d_vect_type) :: wv, xit
type(psb_d_vect_type) :: tw, xit
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(done,x,dzero,wv,desc_data,info)
call psb_geaxpby(done,x,dzero,tw,desc_data,info)
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-done,sv%l,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%u,wv,dzero,xit,desc_data,info)
call psb_spmm(-done,sv%l,xit,done,tw,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%u,tw,dzero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(done,sv%dv,wv,dzero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

3
mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_d_gs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_gs_solver, mld_protect_name => mld_d_gs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_d_vect_type) :: wv, xit
type(psb_d_vect_type) :: tw, xit
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(done,x,dzero,wv,desc_data,info)
call psb_geaxpby(done,x,dzero,tw,desc_data,info)
! Update with U. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-done,sv%u,xit,done,wv,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%l,wv,dzero,xit,desc_data,info)
call psb_spmm(-done,sv%u,xit,done,tw,desc_data,info,doswap=.false.)
call psb_spsm(done,sv%l,tw,dzero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(done,sv%dv,wv,dzero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

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

@ -36,7 +36,7 @@
!
!
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

27
mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: wv, wv1
type(psb_d_vect_type) :: tw, tw1
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
@ -124,31 +125,31 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.)
select case(trans_)
case('N')
call psb_spsm(done,sv%l,x,dzero,wv,desc_data,info,&
call psb_spsm(done,sv%l,x,dzero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%u,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%u,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_, work=aux)
case('T')
call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
call psb_spsm(done,sv%u,x,dzero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case('C')
call psb_spsm(done,sv%u,x,dzero,wv,desc_data,info,&
call psb_spsm(done,sv%u,x,dzero,tw,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
call wv1%mlt(done,sv%dv,wv,dzero,info,conjgx=trans_)
call tw1%mlt(done,sv%dv,tw,dzero,info,conjgx=trans_)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw1,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
@ -164,8 +165,8 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call wv1%free(info)
call tw%free(info)
call tw1%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then
else

5
mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -40,7 +40,7 @@
!
!
subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_d_mumps_solver
implicit none
@ -49,8 +49,9 @@ subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

3
mlprec/impl/solver/mld_s_base_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_s_bwgs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_gs_solver, mld_protect_name => mld_s_bwgs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_s_vect_type) :: wv, xit
type(psb_s_vect_type) :: tw, xit
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(sone,x,szero,wv,desc_data,info)
call psb_geaxpby(sone,x,szero,tw,desc_data,info)
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-sone,sv%l,xit,sone,wv,desc_data,info,doswap=.false.)
call psb_spsm(sone,sv%u,wv,szero,xit,desc_data,info)
call psb_spmm(-sone,sv%l,xit,sone,tw,desc_data,info,doswap=.false.)
call psb_spsm(sone,sv%u,tw,szero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(sone,sv%dv,wv,szero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

3
mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_s_gs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_gs_solver, mld_protect_name => mld_s_gs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_s_vect_type) :: wv, xit
type(psb_s_vect_type) :: tw, xit
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(sone,x,szero,wv,desc_data,info)
call psb_geaxpby(sone,x,szero,tw,desc_data,info)
! Update with U. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-sone,sv%u,xit,sone,wv,desc_data,info,doswap=.false.)
call psb_spsm(sone,sv%l,wv,szero,xit,desc_data,info)
call psb_spmm(-sone,sv%u,xit,sone,tw,desc_data,info,doswap=.false.)
call psb_spsm(sone,sv%l,tw,szero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(sone,sv%dv,wv,szero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

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

@ -36,7 +36,7 @@
!
!
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

27
mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: wv, wv1
type(psb_s_vect_type) :: tw, tw1
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
@ -124,31 +125,31 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.)
select case(trans_)
case('N')
call psb_spsm(sone,sv%l,x,szero,wv,desc_data,info,&
call psb_spsm(sone,sv%l,x,szero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%u,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%u,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_, work=aux)
case('T')
call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
call psb_spsm(sone,sv%u,x,szero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case('C')
call psb_spsm(sone,sv%u,x,szero,wv,desc_data,info,&
call psb_spsm(sone,sv%u,x,szero,tw,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
call wv1%mlt(sone,sv%dv,wv,szero,info,conjgx=trans_)
call tw1%mlt(sone,sv%dv,tw,szero,info,conjgx=trans_)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw1,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
@ -164,8 +165,8 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call wv1%free(info)
call tw%free(info)
call tw1%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then
else

5
mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -40,7 +40,7 @@
!
!
subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_s_mumps_solver
implicit none
@ -49,8 +49,9 @@ subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

3
mlprec/impl/solver/mld_z_base_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_z_bwgs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_gs_solver, mld_protect_name => mld_z_bwgs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_z_vect_type) :: wv, xit
type(psb_z_vect_type) :: tw, xit
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(zone,x,zzero,wv,desc_data,info)
call psb_geaxpby(zone,x,zzero,tw,desc_data,info)
! Update with L. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-zone,sv%l,xit,zone,wv,desc_data,info,doswap=.false.)
call psb_spsm(zone,sv%u,wv,zzero,xit,desc_data,info)
call psb_spmm(-zone,sv%l,xit,zone,tw,desc_data,info,doswap=.false.)
call psb_spsm(zone,sv%u,tw,zzero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(zone,sv%dv,wv,zzero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

3
mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

30
mlprec/impl/solver/mld_z_gs_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_gs_solver, mld_protect_name => mld_z_gs_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx
type(psb_z_vect_type) :: wv, xit
type(psb_z_vect_type) :: tw, xit
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -120,7 +121,7 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.)
select case (init_)
case('Z')
@ -148,11 +149,11 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
!
!
do itx=1,sv%sweeps
call psb_geaxpby(zone,x,zzero,wv,desc_data,info)
call psb_geaxpby(zone,x,zzero,tw,desc_data,info)
! Update with U. The off-diagonal block is taken care
! from the Jacobi smoother, hence this is purely local.
call psb_spmm(-zone,sv%u,xit,zone,wv,desc_data,info,doswap=.false.)
call psb_spsm(zone,sv%l,wv,zzero,xit,desc_data,info)
call psb_spmm(-zone,sv%u,xit,zone,tw,desc_data,info,doswap=.false.)
call psb_spsm(zone,sv%l,tw,zzero,xit,desc_data,info)
end do
call psb_geaxpby(alpha,xit,beta,y,desc_data,info)
@ -166,21 +167,6 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
!!$ case('T')
!!$ call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ case('C')
!!$
!!$ call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
!!$
!!$ call wv1%mlt(zone,sv%dv,wv,zzero,info,conjgx=trans_)
!!$
!!$ if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
!!$ & trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
info = psb_err_internal_error_
@ -196,7 +182,7 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call tw%free(info)
call xit%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then

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

@ -36,7 +36,7 @@
!
!
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect
@ -48,6 +48,7 @@ subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

27
mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90
Unescape Escape View File

@ -36,7 +36,7 @@
!
!
subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply_vect
@ -48,12 +48,13 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col
type(psb_z_vect_type) :: wv, wv1
type(psb_z_vect_type) :: tw, tw1
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
@ -124,31 +125,31 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999
end if
call psb_geasb(wv,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(wv1,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.)
select case(trans_)
case('N')
call psb_spsm(zone,sv%l,x,zzero,wv,desc_data,info,&
call psb_spsm(zone,sv%l,x,zzero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%u,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%u,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_, work=aux)
case('T')
call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
call psb_spsm(zone,sv%u,x,zzero,tw,desc_data,info,&
& trans=trans_,scale='L',diag=sv%dv,choice=psb_none_,work=aux)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case('C')
call psb_spsm(zone,sv%u,x,zzero,wv,desc_data,info,&
call psb_spsm(zone,sv%u,x,zzero,tw,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
call wv1%mlt(zone,sv%dv,wv,zzero,info,conjgx=trans_)
call tw1%mlt(zone,sv%dv,tw,zzero,info,conjgx=trans_)
if (info == psb_success_) call psb_spsm(alpha,sv%l,wv1,beta,y,desc_data,info,&
if (info == psb_success_) call psb_spsm(alpha,sv%l,tw1,beta,y,desc_data,info,&
& trans=trans_,scale='U',choice=psb_none_,work=aux)
case default
@ -164,8 +165,8 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve')
goto 9999
endif
call wv%free(info)
call wv1%free(info)
call tw%free(info)
call tw1%free(info)
if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then
else

5
mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -40,7 +40,7 @@
!
!
subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
use mld_z_mumps_solver
implicit none
@ -49,8 +49,9 @@ subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

3
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -143,7 +143,7 @@ module mld_c_base_solver_mod
interface
subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_base_solver_type, psb_ipk_
@ -155,6 +155,7 @@ module mld_c_base_solver_mod
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

3
mlprec/mld_c_diag_solver.f90
Unescape Escape View File

@ -76,7 +76,7 @@ module mld_c_diag_solver
interface
subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_diag_solver_type, psb_ipk_
@ -87,6 +87,7 @@ module mld_c_diag_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

6
mlprec/mld_c_gs_solver.f90
Unescape Escape View File

@ -107,7 +107,7 @@ module mld_c_gs_solver
interface
subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_c_gs_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
@ -118,12 +118,13 @@ module mld_c_gs_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
end subroutine mld_c_gs_solver_apply_vect
subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_c_bwgs_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
@ -134,6 +135,7 @@ module mld_c_gs_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

3
mlprec/mld_c_id_solver.f90
Unescape Escape View File

@ -64,7 +64,7 @@ module mld_c_id_solver
interface
subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& mld_c_id_solver_type, psb_ipk_
@ -75,6 +75,7 @@ module mld_c_id_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

3
mlprec/mld_c_ilu_solver.f90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_c_ilu_solver
interface
subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
@ -114,6 +114,7 @@ module mld_c_ilu_solver
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

5
mlprec/mld_c_mumps_solver.F90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_c_mumps_solver
interface
subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_c_mumps_solver_type, psb_c_vect_type, psb_dpk_, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
implicit none
@ -112,8 +112,9 @@ module mld_c_mumps_solver
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

7
mlprec/mld_c_slu_solver.F90
Unescape Escape View File

@ -211,7 +211,7 @@ contains
end subroutine c_slu_solver_apply
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -219,9 +219,10 @@ contains
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_c_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu

3
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -143,7 +143,7 @@ module mld_d_base_solver_mod
interface
subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_base_solver_type, psb_ipk_
@ -155,6 +155,7 @@ module mld_d_base_solver_mod
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

3
mlprec/mld_d_diag_solver.f90
Unescape Escape View File

@ -76,7 +76,7 @@ module mld_d_diag_solver
interface
subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_diag_solver_type, psb_ipk_
@ -87,6 +87,7 @@ module mld_d_diag_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

6
mlprec/mld_d_gs_solver.f90
Unescape Escape View File

@ -107,7 +107,7 @@ module mld_d_gs_solver
interface
subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_d_gs_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
@ -118,12 +118,13 @@ module mld_d_gs_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine mld_d_gs_solver_apply_vect
subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_d_bwgs_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
@ -134,6 +135,7 @@ module mld_d_gs_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

3
mlprec/mld_d_id_solver.f90
Unescape Escape View File

@ -64,7 +64,7 @@ module mld_d_id_solver
interface
subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& mld_d_id_solver_type, psb_ipk_
@ -75,6 +75,7 @@ module mld_d_id_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

3
mlprec/mld_d_ilu_solver.f90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_d_ilu_solver
interface
subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
@ -114,6 +114,7 @@ module mld_d_ilu_solver
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

5
mlprec/mld_d_mumps_solver.F90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_d_mumps_solver
interface
subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_d_mumps_solver_type, psb_d_vect_type, psb_dpk_, psb_spk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
implicit none
@ -112,8 +112,9 @@ module mld_d_mumps_solver
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

7
mlprec/mld_d_slu_solver.F90
Unescape Escape View File

@ -211,7 +211,7 @@ contains
end subroutine d_slu_solver_apply
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -219,9 +219,10 @@ contains
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

7
mlprec/mld_d_sludist_solver.F90
Unescape Escape View File

@ -212,7 +212,7 @@ contains
end subroutine d_sludist_solver_apply
subroutine d_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -220,9 +220,10 @@ contains
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

5
mlprec/mld_d_umf_solver.F90
Unescape Escape View File

@ -215,7 +215,7 @@ contains
end subroutine d_umf_solver_apply
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -223,8 +223,9 @@ contains
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu

3
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -143,7 +143,7 @@ module mld_s_base_solver_mod
interface
subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_base_solver_type, psb_ipk_
@ -155,6 +155,7 @@ module mld_s_base_solver_mod
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

3
mlprec/mld_s_diag_solver.f90
Unescape Escape View File

@ -76,7 +76,7 @@ module mld_s_diag_solver
interface
subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_diag_solver_type, psb_ipk_
@ -87,6 +87,7 @@ module mld_s_diag_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

6
mlprec/mld_s_gs_solver.f90
Unescape Escape View File

@ -107,7 +107,7 @@ module mld_s_gs_solver
interface
subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_s_gs_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
@ -118,12 +118,13 @@ module mld_s_gs_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu
end subroutine mld_s_gs_solver_apply_vect
subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_s_bwgs_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
@ -134,6 +135,7 @@ module mld_s_gs_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

3
mlprec/mld_s_id_solver.f90
Unescape Escape View File

@ -64,7 +64,7 @@ module mld_s_id_solver
interface
subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& mld_s_id_solver_type, psb_ipk_
@ -75,6 +75,7 @@ module mld_s_id_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

3
mlprec/mld_s_ilu_solver.f90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_s_ilu_solver
interface
subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
@ -114,6 +114,7 @@ module mld_s_ilu_solver
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

5
mlprec/mld_s_mumps_solver.F90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_s_mumps_solver
interface
subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_s_mumps_solver_type, psb_s_vect_type, psb_dpk_, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
implicit none
@ -112,8 +112,9 @@ module mld_s_mumps_solver
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
type(psb_s_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

7
mlprec/mld_s_slu_solver.F90
Unescape Escape View File

@ -211,7 +211,7 @@ contains
end subroutine s_slu_solver_apply
subroutine s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -219,9 +219,10 @@ contains
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_s_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_s_vect_type),intent(inout), optional :: initu

3
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -143,7 +143,7 @@ module mld_z_base_solver_mod
interface
subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_base_solver_type, psb_ipk_
@ -155,6 +155,7 @@ module mld_z_base_solver_mod
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

3
mlprec/mld_z_diag_solver.f90
Unescape Escape View File

@ -76,7 +76,7 @@ module mld_z_diag_solver
interface
subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_diag_solver_type, psb_ipk_
@ -87,6 +87,7 @@ module mld_z_diag_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

6
mlprec/mld_z_gs_solver.f90
Unescape Escape View File

@ -107,7 +107,7 @@ module mld_z_gs_solver
interface
subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_z_gs_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
@ -118,12 +118,13 @@ module mld_z_gs_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu
end subroutine mld_z_gs_solver_apply_vect
subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_z_bwgs_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
@ -134,6 +135,7 @@ module mld_z_gs_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

3
mlprec/mld_z_id_solver.f90
Unescape Escape View File

@ -64,7 +64,7 @@ module mld_z_id_solver
interface
subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
& mld_z_id_solver_type, psb_ipk_
@ -75,6 +75,7 @@ module mld_z_id_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

3
mlprec/mld_z_ilu_solver.f90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_z_ilu_solver
interface
subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
@ -114,6 +114,7 @@ module mld_z_ilu_solver
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

5
mlprec/mld_z_mumps_solver.F90
Unescape Escape View File

@ -103,7 +103,7 @@ module mld_z_mumps_solver
interface
subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
import :: psb_desc_type, mld_z_mumps_solver_type, psb_z_vect_type, psb_dpk_, psb_spk_, &
& psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
implicit none
@ -112,8 +112,9 @@ module mld_z_mumps_solver
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

7
mlprec/mld_z_slu_solver.F90
Unescape Escape View File

@ -211,7 +211,7 @@ contains
end subroutine z_slu_solver_apply
subroutine z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -219,9 +219,10 @@ contains
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_z_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

7
mlprec/mld_z_sludist_solver.F90
Unescape Escape View File

@ -212,7 +212,7 @@ contains
end subroutine z_sludist_solver_apply
subroutine z_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -220,9 +220,10 @@ contains
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
type(psb_z_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

5
mlprec/mld_z_umf_solver.F90
Unescape Escape View File

@ -215,7 +215,7 @@ contains
end subroutine z_umf_solver_apply
subroutine z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
@ -223,8 +223,9 @@ contains
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
type(psb_z_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_z_vect_type),intent(inout), optional :: initu

Write Preview
Loading…
Cancel
Save