|
|
@ -133,6 +133,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
|
|
|
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
|
|
|
& omega
|
|
|
|
& omega
|
|
|
|
real(kind(1.d0)) :: errnum, errden
|
|
|
|
real(kind(1.d0)) :: errnum, errden
|
|
|
|
|
|
|
|
type(psb_itconv_type) :: stopdat
|
|
|
|
character(len=20) :: name
|
|
|
|
character(len=20) :: name
|
|
|
|
character(len=*), parameter :: methdname='BiCGStab(L)'
|
|
|
|
character(len=*), parameter :: methdname='BiCGStab(L)'
|
|
|
|
|
|
|
|
|
|
|
@ -157,18 +158,6 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
else
|
|
|
|
else
|
|
|
|
istop_ = 1
|
|
|
|
istop_ = 1
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
!
|
|
|
|
|
|
|
|
! ISTOP_ = 1: Normwise backward error, infinity norm
|
|
|
|
|
|
|
|
! ISTOP_ = 2: ||r||/||b|| norm 2
|
|
|
|
|
|
|
|
!
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if ((istop_ < 1 ).or.(istop_ > 2 ) ) then
|
|
|
|
|
|
|
|
info=5001
|
|
|
|
|
|
|
|
int_err=istop_
|
|
|
|
|
|
|
|
err=info
|
|
|
|
|
|
|
|
call psb_errpush(info,name,i_err=int_err)
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (present(itmax)) then
|
|
|
|
if (present(itmax)) then
|
|
|
|
litmax = itmax
|
|
|
|
litmax = itmax
|
|
|
@ -202,15 +191,10 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info)
|
|
|
|
call psb_chkvect(mglob,1,size(x,1),1,1,desc_a,info)
|
|
|
|
if(info /= 0) then
|
|
|
|
if (info == 0) call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info)
|
|
|
|
info=4010
|
|
|
|
if (info /= 0) then
|
|
|
|
call psb_errpush(info,name,a_err='psb_chkvect on X')
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
call psb_chkvect(mglob,1,size(b,1),1,1,desc_a,info)
|
|
|
|
|
|
|
|
if(info /= 0) then
|
|
|
|
|
|
|
|
info=4010
|
|
|
|
info=4010
|
|
|
|
call psb_errpush(info,name,a_err='psb_chkvect on B')
|
|
|
|
call psb_errpush(info,name,a_err='psb_chkvect on X/B')
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
@ -249,19 +233,12 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
! Ensure global coherence for convergence checks.
|
|
|
|
! Ensure global coherence for convergence checks.
|
|
|
|
call psb_set_coher(ictxt,isvch)
|
|
|
|
call psb_set_coher(ictxt,isvch)
|
|
|
|
|
|
|
|
|
|
|
|
if (istop_ == 1) then
|
|
|
|
|
|
|
|
ani = psb_spnrmi(a,desc_a,info)
|
|
|
|
call psb_init_conv(methdname,istop_,itrace_,a,b,eps,desc_a,stopdat,info)
|
|
|
|
bni = psb_geamax(b,desc_a,info)
|
|
|
|
if (info /= 0) Then
|
|
|
|
else if (istop_ == 2) then
|
|
|
|
call psb_errpush(4011,name)
|
|
|
|
bn2 = psb_genrm2(b,desc_a,info)
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
errnum = dzero
|
|
|
|
|
|
|
|
errden = done
|
|
|
|
|
|
|
|
if (info /= 0) then
|
|
|
|
|
|
|
|
info=4011
|
|
|
|
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
End If
|
|
|
|
|
|
|
|
|
|
|
|
itx = 0
|
|
|
|
itx = 0
|
|
|
|
restart: do
|
|
|
|
restart: do
|
|
|
@ -271,15 +248,16 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
if (debug_level >= psb_debug_ext_) &
|
|
|
|
if (debug_level >= psb_debug_ext_) &
|
|
|
|
& write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it
|
|
|
|
& write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it
|
|
|
|
if (itx >= litmax) exit restart
|
|
|
|
if (itx >= litmax) exit restart
|
|
|
|
|
|
|
|
|
|
|
|
it = 0
|
|
|
|
it = 0
|
|
|
|
call psb_geaxpby(done,b,dzero,r,desc_a,info)
|
|
|
|
call psb_geaxpby(done,b,dzero,r,desc_a,info)
|
|
|
|
call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux)
|
|
|
|
if (info == 0) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux)
|
|
|
|
|
|
|
|
|
|
|
|
call psb_precaply(prec,r,desc_a,info)
|
|
|
|
if (info == 0) call psb_precaply(prec,r,desc_a,info)
|
|
|
|
|
|
|
|
|
|
|
|
call psb_geaxpby(done,r,dzero,rt0,desc_a,info)
|
|
|
|
if (info == 0) call psb_geaxpby(done,r,dzero,rt0,desc_a,info)
|
|
|
|
call psb_geaxpby(done,r,dzero,rh(:,0),desc_a,info)
|
|
|
|
if (info == 0) call psb_geaxpby(done,r,dzero,rh(:,0),desc_a,info)
|
|
|
|
call psb_geaxpby(dzero,r,dzero,uh(:,0),desc_a,info)
|
|
|
|
if (info == 0) call psb_geaxpby(dzero,r,dzero,uh(:,0),desc_a,info)
|
|
|
|
if (info /= 0) then
|
|
|
|
if (info /= 0) then
|
|
|
|
info=4011
|
|
|
|
info=4011
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
call psb_errpush(info,name)
|
|
|
@ -294,25 +272,11 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
& write(debug_unit,*) me,' ',trim(name),&
|
|
|
|
& write(debug_unit,*) me,' ',trim(name),&
|
|
|
|
& ' on entry to amax: b: ',Size(b)
|
|
|
|
& ' on entry to amax: b: ',Size(b)
|
|
|
|
|
|
|
|
|
|
|
|
if (istop_ == 1) then
|
|
|
|
if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart
|
|
|
|
rni = psb_geamax(r,desc_a,info)
|
|
|
|
|
|
|
|
xni = psb_geamax(x,desc_a,info)
|
|
|
|
|
|
|
|
errnum = rni
|
|
|
|
|
|
|
|
errden = (ani*xni+bni)
|
|
|
|
|
|
|
|
else if (istop_ == 2) then
|
|
|
|
|
|
|
|
rni = psb_genrm2(r,desc_a,info)
|
|
|
|
|
|
|
|
errnum = rni
|
|
|
|
|
|
|
|
errden = bn2
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
if (info /= 0) Then
|
|
|
|
if (info /= 0) Then
|
|
|
|
info=4011
|
|
|
|
call psb_errpush(4011,name)
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
End If
|
|
|
|
|
|
|
|
|
|
|
|
if (errnum <= eps*errden) exit restart
|
|
|
|
|
|
|
|
if (itrace_ > 0) &
|
|
|
|
|
|
|
|
& call log_conv(methdname,me,itx,itrace_,errnum,errden,eps)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
iteration: do
|
|
|
|
iteration: do
|
|
|
|
it = it + nl
|
|
|
|
it = it + nl
|
|
|
@ -406,39 +370,16 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
|
|
|
|
call psb_geaxpby(-gamma1(j),rh(:,j),done,rh(:,0),desc_a,info)
|
|
|
|
call psb_geaxpby(-gamma1(j),rh(:,j),done,rh(:,0),desc_a,info)
|
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
|
|
if (istop_ == 1) then
|
|
|
|
if (psb_check_conv(methdname,itx,x,rh(:,0),desc_a,stopdat,info)) exit restart
|
|
|
|
rni = psb_geamax(rh(:,0),desc_a,info)
|
|
|
|
if (info /= 0) Then
|
|
|
|
xni = psb_geamax(x,desc_a,info)
|
|
|
|
call psb_errpush(4011,name)
|
|
|
|
errnum = rni
|
|
|
|
goto 9999
|
|
|
|
errden = (ani*xni+bni)
|
|
|
|
End If
|
|
|
|
else if (istop_ == 2) then
|
|
|
|
|
|
|
|
rni = psb_genrm2(rh(:,0),desc_a,info)
|
|
|
|
|
|
|
|
errnum = rni
|
|
|
|
|
|
|
|
errden = bn2
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (errnum <= eps*errden) exit restart
|
|
|
|
|
|
|
|
if (itx >= litmax) exit restart
|
|
|
|
|
|
|
|
if (itrace_ > 0) &
|
|
|
|
|
|
|
|
& call log_conv(methdname,me,itx,itrace_,errnum,errden,eps)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
end do iteration
|
|
|
|
end do iteration
|
|
|
|
end do restart
|
|
|
|
end do restart
|
|
|
|
|
|
|
|
|
|
|
|
if (itrace_ > 0) &
|
|
|
|
call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter)
|
|
|
|
& call log_conv(methdname,me,itx,1,errnum,errden,eps)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (present(err)) then
|
|
|
|
|
|
|
|
if (errden /= dzero) then
|
|
|
|
|
|
|
|
err = errnum/errden
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
err = errnum
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if (present(iter)) iter = itx
|
|
|
|
|
|
|
|
if (errnum > eps*errden) &
|
|
|
|
|
|
|
|
& call end_log(methdname,me,itx,errnum,errden,eps)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
deallocate(aux,stat=info)
|
|
|
|
deallocate(aux,stat=info)
|
|
|
|
if (info == 0) call psb_gefree(wwrk,desc_a,info)
|
|
|
|
if (info == 0) call psb_gefree(wwrk,desc_a,info)
|
|
|
|