source: Sophya/trunk/SophyaExt/CodeMinuit/code/mnfixp.F@ 2907

Last change on this file since 2907 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.3 KB
Line 
1*
2* $Id: mnfixp.F,v 1.1.1.1 2003-06-11 14:18:27 cmv Exp $
3*
4* $Log: not supported by cvs2svn $
5* Revision 1.1.1.1 1996/03/07 14:31:29 mclareni
6* Minuit
7*
8*
9#include "minuit/pilot.h"
10 SUBROUTINE MNFIXP(IINT,IERR)
11#include "minuit/d506dp.inc"
12CC removes parameter IINT from the internal (variable) parameter
13CC list, and arranges the rest of the list to fill the hole.
14CC
15#include "minuit/d506cm.inc"
16 DIMENSION YY(MNI)
17C first see if it can be done
18 IERR = 0
19 IF (IINT.GT.NPAR .OR. IINT.LE.0) THEN
20 IERR = 1
21 WRITE (ISYSWR,'(A,I4)')
22 + ' MINUIT ERROR. ARGUMENT TO MNFIXP=',IINT
23 GO TO 300
24 ENDIF
25 IEXT = NEXOFI(IINT)
26 IF (NPFIX .GE. MNI) THEN
27 IERR = 1
28 WRITE (ISYSWR,'(A,I4,A,I4)') ' MINUIT CANNOT FIX PARAMETER',
29 + IEXT,' MAXIMUM NUMBER THAT CAN BE FIXED IS',MNI
30 GO TO 300
31 ENDIF
32C reduce number of variable parameters by one
33 NIOFEX(IEXT) = 0
34 NOLD = NPAR
35 NPAR = NPAR - 1
36C save values in case parameter is later restored
37 NPFIX = NPFIX + 1
38 IPFIX(NPFIX) = IEXT
39 LC = IINT
40 XS(NPFIX) = X(LC)
41 XTS(NPFIX) = XT(LC)
42 DIRINS(NPFIX) = WERR(LC)
43 GRDS(NPFIX) = GRD(LC)
44 G2S(NPFIX) = G2(LC)
45 GSTEPS(NPFIX) = GSTEP(LC)
46C shift values for other parameters to fill hole
47 DO 100 IK= IEXT+1, NU
48 IF (NIOFEX(IK) .GT. 0) THEN
49 LC = NIOFEX(IK) - 1
50 NIOFEX(IK) = LC
51 NEXOFI(LC) = IK
52 X(LC) = X(LC+1)
53 XT(LC) = XT(LC+1)
54 DIRIN(LC) = DIRIN(LC+1)
55 WERR(LC) = WERR(LC+1)
56 GRD(LC) = GRD(LC+1)
57 G2(LC) = G2(LC+1)
58 GSTEP(LC) = GSTEP(LC+1)
59 ENDIF
60 100 CONTINUE
61 IF (ISW(2) .LE. 0) GO TO 300
62C remove one row and one column from variance matrix
63 IF (NPAR .LE. 0) GO TO 300
64 DO 260 I= 1, NOLD
65 M = MAX(I,IINT)
66 N = MIN(I,IINT)
67 NDEX = M*(M-1)/2 + N
68 260 YY(I)=VHMAT(NDEX)
69 YYOVER = 1.0/YY(IINT)
70 KNEW = 0
71 KOLD = 0
72 DO 294 I= 1, NOLD
73 DO 292 J= 1, I
74 KOLD = KOLD + 1
75 IF (J.EQ.IINT .OR. I.EQ.IINT) GO TO 292
76 KNEW = KNEW + 1
77 VHMAT(KNEW) = VHMAT(KOLD) - YY(J)*YY(I)*YYOVER
78 292 CONTINUE
79 294 CONTINUE
80 300 RETURN
81 END
Note: See TracBrowser for help on using the repository browser.