From e41251d525d260ff1699a524e193619352a744b7 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 1 Feb 2012 18:25:43 +0000 Subject: [PATCH] psblas3-integer8: 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. --- base/modules/psi_penv_mod.F90 | 17 ++-------- krylov/psb_c_inner_krylov_mod.f90 | 34 ++++++++++---------- krylov/psb_cbicg.f90 | 10 ------ krylov/psb_ccg.f90 | 10 ------ krylov/psb_ccgs.f90 | 9 ------ krylov/psb_ccgstab.f90 | 10 ------ krylov/psb_ccgstabl.f90 | 10 ------ krylov/psb_crgmres.f90 | 10 ------ krylov/psb_d_inner_krylov_mod.f90 | 39 ++++++++++++----------- krylov/psb_dbicg.f90 | 8 ----- krylov/psb_dcg.F90 | 11 ------- krylov/psb_dcgs.f90 | 10 ------ krylov/psb_dcgstab.F90 | 9 ------ krylov/psb_dcgstabl.f90 | 11 ------- krylov/psb_drgmres.f90 | 12 ------- krylov/psb_s_inner_krylov_mod.f90 | 40 ++++++++++++----------- krylov/psb_scgstab.F90 | 9 ------ krylov/psb_z_inner_krylov_mod.f90 | 53 +++++++++++++++---------------- 18 files changed, 89 insertions(+), 223 deletions(-) diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index 012f3b16..e20e681a 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -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 diff --git a/krylov/psb_c_inner_krylov_mod.f90 b/krylov/psb_c_inner_krylov_mod.f90 index 3a7214eb..cc71077d 100644 --- a/krylov/psb_c_inner_krylov_mod.f90 +++ b/krylov/psb_c_inner_krylov_mod.f90 @@ -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 diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index 2087330c..845e92fd 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -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 diff --git a/krylov/psb_ccg.f90 b/krylov/psb_ccg.f90 index bf2ac77d..ef2ce7e4 100644 --- a/krylov/psb_ccg.f90 +++ b/krylov/psb_ccg.f90 @@ -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 diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index 20d1b190..3db7fcfc 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -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 diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index 0b3c3e02..8100bc9a 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -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 diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index 1700bd86..0b79e9ad 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -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 diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index a2163e4e..f059ff9a 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -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 diff --git a/krylov/psb_d_inner_krylov_mod.f90 b/krylov/psb_d_inner_krylov_mod.f90 index 0fa72a51..9738fb02 100644 --- a/krylov/psb_d_inner_krylov_mod.f90 +++ b/krylov/psb_d_inner_krylov_mod.f90 @@ -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 diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 79f03b95..9034a892 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -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 diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index c9d874af..c899acd2 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -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 diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index bdee82dd..ddf5c630 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -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 diff --git a/krylov/psb_dcgstab.F90 b/krylov/psb_dcgstab.F90 index c05e438e..49db1e85 100644 --- a/krylov/psb_dcgstab.F90 +++ b/krylov/psb_dcgstab.F90 @@ -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 diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index b79dbd88..91e0c1c8 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -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 diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index a4d079de..80abdb51 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -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 diff --git a/krylov/psb_s_inner_krylov_mod.f90 b/krylov/psb_s_inner_krylov_mod.f90 index c9c0b1fe..35b6f018 100644 --- a/krylov/psb_s_inner_krylov_mod.f90 +++ b/krylov/psb_s_inner_krylov_mod.f90 @@ -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 diff --git a/krylov/psb_scgstab.F90 b/krylov/psb_scgstab.F90 index 0f6f4f25..7073457a 100644 --- a/krylov/psb_scgstab.F90 +++ b/krylov/psb_scgstab.F90 @@ -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 diff --git a/krylov/psb_z_inner_krylov_mod.f90 b/krylov/psb_z_inner_krylov_mod.f90 index e5439b67..78bedaf5 100644 --- a/krylov/psb_z_inner_krylov_mod.f90 +++ b/krylov/psb_z_inner_krylov_mod.f90 @@ -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