| [2403] | 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"
|
|---|
| 12 | CC removes parameter IINT from the internal (variable) parameter
|
|---|
| 13 | CC list, and arranges the rest of the list to fill the hole.
|
|---|
| 14 | CC
|
|---|
| 15 | #include "minuit/d506cm.inc"
|
|---|
| 16 | DIMENSION YY(MNI)
|
|---|
| 17 | C 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
|
|---|
| 32 | C reduce number of variable parameters by one
|
|---|
| 33 | NIOFEX(IEXT) = 0
|
|---|
| 34 | NOLD = NPAR
|
|---|
| 35 | NPAR = NPAR - 1
|
|---|
| 36 | C 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)
|
|---|
| 46 | C 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
|
|---|
| 62 | C 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
|
|---|
![(please configure the [header_logo] section in trac.ini)](/PI/chrome/site/your_project_logo.png){kind=logo}
