
      subroutine samplingscheme(sampfunc,nparams,msamp,
     &  bestguess,guessconfid0,bmax,bmin,params,ysamp)
!
! This subroutine conducts samples from a given function using both random and
! systematic strategies. In the random strategy, sampled points randomly scatter 
! around the bestguess point. The closeness to the bestguess depends on the confidence
! on the bestguess. For any given parameter, the width of the last interval is 
! guessconfid0 X the width of the first interval. In the systematic strategy, two values 
! for each parameter are determined with the new bestguess after
! the random sampling in the middle. The two determined values of all parameters
! are systematically combined to form new additional sampling points. 
!
! After the two sampling strategies, the latest best guess is the first point in params.

      
      implicit none
      integer nparams,msamp
      double precision bestguess(nparams),guessconfid0,
     &    bmax(nparams),bmin(nparams),params(nparams,msamp),
     &    ysamp(msamp),guessconfid
      integer i,nright,nleft,ibest,msamptemp
      double precision accum,x1,delta,j,ybest,temp
      
      external sampfunc
      
      guessconfid=dmax1(1.0d0,guessconfid0)
      
      do i=1,nparams
        if(bestguess(i).lt.bmin(i).or.bestguess(i).gt.
     &    bmax(i))then
          write(*,*)'best guess out of bounds, sampling stops'
          stop
        endif
      enddo
      msamptemp=msamp-1-2*nparams
      
      if(msamptemp.lt.0)then
        write(*,*)'sampling number must be larger than',
     &      (1+2*nparams)
        stop
      endif
      if(msamptemp.gt.0)then
        if(msamptemp.ge.3)then
          if(mod(msamptemp,2).eq.0)then
            nright=msamptemp/2
            nleft=msamptemp/2
          else
            nright=msamptemp/2+1
            nleft=msamptemp/2
          endif
          do i=1,nparams
!first divide the right        
            x1=2.0d0*(bmax(i)-bestguess(i))/
     &        (dble(nright)*(guessconfid+1.0d0))
            delta=x1*(guessconfid-1.0d0)/dble(nright-1)
            accum=0.0d0
            do j=1,nright
              accum=accum+x1+dble(j-1)*delta
              params(i,j)=accum+bestguess(i)
            enddo
!
!then divide the left
            x1=2.0d0*(bestguess(i)-bmin(i))/
     &        (dble(nleft)*(guessconfid+1.0d0))
            delta=x1*(guessconfid-1.0d0)/dble(nleft-1)
            accum=0.0d0
            do j=1,nleft
              accum=accum+x1+dble(j-1)*delta
              params(i,j+nright)=bestguess(i)-accum
            enddo      
          enddo
        else
          if(msamptemp.eq.1)then
            do i=1,nparams
! arbitrarily take one value
              params(i,1)=bestguess(i)+(bmax(i)-bestguess(i))
     &                    *0.339354235d0
            enddo
          endif
          if(msamptemp.eq.2)then
            do i=1,nparams
! arbitrarily take two values              
              params(i,1)=bestguess(i)+(bmax(i)-bestguess(i))
     &                    *0.339354235d0
              params(i,2)=bestguess(i)-(bestguess(i)-bmin(i))
     &                    *0.339354235d0
            enddo
          endif
        endif
        call randpermut_dim_samp(msamptemp,nparams,
     &        params(1:nparams,1:msamptemp))
      endif
      msamptemp=msamptemp+1
      do i=1,nparams
        params(i,msamptemp)=bestguess(i)
      enddo
      do i=1,msamptemp
        call sampfunc(nparams,params(1:nparams,i:i),ysamp(i))
      enddo
      
      ibest=1
      ybest=ysamp(ibest)
      do i=2,msamptemp
        if(ysamp(i).lt.ybest)then
          ibest=i
          ybest=ysamp(i)
        endif
      enddo
      
      do i=1,nparams
        msamptemp=msamptemp+1
        params(i,msamptemp)=params(i,ibest)+
     &       (bmax(i)-params(i,ibest))/(1.0d0+guessconfid)
        msamptemp=msamptemp+1
        params(i,msamptemp)=params(i,ibest)-
     &       (params(i,ibest)-bmin(i))/(1.0d0+guessconfid)
        do j=1,i-1
          params(j,msamptemp-1)=params(j,ibest)
          params(j,msamptemp)=params(j,ibest)
        enddo
        do j=i+1,nparams
          params(j,msamptemp-1)=params(j,ibest)
          params(j,msamptemp)=params(j,ibest)
        enddo
      enddo
      do i=msamptemp-2*nparams+1,msamptemp
        call sampfunc(nparams,params(1:nparams,i:i),ysamp(i))
        if(ysamp(i).lt.ybest)then
          ibest=i
          ybest=ysamp(i)
        endif
      enddo
      do i=1,nparams
        temp=params(i,1)
        params(i,1)=params(i,ibest)
        params(i,ibest)=temp
      enddo
      temp=ysamp(1)
      ysamp(1)=ysamp(ibest)
      ysamp(ibest)=temp
      
      return
      end
