mnline.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mnline (FCN, START, FSTART, STEP, SLOPE, TOLER, FUTIL)

Function/Subroutine Documentation

mnline()

subroutine mnline	(	external	FCN,
		dimension(*)	START,
			FSTART,
		dimension(*)	STEP,
			SLOPE,
			TOLER,
		external	FUTIL
	)

Definition at line 10 of file mnline.f.

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

Referenced by mnmigr().

*
* $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        Perform a line search from position START
CC        along direction STEP, where the length of vector STEP
CC                   gives the expected position of minimum.
CC        FSTART is value of function at START
CC        SLOPE (if non-zero) is df/dx along STEP at START
CC        TOLER is initial tolerance of minimum in direction STEP
*
* $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
      dimension start(*), step(*)
      parameter(maxpt=12)
      dimension xpq(maxpt),ypq(maxpt)
      CHARACTER*1 chpq(maxpt)
      dimension xvals(3),fvals(3),coeff(3)
      CHARACTER*26 charal
      CHARACTER*60 cmess
      parameter(slambg=5.,alpha=2.)
C SLAMBG and ALPHA control the maximum individual steps allowed.
C The first step is always =1. The max length of second step is SLAMBG.
C The max size of subsequent steps is the maximum previous successful
C   step multiplied by ALPHA + the size of most recent successful step,
C   but cannot be smaller than SLAMBG.
      LOGICAL ldebug
      DATA charal / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
      ldebug = (idbg(1).GE.1)
C                  starting values for overall limits on total step SLAM
      overal = 1000.
      undral = -100.
C                              debug check if start is ok
      IF (ldebug)  THEN
         CALL mninex(start)
         CALL fcn(nparx,gin,f1,u,4,futil)
         nfcn=nfcn+1
         IF (f1 .NE. fstart) THEN
             WRITE (isyswr,'(A/2E14.5/2X,10F10.5)')
     + ' MNLINE start point not consistent, F values, parameters=',
     +  (x(kk),kk=1,npar)
         ENDIF
      ENDIF
C                                      . set up linear search along STEP
      fvmin = fstart
      xvmin = zero
      nxypt = 1
      chpq(1) = charal(1:1)
      xpq(1) = 0.
      ypq(1) = fstart
C               SLAMIN = smallest possible value of ABS(SLAM)
      slamin = zero
      DO 20 i= 1, npar
      IF (step(i) .EQ. zero)  GO TO 20
      ratio = abs(start(i)/step(i))
      IF (slamin .EQ. zero)     slamin = ratio
      IF (ratio .LT. slamin)  slamin = ratio
   20 x(i) = start(i) + step(i)
      IF (slamin .EQ. zero)  slamin = epsmac
      slamin = slamin*epsma2
      nparx = npar
C
      CALL mninex(x)
      CALL fcn(nparx,gin,f1,u,4,futil)
      nfcn=nfcn+1
      nxypt = nxypt + 1
      chpq(nxypt) = charal(nxypt:nxypt)
      xpq(nxypt) = 1.
      ypq(nxypt) = f1
      IF (f1 .LT. fstart) THEN
         fvmin = f1
         xvmin = 1.0
      ENDIF
C                         . quadr interp using slope GDEL and two points
      slam = 1.
      toler8 = toler
      slamax = slambg
      flast = f1
C                         can iterate on two-points (cut) if no imprvmnt
   25 CONTINUE
      denom = 2.0*(flast-fstart-slope*slam)/slam**2
C     IF (DENOM .EQ. ZERO)  DENOM = -0.1*SLOPE
                            slam  = 1.
      IF (denom .NE. zero)  slam = -slope/denom
      IF (slam  .LT. zero)  slam = slamax
      IF (slam .GT. slamax)  slam = slamax
      IF (slam .LT. toler8)  slam = toler8
      IF (slam .LT. slamin)  GO TO 80
      IF (abs(slam-1.0).LT.toler8 .AND. f1.LT.fstart)  GO TO 70
      IF (abs(slam-1.0).LT.toler8) slam = 1.0+toler8
      IF (nxypt .GE. maxpt) GO TO 65
      DO 30 i= 1, npar
   30 x(i) = start(i) + slam*step(i)
      CALL mninex(x)
      CALL fcn(npar,gin,f2,u,4,futil)
      nfcn = nfcn + 1
      nxypt = nxypt + 1
      chpq(nxypt) = charal(nxypt:nxypt)
      xpq(nxypt) = slam
      ypq(nxypt) = f2
      IF (f2 .LT. fvmin)  THEN
         fvmin = f2
         xvmin = slam
      ENDIF
      IF (fstart .EQ. fvmin) THEN
         flast = f2
         toler8 = toler*slam
         overal = slam-toler8
         slamax = overal
         GO TO 25
      ENDIF
