Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,90 @@
+      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