91 lines
2.5 KiB
Fortran
91 lines
2.5 KiB
Fortran
SUBROUTINE linbcg(n,b,x,itol,tol,itmax,iter,err)
|
|
INTEGER iter,itmax,itol,n,NMAX
|
|
DOUBLE PRECISION err,tol,b(*),x(*),EPS
|
|
PARAMETER (NMAX=1024,EPS=1.d-14)
|
|
CU USES atimes,asolve,snrm
|
|
INTEGER j
|
|
DOUBLE PRECISION ak,akden,bk,bkden,bknum,bnrm,dxnrm,xnrm,zm1nrm,
|
|
*znrm,p(NMAX),pp(NMAX),r(NMAX),rr(NMAX),z(NMAX),zz(NMAX),snrm
|
|
iter=0
|
|
call atimes(n,x,r,0)
|
|
do 11 j=1,n
|
|
r(j)=b(j)-r(j)
|
|
rr(j)=r(j)
|
|
11 continue
|
|
C call atimes(n,r,rr,0)
|
|
if(itol.eq.1) then
|
|
bnrm=snrm(n,b,itol)
|
|
call asolve(n,r,z,0)
|
|
else if (itol.eq.2) then
|
|
call asolve(n,b,z,0)
|
|
bnrm=snrm(n,z,itol)
|
|
call asolve(n,r,z,0)
|
|
else if (itol.eq.3.or.itol.eq.4) then
|
|
call asolve(n,b,z,0)
|
|
bnrm=snrm(n,z,itol)
|
|
call asolve(n,r,z,0)
|
|
znrm=snrm(n,z,itol)
|
|
else
|
|
pause 'illegal itol in linbcg'
|
|
endif
|
|
100 if (iter.le.itmax) then
|
|
iter=iter+1
|
|
call asolve(n,rr,zz,1)
|
|
bknum=0.d0
|
|
do 12 j=1,n
|
|
bknum=bknum+z(j)*rr(j)
|
|
12 continue
|
|
if(iter.eq.1) then
|
|
do 13 j=1,n
|
|
p(j)=z(j)
|
|
pp(j)=zz(j)
|
|
13 continue
|
|
else
|
|
bk=bknum/bkden
|
|
do 14 j=1,n
|
|
p(j)=bk*p(j)+z(j)
|
|
pp(j)=bk*pp(j)+zz(j)
|
|
14 continue
|
|
endif
|
|
bkden=bknum
|
|
call atimes(n,p,z,0)
|
|
akden=0.d0
|
|
do 15 j=1,n
|
|
akden=akden+z(j)*pp(j)
|
|
15 continue
|
|
ak=bknum/akden
|
|
call atimes(n,pp,zz,1)
|
|
do 16 j=1,n
|
|
x(j)=x(j)+ak*p(j)
|
|
r(j)=r(j)-ak*z(j)
|
|
rr(j)=rr(j)-ak*zz(j)
|
|
16 continue
|
|
call asolve(n,r,z,0)
|
|
if(itol.eq.1)then
|
|
err=snrm(n,r,itol)/bnrm
|
|
else if(itol.eq.2)then
|
|
err=snrm(n,z,itol)/bnrm
|
|
else if(itol.eq.3.or.itol.eq.4)then
|
|
zm1nrm=znrm
|
|
znrm=snrm(n,z,itol)
|
|
if(abs(zm1nrm-znrm).gt.EPS*znrm) then
|
|
dxnrm=abs(ak)*snrm(n,p,itol)
|
|
err=znrm/abs(zm1nrm-znrm)*dxnrm
|
|
else
|
|
err=znrm/bnrm
|
|
goto 100
|
|
endif
|
|
xnrm=snrm(n,x,itol)
|
|
if(err.le.0.5d0*xnrm) then
|
|
err=err/xnrm
|
|
else
|
|
err=znrm/bnrm
|
|
goto 100
|
|
endif
|
|
endif
|
|
write (*,*) ' iter=',iter,' err=',err
|
|
if(err.gt.tol) goto 100
|
|
endif
|
|
return
|
|
END
|