| 1 | * | 
|---|
| 2 | * $Id: mnhes1.F,v 1.1.1.1 2003-06-11 14:18:28 cmv Exp $ | 
|---|
| 3 | * | 
|---|
| 4 | * $Log: not supported by cvs2svn $ | 
|---|
| 5 | * Revision 1.1.1.1  1996/03/07 14:31:30  mclareni | 
|---|
| 6 | * Minuit | 
|---|
| 7 | * | 
|---|
| 8 | * | 
|---|
| 9 | #include "minuit/pilot.h" | 
|---|
| 10 | SUBROUTINE MNHES1(FCN,FUTIL) | 
|---|
| 11 | #include "minuit/d506dp.inc" | 
|---|
| 12 | CC      Called from MNHESS and MNGRAD | 
|---|
| 13 | CC      Calculate first derivatives (GRD) and uncertainties (DGRD) | 
|---|
| 14 | CC         and appropriate step sizes GSTEP | 
|---|
| 15 | #include "minuit/d506cm.inc" | 
|---|
| 16 | EXTERNAL FCN,FUTIL | 
|---|
| 17 | LOGICAL LDEBUG | 
|---|
| 18 | CHARACTER CBF1*22 | 
|---|
| 19 | LDEBUG = (IDBG(5) .GE. 1) | 
|---|
| 20 | IF (ISTRAT .LE. 0) NCYC = 1 | 
|---|
| 21 | IF (ISTRAT .EQ. 1) NCYC = 2 | 
|---|
| 22 | IF (ISTRAT .GT. 1) NCYC = 6 | 
|---|
| 23 | IDRV = 1 | 
|---|
| 24 | NPARX = NPAR | 
|---|
| 25 | DFMIN = 4.*EPSMA2*(ABS(AMIN)+UP) | 
|---|
| 26 | C                                     main loop over parameters | 
|---|
| 27 | DO 100 I= 1, NPAR | 
|---|
| 28 | XTF = X(I) | 
|---|
| 29 | DMIN = 4.*EPSMA2*ABS(XTF) | 
|---|
| 30 | EPSPRI = EPSMA2 + ABS(GRD(I)*EPSMA2) | 
|---|
| 31 | OPTSTP = SQRT(DFMIN/(ABS(G2(I))+EPSPRI)) | 
|---|
| 32 | D = 0.2 * ABS(GSTEP(I)) | 
|---|
| 33 | IF (D .GT. OPTSTP)  D = OPTSTP | 
|---|
| 34 | IF (D .LT. DMIN)  D = DMIN | 
|---|
| 35 | CHGOLD = 10000. | 
|---|
| 36 | C                                       iterate reducing step size | 
|---|
| 37 | DO 50 ICYC= 1, NCYC | 
|---|
| 38 | X(I) = XTF + D | 
|---|
| 39 | CALL MNINEX(X) | 
|---|
| 40 | CALL FCN(NPARX,GIN,FS1,U,4,FUTIL) | 
|---|
| 41 | NFCN = NFCN + 1 | 
|---|
| 42 | X(I) = XTF - D | 
|---|
| 43 | CALL MNINEX(X) | 
|---|
| 44 | CALL FCN(NPARX,GIN,FS2,U,4,FUTIL) | 
|---|
| 45 | NFCN = NFCN + 1 | 
|---|
| 46 | X(I) = XTF | 
|---|
| 47 | C                                       check if step sizes appropriate | 
|---|
| 48 | SAG = 0.5*(FS1+FS2-2.0*AMIN) | 
|---|
| 49 | GRDOLD = GRD(I) | 
|---|
| 50 | GRDNEW = (FS1-FS2)/(2.0*D) | 
|---|
| 51 | DGMIN = EPSMAC*(ABS(FS1)+ABS(FS2))/D | 
|---|
| 52 | IF (LDEBUG) WRITE (ISYSWR,11) I,IDRV,GSTEP(I),D,G2(I),GRDNEW,SAG | 
|---|
| 53 | 11 FORMAT (I4,I2,6G12.5) | 
|---|
| 54 | IF (GRDNEW .EQ. ZERO)  GO TO 60 | 
|---|
| 55 | CHANGE = ABS((GRDOLD-GRDNEW)/GRDNEW) | 
|---|
| 56 | IF (CHANGE.GT.CHGOLD .AND. ICYC.GT.1)  GO TO 60 | 
|---|
| 57 | CHGOLD = CHANGE | 
|---|
| 58 | GRD(I) = GRDNEW | 
|---|
| 59 | GSTEP(I) = SIGN(D,GSTEP(I)) | 
|---|
| 60 | C                  decrease step until first derivative changes by <5% | 
|---|
| 61 | IF (CHANGE .LT. 0.05) GO TO 60 | 
|---|
| 62 | IF (ABS(GRDOLD-GRDNEW) .LT. DGMIN)  GO TO 60 | 
|---|
| 63 | IF (D .LT. DMIN)  THEN | 
|---|
| 64 | CALL MNWARN('D','MNHES1','Step size too small for 1st drv.') | 
|---|
| 65 | GO TO 60 | 
|---|
| 66 | ENDIF | 
|---|
| 67 | D = 0.2*D | 
|---|
| 68 | 50 CONTINUE | 
|---|
| 69 | C                                       loop satisfied = too many iter | 
|---|
| 70 | WRITE (CBF1,'(2G11.3)') GRDOLD,GRDNEW | 
|---|
| 71 | CALL MNWARN('D','MNHES1','Too many iterations on D1.'//CBF1) | 
|---|
| 72 | 60 CONTINUE | 
|---|
| 73 | DGRD(I) = MAX(DGMIN,ABS(GRDOLD-GRDNEW)) | 
|---|
| 74 | 100 CONTINUE | 
|---|
| 75 | C                                        end of first deriv. loop | 
|---|
| 76 | CALL MNINEX(X) | 
|---|
| 77 | RETURN | 
|---|
| 78 | END | 
|---|