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

psblas3-integer8:

Browse Source 
base/modules/psi_penv_mod.F90
 krylov/psb_c_inner_krylov_mod.f90
 krylov/psb_cbicg.f90
 krylov/psb_ccg.f90
 krylov/psb_ccgs.f90
 krylov/psb_ccgstab.f90
 krylov/psb_ccgstabl.f90
 krylov/psb_crgmres.f90
 krylov/psb_d_inner_krylov_mod.f90
 krylov/psb_dbicg.f90
 krylov/psb_dcg.F90
 krylov/psb_dcgs.f90
 krylov/psb_dcgstab.F90
 krylov/psb_dcgstabl.f90
 krylov/psb_drgmres.f90
 krylov/psb_s_inner_krylov_mod.f90
 krylov/psb_scgstab.F90
 krylov/psb_z_inner_krylov_mod.f90

Added some krylov stuff. Retiring set/get coher.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 8eeff0abda
commit e41251d525
18 changed files with 89 additions and 223 deletions
Show Stats Download Patch File Download Diff File

17
base/modules/psi_penv_mod.F90
Unescape Escape View File

@ -21,7 +21,7 @@ module psi_penv_mod
interface psb_barrier
module procedure psb_barrier
end interface
#if defined(LONG_INTEGERS)
interface psb_init
module procedure psb_init_ipk
@ -42,6 +42,7 @@ module psi_penv_mod
interface psb_barrier
module procedure psb_barrier_ipk
end interface
#endif
interface psb_wtime
@ -470,20 +471,6 @@ contains
end subroutine psb_info
subroutine psb_set_coher(ictxt,isvch)
integer(psb_mpik_) :: ictxt, isvch
! Ensure global repeatability for convergence checks.
! Do nothing. Obsolete.
end subroutine psb_set_coher
subroutine psb_restore_coher(ictxt,isvch)
integer(psb_mpik_) :: ictxt, isvch
! Ensure global coherence for convergence checks.
! Do nothing. Obsolete.
end subroutine psb_restore_coher
subroutine psb_get_mpicomm(ictxt,comm)
integer(psb_mpik_) :: ictxt, comm

34
krylov/psb_c_inner_krylov_mod.f90
Unescape Escape View File

@ -60,7 +60,7 @@ contains
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -90,7 +90,8 @@ contains
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -118,7 +119,7 @@ contains
end subroutine psb_c_init_conv
function psb_c_check_conv(methdname,it,x,r,desc_a,stopdat,info)
function psb_c_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
@ -126,7 +127,7 @@ contains
complex(psb_spk_), intent(in) :: x(:), r(:)
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
logical :: psb_c_check_conv
logical :: res
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
@ -138,7 +139,8 @@ contains
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
psb_c_check_conv = .false.
res = .false.
select case(stopdat%controls(psb_ik_stopc_))
case(1)
@ -165,18 +167,17 @@ contains
end if
if (stopdat%values(psb_ik_errden_) == dzero) then
psb_c_check_conv = (stopdat%values(psb_ik_errnum_) <=&
& stopdat%values(psb_ik_eps_))
res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_))
else
psb_c_check_conv = (stopdat%values(psb_ik_errnum_) <=&
res = (stopdat%values(psb_ik_errnum_) <= &
& stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_))
end if
psb_c_check_conv = (psb_c_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it))
res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it))
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.psb_c_check_conv)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -205,7 +206,7 @@ contains
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -218,7 +219,7 @@ contains
call psb_info(ictxt, me, np)
stopdat%controls(:) = 0
stopdat%values(:) = szero
stopdat%values(:) = dzero
stopdat%controls(psb_ik_stopc_) = stopc
stopdat%controls(psb_ik_trace_) = trace
@ -235,7 +236,8 @@ contains
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -244,7 +246,7 @@ contains
end if
stopdat%values(psb_ik_eps_) = eps
stopdat%values(psb_ik_errnum_) = szero
stopdat%values(psb_ik_errnum_) = dzero
stopdat%values(psb_ik_errden_) = done
if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))&
@ -322,7 +324,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if

10
krylov/psb_cbicg.f90
Unescape Escape View File

@ -143,9 +143,6 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (present(istop)) then
istop_ = istop
@ -318,8 +315,6 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -386,9 +381,6 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,&
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (.not.allocated(b%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
@ -568,8 +560,6 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,&
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

10
krylov/psb_ccg.f90
Unescape Escape View File

@ -185,9 +185,6 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
itx=0
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
restart: do
!!$
!!$ r0 = b-Ax0
@ -267,8 +264,6 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -387,8 +382,6 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,&
itx=0
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
restart: do
!!$
@ -468,9 +461,6 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

9
krylov/psb_ccgs.f90
Unescape Escape View File

@ -188,8 +188,6 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
@ -313,8 +311,6 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -434,9 +430,6 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,&
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
@ -555,8 +548,6 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

10
krylov/psb_ccgstab.f90
Unescape Escape View File

@ -191,9 +191,6 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
itrace_ = 0
end if
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
@ -340,8 +337,6 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -486,9 +481,6 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (psb_errstatus_fatal()) Then
@ -656,8 +648,6 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

10
krylov/psb_ccgstabl.f90
Unescape Escape View File

@ -232,9 +232,6 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
ww => wwrk(:,9)
rt0 => wwrk(:,10)
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (info /= psb_success_) Then
@ -396,8 +393,6 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -553,9 +548,6 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,&
ww => wwrk(9)
rt0 => wwrk(10)
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (info /= psb_success_) Then
@ -720,8 +712,6 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

10
krylov/psb_crgmres.f90
Unescape Escape View File

@ -239,8 +239,6 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
& ' Size of V,W,W1 ',size(v),size(v,1),&
& size(w),size(w,1),size(w1),size(w1,1), size(v(:,1))
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info)
@ -456,9 +454,6 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -737,8 +732,6 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
& ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),&
& w%get_nrows(),w1%get_nrows()
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info)
@ -953,9 +946,6 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

39
krylov/psb_d_inner_krylov_mod.f90
Unescape Escape View File

@ -46,21 +46,21 @@ Module psb_d_inner_krylov_mod
end interface
contains
subroutine psb_d_init_conv(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: stopc, trace,itmax
integer(psb_ipk_), intent(in) :: stopc, trace, itmax
type(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: b(:), eps
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(in) :: eps
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -82,14 +82,16 @@ contains
select case(stopdat%controls(psb_ik_stopc_))
case (1)
stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
if (info == psb_success_)&
& stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
case (2)
stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info)
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -116,12 +118,13 @@ contains
end subroutine psb_d_init_conv
function psb_d_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: it
real(psb_dpk_), intent(in) :: x(:), r(:)
real(psb_dpk_), intent(in) :: x(:), r(:)
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
logical :: res
@ -142,14 +145,13 @@ contains
select case(stopdat%controls(psb_ik_stopc_))
case(1)
stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info)
if (info == psb_success_)&
& stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info)
stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_)
stopdat%values(psb_ik_errden_) = &
stopdat%values(psb_ik_errden_) =&
& (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)&
& +stopdat%values(psb_ik_bni_))
& +stopdat%values(psb_ik_bni_))
case(2)
stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info)
stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info)
stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_)
stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_)
@ -175,7 +177,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -191,6 +193,7 @@ contains
end function psb_d_check_conv
subroutine psb_d_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info)
use psb_base_mod
implicit none
@ -203,7 +206,7 @@ contains
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -216,7 +219,7 @@ contains
call psb_info(ictxt, me, np)
stopdat%controls(:) = 0
stopdat%values(:) = 0.0d0
stopdat%values(:) = dzero
stopdat%controls(psb_ik_stopc_) = stopc
stopdat%controls(psb_ik_trace_) = trace
@ -233,7 +236,8 @@ contains
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -320,7 +324,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -336,5 +340,4 @@ contains
end function psb_d_check_conv_vect
end module psb_d_inner_krylov_mod

8
krylov/psb_dbicg.f90
Unescape Escape View File

@ -142,8 +142,6 @@
!!$ n_row = desc_a%get_local_rows()
!!$ n_col = desc_a%get_local_cols()
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$
!!$ if (present(istop)) then
@ -313,8 +311,6 @@
!!$ call psb_errpush(info,name)
!!$ goto 9999
!!$ end if
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
@ -378,8 +374,6 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,&
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (.not.allocated(b%v)) then
info = psb_err_invalid_vect_state_
@ -559,8 +553,6 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,&
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

11
krylov/psb_dcg.F90
Unescape Escape View File

@ -199,8 +199,6 @@
!!$
!!$ itx=0
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$ restart: do
!!$! !$
@ -305,9 +303,6 @@
!!$ goto 9999
!!$ end if
!!$
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
@ -436,9 +431,6 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
itx=0
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
restart: do
!!$
!!$ r0 = b-Ax0
@ -543,9 +535,6 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

10
krylov/psb_dcgs.f90
Unescape Escape View File

