mnscan.f

Go to the documentation of this file.

*
* $Id: mnscan.F,v 1.2 1996/03/15 18:02:51 james Exp $
*
* $Log: mnscan.F,v $
* Revision 1.2  1996/03/15 18:02:51  james
*     Modified Files:
* mnderi.F eliminate possible division by zero
* mnexcm.F suppress print on STOP when print flag=-1
*          set FVAL3 to flag if FCN already called with IFLAG=3
* mninit.F set version 96.03
* mnlims.F remove arguments, not needed
* mnmigr.F VLEN -> LENV in debug print statement
* mnparm.F move call to MNRSET to after NPAR redefined, to zero all
* mnpsdf.F eliminate possible division by zero
* mnscan.F suppress printout when print flag =-1
* mnset.F  remove arguments in call to MNLIMS
* mnsimp.F fix CSTATU so status is PROGRESS only if new minimum
* mnvert.F eliminate possible division by zero
*
* Revision 1.1.1.1  1996/03/07 14:31:31  mclareni
* Minuit
*
*
      SUBROUTINE mnscan(FCN,FUTIL)
*
* $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        Scans the values of FCN as a function of one parameter
CC        and plots the resulting values as a curve using MNPLOT.
CC        It may be called to scan one parameter or all parameters.
CC        retains the best function and parameter values found.
*
* $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
      EXTERNAL fcn,futil
      xlreq = min(word7(3),word7(4))
      xhreq = max(word7(3),word7(4))
      ncall = word7(2) + 0.01
      IF (ncall .LE. 1)  ncall = 41
      IF (ncall .GT. maxcpt)  ncall = maxcpt
      nccall = ncall
      IF (amin .EQ. undefi)  CALL mnamin(fcn,futil)
      iparwd = word7(1) + 0.1
      ipar = max(iparwd, 0)
      iint = niofex(ipar)
      cstatu = 'NO CHANGE'
      IF (iparwd .GT. 0)  GO TO 200
C
C         equivalent to a loop over parameters requested
  100 ipar = ipar + 1
      IF (ipar .GT. nu)  GO TO 900
      iint = niofex(ipar)
      IF (iint .LE. 0)  GO TO 100
C         set up range for parameter IPAR
  200 CONTINUE
      ubest = u(ipar)
      xpt(1) = ubest
      ypt(1) = amin
      chpt(1)= ' '
      xpt(2) = ubest
      ypt(2) = amin
      chpt(2)= 'X'
      nxypt = 2
      IF (nvarl(ipar) .GT. 1)  GO TO 300
C         no limits on parameter
      IF (xlreq .EQ. xhreq)  GO TO 250
      unext = xlreq
      step = (xhreq-xlreq)/float(ncall-1)
      GO TO 500
  250 CONTINUE
      xl = ubest - werr(iint)
      xh = ubest+  werr(iint)
      CALL mnbins(xl,xh,ncall, unext,uhigh,nbins,step)
      nccall = nbins + 1
      GO TO 500
C         limits on parameter
  300 CONTINUE
      IF (xlreq .EQ. xhreq)  GO TO 350
      xl = max(xlreq,alim(ipar))
      xh = min(xhreq,blim(ipar))
      IF (xl .GE. xh)  GO TO 700
      unext = xl
      step = (xh-xl)/float(ncall-1)
      GO TO 500
  350 CONTINUE
      unext = alim(ipar)
      step = (blim(ipar)-alim(ipar))/float(ncall-1)
C         main scanning loop over parameter IPAR
  500 CONTINUE
      DO 600 icall = 1, nccall
      u(ipar) = unext
      nparx = npar
      CALL fcn(nparx,gin,fnext,u,4,futil)
      nfcn = nfcn + 1
      nxypt = nxypt + 1
      xpt(nxypt) = unext
      ypt(nxypt) = fnext
      chpt(nxypt) = '*'
      IF (fnext .LT. amin)  THEN
        amin = fnext
        ubest = unext
        cstatu= 'IMPROVED  '
        ENDIF
  530 CONTINUE
      unext = unext + step
  600 CONTINUE
C         finished with scan of parameter IPAR
      u(ipar) = ubest
      CALL mnexin(x)
      IF (isw(5) .GE. 1)  THEN
        WRITE (isyswr,1001)  newpag,ipar,cpnam(ipar)
        nunit = isyswr
        CALL mnplot(xpt,ypt,chpt,nxypt,nunit,npagwd,npagln)
      ENDIF
      GO TO 800
  700 CONTINUE
      WRITE (isyswr,1000) ipar
  800 CONTINUE
      IF (iparwd .LE. 0)  GO TO 100
C         finished with all parameters
  900 CONTINUE
      IF (isw(5) .GE. 0) CALL mnprin(5,amin)
      RETURN
 1000 FORMAT (46h requested range outside limits for PARAMETER  ,i3/)
 1001 FORMAT (i1,'SCAN OF PARAMETER NO.',i3,3h,   ,a10)
      END