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)return 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 C (C) Copr. 1986-92 Numerical Recipes Software .