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

Added use of WV in solve apply_vect

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 63233716c4
commit 54d1478e21
12 changed files with 652 additions and 572 deletions
Show Stats Download Patch File Download Diff File

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

@ -54,7 +54,6 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_c_vect_type),intent(inout), optional :: initu type(psb_c_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_c_vect_type) :: tw, xit
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_spk_), allocatable :: temp(:) complex(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_c_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_c_vect_type),intent(inout), optional :: initu type(psb_c_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_c_vect_type) :: tw, xit
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_spk_), allocatable :: temp(:) complex(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_c_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -125,8 +125,16 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), tw1 => wv(2))
select case(trans_) select case(trans_)
case('N') case('N')
@ -165,8 +173,8 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call tw1%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_d_vect_type),intent(inout), optional :: initu type(psb_d_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_d_vect_type) :: tw, xit
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_dpk_), allocatable :: temp(:) real(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_d_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_d_vect_type),intent(inout), optional :: initu type(psb_d_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_d_vect_type) :: tw, xit
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_dpk_), allocatable :: temp(:) real(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_d_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -125,8 +125,16 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), tw1 => wv(2))
select case(trans_) select case(trans_)
case('N') case('N')
@ -165,8 +173,8 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call tw1%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_s_vect_type),intent(inout), optional :: initu type(psb_s_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_s_vect_type) :: tw, xit
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_spk_), allocatable :: temp(:) real(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_s_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_s_vect_type),intent(inout), optional :: initu type(psb_s_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_s_vect_type) :: tw, xit
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_spk_), allocatable :: temp(:) real(psb_spk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_s_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -125,8 +125,16 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), tw1 => wv(2))
select case(trans_) select case(trans_)
case('N') case('N')
@ -165,8 +173,8 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call tw1%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_z_vect_type),intent(inout), optional :: initu type(psb_z_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_z_vect_type) :: tw, xit
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_dpk_), allocatable :: temp(:) complex(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_z_bwgs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -54,7 +54,6 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
type(psb_z_vect_type),intent(inout), optional :: initu type(psb_z_vect_type),intent(inout), optional :: initu
integer(psb_ipk_) :: n_row,n_col, itx integer(psb_ipk_) :: n_row,n_col, itx
type(psb_z_vect_type) :: tw, xit
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_dpk_), allocatable :: temp(:) complex(psb_dpk_), allocatable :: temp(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -121,8 +120,15 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
call psb_geasb(xit,desc_data,info,mold=x%v,scratch=.true.) info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), xit => wv(2))
select case (init_) select case (init_)
case('Z') case('Z')
call xit%zero() call xit%zero()
@ -182,8 +188,8 @@ subroutine mld_z_gs_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call xit%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -125,8 +125,16 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
call psb_geasb(tw,desc_data,info,mold=x%v,scratch=.true.)
call psb_geasb(tw1,desc_data,info,mold=x%v,scratch=.true.) if (size(wv) < 2) then
info = psb_err_internal_error_
call psb_errpush(info,name,&
& a_err='invalid wv size')
goto 9999
end if
associate(tw => wv(1), tw1 => wv(2))
select case(trans_) select case(trans_)
case('N') case('N')
@ -165,8 +173,8 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& a_err='Error in subsolve') & a_err='Error in subsolve')
goto 9999 goto 9999
endif endif
call tw%free(info) end associate
call tw1%free(info)
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

Write Preview
Loading…
Cancel
Save