SUBROUTINE amebsa(p,y,mp,np,ndim,pb,yb,ftol,funk,iter,temptr) INTEGER iter,mp,ndim,np,NMAX REAL ftol,temptr,yb,p(mp,np),pb(np),y(mp),funk PARAMETER (NMAX=200) EXTERNAL funk CU USES amotsa,funk,ran1 INTEGER i,idum,ihi,ilo,inhi,j,m,n REAL rtol,sum,swap,tt,yhi,ylo,ynhi,ysave,yt,ytry,psum(NMAX), *amotsa,ran1 COMMON /ambsa/ tt,idum tt=-temptr 1 do 12 n=1,ndim sum=0. do 11 m=1,ndim+1 sum=sum+p(m,n) 11 continue psum(n)=sum 12 continue 2 ilo=1 inhi=1 ihi=2 ylo=y(1)+tt*log(ran1(idum)) ynhi=ylo yhi=y(2)+tt*log(ran1(idum)) if (ylo.gt.yhi) then ihi=1 inhi=2 ilo=2 ynhi=yhi yhi=ylo ylo=ynhi endif do 13 i=3,ndim+1 yt=y(i)+tt*log(ran1(idum)) if(yt.le.ylo) then ilo=i ylo=yt endif if(yt.gt.yhi) then inhi=ihi ynhi=yhi ihi=i yhi=yt else if(yt.gt.ynhi) then inhi=i ynhi=yt endif 13 continue rtol=2.*abs(yhi-ylo)/(abs(yhi)+abs(ylo)) if (rtol.lt.ftol.or.iter.lt.0) then swap=y(1) y(1)=y(ilo) y(ilo)=swap do 14 n=1,ndim swap=p(1,n) p(1,n)=p(ilo,n) p(ilo,n)=swap 14 continue return endif iter=iter-2 ytry=amotsa(p,y,psum,mp,np,ndim,pb,yb,funk,ihi,yhi,-1.0) if (ytry.le.ylo) then ytry=amotsa(p,y,psum,mp,np,ndim,pb,yb,funk,ihi,yhi,2.0) else if (ytry.ge.ynhi) then ysave=yhi ytry=amotsa(p,y,psum,mp,np,ndim,pb,yb,funk,ihi,yhi,0.5) if (ytry.ge.ysave) then do 16 i=1,ndim+1 if(i.ne.ilo)then do 15 j=1,ndim psum(j)=0.5*(p(i,j)+p(ilo,j)) p(i,j)=psum(j) 15 continue y(i)=funk(psum) endif 16 continue iter=iter-ndim goto 1 endif else iter=iter+1 endif goto 2 END C (C) Copr. 1986-92 Numerical Recipes Software .