Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,71 @@
+      SUBROUTINE amoeba(p,y,mp,np,ndim,ftol,funk,iter)
+      INTEGER iter,mp,ndim,np,NMAX,ITMAX
+      REAL ftol,p(mp,np),y(mp),funk
+      PARAMETER (NMAX=20,ITMAX=5000)
+      EXTERNAL funk
+CU    USES amotry,funk
+      INTEGER i,ihi,ilo,inhi,j,m,n
+      REAL rtol,sum,swap,ysave,ytry,psum(NMAX),amotry
+      iter=0
+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
+      if (y(1).gt.y(2)) then
+        ihi=1
+        inhi=2
+      else
+        ihi=2
+        inhi=1
+      endif
+      do 13 i=1,ndim+1
+        if(y(i).le.y(ilo)) ilo=i
+        if(y(i).gt.y(ihi)) then
+          inhi=ihi
+          ihi=i
+        else if(y(i).gt.y(inhi)) then
+          if(i.ne.ihi) inhi=i
+        endif
+13    continue
+      rtol=2.*abs(y(ihi)-y(ilo))/(abs(y(ihi))+abs(y(ilo)))
+      if (rtol.lt.ftol) 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
+      if (iter.ge.ITMAX) pause 'ITMAX exceeded in amoeba'
+      iter=iter+2
+      ytry=amotry(p,y,psum,mp,np,ndim,funk,ihi,-1.0)
+      if (ytry.le.y(ilo)) then
+        ytry=amotry(p,y,psum,mp,np,ndim,funk,ihi,2.0)
+      else if (ytry.ge.y(inhi)) then
+        ysave=y(ihi)
+        ytry=amotry(p,y,psum,mp,np,ndim,funk,ihi,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