@ -187,9 +187,6 @@
!!$ itrace_ = 0
!!$ End If
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$ itx = 0
!!$
!!$ call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
@ -307,8 +304,6 @@
!!$ goto 9999
!!$ end if
!!$
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
@ -427,9 +422,6 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,&
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
@ -547,8 +539,6 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

9
krylov/psb_dcgstab.F90
Unescape Escape View File

@ -222,8 +222,6 @@
!!$ itrace_ = 0
!!$ End If
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$ itx = 0
!!$ call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
@ -407,8 +405,6 @@
!!$ call mpi_Pcontrol(2,info)
!!$ call mpi_Pcontrol(0,info)
!!$#endif
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
@ -544,9 +540,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (psb_errstatus_fatal()) Then
@ -716,8 +709,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

11
krylov/psb_dcgstabl.f90
Unescape Escape View File

@ -232,9 +232,6 @@
!!$ ww => wwrk(:,9)
!!$ rt0 => wwrk(:,10)
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$
!!$ call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
!!$ if (info /= psb_success_) Then
@ -392,8 +389,6 @@
!!$ goto 9999
!!$ end if
!!$
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
@ -546,10 +541,6 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,&
ww => wwrk(9)
rt0 => wwrk(10)
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (info /= psb_success_) Then
call psb_errpush(psb_err_from_subroutine_non_,name)
@ -712,8 +703,6 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

12
krylov/psb_drgmres.f90
Unescape Escape View File

@ -240,9 +240,6 @@
!!$ & ' Size of V,W,W1 ',size(v),size(v,1),&
!!$ & size(w),size(w,1),size(w1),size(w1,1), size(v(:,1))
!!$
!!$ ! Ensure global coherence for convergence checks.
!!$ call psb_set_coher(ictxt,isvch)
!!$
!!$ if (istop_ == 1) then
!!$ ani = psb_spnrmi(a,desc_a,info)
!!$ bni = psb_geamax(b,desc_a,info)
@ -450,9 +447,6 @@
!!$ goto 9999
!!$ end if
!!$
!!$ ! restore external global coherence behaviour
!!$ call psb_restore_coher(ictxt,isvch)
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
@ -612,9 +606,6 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
& ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),&
& w%get_nrows(),w1%get_nrows()
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info)
bni = psb_geamax(b,desc_a,info)
@ -824,9 +815,6 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

40
krylov/psb_s_inner_krylov_mod.f90
Unescape Escape View File

@ -46,21 +46,21 @@ Module psb_s_inner_krylov_mod
end interface
contains
subroutine psb_s_init_conv(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: stopc, trace,itmax
integer(psb_ipk_), intent(in) :: stopc, trace, itmax
type(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(in) :: b(:), eps
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(in) :: eps
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -82,14 +82,16 @@ contains
select case(stopdat%controls(psb_ik_stopc_))
case (1)
stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
if (info == psb_success_)&
& stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
case (2)
stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info)
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -116,12 +118,13 @@ contains
end subroutine psb_s_init_conv
function psb_s_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: it
real(psb_spk_), intent(in) :: x(:), r(:)
real(psb_spk_), intent(in) :: x(:), r(:)
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
logical :: res
@ -144,11 +147,11 @@ contains
stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info)
stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_)
stopdat%values(psb_ik_errden_) = &
stopdat%values(psb_ik_errden_) =&
& (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)&
& +stopdat%values(psb_ik_bni_))
& +stopdat%values(psb_ik_bni_))
case(2)
stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info)
stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info)
stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_)
stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_)
@ -166,7 +169,7 @@ contains
if (stopdat%values(psb_ik_errden_) == dzero) then
res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_))
else
res = (stopdat%values(psb_ik_errnum_) <=&
res = (stopdat%values(psb_ik_errnum_) <= &
& stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_))
end if
@ -174,7 +177,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -190,6 +193,7 @@ contains
end function psb_s_check_conv
subroutine psb_s_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info)
use psb_base_mod
implicit none
@ -202,7 +206,7 @@ contains
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -215,7 +219,7 @@ contains
call psb_info(ictxt, me, np)
stopdat%controls(:) = 0
stopdat%values(:) = szero
stopdat%values(:) = dzero
stopdat%controls(psb_ik_stopc_) = stopc
stopdat%controls(psb_ik_trace_) = trace
@ -232,7 +236,8 @@ contains
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -241,7 +246,7 @@ contains
end if
stopdat%values(psb_ik_eps_) = eps
stopdat%values(psb_ik_errnum_) = szero
stopdat%values(psb_ik_errnum_) = dzero
stopdat%values(psb_ik_errden_) = done
if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))&
@ -319,7 +324,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -335,5 +340,4 @@ contains
end function psb_s_check_conv_vect
end module psb_s_inner_krylov_mod

9
krylov/psb_scgstab.F90
Unescape Escape View File

@ -223,9 +223,6 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
if (info /= psb_success_) Then
@ -389,8 +386,6 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#ifdef MPE_KRYLOV
imerr = MPE_Log_event( istpe, 0, "ed CGSTAB" )
#endif
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return
@ -536,8 +531,6 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
itrace_ = 0
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(ictxt,isvch)
itx = 0
call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info)
@ -708,8 +701,6 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_errpush(info,name)
goto 9999
end if
! restore external global coherence behaviour
call psb_restore_coher(ictxt,isvch)
call psb_erractionrestore(err_act)
return

53
krylov/psb_z_inner_krylov_mod.f90
Unescape Escape View File

@ -33,7 +33,6 @@
! File: psb_krylov_mod.f90
! Interfaces for Krylov subspace iterative methods.
!
Module psb_z_inner_krylov_mod
use psb_base_inner_krylov_mod
@ -47,23 +46,21 @@ Module psb_z_inner_krylov_mod
end interface
contains
subroutine psb_z_init_conv(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: stopc, trace, itmax
type(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(in) :: eps
complex(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(in) :: eps
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -85,14 +82,16 @@ contains
select case(stopdat%controls(psb_ik_stopc_))
case (1)
stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
if (info == psb_success_)&
& stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info)
case (2)
stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info)
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -120,15 +119,15 @@ contains
end subroutine psb_z_init_conv
function psb_z_check_conv(methdname,it,x,r,desc_a,stopdat,info)
function psb_z_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res)
use psb_base_mod
implicit none
character(len=*), intent(in) :: methdname
integer(psb_ipk_), intent(in) :: it
complex(psb_dpk_), intent(in) :: x(:), r(:)
complex(psb_dpk_), intent(in) :: x(:), r(:)
type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat
logical :: psb_z_check_conv
logical :: res
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
@ -140,14 +139,15 @@ contains
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
psb_z_check_conv = .false.
res = .false.
select case(stopdat%controls(psb_ik_stopc_))
case(1)
stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info)
if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info)
stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_)
stopdat%values(psb_ik_errden_) = &
stopdat%values(psb_ik_errden_) =&
& (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)&
& +stopdat%values(psb_ik_bni_))
case(2)
@ -167,18 +167,17 @@ contains
end if
if (stopdat%values(psb_ik_errden_) == dzero) then
psb_z_check_conv = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_))
res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_))
else
psb_z_check_conv = &
& (stopdat%values(psb_ik_errnum_) <=&
& stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_))
res = (stopdat%values(psb_ik_errnum_) <= &
& stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_))
end if
psb_z_check_conv = (psb_z_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it))
res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it))
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.psb_z_check_conv)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -207,7 +206,7 @@ contains
type(psb_itconv_type) :: stopdat
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: ictxt, me, np, err_act
integer(psb_ipk_) :: ictxt, me, np, err_act, ierr(5)
character(len=20) :: name
info = psb_success_
@ -220,7 +219,7 @@ contains
call psb_info(ictxt, me, np)
stopdat%controls(:) = 0
stopdat%values(:) = szero
stopdat%values(:) = dzero
stopdat%controls(psb_ik_stopc_) = stopc
stopdat%controls(psb_ik_trace_) = trace
@ -237,7 +236,8 @@ contains
case default
info=psb_err_invalid_istop_
call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/))
ierr(1) = stopc
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
if (info /= psb_success_) then
@ -246,7 +246,7 @@ contains
end if
stopdat%values(psb_ik_eps_) = eps
stopdat%values(psb_ik_errnum_) = szero
stopdat%values(psb_ik_errnum_) = dzero
stopdat%values(psb_ik_errden_) = done
if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))&
@ -281,7 +281,7 @@ contains
info = psb_success_
res = .false.
if (psb_errstatus_fatal()) return
name = 'psb_zheck_conv'
name = 'psb_check_conv'
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
@ -324,7 +324,7 @@ contains
if ( (stopdat%controls(psb_ik_trace_) > 0).and.&
& ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then
call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),&
call log_conv(methdname,me,it,ione,stopdat%values(psb_ik_errnum_),&
& stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_))
end if
@ -340,5 +340,4 @@ contains
end function psb_z_check_conv_vect
end module psb_z_inner_krylov_mod

Write Preview
Loading…
Cancel
Save