C @(#)fit_user.for	10.7 (ESO-IPG) 2/13/96 16:33:51
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C       Internet e-mail: midas@eso.org
C       Postal address: European Southern Observatory
C                       Data Management Division 
C                       Karl-Schwarzschild-Strasse 2
C                       D 85748 Garching bei Muenchen 
C                       GERMANY
C===========================================================================
C


C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE  EdtPar(iflag)
C        
C       Edit parameter table. 
C       iflag=0 ok
C       iflag=-1 quit
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

          implicit none
          include 'MID_REL_INCL:fit_var.inc'
          integer ipos
          integer iflag
          integer ist,nline,jj,kk,iexist
          character*20 com1,com2,com3,com4,command
          character*80 helpstr
          character test
          character*4 cvalue
          real value
          logical reval,iok,inewl

 100      continue              !starts loop

          call sttdis(' ',0,ist)
          call sttdis(' ',0,ist)
          call sttdis(' ',0,ist)
          call ShPar1('EDITPARAM')
          call sttdis(' ',0,ist)
          command = ' '
          call AskC('Input command (e.g. ''B #3 25.3'', ''help'' )',
     1         command,ist)
          
          if (command.eq.' ') goto 100
C
C     Reads, checks and processes first string of command
C

          if (command.eq.'help'.or.command.eq.'HELP') then
           call sttdis(' ',0,ist)
           call sttdis(' ** HELP Edit Parameter   **',0,ist)
           call sttdis(' ',0,ist)
           call sttdis(' * To modify the value of a  parameter enter:'
     1          ,0,ist)
           call sttdis('           <Col.name>  #<Row number>  <value>',
     1          0,ist)
           write(helpstr,*)'    Where: Col.name is the name of the '
     1          ,'column desired (E, L, PL, N ....)'
           call sttdis(helpstr,0,ist)
           write(helpstr,*)'       Row number is the number of the row'
           call sttdis(helpstr,0,ist)
           write(helpstr,*)'       value is the new value to input'
           write(helpstr,*)'Examples:'
           call sttdis(helpstr,0,ist)
           write(helpstr,*)'          E  #2  CIV_1548   '
           call sttdis(helpstr,0,ist)
           write(helpstr,*)'          N  #1  13.5       '
           call sttdis(helpstr,0,ist)
           write(helpstr,*)'          PB #3  5.F        '
           call sttdis(helpstr,0,ist)

           call sttdis(' ',0,ist)
           call sttdis(' To delete a line: ',0,ist)
           call sttdis('          D   #<Row number>',0,ist)
           call sttdis(' ',0,ist)
           call sttdis(' To exit:          ',0,ist)
           call sttdis('          EXIT (saving)',0,ist)
           call sttdis('          QUIT (not saving)',0,ist)

           goto 100
          end if

          if (command.eq.'exit'.or.command.eq.'EXIT') then
             iflag=0
             return
          end if

          if (command.eq.'quit'.or.command.eq.'QUIT') then
             iflag=-1
             return
          end if


                                ! parameter name
          com1=command(1:2)
          iok=.false.
          if (com1.eq.'l '.or.com1.eq.'L ') then
             com1='L '
             iok=.true.
             reval=.true.
          end if
          if (com1.eq.'n '.or.com1.eq.'N ') then
             com1='N '
             iok=.true.
             reval=.true.
          end if
          if (com1.eq.'b '.or.com1.eq.'B ') then
             com1='B '
             iok=.true.
             reval=.true.
          end if
          if (com1.eq.'bt'.or.com1.eq.'BT') then
             com1='BT'
             iok=.true.
             reval=.true.
          end if

          if (com1.eq.'pl'.or.com1.eq.'PL') then
             com1='PL'
             iok=.true.
             reval=.false.
          end if
          if (com1.eq.'pn'.or.com1.eq.'PN') then
             com1='PN'
             iok=.true.
             reval=.false.
          end if
          if (com1.eq.'pb'.or.com1.eq.'PB') then
             com1='PB'
             iok=.true.
             reval=.false.
          end if
          if (com1.eq.'pt'.or.com1.eq.'PT') then
             com1='PT'
             iok=.true.
             reval=.false.
          end if

          if (com1.eq.'d '.or.com1.eq.'D ') then
             com1='D '
             iok=.true.
          end if
          if (com1.eq.'e '.or.com1.eq.'E ') then
             com1='E '
             iok=.true.
          end if


          if (.not.iok) then
             call ErrMsg('Parameter name not found')
             goto 100
          end if

C
C       Gets line number (this is always needed)
C
                                !line number
          ipos=index(command,'#')
          if (ipos.eq.0) then
            call ErrMsg('Error in line specification (# is missing)')
            goto 100
          end if
          com2=command(ipos+1:20)
          read(com2,*)nline    
          if (nline.gt.(NROWS+1)) then !Errors in line number
             call ErrMsg('Line number too large')
             goto 100
          end if
          if (nline.lt.1) then 
             call ErrMsg('Line number too small')
             goto 100
          end if

                                !add a new line          
          if (nline.eq.(NROWS+1)) then
             inewl=.false.
             ist=0              !waits for reply
             call AskYN('Create new line?',inewl,ist)
             if (inewl) then
                NROWS = NROWS + 1
                ElmtNm(NROWS)='             '
                LamIni(NROWS)=0.
                NIni(NROWS)=0.
                BIni(NROWS)=0.
                BtuIni(NROWS)=0.
                do jj=1,4
                   CPar(jj,NROWS)='    '
                end do
             end if
                                ! here doesn't goto100 to process the command
          end if

          
                                ! delete a line
          if (com1.eq.'D ') then
             inewl=.false.
             ist=0              !waits for reply
             call AskYN('Confirm deletion of line?',inewl,ist)
             if (inewl) then
                do jj=nline+1,NROWS
                   ElmtNm(JJ-1)= ElmtNm(JJ)
                   LamIni(JJ-1)=LamIni(JJ)
                   NIni(JJ-1)=NIni(JJ)
                   BIni(JJ-1)=BIni(JJ)
                   BtuIni(JJ-1)=BtuIni(JJ)
                   do kk=1,4
                      CPar(kk,JJ-1)=CPar(kk,jj)
                   end do
                end do
                ElmtNm(NROWS)='             '
                LamIni(NROWS)=0.
                NIni(NROWS)=0.
                BIni(NROWS)=0.
                BtuIni(NROWS)=0.
                do jj=1,4
                   CPar(jj,NROWS)='    '
                end do
                NROWS = NROWS - 1
             end if
             goto 100
          end if
             

C
C     reads the third command end processes it. 
C
                                ! Element
          if (com1.eq.'E ') then
             ipos=index(com2,' ')
             com3=com2(ipos:20)
             ipos=0
 102         ipos=ipos+1
             test=com3(ipos:ipos)
             if (test.eq.' ') goto 102
             com4=com3(ipos:14)
             do jj=1,AT_N
                if (com4.eq.AT_NAM(jj))  iexist=1
             end do  
             if (iexist.eq.0) then
                call ErrMsg('Element not found')
                goto 100
             end if
             write(ElmtNm(nline),'(a14)')com4 ! converts to c*14
             goto 100
          end if


                                ! new value
          ipos=index(com2,' ')
          com3=com2(ipos:20)
          if (reval) then
             read(com3,*)value
          else
             ipos=0
 101         ipos=ipos+1
             test=com3(ipos:ipos)
             if (test.eq.' ') goto 101
             com4=com3(ipos:20)
             write(cvalue,'(a4)')com4 ! converts to c*4 and flushright
             call CnvrtP(cvalue,ipos,test,ist)
             if (ist.eq.1) write(cvalue,'(i2,a1,a1)')ipos,'.',test
             if (ist.eq.0) write(cvalue,'(i4)')ipos
          end if


          if (com1.eq.'L ') LamIni(nline)=value
          if (com1.eq.'N ') NIni(nline)=value
          if (com1.eq.'B ') BIni(nline)=value
          if (com1.eq.'BT') BtuIni(nline)=value
          if (com1.eq.'PL') CPar(1,nline)=cvalue
          if (com1.eq.'PN') CPar(2,nline)=cvalue
          if (com1.eq.'PB') CPar(3,nline)=cvalue
          if (com1.eq.'PT') CPar(4,nline)=cvalue

          GOTO 100              ! asks for a new input

          end


C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE  ShoRes
C        Stampa sullo schermo i risultati del fit
C        leggendo il file 'fdummy.res'
C       Plots the fitted spectrum    
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        implicit none

        include 'MID_REL_INCL:fit_var.inc'

        character*79 sttapp
        integer istt,i


C        include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'

C!!!!!!!
C        Legge il file 'fdummy.res' e stampa i risultati
C!!!!!!!
        call sttdis(' ',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('***** Result of the fit: *****',0,istt)
        call sttdis(' ',0,istt)
        open(10,file='fdummy.res',status='old')
        read(10,*)chi,prob
        write(sttapp,'(A20,f6.2,f6.2)')'Reduced chi2, prob:',chi,prob
        call sttdis(sttapp,0,istt)
        call sttdis(' ',0,istt)
        call sttdis(' ',0,istt)
        if (IMINOS.eq.0) then
           write(sttapp,'(A8,A5,A7,A6,A6,A5,A8,A5)')'LamCen','+/-',
     1          'N  ','+/-','b  ','+/-','  b tur.','+/-'
           call sttdis(sttapp,0,istt)
        else
           write(sttapp,'(A8,A5,A7,A6,A6,A5,A8,A5)')'LamCen',' + ',
     1          'N  ',' + ','b  ',' + ','  b tur.',' + '
           call sttdis(sttapp,0,istt)
           write(sttapp,'(A8,A5,A7,A6,A6,A5,A8,A5)')'      ',' - ',
     1          '   ',' - ','   ',' - ','        ',' - '
           call sttdis(sttapp,0,istt)
        end if
        call sttdis(' ',0,istt)
        
        do i=1,nrows
         read(10,'(17G19.9E3)')LamCen(i),NHfit(i),BDopp(i),BTur(i),
     1        w(i),ErLaPa(i),ErNnPa(i),ErBbPa(i),ErBtPa(i),
     2        ErLaPo(i),ErLaNe(i),ErNnPo(i),ErNnNe(i),
     3        ErBbPo(i),ErBbNe(i),ErBtPo(i),ErBtNe(i)
         Redshi(i) = LamCen(i) / AtmLam(i) - 1.
         Temper(i) = AtmMas(i) * BDopp(i)* BDopp(i) * 60.137
         if (BDopp(i).lt.0) BDopp(i)=-BDopp(i)
         if (Btur(i).lt.0)Btur(i)=-Btur(i)
         if (IMINOS.eq.0) then
            write(sttapp,98)LamCen(i),ErLaPa(i),NHfit(i),ErNnPa(i),
     1           BDopp(i),ErBbPa(i),BTur(i),ErBtPa(i),ElmtNm(i)
            call sttdis(sttapp,0,istt)
          else
            write(sttapp,98)LamCen(i),ErLaPo(i),NHfit(i),ErNnPo(i),
     1           BDopp(i),ErBbPo(i),BTur(i),ErBtPo(i),ElmtNm(i)
            call sttdis(sttapp,0,istt)
            write(sttapp,99)ErLaNe(i),ErNnNe(i),
     1           ErBbNe(i),ErBtNe(i)
            call sttdis(sttapp,0,istt)
         end if
        end do
  
 98     format(f8.2,f5.2,f7.2,f6.2,f6.1,f5.1,f6.1,f5.1,3x,a14)
 99     format(8x,f5.2,7x,f6.2,6x,f5.1,6x,f5.1)

        close(10)

        NGRALI=nrows
        return
        end

C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE  ReaRes
C       Versione semplificata di ShoRes
C       Si limita a leggere il file fdummy.res 
C       Utile per ITERATE
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        implicit none

        include 'MID_REL_INCL:fit_var.inc'

        integer i


C        include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'

C!!!!!!!
C        Legge il file 'fdummy.res'
C!!!!!!!
        open(10,file='fdummy.res',status='old',err=100)
        read(10,*)chi,prob
        
        i=0
 10     continue
         i = i + 1
         read(10,'(17G19.9E3)',end=100,err=100)LamCen(i),NHfit(i),
     1        BDopp(i),BTur(i),
     2        w(i),ErLaPa(i),ErNnPa(i),ErBbPa(i),ErBtPa(i),
     3        ErLaPo(i),ErLaNe(i),ErNnPo(i),ErNnNe(i),
     4        ErBbPo(i),ErBbNe(i),ErBtPo(i),ErBtNe(i)
         Redshi(i) = LamCen(i) / AtmLam(i) - 1.
         Temper(i) = AtmMas(i) * BDopp(i)* BDopp(i) * 60.137
         if (BDopp(i).lt.0) BDopp(i)=-BDopp(i)
         if (Btur(i).lt.0)Btur(i)=-Btur(i)
        goto 10

 100     continue
        NGRALI = i - 1
        
        close(10)

        return
        end




C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      SUBROUTINE AskStp(command,iok)
C
C     Asks for setup parameters
C
C     iok    integer    (out)   =0 if ok, =-1 if quit
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
           implicit none
           character*(*)command
           integer iok
           include 'MID_REL_INCL:fit_var.inc'
           
           integer istt
           logical logtur
           character*40 Mes
           character*80 strout
           character Risp1
           character*20 Option(10)


           Option(1)='(P)rogram set-up'
           Option(2)='(D)ata set-up'
           Option(3)='(G)raphic set-up'
           Option(4)='(E)nd'
           Option(5)='(Q)uit'

           if (Command.eq.'PROGRAM') then
              Risp1='P'
              goto 101
           end if
           if (Command.eq.'DATA') then
              Risp1='D'
              goto 101
           end if
           if (Command.eq.'GRAPHIC') then
              Risp1='G'
              goto 101
           end if

 100       Mes ='************'
           write(strout,'(18x,A12,3x,A14,3x,A12)')Mes,'SET-UP  MENU',
     1          Mes
           call sttdis(strout,0,istt)
           call sttdis(' ',0,istt)
           call sttdis(' ',0,istt)
           write(strout,'(10x,A20,10x,a20)')Option(1),Option(4)
           call sttdis(strout,0,istt)
           write(strout,'(10x,A20,10x,a20)')Option(2),Option(5)
           call sttdis(strout,0,istt)
           write(strout,'(10x,a20)')Option(3)
           call sttdis(strout,0,istt)

           
           Risp1=' '
           istt=-2
           call AskC(' ',Risp1,istt)

 101       if (Risp1.eq.'E'.or.Risp1.eq.'e') then
              iok=0
              return
           end if

           if (Risp1.eq.'Q'.or.Risp1.eq.'q') then
              iok=-1
              return
           end if

           istt=0
           iok=0
           if (Risp1.eq.'P'.or.Risp1.eq.'p') then
              call AskC('Spectrum table',FILSPE,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99) return

              call AskC('Output table',FILOUT,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99) return

              call AskC('Log name',FILLOG,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              istt=1            !DON'T wait for reply
              call AskYN('Graphic output?',I_GRAP,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              if (TURBLN .eq. 1) logtur = .true.
              if (TURBLN .eq. 0) logtur = .false.
              istt=1            !DON'T wait for reply
              call AskYN('Show turbolence parameter?',logtur,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              if (logtur) TURBLN =1
              if (.not. logtur) TURBLN =0
           end if

           if (Risp1.eq.'D'.or.Risp1.eq.'d') then
              call AskD('Positive range for lambda (Angst, 0=free)',
     1             LamLim(1),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              call AskD('Negative range for lambda (Angst, 0=free)',
     1             LamLim(2),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Minimum N allowed (0=free)',NLim(1),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              call AskD('Maximum N allowed (0=free)',NLim(2),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Minimum b allowed (0=free)',BLim(1),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              call AskD('Maximum b allowed (0=free)',BLim(2),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Minimum b turb. allowed (0=free)',
     1             BtuLim(1),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              call AskD('Maximum b turb.allowed (0=free)',
     1             BtuLim(2),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Initial step for lambda (A)',
     1             LamLim(3),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Initial step for N',NLim(3),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Initial step for b',BLim(3),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
              
              call AskD('Initial step for b turb.',BtuLim(3),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

           end if

           if (Risp1.eq.'G'.or.Risp1.eq.'g') then

              istt=1            !DON'T wait for reply
              call AskYN('Graphic output?',I_GRAP,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskD('Space below spectrum',GR_BOT,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskD('Space over spectrum',GR_TOP,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskD('Offset for labels',GR_LAB,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskD('Y-position of line ticks',GR_TIC,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              istt=1            !DON'T wait for reply
              call AskYN('Plot residuals?',I_RESD,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              istt=1            !DON'T wait for reply
              call AskYN('Plot variance?',I_VAR,istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for plot ',GCOLOR(1),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for fitted profile ',GCOLOR(3),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for reference lines ',GCOLOR(2),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for residuals ',GCOLOR(4),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for variance ',GCOLOR(5),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for labels ',GCOLOR(6),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return

              call AskI('Color for line ticks ',GCOLOR(7),istt)
              if (istt.eq.-1)  goto 100
              if (istt.eq.-99)  return
           end if

           goto 100

        end


C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskMin(ierr)
C
C        Imposta la configurazione per la minimizzazione        
C        Presenta dapprimaun menu generale per :
C        a) scegliere la procedura standard (MINIMIZE+HESSE)
C        b) choose the current set of instructions
C        c) impostare a piacere un set di istruzioni MINUIT
C
C        prima vengono definiti i comandi, poi viene scritto  
C        il file
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        implicit none
        integer ierr
        
        include 'MID_REL_INCL:fit_var.inc'

        character*1 risp
        character*10 lett
        character*20 Menu1(10),Menu2(10),Menu3(10),Menu4(10)
        character*60 stt_ap,Mes
        character*80 strout
        integer istt,i,j,numcom,nparf,nparf2
        real up

        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'

        Menu1(1)='(M)inimize'
        Menu1(2)='(I)mprove'
        Menu1(3)='see(K)'
        Menu1(4)='(F)ix'
        Menu1(5)='(R)elease'

        Menu2(1)='(H)esse'
        Menu2(2)='mi(N)os'
        Menu2(3)='(S)can'
        Menu2(4)='(C)ontour'

        Menu3(1)='set err(O)r'
        Menu3(2)='set prin(T)'
        Menu3(3)='set ran(D)om'
        Menu3(4)='set strate(G)y'

        Menu4(1)='(E)nd'
        Menu4(2)='(Q)uit'

C!!!!!!!
C     main menu
C!!!!!!!
        
 10     risp = ' '
        lett = ' '  
        call sttdis(' ',0,istt)
        call sttdis(' ',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('  *** Current instruction set: ***',0,istt)
        call sttdis(' ',0,istt)
        if (NMINCM.gt.0) then
           do i=1,NMINCM
              call sttdis(MINCOM(i),0,istt)
           end do
        end if
        call sttdis(' ',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('*********** FIT Options ************',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('(S)tandard procedure (MINIMIZE+HESSIAN ERRORS)'
     +       ,0,istt)
        call sttdis(' ',0,istt)
        call sttdis('(C)urrent instruction set',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('(I)nput commands',0,istt)
        call sttdis(' ',0,istt)
        call sttdis('(Q)uit (back to Fitlyman Menu)',0,istt)
        call sttdis(' ',0,istt)
        istt=-2
        call AskC(' ',lett,istt)
        
c     read(5,'(a)')lett
        risp=lett
        
        if (risp.eq.'c'.or.risp.eq.'C') then
           ierr=0
           return
        end if
        
        if (risp.ne.'i'.and.risp.ne.'I'.and.risp.ne.'s'.and.risp.ne.'S'
     +       .and. risp .ne.'Q' .and. risp.ne.'q') goto 10
        
        if (risp.eq.'q'.or.risp.eq.'Q') then 
           ierr = -1
           return
        end if
        do i=1,NMXLIN
           MINCOM(i)=' '
        end do
        
C!!!!!!!
C     Comandi per la procedura standard
C!!!!!!!
        if (risp.eq.'s'.or.risp.eq.'S') then
           NMINCM=4
           MINCOM(1)='SET ERRORDEF 1.'
           MINCOM(2)='MINIMIZE'
           MINCOM(3)='HESSE'
           MINCOM(4)='RETURN'
           ierr=0
          return
       end if        
       
C!!!!!!!
C     Procedura a scelta
C!!!!!!!
       if (risp.eq.'i'.or.risp.eq.'I') then
 
          NumCom=0
 20       call sttdis(' ',0,istt)
          call sttdis(' ',0,istt)
          call sttdis(' ',0,istt)
          if (NumCom.gt.0) then
             call sttdis('  ***Current instruction set: ***',0,istt)
             do i=1,NumCom
                call sttdis(MINCOM(i),0,istt)
             end do
          end if

          call sttdis(' ',0,istt)
          Mes ='************'
           write(strout,'(18x,A16,3x,A14,3x,A12)')Mes,
     1          'MINUIT  COMMANDS',Mes
           call sttdis(strout,0,istt)
           call sttdis(' ',0,istt)
           call sttdis(' ',0,istt)
           do j=1,5
              write(strout,'(4A20)')Menu1(j),Menu2(j),Menu3(j),Menu4(j)
              call sttdis(strout,0,istt)
           end do
          call sttdis(' ',0,istt)

          istt=-2
          call AskC('--- ? ---',stt_ap,istt)
          read(stt_ap,'(a1)')lett
          risp=lett
          
                                !MINIMIZE
          if (risp.eq.'m'.or.risp.eq.'M') then
             NumCom=NumCom+1
             MINCOM(NumCom)='MINIMIZE'
             goto 20
          end if
          
                                !IMPROVE  
          if (risp.eq.'i'.or.risp.eq.'I') then
             NumCom=NumCom+1
             MINCOM(NumCom)='IMPROVE'
             goto 20
          end if
          
                                 !SEEK     
          if (risp.eq.'k'.or.risp.eq.'K') then
             NumCom=NumCom+1
             MINCOM(NumCom)='SEEK'
             goto 20
          end if
          
                                !FIX
          if (risp.eq.'f'.or.risp.eq.'F') then
             call ShPar1('NORMAL')
             call AskI('  --> Parameter to fix:', NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),301)NParF
             goto 20
          end if
 301      format('FIX',3x,i2)

                                !RELEASE
          if (risp.eq.'r'.or.risp.eq.'R') then
             call AskI('  --> Parameter to release:', NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),302)NParF
             goto 20
          end if
 302      format('RELEASE',3x,i2)

                               !HESSE
          if (risp.eq.'h'.or.risp.eq.'H') then
             NumCom=NumCom+1
             MINCOM(NumCom)='HESSE'
             goto 20
          end if
          
                                !MINOS  
          if (risp.eq.'n'.or.risp.eq.'N') then
             NumCom=NumCom+1
             MINCOM(NumCom)='MINOS'
             goto 20
          end if


                                !SCAN   
          if (risp.eq.'s'.or.risp.eq.'S') then
             call AskI('  --> Parameter to scan:', NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),101)NParF
             goto 20
          end if
 101      format('SCAN',5x,i2)


                                !CONTOUR
          if (risp.eq.'c'.or.risp.eq.'C') then
             call AskI('  --> Parameter on x axis:',NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             call AskI('  --> Parameter on y axis:',NParF2,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),102)NParF,NParF2
             goto 20
          end if
 102      format('CONTOUR',5x,i3,1x,i3)

                                !SET ERROR
          if (risp.eq.'o'.or.risp.eq.'O') then
             call AskR('  --> Error level:',up,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),201)up
             goto 20
          end if
 201      format('SET ERRORDEF',5x,f6.2)

                                !SET PRINT
          if (risp.eq.'t'.or.risp.eq.'T') then
             call AskI('  --> Number of columns:',NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),202)NParF
             goto 20
          end if
 202      format('SET PRINT',5x,i3)

                                !SET RANDOM
          if (risp.eq.'d'.or.risp.eq.'D') then
             call AskI('  --> Random seed:',NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),204)NParF
             goto 20
          end if
 204      format('SET RANDOM',5x,i8)

                                !SET STRATEGY
          if (risp.eq.'g'.or.risp.eq.'G') then
             call AskI('  --> Strategy level',NParF,istt)
             if (istt .eq. -1) goto 20 ! redo
             NumCom=NumCom+1
             write(MINCOM(NumCom),205)NParF
             goto 20
          end if
 205      format('SET STRATEGY',5x,i2)
          
          if (risp.eq.'e'.or.risp.eq.'E') then
                                !END
             call sttdis('END',0,istt)
             NumCom=NumCom+1
             MINCOM(NumCom)='RETURN'
             NMINCM=NumCom
             ierr=0
             return
          end if
          
                                !QUIT
          if (risp.eq.'q'.or.risp.eq.'Q') then 
             ierr = -1
             return
          end if
          
          goto 20
       end if
       
       return
       end
      
      
      
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskI(Commnt,Valore,ier)
C
C        Routine di I/O per leggere una variabile da tastiera.
C        Presenta all'utente una descrizione della variabile (Commnt)
C        e un valore di default (Valore).
C        Se l'utente risponde REDO  ier=-1
C        Se l'utente risponde GO  ier=-99
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Commnt
        character*20 a
        character t(1),a1
        character*300 stt_ap
        integer Valore,ier
        integer myslen

        ier=0
10        write(stt_ap,'(1x,a,a,I13,a)')Commnt(1:myslen(Commnt)),' [',
     >       Valore,' ]'
        t(1)=' '
        call sttdis(stt_ap(1:myslen(stt_ap)),0,ist)
        call stkwrc('INPUTC',1,t,1,20,i,i) 
        call stkprc(' ','INPUTC',1,1,20,iletti,a,ikun,ik,is)

        if (a(1:4).eq.'redo'.or.a(1:4).eq.'REDO') then
                ier=-1
                return
        end if

        if (a(1:2).eq.'go'.or.a(1:2).eq.'GO') then
                ier=-99
                return
        end if


        a1=a
         if (a1.ne.' ') read(a,*,err=10)valore

        ier=0


        return
        end



C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskD(Commnt,Valore,ier)
C
C       Routine di I/O per leggere una variabile da tastiera.
C       Presenta all'utente una descrizione della variabile (Commnt
C       e un valore di default (Valore).
C       Se l'utente risponde negativo ier<0
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Commnt
        DOUBLE PRECISION Valore
        character t(1),a1
        character*20 a
        character*300 stt_ap
        integer ier
        integer myslen

        ier=0
10      write(stt_ap,'(1x,a,a,F9.4,a)')Commnt(1:myslen(Commnt)),' ['
     >       ,Valore,' ]'
        t(1)=' '
        call sttdis(stt_ap(1:myslen(stt_ap)),0,ist)
        call stkwrc('INPUTC',1,t,1,20,i,i)                           

        call stkprc(' ','INPUTC',1,1,20,iletti,a,ikun,ik,is)

        if (a(1:4).eq.'redo'.or.a(1:4).eq.'REDO') then
                ier=-1
                return
        end if

        if (a(1:2).eq.'go'.or.a(1:2).eq.'GO') then
                ier=-99
                return
        end if

        if (a(1:1).eq.'c'.or.a(1:1).eq.'C') then
                ier=-98
                return
        end if


        a1=a
        if (a1.ne.' ') read(a,*,err=10)Valore

        return
        end

C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskR(Commnt,Valore,ier)
C  
C       Routine di I/O per leggere una variabile da tastiera.
C        Presenta all'utente una descrizione della variabile (Commnt)
C        e un valore di default (Valore).
C        Se l'utente risponde negativo ier<0
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Commnt
        real Valore
        character*300 stt_ap
        character*20 a
        character t(1),a1
        integer ier
        integer myslen

        ier=0
10        write(stt_ap,'(1x,a,a,F9.4,a)')Commnt(1:myslen(Commnt)),' ['
     >       ,Valore,' ]'
        call sttdis(stt_ap(1:myslen(stt_ap)),0,ifl)        
        t(1)=' ' 
        call stkwrc('INPUTC',1,t,1,1,i,i) 
        call stkprc(' ','INPUTC',1,1,20,iletti,a,ikun,ik,is)

        if (a(1:4).eq.'redo'.or.a(1:4).eq.'REDO') then
                ier=-1
                return
        end if

        if (a(1:2).eq.'go'.or.a(1:2).eq.'GO') then
                ier=-99
                return
        end if

        
        if (a(1:1).eq.'c'.or.a(1:1).eq.'C') then
                ier=-98
                return
        end if

        a1=a
        if (a1.ne.' ') read(a,*,err=10)Valore

        return
        end




C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskYN(Commnt,Valore,ier)
C
C        Routine di I/O per leggere una variabile da tastiera.
C        Presenta all'utente una descrizione della variabile (Commnt)
C        e un valore di default (Valore).
C        if ier in input=0, wait for a reply.
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Commnt
        logical Valore
        character*20 a,val
        integer ier
        character*300 stt_ap
        character t(1),a1
        integer myslen

        val='N'
        if (Valore) val='Y'
10        write(stt_ap,'(1x,a,a,a1,a)')Commnt(1:myslen(Commnt)),' [',
     >       Val,' ]'
        t(1)=' '
        call sttdis(stt_ap(1:myslen(stt_ap)),0,ist)
        call stkwrc('INPUTC',1,t,1,20,i,i) 
        call stkprc(' ','INPUTC',1,1,20,iletti,a,ikun,ik,is)

        if (iletti.eq.0) then
           if (ier.eq.0) goto 10
           ier=0
           return
        end if

        if (a(1:4).eq.'redo'.or.a(1:4).eq.'REDO') then
           ier=-1
           return
        end if


        if (a(1:2).eq.'go'.or.a(1:2).eq.'GO') then
           ier=-99
           return
        end if

        a1=a
        if (a1.ne.'Y'.and.a1.ne.'y'.and.a1.ne.'N'.and.a1.ne.'n')goto 10
        if (a1.eq.'Y'.or.a1.eq.'y') Valore=.true.
        if (a1.eq.'N'.or.a1.eq.'n') Valore=.false.

        ier=0

        return
        end


      
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      SUBROUTINE AskC(Commnt,Valore,ier)
C     
C     Routine di I/O per leggere una variabile da tastiera.
C     Presenta all'utente una descrizione della variabile (Commnt)
C     e un valore di default (Valore).
C     ier = -2 in input: non mostra valore di default
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
      
        IMPLICIT INTEGER (I-K)

        character*(*) Commnt,Valore
        character*20 a
        integer ier
        character*300 stt_ap
        character t(1),a1
        integer myslen

 10     if (ier.eq.-2) then
           write(stt_ap,'(1x,a)')Commnt
        else 
           write(stt_ap,'(1x,a,a2,a,a2)')Commnt(1:myslen(Commnt)),' ['
     >          ,Valore(1:myslen(Valore)),' ]'
        end if
        t(1)=' '
        
        call sttdis(stt_ap(1:myslen(stt_ap)),0,ist)
        call stkwrc('INPUTC',1,t,1,20,i,i) 
        call stkprc(' ','INPUTC',1,1,20,iletti,a,ikun,ik,is)
        
        if (a(1:4).eq.'redo'.or.a(1:4).eq.'REDO') then
           ier=-1
           return
        end if
        
        
        if (a(1:2).eq.'go'.or.a(1:2).eq.'GO') then
           ier=-99
           return
        end if
        
        a1=a
        if (a1.ne.' ') Valore = a
        ier=0
        return
        end

C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskPar(iflag)
C        Ask all'utente una configurazione di righe,
C
Cccc        Nomefile :  char*(*)        Nome del file da aprire
C        iflag:            integer        error flag: if 0 ok, 
C                                if <0 user quitted
C
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
CC        implicit none
        integer iflag

        INCLUDE 'MID_REL_INCL:fit_var.inc'                ! Variabili globali

        character*30 Commnt 
        character*80 stt_ap

        integer iredo,ngroup,i,j,iclin,icpar,ist,itmp
        integer iexist,jold,jj,nj,ij,ik
        integer nli(100),icur
        character kli(100),a
        real xdum,ydum,z,vel

C        include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'


 100    iflag = 0
        iclin = 0
        icpar = 0

        
        if (NROWS.gt.0) then
           ngroup= 0
           do j=1,NROWS
              if (grID(j).gt.ngroup) then
                 ngroup=ngroup+1 
                 kli(ngroup)=Class(j)
                 if (ngroup.ne.1) nli(ngroup-1)=j-jold
                 jold=j
              end if
           end do
           nli(ngroup)=NROWS-jold+1
        end if
   
                 
        continue                        !inizio
        stt_ap='          ******* Line Configuration ******* '
        call sttdis(stt_ap,0,ist)
        call sttdis(' ',0,ist)
        call AskI('--> Number of groups of lines',ngroup,iredo)
        if (iredo.eq.-1) then
           iflag  = -1
           return
        end if
        if (iredo.eq.-99) then
c           iflag  = 0
           call sttdis('GO DISABLED, value unchanged',0,ist)
c           return
        end if
        if(ngroup.eq.0) goto 100

        do i=1,ngroup
           write(stt_ap,'(A5,I3,A9)')'  ###',i,'  group:'
           call sttdis(stt_ap,0,ist)
           call sttdis(' ',0,ist)
           itmp=nli(i)
 101       call AskI('  --> Number of lines: ',itmp,iredo)
           if (iredo.eq.-1)    goto 100
           if (iredo.eq.-99) then
c              iflag  = 0
              call sttdis('GO DISABLED, value unchanged',0,ist)
c              return
           end if
           nli(i)=itmp
           if (nli(i).eq.0) goto 101
           if (nli(i).eq.1) then
              kli(i)='S'
              goto 1000
           end if

 201       call AskC('  --> Kind of group (S,M,z,b,T)',kli(i),iredo)
           if (iredo.eq.-1)     goto 101
           if (iredo.eq.-99) then
              iflag  = 0
              return
           end if
           if (kli(i).eq.'s') kli(i)='S'
           if (kli(i).eq.'m') kli(i)='M'
           if (kli(i).eq.'Z') kli(i)='z'
           if (kli(i).eq.'B') kli(i)='b'
           if (kli(i).eq.'t') kli(i)='T'

 1000           continue
                do j=1,nli(i)
              iclin=iclin+1

 1001         write(stt_ap,'(A7,I3,A8)')'    ###',j,'  line:'
              call sttdis(stt_ap,0,ist)
 1002              Commnt='    --> Element name: (help)'
              Call AskC(Commnt,ElmtNm(iclin),iredo) 
              if (iredo.eq.-1)      goto 100
              if (iredo.eq.-99) then
                 iflag  = 0
                 return
              end if
                                ! help
          if (ElmtNm(iclin).eq.'help'.or.ElmtNm(iclin).eq.'HELP') then
                call sttdis('*** List of elements: **',0,ist)
                nj=nint(AT_N/5.)+1
                do ij=1,nj
                  write(stt_ap,'(1x,5A14)')(AT_NAM(ij+ik*nj),ik=0,4)
                  call sttdis(stt_ap,0,ist)
                end do
          end if
              iexist=0        ! Checks whether it exists.
              do jj=1,AT_N
                 if (ElmtNm(iclin).eq.AT_NAM(jj))  iexist=1
              end do  
              if (iexist.eq.0) goto 1002

 1101         if ((J.EQ.1).or.(j.gt.1.and.kli(i).eq.'S')) then
                 Commnt='    --> Central wavelength: '
                 Call AskD(Commnt,LamIni(iclin),iredo)
                 if (iredo.eq.-1)   goto 100
                 if (iredo.eq.-99) then
                    iflag  = 0
                    return
                 end if
                 if (I_GRAP.and.iredo.eq.-98) then ! legge cursore
                    call GetXCr(xdum,ydum,z,vel,icur)
                    LamIni(iclin)=xdum
                 end if
                 if (.not.I_GRAP.and.iredo.eq.-98) then ! legge cursore
                    call ErrMsg('Graphics not enabled')
                    goto 1101         
                 end if
                 icpar = icpar+1
                 write(CPar(1,iclin),'(i4)')icpar
              else
                 call CnvrtP(CPar(1,iclin-1),itmp,a,ist)
                 write(CPar(1,iclin),'(i2,A2)')itmp,'.z'
              end if
               
 1201         if ((J.EQ.1).or.(j.gt.1.and.kli(i).ne.'M')) then
                 Commnt='    --> Column density: '
                 Call AskD(Commnt,NIni(iclin),iredo)
                 if (iredo.eq.-1)    goto 100
                 if (iredo.eq.-99) then
                    iflag  = 0
                    return
                 end if
                 icpar = icpar+1
                 write(CPar(2,iclin),'(i4)')icpar
              else
                 call CnvrtP(CPar(2,iclin-1),itmp,a,ist)
                 write(CPar(2,iclin),'(i4)')itmp
              end if
          
 1301         if ((J.EQ.1).or.(j.gt.1.and.
     1             (kli(i).eq.'S'.or.kli(i).eq.'z'))) then
                 Commnt='    --> Doppler parameter: '
                 Call AskD(Commnt,BIni(iclin),iredo)
                 if (iredo.eq.-1)     goto 100
                 if (iredo.eq.-99) then
                    iflag  = 0
                    return
                 end if
                 icpar = icpar+1
                 write(CPar(3,iclin),'(i4)')icpar
                 
 1401            if (TURBLN.eq.1) then
                    Commnt='    --> Turbolence parameter: '
                    Call AskD(Commnt,BtuIni(iclin),iredo)
                    if (iredo.eq.-1)   goto 100
                    if (iredo.eq.-99) then
                       iflag  = 0
                       return
                    end if
                    icpar = icpar+1
                    write(CPar(4,iclin),'(i4)')icpar
                 end if
              else

                 call CnvrtP(CPar(3,iclin-1),itmp,a,ist)
                 if (kli(i).eq.'T') then
                    write(CPar(3,iclin),'(i2,A2)')itmp,'.T'
                 else
                    write(CPar(3,iclin),'(i4)')itmp
                 end if

                 if (TURBLN.eq.1) then
                    call CnvrtP(CPar(4,iclin-1),itmp,a,ist)
                    write(CPar(4,iclin),'(i4)')itmp
                 end if

              end if


           end do


        end do
        
        NROWS = iclin

        if (TURBLN.eq.0) then
           icpar = icpar+1
           do j=1,iclin
              write(CPar(4,j),'(i2,a2)')icpar,'.F'
              BTuIni(iclin) = 0.
           end do
        end if

        itmp=0
        do i=1,ngroup
           do j=1,nli(i)
              itmp=itmp+1
              Class(itmp)=kli(i)
              grId(itmp)=i
           end do
        end do

        return
        end




C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE AskFIn(iflag)
C        Ask all'utente una serie di intervalli fit
C
Cccc        Nomefile :  char*(*)        Nome del file da aprire
C        iflag:            integer        error flag: if 0 ok, 
C                                if <0 user quitted
C
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

CC        implicit none

        integer iflag

        INCLUDE 'MID_REL_INCL:fit_var.inc'                ! Variabili globali

        character*50 Commnt
        character*70 stt_ap

        integer iredo,i,istt,icurer
        real estrem,ydum,z,vel

C        include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'

        
C&&&&&&&
C     &        Chiede limiti su cui effettuare il fit
C&&&&&&&
 1000   continue                ! fine input parametri innesco
        
        call sttdis(' ',0,istt)
        call sttdis('             ******* Fit Intervals ******* ',
     1       0,istt)
        call sttdis(' ',0,istt)
        Commnt='### Number of intervals:'
        if (NINTFT .eq. 0) NINTFT = 1
        call AskI(Commnt,NINTFT,iredo)
        if (iredo.eq.-1) return
        if (iredo.eq.-99) goto 1100 ! salta altri input
        
        
        do i  = 1,NINTFT
           write(stt_ap,'(a,i2,a)')'  Input limits of ',i,' ^ interval'
           Commnt='    Minimum wavelength'
           call sttdis(stt_ap,0,istt)
           call AskD(Commnt,FITMIN(i),iredo)
           if (iredo.eq.-1) goto 1000
           if (iredo.eq.-99) goto 1100 ! salta altri input
           
           if (iredo.eq.-98) then ! legge cursore
              if (I_GRAP) then  
                 estrem =   FITMIN(i) 
                 call GetXCr(estrem,ydum,z,vel,icurer)
                 FITMIN(i) = estrem
                 Commnt='    Maximum wavelength'
                 write(stt_ap,'(1x,a,a,F9.4,a)')Commnt,' [',
     1                FITMAX(i),' ]'
                 call sttdis(stt_ap,0,istt)
                 estrem=FITMAX(i)
                 call GetXCr(estrem,ydum,z,vel,icurer)
                 FITMAX(i) = estrem
                 goto 510
              else
                 call ErrMsg('Graphic not enabled')
                 goto 1000
              end if
           end if 
           
           Commnt='    Maximum wavelength'
           call AskD(Commnt,FITMAX(i),iredo)
           if (iredo.eq.-1) goto 1000
           if (iredo.eq.-99) goto 1100 ! salta altri input
           
           if (iredo.eq.-98) then ! legge cursore
              if (I_GRAP) then  
                 call GetXCr(estrem,ydum,z,vel,icurer)                 
                 FITMAX(i) = estrem
              else
                 call Errmsg('Graphic not enabled')
                 goto 1000
              end if  
           end if
           
 510       continue
        end do        
        
 1100   call piksr2(NINTFT,FITMIN,FITMAX) ! sorting!!!
        
        iflag=0
        close (10)
        
        return
        end
      



C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE MMenu(Scelta)
C
C        Presenta il menu principale e ritorna una stringa
C        con l'opzione scelta TUTTA IN MAIUSCOLO
C        indipendentemente da come viene scritta.
C        Per fornire una risposta valida bisogna inviare
C        il carattere scritto in maiuscolo nel menu
C
C        Scelta        char*(*) out        Risposta valida
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        
        character*(*) Scelta
C        implicit none

        INCLUDE 'MID_REL_INCL:fit_var.inc'                ! Variabili globali
        
        character*1  Risp1
c        character*20 Risposta
        character*70 Mes
        CHARACTER*80 STROUT
        integer istt,j
        character*20 FilMen(10),DefMen(10),ManMen(10),GraMen(10)

C        include 'MID_REL_INCL:fit_mid.inc'
        INTEGER MADRID(1)
        INCLUDE 'MID_INCLUDE:ST_DEF.INC'

        COMMON/VMR/MADRID

        INCLUDE 'MID_INCLUDE:ST_DAT.INC'


C&&&&&&&
C     &        Presentazione menu
C&&&&&&&
        FilMen(1)='FILE'
        FilMen(2)=' '
        FilMen(3)='sa(V)e session '
        FilMen(4)='(R)ecover session'
        FilMen(5)='se(T)up'
        FilMen(6)='(E)ND'
        FilMen(7)=' '

        DefMen(1)='PARAMETERS'
        DefMen(2)=' '
        DefMen(3)='(N)ew'
        DefMen(4)='(I)terate'
        DefMen(5)='load from lo(G)'
        DefMen(6)=' '
        DefMen(7)=' '

        ManMen(1)='OPERATIONS'
        ManMen(3)='(S)TANDARD MINIM.'
        ManMen(4)='edit (P)aram'
        ManMen(5)='edit (L)imits'
        ManMen(6)='edit (M)inuit'
        ManMen(7)='(D)irect minimize'
        ManMen(2)=' '

        GraMen(1)='GRAPHICS'
        GraMen(2)=' '
        GraMen(3)='define (W)indow'
        GraMen(4)='plot (B)ackwards'
        GraMen(5)='plot (F)orward'
        GraMen(6)='(C)ursor'
        GraMen(7)=' '
        
 100    continue
                          !  Clear page?

           call sttdis(' ',0,istt)
           call sttdis(' ',0,istt)
           write(Mes,'(A14,F8.2,A4,F8.2,a2,i6,a8)')'Spectrum from ' 
     1          ,XLAMBD(1),' to ',XLAMBD(NPUNTI), ' (',NPUNTI,
     2          ' points)'
           call DisMsg(Mes)
           call sttdis(' ',0,istt)
           
           Mes ='************'
           write(strout,'(18x,A12,3x,A14,3x,A12)')Mes,'FITLYMAN  MENU',
     1          Mes
           call sttdis(strout,0,istt)
           call sttdis(' ',0,istt)
           call sttdis(' ',0,istt)
           do j=1,7
              write(strout,'(4A20)')FilMen(j),DefMen(j),ManMen(j),
     1             GraMen(j)
              call sttdis(strout,0,istt)
           end do

           Risp1=' '
           istt=-2
           call AskC(' ',Risp1,istt)
c           Risp1=Risposta
           if (Risp1.eq.'W'.or.Risp1.eq.'w') then
              Scelta='DEFINEWINDOW'
              return
           end if
           if (Risp1.eq.'b'.or.Risp1.eq.'B') then
              Scelta='GOBACK'
              return
           end if
           if (Risp1.eq.'f'.or.Risp1.eq.'F') then
              Scelta='GOFORW'
              return
           end if
           if (Risp1.eq.'c'.or.Risp1.eq.'C') then
              Scelta='CURSOR'
              return
           end if
           if (Risp1.eq.'n'.or.Risp1.eq.'N') then
              Scelta='NEWLINE'
              return
           end if
           if (Risp1.eq.'i'.or.Risp1.eq.'I') then
              Scelta='ITERATE'
              return
           end if
           if (Risp1.eq.'g'.or.Risp1.eq.'G') then
              Scelta='HISTORY'
              return
           end if
           if (Risp1.eq.'V'.or.Risp1.eq.'v') then
              Scelta='SAVESESSION'
              return
           end if
           if (Risp1.eq.'r'.or.Risp1.eq.'R') then
              Scelta='RECOVER'
              return
           end if
           if (Risp1.eq.'T'.or.Risp1.eq.'t') then
              Scelta='SET-UP'
              return
           end if
           if (Risp1.eq.'e'.or.Risp1.eq.'E') then
              Scelta='END'
              return
           end if
           if (Risp1.eq.'s'.or.Risp1.eq.'S') then
              Scelta='STANDARD'
              return
           end if
           if (Risp1.eq.'p'.or.Risp1.eq.'P') then
              Scelta='EDITPARAM'
              return
           end if
           if (Risp1.eq.'l'.or.Risp1.eq.'L') then
              Scelta='EDITLIM'
              return
           end if
           if (Risp1.eq.'M'.or.Risp1.eq.'m') then
              Scelta='EDITMINUIT'
              return
           end if
           if (Risp1.eq.'d'.or.Risp1.eq.'D') then
              Scelta='DIRECTMINI'
              return
           end if
        goto 100
        
        end
      


C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE ERRMSG(Messaggio)
C
C        Stampa un messaggio d'errore
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Messaggio
        character*80 a

        call bell(1)
        write(a,'(20x,a34)')'************ ERROR ***************'
        call sttdis(a,0,istt)
        call sttdis(' ',0,istt)
        call sttdis(Messaggio,0,istt)
        call sttdis(' ',0,istt)
        write(a,'(20x,a34)')'**********************************'
        call sttdis(a,0,istt)
        call stkprc('   Press <Return> to continue *****','INPUTC',
     1       1,1,20,iletti,a,ikun,ik,is)              
 
        return
        end        

C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE WRNMSG(Messaggio)
C
C        Stampa un messaggio d'errore
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Messaggio
        character*80 a

c        call bell(1)
        write(a,'(20x,a34)')'************ WARNING ***************'
        call sttdis(a,0,istt)
        call sttdis(Messaggio,0,istt)
        call sttdis(' ',0,istt)
 
        return
        end        
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE DISMSG(Messaggio)
C
C        Stampa un messaggio generico
C
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        IMPLICIT INTEGER (I-K)

        character*(*) Messaggio
        character*79 MesDis
        character*73 Mes2

        Mes2 = Messaggio
        write(MesDis,'(A6,A)')' --->  ',Mes2
        call sttdis(MesDis,0,istt)

        return
        end        
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        SUBROUTINE bell(n)
C
C        manda n ring
C        
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

        INTEGER I,N,IER

        character b(1)
        b(1) = char(7)
                
        do i=1,n
                call sttdis(b,0,ier)
c                write(6,*)b
        end do
        return
        end



      function myslen(car1)
      
      character*(*) car1
      integer myslen

      integer i,clen


      clen = len(car1)
      do i = clen,1,-1
         if (car1(i:i).ne.' ') goto 99
      enddo

 99   continue
      myslen=i

      return
      end