mnseek.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mnseek (FCN, FUTIL)

Function/Subroutine Documentation

mnseek()

subroutine mnseek	(	external	FCN,
		external	FUTIL
	)

Definition at line 10 of file mnseek.f.

References a, b, c, d, e, f, g, h, softenpik::half, i, j, m, maxp, mnamin(), mndxdi(), mninex(), mnprin(), mnrn15(), n, o, p, parameter(), up(), x, xs, and z.

Referenced by mnexcm().

*
* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506dp.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506dp.inc
*
C ************ DOUBLE PRECISION VERSION *************
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
CC   Performs a rough (but global) minimization by monte carlo search.
CC        Each time a new minimum is found, the search area is shifted
CC        to be centered at the best value.  Random points are chosen
CC        uniformly over a hypercube determined by current step sizes.
CC   The Metropolis algorithm accepts a worse point with probability
CC      exp(-d/UP), where d is the degradation.  Improved points
CC      are of course always accepted.  Actual steps are random
CC      multiples of the nominal steps (DIRIN).
CC
*
* $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506cm.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506cm.inc
*
      parameter(mne=100 , mni=50)
      parameter(mnihl=mni*(mni+1)/2)
      CHARACTER*10 cpnam
      COMMON
     1/mn7nam/ cpnam(mne)
     2/mn7ext/ u(mne)     ,alim(mne)  ,blim(mne)
     3/mn7err/ erp(mni)   ,ern(mni)   ,werr(mni)  ,globcc(mni)
     4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
     5/mn7int/ x(mni)     ,xt(mni)    ,dirin(mni)
     6/mn7fx2/ xs(mni)    ,xts(mni)   ,dirins(mni)
     7/mn7der/ grd(mni)   ,g2(mni)    ,gstep(mni) ,gin(mne) ,dgrd(mni)
     8/mn7fx3/ grds(mni)  ,g2s(mni)   ,gsteps(mni)
     9/mn7fx1/ ipfix(mni) ,npfix
     a/mn7var/ vhmat(mnihl)
     b/mn7vat/ vthmat(mnihl)
     c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
C
      parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
      parameter(zero=0.0,  one=1.0,   half=0.5)
      COMMON
     d/mn7npr/ maxint ,npar   ,maxext ,nu
     e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
     e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
     f/mn7tit/ cfrom  ,cstatu ,ctitl  ,cword  ,cundef ,cvrsn ,covmes
     g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
     h/mn7min/ amin   ,up     ,edm    ,fval3  ,epsi   ,apsi  ,dcovar
     i/mn7cnv/ nfcn   ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
     j/mn7arg/ word7(maxp)
     k/mn7log/ lwarn  ,lrepor ,limset ,lnolim ,lnewmn ,lphead
     l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
     m/mn7rpt/ xpt(maxcpt)    ,ypt(maxcpt)
     n/mn7cpt/ chpt(maxcpt)
     o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr  ,ke2cr
      CHARACTER ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
     +          cvrsn*6,  covmes(0:3)*22, cstatu*10, chpt*1
      LOGICAL   lwarn, lrepor, limset, lnolim, lnewmn, lphead
      EXTERNAL fcn,futil
      parameter(twopi=2.0*3.141593)
      dimension  xbest(mni), xmid(mni)
      mxfail = word7(1)
      IF (mxfail .LE. 0)  mxfail=100+20*npar
      mxstep = 10*mxfail
      IF (amin .EQ. undefi)  CALL mnamin(fcn,futil)
      alpha = word7(2)
      IF (alpha .LE. zero)  alpha=3.
      IF (isw(5) .GE. 1)  WRITE (isyswr, 3) mxfail,mxstep,alpha
    3 FORMAT (' MNSEEK: MONTE CARLO MINIMIZATION USING METROPOLIS',
     + ' ALGORITHM'/' TO STOP AFTER',i6,' SUCCESSIVE FAILURES, OR',
     + i7,' STEPS'/' MAXIMUM STEP SIZE IS',f9.3,' ERROR BARS.')
      cstatu= 'INITIAL  '
      IF (isw(5) .GE. 2)  CALL mnprin(2,amin)
      cstatu = 'UNCHANGED '
      ifail = 0
      rnum = zero
      rnum1 = zero
      rnum2 = zero
      nparx = npar
      flast = amin
C              set up step sizes, starting values
      DO 10 ipar =  1, npar
      iext = nexofi(ipar)
      dirin(ipar) = 2.0*alpha*werr(ipar)
      IF (nvarl(iext) .GT. 1)  THEN
C              parameter with limits
         CALL mndxdi(x(ipar),ipar,dxdi)
         IF (dxdi .EQ. zero)  dxdi=1.
         dirin(ipar) = 2.0*alpha*werr(ipar)/dxdi
         IF (abs(dirin(ipar)).GT.twopi)  dirin(ipar)=twopi
         ENDIF
      xmid(ipar) = x(ipar)
   10 xbest(ipar) = x(ipar)
C                              search loop
      DO 500 istep= 1, mxstep
      IF (ifail .GE. mxfail)  GO TO 600
        DO 100 ipar= 1, npar
        CALL mnrn15(rnum1,iseed)
        CALL mnrn15(rnum2,iseed)
  100   x(ipar) = xmid(ipar) + 0.5*(rnum1+rnum2-1.)*dirin(ipar)
      CALL mninex(x)
      CALL fcn(nparx,gin,ftry,u,4,futil)
      nfcn = nfcn + 1
      IF (ftry .LT. flast)  THEN
         IF (ftry .LT. amin)  THEN
            cstatu = 'IMPROVEMNT'
            amin = ftry
            DO 200 ib= 1, npar
  200       xbest(ib) = x(ib)
            ifail = 0
            IF (isw(5) .GE. 2) CALL mnprin(2,amin)
            ENDIF
         GO TO 300
      ELSE
         ifail = ifail + 1
C                   Metropolis algorithm
         bar = (amin-ftry)/up
         CALL mnrn15(rnum,iseed)
         IF (bar .LT. log(rnum))  GO TO 500
      ENDIF
C                    Accept new point, move there
  300 CONTINUE
      DO 350 j= 1, npar
      xmid(j) = x(j)
  350 CONTINUE
      flast = ftry
  500 CONTINUE
C                               end search loop
  600 CONTINUE
      IF (isw(5) .GT. 1) WRITE (isyswr,601) ifail
  601 FORMAT(' MNSEEK:',i5,' SUCCESSIVE UNSUCCESSFUL TRIALS.')
      DO 700 ib= 1, npar
  700 x(ib) = xbest(ib)
      CALL mninex(x)
      IF (isw(5) .GE. 1)  CALL mnprin(2,amin)
      IF (isw(5) .EQ. 0)  CALL mnprin(0,amin)
      RETURN

Here is the call graph for this function:

Here is the caller graph for this function: