📄 amebsa.for
字号:
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -