mnhes1.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mnhes1 (FCN, FUTIL)

Function/Subroutine Documentation

mnhes1()

subroutine mnhes1	(	external	FCN,
		external	FUTIL
	)

Definition at line 10 of file mnhes1.f.

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

Referenced by mngrad(), and mnhess().

*
* $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      Called from MNHESS and MNGRAD
CC      Calculate first derivatives (GRD) and uncertainties (DGRD)
CC         and appropriate step sizes GSTEP
*
* $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
      LOGICAL ldebug
      CHARACTER cbf1*22
      ldebug = (idbg(5) .GE. 1)
      IF (istrat .LE. 0) ncyc = 1
      IF (istrat .EQ. 1) ncyc = 2
      IF (istrat .GT. 1) ncyc = 6
      idrv = 1
      nparx = npar
      dfmin = 4.*epsma2*(abs(amin)+up)
C                                     main loop over parameters
      DO 100 i= 1, npar
      xtf = x(i)
      dmin = 4.*epsma2*abs(xtf)
      epspri = epsma2 + abs(grd(i)*epsma2)
      optstp = sqrt(dfmin/(abs(g2(i))+epspri))
      d = 0.2 * abs(gstep(i))
      IF (d .GT. optstp)  d = optstp
      IF (d .LT. dmin)  d = dmin
      chgold = 10000.
C                                       iterate reducing step size
      DO 50 icyc= 1, ncyc
      x(i) = xtf + d
      CALL mninex(x)
      CALL fcn(nparx,gin,fs1,u,4,futil)
      nfcn = nfcn + 1
      x(i) = xtf - d
      CALL mninex(x)
      CALL fcn(nparx,gin,fs2,u,4,futil)
      nfcn = nfcn + 1
      x(i) = xtf
C                                       check if step sizes appropriate
      sag = 0.5*(fs1+fs2-2.0*amin)
      grdold = grd(i)
      grdnew = (fs1-fs2)/(2.0*d)
      dgmin = epsmac*(abs(fs1)+abs(fs2))/d
      IF (ldebug) WRITE (isyswr,11) i,idrv,gstep(i),d,g2(i),grdnew,sag
   11 FORMAT (i4,i2,6g12.5)
      IF (grdnew .EQ. zero)  GO TO 60
      change = abs((grdold-grdnew)/grdnew)
      IF (change.GT.chgold .AND. icyc.GT.1)  GO TO 60
      chgold = change
      grd(i) = grdnew
      gstep(i) = sign(d,gstep(i))
C                  decrease step until first derivative changes by <5%
      IF (change .LT. 0.05) GO TO 60
      IF (abs(grdold-grdnew) .LT. dgmin)  GO TO 60
      IF (d .LT. dmin)  THEN
         CALL mnwarn('D','MNHES1','Step size too small for 1st drv.')
         GO TO 60
      ENDIF
      d = 0.2*d
   50 CONTINUE
C                                       loop satisfied = too many iter
      WRITE (cbf1,'(2G11.3)') grdold,grdnew
      CALL mnwarn('D','MNHES1','Too many iterations on D1.'//cbf1)
   60 CONTINUE
      dgrd(i) = max(dgmin,abs(grdold-grdnew))
  100 CONTINUE
C                                        end of first deriv. loop
      CALL mninex(x)
      RETURN

Here is the call graph for this function:

Here is the caller graph for this function: