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) znrm=1.d0 if(itol.eq.1) then bnrm=snrm(n,b,itol) else if (itol.eq.2) then call asolve(n,b,z,0) bnrm=snrm(n,z,itol) 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 call asolve(n,r,z,0) 100 if (iter.le.itmax) then iter=iter+1 zm1nrm=znrm 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.or.itol.eq.2)then znrm=1.d0 err=snrm(n,r,itol)/bnrm else if(itol.eq.3.or.itol.eq.4)then 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 C (C) Copr. 1986-92 Numerical Recipes Software .