*
* $Id: mnexcm.f,v 1.1.1.1 2003/11/25 22:45:44 dorman Exp $
*
* $Log: mnexcm.f,v $
* Revision 1.1.1.1  2003/11/25 22:45:44  dorman
* Xspec12.0 Export Version 11-25-2003
*
* Revision 7.0  2002/07/12 16:03:19  dorman
*
* version number change
*
* Revision 1.1  2002/06/26 14:52:09  dorman
*
*
* minuit library
*
* Revision 1.1  2001/12/28 02:53:54  kaa
* Added MINUIT source code.
*
* Revision 1.2  1996/03/15 18:02:45  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:29  mclareni
* Minuit
*
*
 
      SUBROUTINE MNEXCM(FCN,COMAND,PLIST,LLIST,IERFLG,FUTIL)
      INCLUDE "d506dp.inc"
CC        Interprets a command and takes appropriate action,
CC        either directly by skipping to the corresponding code in
CC        MNEXCM, or by setting up a call to a subroutine
CC
      INCLUDE "d506cm.inc"
      EXTERNAL FCN,FUTIL
      CHARACTER*(*) COMAND
C   Cannot say DIMENSION PLIST(LLIST) since LLIST can be =0.
      DIMENSION PLIST(*)
      PARAMETER (MXPT=101)
      DIMENSION XPTU(MXPT), YPTU(MXPT)
C  alphabetical order of command names!
      CHARACTER*10 CNAME(40), CNEWAY, CHWHY*18, C26*30, CVBLNK*2
      LOGICAL LTOFIX, LFIXED, LFREED
C
      CHARACTER COMD*4
      CHARACTER CLOWER*26, CUPPER*26
      DATA CLOWER/'abcdefghijklmnopqrstuvwxyz'/
      DATA CUPPER/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
C
C  recognized MINUIT commands:
      DATA CNAME( 1) / 'MINImize  ' /
      DATA CNAME( 2) / 'SEEk      ' /
      DATA CNAME( 3) / 'SIMplex   ' /
      DATA CNAME( 4) / 'MIGrad    ' /
      DATA CNAME( 5) / 'MINOs     ' /
      DATA CNAME( 6) / 'SET xxx   ' /
      DATA CNAME( 7) / 'SHOw xxx  ' /
      DATA CNAME( 8) / 'TOP of pag' /
      DATA CNAME( 9) / 'FIX       ' /
      DATA CNAME(10) / 'REStore   ' /
      DATA CNAME(11) / 'RELease   ' /
      DATA CNAME(12) / 'SCAn      ' /
      DATA CNAME(13) / 'CONtour   ' /
      DATA CNAME(14) / 'HESse     ' /
      DATA CNAME(15) / 'SAVe      ' /
      DATA CNAME(16) / 'IMProve   ' /
      DATA CNAME(17) / 'CALl fcn  ' /
      DATA CNAME(18) / 'STAndard  ' /
      DATA CNAME(19) / 'END       ' /
      DATA CNAME(20) / 'EXIt      ' /
      DATA CNAME(21) / 'RETurn    ' /
      DATA CNAME(22) / 'CLEar     ' /
      DATA CNAME(23) / 'HELP      ' /
      DATA CNAME(24) / 'MNContour ' /
      DATA CNAME(25) / 'STOp      ' /
      DATA CNAME(26) / 'JUMp      ' /
      DATA CNAME(27) / '          ' /
      DATA CNAME(28) / '          ' /
      DATA CNAME(29) / '          ' /
      DATA CNAME(30) / '          ' /
      DATA CNAME(31) / '          ' /
      DATA CNAME(32) / '          ' /
      DATA CNAME(33) / '          ' /
C  obsolete commands:
      DATA CNAME(34) / 'COVARIANCE' /
      DATA CNAME(35) / 'PRINTOUT  ' /
      DATA CNAME(36) / 'GRADIENT  ' /
      DATA CNAME(37) / 'MATOUT    ' /
      DATA CNAME(38) / 'ERROR DEF ' /
      DATA CNAME(39) / 'LIMITS    ' /
      DATA CNAME(40) / 'PUNCH     ' /
      DATA NNTOT/40/
C      IERFLG is now (94.5) defined the same as ICONDN in MNCOMD
CC            = 0: command executed normally
CC              1: command is blank, ignored
CC              2: command line unreadable, ignored
CC              3: unknown command, ignored
CC              4: abnormal termination (e.g., MIGRAD not converged)
CC              9: reserved
CC             10: END command
CC             11: EXIT or STOP command
CC             12: RETURN command
      LK = LEN(COMAND)
      IF (LK .GT. MAXCWD) LK=MAXCWD
      CWORD = COMAND(1:LK)
C              get upper case
      DO 16 ICOL= 1, LK
        DO 15 LET= 1, 26
        IF (CWORD(ICOL:ICOL) .EQ. CLOWER(LET:LET))
     +      CWORD(ICOL:ICOL) = CUPPER(LET:LET)
   15   CONTINUE
   16 CONTINUE
C           Copy the first MAXP arguments into COMMON (WORD7), making
C           sure that WORD7(1)=0. if LLIST=0
      DO 20 IW= 1, MAXP
      WORD7(IW) = ZERO
      IF (IW .LE. LLIST) WORD7(IW) = PLIST(IW)
   20 CONTINUE
      ICOMND = ICOMND + 1
      NFCNLC = NFCN
      IF (CWORD(1:7).NE.'SET PRI' .OR. WORD7(1).GE.0.)  THEN
        IF (ISW(5) .GE. 0) THEN
         LNOW = LLIST
         IF (LNOW .GT. 4)  LNOW=4
         WRITE (ISYSWR,25) ICOMND,CWORD(1:LK),(PLIST(I),I=1,LNOW)
   25    FORMAT (1H ,10(1H*)/' **',I5,' **',A,4G12.4)
         INONDE = 0
         IF (LLIST .GT. LNOW) THEN
           KLL = LLIST
           IF (LLIST .GT. MAXP) THEN
              INONDE = 1
              KLL = MAXP
           ENDIF
           WRITE (CVBLNK,'(I2)') LK
           C26 = '(11H **********,'//CVBLNK//'X,4G12.4)'
           WRITE (ISYSWR,C26) (PLIST(I),I=LNOW+1,KLL)
         ENDIF
         WRITE (ISYSWR, '(1H ,10(1H*))' )
         IF (INONDE .GT. 0)  WRITE (ISYSWR, '(1H ,10(1H*),A,I3,A)')
     +        '  ERROR: ABOVE CALL TO MNEXCM TRIED TO PASS MORE THAN ',
     +        MAXP,' PARAMETERS.'
        ENDIF
      ENDIF
      NFCNMX = WORD7(1)
      IF (NFCNMX .LE. 0)  NFCNMX = 200 + 100*NPAR + 5*NPAR**2
      EPSI = WORD7(2)
      IF (EPSI .LE. ZERO)  EPSI = 0.1 * UP
      LNEWMN = .FALSE.
      LPHEAD = .TRUE.
      ISW(1) = 0
      IERFLG = 0
C                look for command in list CNAME . . . . . . . . . .
      DO 80 I= 1, NNTOT
      IF (CWORD(1:3) .EQ. CNAME(I)(1:3))  GO TO 90
   80 CONTINUE
      WRITE (ISYSWR,'(11X,''UNKNOWN COMMAND IGNORED:'',A)') COMAND
      IERFLG = 3
      GO TO 5000
C                normal case: recognized MINUIT command . . . . . . .
   90 CONTINUE
      IF (CWORD(1:4) .EQ. 'MINO') I = 5
      IF (I.NE.6 .AND. I.NE.7 .AND. I.NE.8 .AND. I.NE.23)  THEN
         CFROM = CNAME(I)
         NFCNFR = NFCN
      ENDIF
C              1    2    3    4    5    6    7    8    9   10
      GO TO ( 400, 200, 300, 400, 500, 700, 700, 800, 900,1000,
     1       1100,1200,1300,1400,1500,1600,1700,1800,1900,1900,
     2       1900,2200,2300,2400,1900,2600,3300,3300,3300,3300,
     3       3300,3300,3300,3400,3500,3600,3700,3800,3900,4000) , I
C                                        . . . . . . . . . . seek
  200 CALL MNSEEK(FCN,FUTIL)
      GO TO 5000
C                                        . . . . . . . . . . simplex
  300 CALL MNSIMP(FCN,FUTIL)
      IF (ISW(4) .LT. 1)  IERFLG = 4
      GO TO 5000
C                                        . . . . . . migrad, minimize
  400 CONTINUE
      NF = NFCN
      APSI = EPSI
      CALL MNMIGR(FCN,FUTIL)
      CALL MNWERR
      IF (ISW(4) .GE. 1)         GO TO 5000
        IERFLG = 4
      IF (ISW(1) .EQ. 1)         GO TO 5000
      IF (CWORD(1:3) .EQ. 'MIG') GO TO 5000
      NFCNMX = NFCNMX + NF - NFCN
      NF = NFCN
      CALL MNSIMP(FCN,FUTIL)
      IF (ISW(1) .EQ. 1)  GO TO 5000
      NFCNMX = NFCNMX + NF - NFCN
      CALL MNMIGR(FCN,FUTIL)
         IF (ISW(4) .GE. 1)  IERFLG = 0
      CALL MNWERR
      GO TO 5000
C                                        . . . . . . . . . . minos
  500 CONTINUE
      NSUPER = NFCN + 2*(NPAR+1)*NFCNMX
C          possible loop over new minima
      EPSI = 0.1 * UP
  510 CONTINUE
      CALL MNCUVE(FCN,FUTIL)
      CALL MNMNOS(FCN,FUTIL)
      IF (.NOT. LNEWMN)  GO TO 5000
      CALL MNRSET(0)
      CALL MNMIGR(FCN,FUTIL)
      CALL MNWERR
      IF (NFCN .LT. NSUPER)  GO TO 510
      WRITE (ISYSWR,'(/'' TOO MANY FUNCTION CALLS. MINOS GIVES UP''/)')
      IERFLG = 4
      GO TO 5000
C                                        . . . . . . . . . .set, show
  700 CALL MNSET(FCN,FUTIL)
      GO TO 5000
C                                        . . . . . . . . . . top of page
  800 CONTINUE
      WRITE (ISYSWR,'(1H1)')
      GO TO 5000
C                                        . . . . . . . . . . fix
  900 LTOFIX = .TRUE.
C                                        . . (also release) ....
  901 CONTINUE
      LFREED = .FALSE.
      LFIXED = .FALSE.
      IF (LLIST .EQ. 0)  THEN
         WRITE (ISYSWR,'(A,A)') CWORD,':  NO PARAMETERS REQUESTED '
         GO TO 5000
      ENDIF
      DO 950 ILIST= 1, LLIST
      IEXT = PLIST(ILIST)
      CHWHY = ' IS UNDEFINED.'
      IF (IEXT .LE. 0)         GO TO 930
      IF (IEXT .GT. NU)        GO TO 930
      IF (NVARL(IEXT) .LT. 0)  GO TO 930
      CHWHY = ' IS CONSTANT.  '
      IF (NVARL(IEXT) .EQ. 0)  GO TO 930
      IINT = NIOFEX(IEXT)
      IF (LTOFIX) THEN
         CHWHY = ' ALREADY FIXED.'
         IF (IINT .EQ. 0)      GO TO 930
         CALL MNFIXP(IINT,IERR)
         IF (IERR .EQ. 0) THEN
            LFIXED = .TRUE.
         ELSE
            IERFLG = 4
         ENDIF
      ELSE
         CHWHY = ' ALREADY VARIABLE.'
         IF (IINT .GT. 0)      GO TO 930
         KRL = -IABS(IEXT)
         CALL MNFREE(KRL)
         LFREED = .TRUE.
      ENDIF
      GO TO 950
  930 WRITE (ISYSWR,'(A,I4,A,A)') ' PARAMETER',IEXT,CHWHY,' IGNORED.'
  950 CONTINUE
      IF (LFREED .OR. LFIXED)  CALL MNRSET(0)
      IF (LFREED)  THEN
          ISW(2) = 0
          DCOVAR = 1.
          EDM = BIGEDM
          ISW(4) = 0
      ENDIF
      CALL MNWERR
      IF (ISW(5) .GT. 1)  CALL MNPRIN(5,AMIN)
      GO TO 5000
C                                        . . . . . . . . . . restore
 1000 IT = WORD7(1)
      IF (IT.GT.1 .OR. IT.LT.0)  GO TO 1005
      LFREED = (NPFIX .GT. 0)
      CALL MNFREE(IT)
      IF (LFREED) THEN
         CALL MNRSET(0)
         ISW(2) = 0
         DCOVAR = 1.
         EDM = BIGEDM
      ENDIF
      GO TO 5000
 1005 WRITE (ISYSWR,'(A,I4)') ' IGNORED.  UNKNOWN ARGUMENT:',IT
      IERFLG = 3
      GO TO 5000
C                                        . . . . . . . . . . release
 1100 LTOFIX = .FALSE.
      GO TO 901
C                                       . . . . . . . . . . scan . . .
 1200 CONTINUE
      IEXT = WORD7(1)
      IF (IEXT .LE. 0)  GO TO 1210
      IT2 = 0
      IF (IEXT .LE. NU)  IT2 = NIOFEX(IEXT)
      IF (IT2 .LE. 0)  GO TO 1250
 1210 CALL MNSCAN(FCN,FUTIL)
      GO TO 5000
 1250 WRITE (ISYSWR,'(A,I4,A)') ' PARAMETER',IEXT,' NOT VARIABLE.'
      IERFLG = 3
      GO TO 5000
C                                        . . . . . . . . . . contour
 1300 CONTINUE
      KE1 = WORD7(1)
      KE2 = WORD7(2)
      IF (KE1 .EQ. 0)  THEN
         IF (NPAR .EQ. 2)  THEN
            KE1 = NEXOFI(1)
            KE2 = NEXOFI(2)
         ELSE
            WRITE (ISYSWR,'(A,A)') CWORD,':  NO PARAMETERS REQUESTED '
            IERFLG = 3
            GO TO 5000
         ENDIF
      ENDIF
      NFCNMX = 1000
      CALL MNCNTR(FCN,KE1,KE2,IERRF,FUTIL)
      IF (IERRF .GT. 0)  IERFLG = 3
      GO TO 5000
C                                        . . . . . . . . . . hesse
 1400 CONTINUE
      CALL MNHESS(FCN,FUTIL)
      CALL MNWERR
      IF (ISW(5) .GE. 0)  CALL MNPRIN(2, AMIN)
      IF (ISW(5) .GE. 1)  CALL MNMATU(1)
      GO TO 5000
C                                        . . . . . . . . . . save
 1500 CONTINUE
      CALL MNSAVE
      GO TO 5000
C                                        . . . . . . . . . . improve
 1600 CONTINUE
      CALL MNCUVE(FCN,FUTIL)
      CALL MNIMPR(FCN,FUTIL)
      IF (LNEWMN)  GO TO 400
      IERFLG = 4
      GO TO 5000
C                                        . . . . . . . . . . call fcn
 1700 IFLAG = WORD7(1)
      NPARX = NPAR
      F = UNDEFI
      CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
      NFCN = NFCN + 1
      NOWPRT = 0
      IF (F .NE. UNDEFI)  THEN
         IF (AMIN .EQ. UNDEFI)  THEN
             AMIN = F
             NOWPRT = 1
         ELSE IF (F .LT. AMIN)  THEN
             AMIN = F
             NOWPRT = 1
         ENDIF
         IF (ISW(5).GE.0 .AND. IFLAG.LE.5 .AND. NOWPRT.EQ.1)
     +          CALL MNPRIN(5,AMIN)
         IF (IFLAG .EQ. 3)  FVAL3=F
      ENDIF
      IF (IFLAG .GT. 5)  CALL MNRSET(1)
      GO TO 5000
C                                        . . . . . . . . . . standard
 1800 CALL STAND
      GO TO 5000
C                                       . . . return, stop, end, exit
 1900 IT = WORD7(1)
      IF (FVAL3 .NE. AMIN .AND. IT .EQ. 0)  THEN
        IFLAG = 3
        IF (ISW(5) .GE. 0)
     +WRITE (ISYSWR,'(/A/)') ' CALL TO USER FUNCTION WITH IFLAG = 3'
        NPARX = NPAR
        CALL FCN(NPARX,GIN,F,U,IFLAG,FUTIL)
        NFCN = NFCN + 1
        FVAL3 = F
      ENDIF
      IERFLG = 11
      IF (CWORD(1:3) .EQ. 'END')  IERFLG = 10
      IF (CWORD(1:3) .EQ. 'RET')  IERFLG = 12
      GO TO 5000
C                                        . . . . . . . . . . clear
 2200 CONTINUE
      CALL MNCLER
      IF (ISW(5) .GE. 1)  WRITE (ISYSWR,'(A)')
     + ' MINUIT MEMORY CLEARED. NO PARAMETERS NOW DEFINED.'
      GO TO 5000
C                                        . . . . . . . . . . help
 2300 CONTINUE
CCCC      IF (INDEX(CWORD,'SHO') .GT. 0)  GO TO 700
CCCC      IF (INDEX(CWORD,'SET') .GT. 0)  GO TO 700
      KCOL = 0
      DO 2310 ICOL= 5,LK
        IF (CWORD(ICOL:ICOL) .EQ. ' ') GO TO 2310
        KCOL = ICOL
        GO TO 2320
 2310 CONTINUE
 2320 CONTINUE
      IF (KCOL .EQ. 0)  THEN
         COMD = '*   '
      ELSE
         COMD = CWORD(KCOL:LK)
      ENDIF
      CALL MNHELP(COMD,ISYSWR)
      GO TO 5000
C                                       . . . . . . . . . . MNContour
 2400 CONTINUE
      EPSI = 0.05 * UP
      KE1 = WORD7(1)
      KE2 = WORD7(2)
      IF (KE1.EQ.0 .AND. NPAR.EQ.2) THEN
         KE1 = NEXOFI(1)
         KE2 = NEXOFI(2)
         ENDIF
      NPTU = WORD7(3)
      IF (NPTU .LE. 0)  NPTU=20
      IF (NPTU .GT. MXPT)  NPTU = MXPT
      NFCNMX =  100*(NPTU+5)*(NPAR+1)
      CALL MNCONT(FCN,KE1,KE2,NPTU,XPTU,YPTU,IERRF,FUTIL)
      IF (IERRF .LT. NPTU) IERFLG = 4
      IF (IERRF .EQ. -1)   IERFLG = 3
      GO TO 5000
C                                      . . . . . . . . . . jump
 2600 CONTINUE
      STEP = WORD7(1)
      IF (STEP .LE. ZERO)  STEP = 2.
      RNO = 0.
      IZERO = 0
      DO 2620 I= 1, NPAR
        CALL MNRN15(RNO,IZERO)
        RNO = 2.0*RNO - 1.0
 2620   X(I) = X(I) + RNO*STEP*WERR(I)
      CALL MNINEX(X)
      CALL MNAMIN(FCN,FUTIL)
      CALL MNRSET(0)
      GO TO 5000
C                                      . . . . . . . . . . blank line
 3300 CONTINUE
      WRITE (ISYSWR,'(10X,A)') ' BLANK COMMAND IGNORED.'
      IERFLG = 1
      GO TO 5000
C  . . . . . . . . obsolete commands     . . . . . . . . . . . . . .
C                                      . . . . . . . . . . covariance
 3400 CONTINUE
      WRITE (ISYSWR, '(A)') ' THE "COVARIANCE" COMMAND IS OSBSOLETE.',
     + ' THE COVARIANCE MATRIX IS NOW SAVED IN A DIFFERENT FORMAT',
     + ' WITH THE "SAVE" COMMAND AND READ IN WITH:"SET COVARIANCE"'
      IERFLG = 3
      GO TO 5000
C                                        . . . . . . . . . . printout
 3500 CONTINUE
      CNEWAY = 'SET PRInt '
      GO TO 3100
C                                        . . . . . . . . . . gradient
 3600 CONTINUE
      CNEWAY = 'SET GRAd  '
      GO TO 3100
C                                        . . . . . . . . . . matout
 3700 CONTINUE
      CNEWAY = 'SHOW COVar'
      GO TO 3100
C                                        . . . . . . . . . error def
 3800 CONTINUE
      CNEWAY = 'SET ERRdef'
      GO TO 3100
C                                        . . . . . . . . . . limits
 3900 CONTINUE
      CNEWAY = 'SET LIMits'
      GO TO 3100
C                                        . . . . . . . . . . punch
 4000 CONTINUE
      CNEWAY = 'SAVE      '
C                                ....... come from obsolete commands
 3100 WRITE (ISYSWR, 3101) CWORD,CNEWAY
 3101 FORMAT (' OBSOLETE COMMAND:',1X,A10,5X,'PLEASE USE:',1X,A10)
      CWORD = CNEWAY
      IF (CWORD .EQ. 'SAVE      ') GO TO 1500
      GO TO 700
C                                 . . . . . . . . . . . . . . . . . .
 5000 RETURN
      END
