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

Last change on this file since 4049 was 2403, checked in by cmv, 22 years ago

Creation du module de code source de MINUIT (CERNLIB) extrait par CMV

cmv 11/06/2003
File size: 2.5 KB
RevLine 
[2403]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"
12CC Called from MNHESS and MNGRAD
13CC Calculate first derivatives (GRD) and uncertainties (DGRD)
14CC 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)
26C 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.
36C 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
47C 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))
60C 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
69C 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
75C end of first deriv. loop
76 CALL MNINEX(X)
77 RETURN
78 END
Note: See TracBrowser for help on using the repository browser.