mnparm.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	mnparm (K, CNAMJ, UK, WK, A, B, IERFLG)

Function/Subroutine Documentation

mnparm()

subroutine mnparm	(		K,
		character*(*)	CNAMJ,
			UK,
			WK,
			A,
			B,
			IERFLG
	)

Definition at line 25 of file mnparm.f.

References a, b, c, d, e, f, false, g, h, softenpik::half, i, j, m, maxp, mnfixp(), mnfree(), mnpint(), mnrset(), mnwarn(), n, o, p, parameter(), true, up(), x, xs, and z.

Referenced by fitlat1(), fittime1(), fittran(), and mnpars().

*
* $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        Called from MNPARS and user-callable
CC    Implements one parameter definition, that is:
CC          K     (external) parameter number
CC          CNAMK parameter name
CC          UK    starting value
CC          WK    starting step size or uncertainty
CC          A, B  lower and upper physical parameter limits
CC    and sets up (updates) the parameter lists.
CC    Output: IERFLG=0 if no problems
CC                  >0 if MNPARM unable to implement definition
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
      CHARACTER*(*) cnamj
      CHARACTER  cnamk*10, chbufi*4
C
      cnamk = cnamj
      kint = npar
      IF (k.LT.1 .OR. k.GT.maxext) THEN
C                     parameter number exceeds allowed maximum value
        WRITE (isyswr,9)  k,maxext
    9   FORMAT (/' MINUIT USER ERROR.  PARAMETER NUMBER IS',i11/
     +         ',  ALLOWED RANGE IS ONE TO',i4/)
        GO TO 800
      ENDIF
C                     normal parameter request
      ktofix = 0
      IF (nvarl(k) .LT. 0) GO TO 50
C         previously defined parameter is being redefined
C                                     find if parameter was fixed
      DO 40 ix= 1, npfix
      IF (ipfix(ix) .EQ. k)  ktofix = k
   40 CONTINUE
      IF (ktofix .GT. 0)  THEN
         CALL mnwarn('W','PARAM DEF','REDEFINING A FIXED PARAMETER.')
         IF (kint .GE. maxint)  THEN
            WRITE (isyswr,'(A)') ' CANNOT RELEASE. MAX NPAR EXCEEDED.'
            GO TO 800
            ENDIF
         CALL mnfree(-k)
         ENDIF
C                       if redefining previously variable parameter
      IF(niofex(k) .GT. 0) kint = npar-1
   50 CONTINUE
C
C                                      . . .print heading
      IF (lphead .AND. isw(5).GE.0) THEN
        WRITE (isyswr,61)
        lphead = .false.
      ENDIF
   61 FORMAT(/' PARAMETER DEFINITIONS:'/
     +        '    NO.   NAME         VALUE      STEP SIZE      LIMITS')
      IF (wk .GT. zero)  GO TO 122
C                                        . . .constant parameter . . . .
      IF (isw(5) .GE. 0)  WRITE (isyswr, 82)  k,cnamk,uk
   82 FORMAT (1x,i5,1x,1h',A10,1H',1x,g13.5, '  constant')
      nvl = 0
      GO TO 200
  122 IF (a.EQ.zero .AND. b.EQ.zero) THEN
C                                      variable parameter without limits
      nvl = 1
      IF (isw(5) .GE. 0)  WRITE (isyswr, 127)  k,cnamk,uk,wk
  127 FORMAT (1x,i5,1x,1h',A10,1H',1x,2g13.5, '     no limits')
      ELSE
C                                         variable parameter with limits
      nvl = 4
      lnolim = .false.
      IF (isw(5) .GE. 0)  WRITE (isyswr, 132)  k,cnamk,uk,wk,a,b
  132 FORMAT(1x,i5,1x,1h',A10,1H',1x,2g13.5,2x,2g13.5)
      ENDIF
