Kolpack-Software-Consulting/piscal
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

New changes from l2g

Browse Source 
w
This commit is contained in:
poprhythm
2022-09-12 16:40:28 +00:00
parent 78eb7147d0
commit d713d4f61a
110 changed files with 87672 additions and 1098 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dataassim/math/optimization/nongradopt.f
+17 -14
View File
@@ -6,7 +6,7 @@
!
integer ndim
double precision beta(1:ndim),bmin(1:ndim),
& bmax(1:ndim),ftol,fatbeta
&bmax(1:ndim),ftol,fatbeta,f1dim
!
! ------------------ Inputs -----------------------------
! ndim: the total number of parameters to be estimated
@@ -24,7 +24,7 @@
integer n,nn,mpamoeba,npamoeba,iredo,maxredo,ITMAX,
& icycle
parameter(maxredo=10,ITMAX=10000)
parameter(maxredo=5,ITMAX=50000)
double precision fbest,xbest(1:ndim),term,
& xinidir(1:ndim,1:ndim),xbest0(1:ndim),
& pamoeba(1:ndim+1,1:ndim),famoeba(1:ndim+1)
@@ -50,7 +50,7 @@
fatbeta=fbest
goto 10
endif
if((fbest-fatbeta).gt.ftol)then
if((fbest-fatbeta).gt.100.0d0*ftol)then
if(iredo.gt.maxredo)goto 10
iredo=iredo+1
goto 3
@@ -92,6 +92,9 @@
if((fbest-fatbeta).gt.ftol*100.0d0.and.term.gt.1.0d-2)then
term=term/3.0d0
fbest=fatbeta
do n=1,ndim
xbest(n)=beta(n)
enddo
goto 30
endif
do n=1,ndim
@@ -144,7 +147,7 @@
return
endif
enddo
if((fbest-fatbeta).gt.ftol)then
if((fbest-fatbeta).gt.ftol*100.0d0)then
if(iredo.gt.maxredo)then
if(icycle.lt.maxredo)then
icycle=icycle+1
@@ -167,15 +170,15 @@
external funkmin
CU USES guamotry,funkmin
INTEGER i,ihi,ilo,inhi,j,m,n
double precision rtol,sum,swap,ysave,ytry,psum(ndim),
double precision rtol,cumx,swap,ysave,ytry,pcumx(ndim),
& guamotry,degen
iter=0
1 do 12 n=1,ndim
sum=0.0d0
cumx=0.0d0
do 11 m=1,ndim+1
sum=sum+p(m,n)
cumx=cumx+p(m,n)
11 continue
psum(n)=sum
pcumx(n)=cumx
12 continue
2 ilo=1
if (y(1).gt.y(2)) then
@@ -232,20 +235,20 @@ CU USES guamotry,funkmin
endif
if(iter.ge.ITMAX)return
iter=iter+2
ytry=guamotry(p,y,psum,mp,np,ndim,funkmin,ihi,-1.0d0)
ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,-1.0d0)
if (ytry.le.y(ilo))then
ytry=guamotry(p,y,psum,mp,np,ndim,funkmin,ihi,2.0d0)
ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,2.0d0)
else if (ytry.ge.y(inhi)) then
ysave=y(ihi)
ytry=guamotry(p,y,psum,mp,np,ndim,funkmin,ihi,0.5d0)
ytry=guamotry(p,y,pcumx,mp,np,ndim,funkmin,ihi,0.5d0)
if (ytry.ge.ysave) then
do 16 i=1,ndim+1
if(i.ne.ilo)then
do 15 j=1,ndim
psum(j)=0.5d0*(p(i,j)+p(ilo,j))
p(i,j)=psum(j)
pcumx(j)=0.5d0*(p(i,j)+p(ilo,j))
p(i,j)=pcumx(j)
15 continue
call funkmin(ndim,psum,y(i))
call funkmin(ndim,pcumx,y(i))
endif
16 continue
iter=iter+ndim