|
|
|
@ -72,7 +72,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
|
|
|
|
real(kind(1.d0)) ::rerr
|
|
|
|
|
real(kind(1.d0)) ::alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
|
|
|
|
|
& sigma
|
|
|
|
|
integer :: litmax, liter, listop, naux, m, mglob, it, itrac,&
|
|
|
|
|
integer :: litmax, liter, listop, naux, m, mglob, it, itx, itrac,&
|
|
|
|
|
& nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5)
|
|
|
|
|
character ::diagl, diagu
|
|
|
|
|
logical, parameter :: exchange=.true., noexchange=.false.
|
|
|
|
@ -154,9 +154,12 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
|
|
|
|
ich = 1
|
|
|
|
|
call blacs_set(icontxt,16,ich)
|
|
|
|
|
|
|
|
|
|
restart: do
|
|
|
|
|
!!$
|
|
|
|
|
!!$ r0 = b-Ax0
|
|
|
|
|
!!$
|
|
|
|
|
if (itx>= litmax) exit restart
|
|
|
|
|
it = 0
|
|
|
|
|
call psb_axpby(one,b,zero,r,desc_a,info)
|
|
|
|
|
call psb_spmm(-one,a,x,one,r,desc_a,info,work=aux)
|
|
|
|
|
if (info.ne.0) then
|
|
|
|
@ -179,7 +182,9 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
iteration: do it = 1, itmax
|
|
|
|
|
iteration: do
|
|
|
|
|
it = it + 1
|
|
|
|
|
itx = itx + 1
|
|
|
|
|
|
|
|
|
|
!!$
|
|
|
|
|
!!$ solve mz = r
|
|
|
|
@ -230,7 +235,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
|
|
|
|
xni = psb_amax(x,desc_a,info)
|
|
|
|
|
rerr = rni/(ani*xni+bni)
|
|
|
|
|
If (itrac /= -1) Then
|
|
|
|
|
If (me.Eq.0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cg: ',it,rerr,rni,bni,&
|
|
|
|
|
If (me.Eq.0) Write(itrac,'(a,i4,5(2x,es10.4))') 'cg: ',itx,rerr,rni,bni,&
|
|
|
|
|
&xni,ani
|
|
|
|
|
Endif
|
|
|
|
|
|
|
|
|
@ -239,21 +244,20 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
|
|
|
|
|
rni = psb_nrm2(r,desc_a,info)
|
|
|
|
|
rerr = rni/bn2
|
|
|
|
|
If (itrac /= -1) Then
|
|
|
|
|
If (me.Eq.0) Write(itrac,'(a,i4,3(2x,es10.4)))') 'cg: ',it,rerr,rni,bn2
|
|
|
|
|
If (me.Eq.0) Write(itrac,'(a,i4,3(2x,es10.4)))') 'cg: ',itx,rerr,rni,bn2
|
|
|
|
|
Endif
|
|
|
|
|
Endif
|
|
|
|
|
|
|
|
|
|
if (rerr<=eps) then
|
|
|
|
|
exit iteration
|
|
|
|
|
end if
|
|
|
|
|
if (rerr<=eps) exit restart
|
|
|
|
|
if (itx>= litmax) exit restart
|
|
|
|
|
end do iteration
|
|
|
|
|
end do restart
|
|
|
|
|
|
|
|
|
|
if (present(err)) err=rerr
|
|
|
|
|
if (present(iter)) iter = it
|
|
|
|
|
if (present(iter)) iter = itx
|
|
|
|
|
if (rerr>eps) then
|
|
|
|
|
write(0,*) 'CG Failed to converge to ',eps,&
|
|
|
|
|
& ' in ',litmax,' iterations '
|
|
|
|
|
info=it
|
|
|
|
|
info=itx
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
deallocate(aux)
|
|
|
|
|