Initial commit

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