C                                        . quadr interp using 3 points
      xvals(1) = xpq(1)
      fvals(1) = ypq(1)
      xvals(2) = xpq(nxypt-1)
      fvals(2) = ypq(nxypt-1)
      xvals(3) = xpq(nxypt)
      fvals(3) = ypq(nxypt)
C                             begin iteration, calculate desired step
   50 CONTINUE
      slamax = max(slamax,alpha*abs(xvmin))
      CALL mnpfit(xvals,fvals,3,coeff,sdev)
      IF (coeff(3) .LE. zero)  THEN
         slopem = 2.0*coeff(3)*xvmin + coeff(2)
         IF (slopem .LE. zero) THEN
            slam = xvmin + slamax
         ELSE
            slam = xvmin - slamax
         ENDIF
      ELSE
         slam = -coeff(2)/(2.0*coeff(3))
         IF (slam .GT. xvmin+slamax)  slam = xvmin+slamax
         IF (slam .LT. xvmin-slamax)  slam = xvmin-slamax
      ENDIF
      IF (slam .GT. zero) THEN
          IF (slam .GT. overal) slam = overal
      ELSE
          IF (slam .LT. undral) slam = undral
      ENDIF
C               come here if step was cut below
   52 CONTINUE
      toler9 = max(toler8,abs(toler8*slam))
      DO 55 ipt= 1, 3
      IF (abs(slam-xvals(ipt)) .LT. toler9)  GO TO 70
   55 CONTINUE
C                take the step
      IF (nxypt .GE. maxpt) GO TO 65
      DO 60 i= 1, npar
   60 x(i) = start(i)+slam*step(i)
      CALL mninex(x)
      CALL fcn(nparx,gin,f3,u,4,futil)
      nfcn = nfcn + 1
      nxypt = nxypt + 1
      chpq(nxypt) = charal(nxypt:nxypt)
      xpq(nxypt) = slam
      ypq(nxypt) = f3
C             find worst previous point out of three
      fvmax = fvals(1)
      nvmax = 1
      IF (fvals(2) .GT. fvmax) THEN
         fvmax = fvals(2)
         nvmax = 2
      ENDIF
      IF (fvals(3) .GT. fvmax) THEN
         fvmax = fvals(3)
         nvmax = 3
      ENDIF
C              if latest point worse than all three previous, cut step
      IF (f3 .GE. fvmax)  THEN
          IF (nxypt .GE. maxpt) GO TO 65
          IF (slam .GT. xvmin) overal = min(overal,slam-toler8)
          IF (slam .LT. xvmin) undral = max(undral,slam+toler8)
          slam = 0.5*(slam+xvmin)
          GO TO 52
      ENDIF
C              prepare another iteration, replace worst previous point
      xvals(nvmax) = slam
      fvals(nvmax) = f3
      IF (f3 .LT. fvmin)  THEN
         fvmin = f3
         xvmin = slam
      ELSE
         IF (slam .GT. xvmin) overal = min(overal,slam-toler8)
         IF (slam .LT. xvmin) undral = max(undral,slam+toler8)
      ENDIF
      IF (nxypt .LT. maxpt)  GO TO 50
C                                            . . end of iteration . . .
C            stop because too many iterations
   65 cmess = ' LINE SEARCH HAS EXHAUSTED THE LIMIT OF FUNCTION CALLS '
      IF (ldebug) THEN
        WRITE (isyswr,'(A/(2X,6G12.4))') ' MNLINE DEBUG: steps=',
     +    (step(kk),kk=1,npar)
      ENDIF
      GO TO 100
C            stop because within tolerance
   70 CONTINUE
      cmess = ' LINE SEARCH HAS ATTAINED TOLERANCE '
      GO TO 100
   80 CONTINUE
      cmess = ' STEP SIZE AT ARITHMETICALLY ALLOWED MINIMUM'
  100 CONTINUE
      amin = fvmin
      DO 120 i= 1, npar
      dirin(i) = step(i)*xvmin
  120 x(i) = start(i) + dirin(i)
      CALL mninex(x)
      IF (xvmin .LT. 0.)      CALL mnwarn('D','MNLINE',
     +                   ' LINE MINIMUM IN BACKWARDS DIRECTION')
      IF (fvmin .EQ. fstart)  CALL mnwarn('D','MNLINE',
     +                     ' LINE SEARCH FINDS NO IMPROVEMENT ')
      IF (ldebug)  THEN
         WRITE (isyswr,'('' AFTER'',I3,'' POINTS,'',A)') nxypt,cmess
         CALL mnplot(xpq,ypq,chpq,nxypt,isyswr,npagwd,npagln)
      ENDIF
      RETURN

Here is the call graph for this function:

Here is the caller graph for this function: