mnfixp.f

Go to the documentation of this file.

*
* $Id: mnfixp.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
*
* $Log: mnfixp.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:29  mclareni
* Minuit
*
*
      SUBROUTINE mnfixp(IINT,IERR)
*
* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506dp.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506dp.inc
*
C ************ DOUBLE PRECISION VERSION *************
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
CC        removes parameter IINT from the internal (variable) parameter
CC        list, and arranges the rest of the list to fill the hole.
CC
*
* $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506cm.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506cm.inc
*
      parameter(mne=100 , mni=50)
      parameter(mnihl=mni*(mni+1)/2)
      CHARACTER*10 CPNAM
      COMMON
     1/mn7nam/ cpnam(mne)
     2/mn7ext/ u(mne)     ,alim(mne)  ,blim(mne)
     3/mn7err/ erp(mni)   ,ern(mni)   ,werr(mni)  ,globcc(mni)
     4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
     5/mn7int/ x(mni)     ,xt(mni)    ,dirin(mni)
     6/mn7fx2/ xs(mni)    ,xts(mni)   ,dirins(mni)
     7/mn7der/ grd(mni)   ,g2(mni)    ,gstep(mni) ,gin(mne) ,dgrd(mni)
     8/mn7fx3/ grds(mni)  ,g2s(mni)   ,gsteps(mni)
     9/mn7fx1/ ipfix(mni) ,npfix
     a/mn7var/ vhmat(mnihl)
     b/mn7vat/ vthmat(mnihl)
     c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
C
      parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
      parameter(zero=0.0,  one=1.0,   half=0.5)
      COMMON
     d/mn7npr/ maxint ,npar   ,maxext ,nu
     e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
     e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
     f/mn7tit/ cfrom  ,cstatu ,ctitl  ,cword  ,cundef ,cvrsn ,covmes
     g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
     h/mn7min/ amin   ,up     ,edm    ,fval3  ,epsi   ,apsi  ,dcovar
     i/mn7cnv/ nfcn   ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
     j/mn7arg/ word7(maxp)
     k/mn7log/ lwarn  ,lrepor ,limset ,lnolim ,lnewmn ,lphead
     l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
     m/mn7rpt/ xpt(maxcpt)    ,ypt(maxcpt)
     n/mn7cpt/ chpt(maxcpt)
     o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr  ,ke2cr
      CHARACTER CTITL*50, CWORD*(maxcwd), CUNDEF*10, CFROM*8,
     +          cvrsn*6,  covmes(0:3)*22, cstatu*10, chpt*1
      LOGICAL   LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
      dimension yy(mni)
C                           first see if it can be done
      ierr = 0
      IF (iint.GT.npar .OR. iint.LE.0)  THEN
         ierr = 1
         WRITE (isyswr,'(A,I4)')
     +       ' MINUIT ERROR.  ARGUMENT TO MNFIXP=',iint
         GO TO 300
      ENDIF
      iext = nexofi(iint)
      IF (npfix .GE. mni) THEN
         ierr = 1
         WRITE (isyswr,'(A,I4,A,I4)') ' MINUIT CANNOT FIX PARAMETER',
     +   iext,' MAXIMUM NUMBER THAT CAN BE FIXED IS',mni
         GO TO 300
      ENDIF
C                           reduce number of variable parameters by one
      niofex(iext) = 0
      nold = npar
      npar = npar - 1
C                       save values in case parameter is later restored
      npfix = npfix + 1
      ipfix(npfix) = iext
      lc = iint
      xs(npfix) = x(lc)
      xts(npfix) = xt(lc)
      dirins(npfix) = werr(lc)
      grds(npfix) = grd(lc)
      g2s(npfix) = g2(lc)
      gsteps(npfix) = gstep(lc)
C                        shift values for other parameters to fill hole
      DO 100  ik= iext+1, nu
         IF  (niofex(ik) .GT. 0)  THEN
         lc = niofex(ik) - 1
         niofex(ik) = lc
         nexofi(lc) = ik
         x(lc)     = x(lc+1)
         xt(lc)    = xt(lc+1)
         dirin(lc) = dirin(lc+1)
         werr(lc)  = werr(lc+1)
         grd(lc)   = grd(lc+1)
         g2(lc)    = g2(lc+1)
         gstep(lc) = gstep(lc+1)
         ENDIF
  100 CONTINUE
      IF (isw(2) .LE. 0)  GO TO 300
C                    remove one row and one column from variance matrix
      IF (npar .LE. 0)  GO TO 300
      DO 260 i= 1, nold
      m = max(i,iint)
      n = min(i,iint)
      ndex = m*(m-1)/2 + n
  260 yy(i)=vhmat(ndex)
      yyover = 1.0/yy(iint)
      knew = 0
      kold = 0
      DO 294 i= 1, nold
      DO 292 j= 1, i
      kold = kold + 1
      IF (j.EQ.iint .OR. i.EQ.iint)  GO TO 292
      knew = knew + 1
      vhmat(knew) = vhmat(kold) - yy(j)*yy(i)*yyover
  292 CONTINUE
  294 CONTINUE
  300 RETURN
      END