Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,78 @@
+      SUBROUTINE newt(x,n,check)
+      INTEGER n,nn,NP,MAXITS
+      LOGICAL check
+      REAL x(n),fvec,TOLF,TOLMIN,TOLX,STPMX
+      PARAMETER (NP=40,MAXITS=200,TOLF=1.e-4,TOLMIN=1.e-6,TOLX=1.e-7,
+     *STPMX=100.)
+      COMMON /newtv/ fvec(NP),nn
+      SAVE /newtv/
+CU    USES fdjac,fmin,lnsrch,lubksb,ludcmp
+      INTEGER i,its,j,indx(NP)
+      REAL d,den,f,fold,stpmax,sum,temp,test,fjac(NP,NP),g(NP),p(NP),
+     *xold(NP),fmin
+      EXTERNAL fmin
+      nn=n
+      f=fmin(x)
+      test=0.
+      do 11 i=1,n
+        if(abs(fvec(i)).gt.test)test=abs(fvec(i))
+11    continue
+      if(test.lt..01*TOLF)then
+        check=.false.
+        return
+      endif
+      sum=0.
+      do 12 i=1,n
+        sum=sum+x(i)**2
+12    continue
+      stpmax=STPMX*max(sqrt(sum),float(n))
+      do 21 its=1,MAXITS
+        call fdjac(n,x,fvec,NP,fjac)
+        do 14 i=1,n
+          sum=0.
+          do 13 j=1,n
+            sum=sum+fjac(j,i)*fvec(j)
+13        continue
+          g(i)=sum
+14      continue
+        do 15 i=1,n
+          xold(i)=x(i)
+15      continue
+        fold=f
+        do 16 i=1,n
+          p(i)=-fvec(i)
+16      continue
+        call ludcmp(fjac,n,NP,indx,d)
+        call lubksb(fjac,n,NP,indx,p)
+        call lnsrch(n,xold,fold,g,p,x,f,stpmax,check,fmin)
+        test=0.
+        do 17 i=1,n
+          if(abs(fvec(i)).gt.test)test=abs(fvec(i))
+17      continue
+        if(test.lt.TOLF)then
+          check=.false.
+          return
+        endif
+        if(check)then
+          test=0.
+          den=max(f,.5*n)
+          do 18 i=1,n
+            temp=abs(g(i))*max(abs(x(i)),1.)/den
+            if(temp.gt.test)test=temp
+18        continue
+          if(test.lt.TOLMIN)then
+            check=.true.
+          else
+            check=.false.
+          endif
+          return
+        endif
+        test=0.
+        do 19 i=1,n
+          temp=(abs(x(i)-xold(i)))/max(abs(x(i)),1.)
+          if(temp.gt.test)test=temp
+19      continue
+        if(test.lt.TOLX)return
+21    continue
+      pause 'MAXITS exceeded in newt'
+      END