source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnhes1.F

*
* $Id: mnhes1.F,v 1.1.1.1 2003-06-11 14:18:28 cmv Exp $
*
* $Log: not supported by cvs2svn $
* Revision 1.1.1.1  1996/03/07 14:31:30  mclareni
* Minuit
*
*
#include "minuit/pilot.h"
      SUBROUTINE MNHES1(FCN,FUTIL)
#include "minuit/d506dp.inc"
CC      Called from MNHESS and MNGRAD
CC      Calculate first derivatives (GRD) and uncertainties (DGRD)
CC         and appropriate step sizes GSTEP
#include "minuit/d506cm.inc"
      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
      END