mnmnos.f

Go to the documentation of this file.

*
* $Id: mnmnos.F,v 1.1.1.1 1996/03/07 14:31:30 mclareni Exp $
*
* $Log: mnmnos.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:30  mclareni
* Minuit
*
*
      SUBROUTINE mnmnos(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        Performs a MINOS error analysis on those parameters for
CC        which it is requested on the MINOS command by calling 
CC        MNMNOT for each parameter requested.
*
* $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
      IF (npar .LE. 0)  GO TO 700
      ngood = 0
      nbad = 0
      nfcnmi = nfcn
C                                      . loop over parameters requested
      DO 570 knt= 1, npar
      IF (int(word7(2)) .EQ. 0) THEN
          ilax = nexofi(knt)
      ELSE
          IF (knt .GE. 7)  GO TO 580
          ilax = int(word7(knt+1))
          IF (ilax .EQ. 0)  GO TO 580
          IF (ilax .GT. 0 .AND. ilax .LE. nu) THEN
             IF (niofex(ilax) .GT. 0)  GO TO 565
          ENDIF
          WRITE (isyswr,564) ilax
  564     FORMAT (' PARAMETER NUMBER ',i5,' NOT VARIABLE. IGNORED.')
          GO TO 570
      ENDIF
  565 CONTINUE
C                                         calculate one pair of M E's
      ilax2 = 0
      CALL mnmnot(fcn,ilax,ilax2,val2pl,val2mi,futil)
      IF (lnewmn)  GO TO 650
C                                          update NGOOD and NBAD
      iin = niofex(ilax)
      IF (erp(iin) .GT. zero) THEN
         ngood=ngood+1
      ELSE
         nbad=nbad+1
      ENDIF
      IF (ern(iin) .LT. zero) THEN
         ngood=ngood+1
      ELSE
         nbad=nbad+1
      ENDIF
  570 CONTINUE
C                                           end of loop . . . . . . .
  580 CONTINUE
C                                        . . . . printout final values .
      cfrom = 'MINOS   '
      nfcnfr = nfcnmi
      cstatu= 'UNCHANGED '
      IF (ngood.EQ.0.AND.nbad.EQ.0) GO TO 700
      IF (ngood.GT.0.AND.nbad.EQ.0) cstatu='SUCCESSFUL'
      IF (ngood.EQ.0.AND.nbad.GT.0) cstatu='FAILURE   '
      IF (ngood.GT.0.AND.nbad.GT.0) cstatu='PROBLEMS  '
      IF (isw(5) .GE. 0) CALL mnprin(4,amin)
      IF (isw(5) .GE. 2) CALL mnmatu(0)
      GO TO 900
C                                        . . . new minimum found . . . .
  650 CONTINUE
      cfrom = 'MINOS   '
      nfcnfr = nfcnmi
      cstatu= 'NEW MINIMU'
      IF (isw(5) .GE. 0) CALL mnprin(4,amin)
      WRITE (isyswr,675)
  675 FORMAT(/50h new minimum found.  go back to minimization step./1h ,
     +60(1h=)/60x,1hv/60x,1hv/60x,1hv/57x,7hvvvvvvv/58x,5hvvvvv/59x,
     +3hvvv/60x,1hv//)
      GO TO 900
  700 WRITE (isyswr,'(A)') ' THERE ARE NO MINOS ERRORS TO CALCULATE.'
  900 RETURN
      END