mnfree.f

Go to the documentation of this file.

*
* $Id: mnfree.F,v 1.1.1.1 1996/03/07 14:31:29 mclareni Exp $
*
* $Log: mnfree.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:29  mclareni
* Minuit
*
*
      SUBROUTINE mnfree(K)
*
* $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        Restores one or more fixed parameter(s) to variable status
CC        by inserting it into the internal parameter list at the
CC        appropriate place.
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
C--       K = 0 means restore all parameters
C--       K = 1 means restore the last parameter fixed
C--       K = -I means restore external parameter I (if possible)
C--       IQ = fix-location where internal parameters were stored
C--       IR = external number of parameter being restored
C--       IS = internal number of parameter being restored
      IF (k .GT. 1)  WRITE (isyswr,510)
      IF (npfix .LT. 1)  WRITE (isyswr,500)
      IF (k.EQ.1 .OR. k.EQ.0)  GO TO 40
C                   release parameter with specified external number
      ka = iabs(k)
      IF (niofex(ka) .EQ. 0)  GO TO 15
      WRITE (isyswr,540)
  540 FORMAT (' IGNORED.  PARAMETER SPECIFIED IS ALREADY VARIABLE.')
      RETURN
   15 IF (npfix .LT. 1)  GO TO 21
      DO 20 ik= 1, npfix
      IF (ipfix(ik) .EQ. ka)  GO TO 24
   20 CONTINUE
   21 WRITE (isyswr,530) ka
  530 FORMAT (' PARAMETER',i4,' NOT FIXED.  CANNOT BE RELEASED.')
      RETURN
   24 IF (ik .EQ. npfix)  GO TO 40
C                   move specified parameter to end of list
      ipsav = ka
      xv = xs(ik)
      xtv = xts(ik)
      dirinv = dirins(ik)
      grdv = grds(ik)
      g2v = g2s(ik)
      gstepv = gsteps(ik)
         DO 30 i= ik+1,npfix
         ipfix(i-1) = ipfix(i)
         xs(i-1) = xs(i)
         xts(i-1) = xts(i)
         dirins(i-1) = dirins(i)
         grds(i-1) = grds(i)
         g2s(i-1) = g2s(i)
         gsteps(i-1) = gsteps(i)
   30    CONTINUE
      ipfix(npfix) = ipsav
      xs(npfix) = xv
      xts(npfix) = xtv
      dirins(npfix) = dirinv
      grds(npfix) = grdv
      g2s(npfix) = g2v
      gsteps(npfix) = gstepv
C                restore last parameter in fixed list  -- IPFIX(NPFIX)
   40 CONTINUE
      IF (npfix .LT. 1)  GO TO 300
      ir = ipfix(npfix)
      is = 0
      DO 100 ik= nu, ir, -1
        IF (niofex(ik) .GT. 0) THEN
         lc = niofex(ik) + 1
         is = lc - 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
      npar = npar + 1
      IF (is .EQ. 0)   is = npar
      niofex(ir) = is
      nexofi(is) = ir
      iq = npfix
      x(is) = xs(iq)
      xt(is) = xts(iq)
      dirin(is) = dirins(iq)
      werr(is)  = dirins(iq)
      grd(is) = grds(iq)
      g2(is) = g2s(iq)
      gstep(is) = gsteps(iq)
      npfix = npfix - 1
      isw(2) = 0
      dcovar = 1.
      IF (isw(5)-itaur .GE. 1)  WRITE(isyswr,520) ir,cpnam(ir)
      IF (k.EQ.0)  GO TO 40
  300 CONTINUE
C         if different from internal, external values are taken
      CALL mnexin(x)
  400 RETURN
  500 FORMAT (' CALL TO MNFREE IGNORED.  THERE ARE NO FIXED PA',
     + 'RAMETERS'/)
  510 FORMAT (' CALL TO MNFREE IGNORED.  ARGUMENT GREATER THAN ONE'/)
  520 FORMAT (20x, 9hparameter,i4,2h, ,a10,' RESTORED TO VARIABLE.')
      END