53 lines
1.7 KiB
FortranFixed
53 lines
1.7 KiB
FortranFixed
subroutine uniformgridsampling(sampfunc,nparams,
|
|
& msect0,bestguess,yatguess,bmax,bmin)
|
|
implicit none
|
|
!
|
|
integer nparams,msect0,ihowsamp
|
|
double precision bestguess(nparams),guessconfid0,
|
|
& bmax(nparams),bmin(nparams),params(nparams,msect0+1),
|
|
& guessconfid,yatguess,beta(nparams),fatbeta
|
|
integer i,nright,nleft,j,k,n,msect,m
|
|
double precision tiny,x1,delta,eps
|
|
parameter(eps=1.0d-9)
|
|
external sampfunc
|
|
!
|
|
msect=msect0
|
|
do i=1,nparams
|
|
tiny=(bmax(i)-bmin(i))*eps
|
|
x1=(bmax(i)-bmin(i)-2.0d0*tiny)/dble(msect)
|
|
params(i,1)=bmin(i)+tiny
|
|
do j=2,msect+1
|
|
params(i,j)=params(i,j-1)+x1
|
|
params(i,j)=dmax1(params(i,j),bmin(i))
|
|
params(i,j)=dmin1(params(i,j),bmax(i))
|
|
enddo
|
|
enddo
|
|
msect=msect+1
|
|
yatguess=1.0d+100
|
|
do i=1,msect**nparams
|
|
do j=1,nparams
|
|
!the size of the larger repeated unit is msect**(nparams-j+1)
|
|
k=i/(msect**(nparams-j+1))
|
|
n=mod(i,(msect**(nparams-j+1)))
|
|
if(n.eq.0)k=k-1
|
|
!k is the number of repeated units before i (not include the unit i is in)
|
|
k=i-k*(msect**(nparams-j+1))
|
|
!now k is the position in the larger repeated unit
|
|
!the size of the smaller repeated unit is (msect**(nparams-j+1))/msect
|
|
m=(msect**(nparams-j+1))/msect
|
|
n=k/m
|
|
if(mod(k,m).ne.0)n=n+1
|
|
beta(j)=params(j,n)
|
|
enddo
|
|
call sampfunc(nparams,beta,fatbeta)
|
|
if(fatbeta.lt.yatguess)then
|
|
yatguess=fatbeta
|
|
do j=1,nparams
|
|
bestguess(j)=beta(j)
|
|
enddo
|
|
endif
|
|
enddo
|
|
1 format(1x,i5,4f15.8)
|
|
return
|
|
end
|