C                             . . request for another variable parameter
      kint = kint + 1
      IF (kint .GT. maxint)  THEN
         WRITE (isyswr,135)  maxint
  135    FORMAT (/' MINUIT USER ERROR.   TOO MANY VARIABLE PARAMETERS.'/
     +   ' THIS VERSION OF MINUIT DIMENSIONED FOR',i4//)
         GO TO 800
         ENDIF
      IF (nvl .EQ. 1)  GO TO 200
      IF (a .EQ. b)  THEN
        WRITE (isyswr,'(/A,A/A/)') ' USER ERROR IN MINUIT PARAMETER',
     +   ' DEFINITION',' UPPER AND LOWER LIMITS EQUAL.'
        GO TO 800
        ENDIF
      IF (b .LT. a) THEN
         sav = b
         b = a
         a = sav
         CALL mnwarn('W','PARAM DEF','PARAMETER LIMITS WERE REVERSED.')
         IF (lwarn) lphead=.true.
         ENDIF
      IF ((b-a) .GT. 1.0e7)  THEN
         WRITE (chbufi,'(I4)') k
         CALL mnwarn('W','PARAM DEF',
     +               'LIMITS ON PARAM'//chbufi//' TOO FAR APART.')
         IF (lwarn) lphead=.true.
      ENDIF
      danger = (b-uk)*(uk-a)
      IF (danger .LT. 0.)
     +     CALL mnwarn('W','PARAM DEF','STARTING VALUE OUTSIDE LIMITS.')
      IF (danger .EQ. 0.)
     +     CALL mnwarn('W','PARAM DEF','STARTING VALUE IS AT LIMIT.')
  200 CONTINUE
C                           . . . input OK, set values, arrange lists,
C                                    calculate step sizes GSTEP, DIRIN
      cfrom = 'PARAMETR'
      nfcnfr = nfcn
      cstatu= 'NEW VALUES'
      nu = max(nu,k)
      cpnam(k) = cnamk
      u(k) = uk
      alim(k) = a
      blim(k) = b
      nvarl(k) = nvl
C                             K is external number of new parameter
C           LASTIN is the number of var. params with ext. param. no.< K
      lastin = 0
      DO 240 ix= 1, k-1
      IF (niofex(ix) .GT. 0)  lastin=lastin+1
  240 CONTINUE
C                 KINT is new number of variable params, NPAR is old
      IF (kint .EQ. npar)  GO TO 280
      IF (kint .GT. npar) THEN
C                          insert new variable parameter in list
         DO 260 in= npar,lastin+1,-1
         ix = nexofi(in)
         niofex(ix) = in+1
         nexofi(in+1)= ix
         x(in+1) = x(in)
         xt(in+1) = xt(in)
         dirin(in+1) = dirin(in)
         g2(in+1) = g2(in)
         gstep(in+1) = gstep(in)
  260    CONTINUE
      ELSE
C                          remove variable parameter from list
         DO 270 in= lastin+1,kint
         ix = nexofi(in+1)
         niofex(ix) = in
         nexofi(in)= ix
         x(in)= x(in+1)
         xt(in)= xt(in+1)
         dirin(in)= dirin(in+1)
         g2(in)= g2(in+1)
         gstep(in)= gstep(in+1)
  270    CONTINUE
      ENDIF
  280 CONTINUE
      ix = k
      niofex(ix) = 0
      npar = kint
      CALL mnrset(1)
C                                       lists are now arranged . . . .
      IF (nvl .GT. 0)  THEN
         in = lastin+1
         nexofi(in) = ix
         niofex(ix) = in
         sav = u(ix)
         CALL mnpint(sav,ix,pinti)
         x(in) = pinti
         xt(in) = x(in)
         werr(in) = wk
         sav2 = sav + wk
         CALL mnpint(sav2,ix,pinti)
         vplu = pinti - x(in)
         sav2 = sav - wk
         CALL mnpint(sav2,ix,pinti)
         vminu = pinti - x(in)
         dirin(in) = 0.5 * (abs(vplu) +abs(vminu))
         g2(in) = 2.0*up / dirin(in)**2
         gsmin = 8.*epsma2*abs(x(in))
         gstep(in) = max(gsmin, 0.1*dirin(in))
         IF (amin .NE. undefi) THEN
             small = sqrt(epsma2*(amin+up)/up)
             gstep(in) = max(gsmin, small*dirin(in))
         ENDIF
         grd(in) = g2(in)*dirin(in)
C                   if parameter has limits
         IF (nvarl(k) .GT. 1) THEN
            IF (gstep(in).GT. 0.5)  gstep(in)=0.5
            gstep(in) = -gstep(in)
         ENDIF
      ENDIF
      IF (ktofix .GT. 0)  THEN
         kinfix = niofex(ktofix)
         IF (kinfix .GT. 0)  CALL mnfixp(kinfix,ierr)
         IF (ierr .GT. 0)  GO TO 800
      ENDIF
      ierflg = 0
      RETURN
C                   error on input, unable to implement request  . . . .
  800 CONTINUE
      ierflg = 1
      RETURN

Here is the call graph for this function:

Here is the caller graph for this function: