SUBROUTINE lvmfit(ftstat, qercal, ntrial, crtdel, qask, qansw, 
     &                  statnm, nbins, ier)

      DOUBLE PRECISION crtdel
      REAL ftstat
      INTEGER ntrial, nbins, ier
      CHARACTER statnm*11
      LOGICAL qercal, qask, qansw

c	lvmfit	rashafer	29 Oct 1983
c		XSPEC subroutine that initiates the call to the
c		Marquadt process minimization routine lvmrun

c       ftstat  R               r: fit statistic
c	qercal	L4		i: indicates that this is called by the
c				error calculation routine, therefore the
c				chattyness is reduced and NO sigmas are
c				calculated.
c       ntrial  i               i: number of trials before prompting
c       crtdel  d               i: critical delta fit statistic
c       qask    l               i: if true prompt user
c       qansw   l               i: if !qask specify whether to continue (T)
c       statnm  c*11            i: name of statistic in use
c       nbins   i4              i: total number of PHA bins - required to test
c                                  for an overdetermined fit
c	ier	i4		r: CRFITX error flag - Plus if the answer
c				to the Continue Fitting question is EOF
c				IER = -1

      INCLUDE '../../inc/xspec.inc'

c Dynamically allocated arrays

      INTEGER iparval, iparnum, iparind, itparval, itparnum, isavpar
      INTEGER iqzrnmp, iqpgpar, ialpha, iarray, ivmat, ibeta, iwvec
      INTEGER iainv

c Local variables

      INTEGER nvpar, ivpar, ifpar, istat, intch, logch

c External functions

      DOUBLE PRECISION fgpval
      INTEGER fgnvpr, fgnfpr
      LOGICAL fgqfrz
      EXTERNAL fgpval, fgnvpr, fgnfpr, fgqfrz

c The number of parameters that will be fit

      nvpar = fgnvpr()

c Grab the memory for the temporary arrays

      CALL udmget(nvpar*6, 7, iparval, istat)
      CALL udmget(nvpar*6, 7, itparval, istat)
      CALL udmget(nvpar, 4, iparnum, istat)
      CALL udmget(nvpar, 4, itparnum, istat)
      CALL udmget(nvpar, 4, iparind, istat)
      CALL udmget(nvpar, 1, iqzrnmp, istat)
      CALL udmget(nvpar, 1, iqpgpar, istat)
      CALL udmget(nvpar**2, 7, ialpha, istat)
      CALL udmget(nvpar**2, 7, iarray, istat)
      CALL udmget(nvpar**2, 7, ivmat, istat)
      CALL udmget(nvpar, 7, ibeta, istat)
      CALL udmget(nvpar, 7, iwvec, istat)
      CALL udmget(nvpar, 7, isavpar, istat)
      CALL udmget(nvpar**2, 7, iainv, istat)


c Set up the parameter arrays for input to LVMRUN. Note that we load the
c adjusted parameter value

      ivpar = 0
      DO ifpar = 1, fgnfpr()
         IF ( .NOT.fgqfrz(ifpar) ) THEN
            ivpar = ivpar + 1
            MEMI(iparnum+ivpar-1) = ifpar
            MEMD(iparval+(ivpar-1)*6) = fgpval(ifpar, 'a')
            MEMD(iparval+(ivpar-1)*6+1) = fgpval(ifpar, 'l')
            MEMD(iparval+(ivpar-1)*6+2) = fgpval(ifpar, 'b')
            MEMD(iparval+(ivpar-1)*6+3) = fgpval(ifpar, 't')
            MEMD(iparval+(ivpar-1)*6+4) = fgpval(ifpar, 'h')
            MEMD(iparval+(ivpar-1)*6+5) = fgpval(ifpar, 's')
         ENDIF
      ENDDO

c Set the parind array which indicates which parameters depend on which
c normalizations and is used to decide when to temporarily freeze a parameter
c due to a zero norm condition.

      CALL setznm(nvpar, MEMI(iparnum), MEMI(iparind))

c Now run the L-M fit

      CALL lvmrun(nvpar, MEMD(iparval), MEMI(iparnum), MEMI(iparind), 
     &            ftstat, qercal, ntrial, crtdel, qask, qansw, statnm, 
     &            nbins, MEMD(itparval), MEMI(itparnum), MEML(iqzrnmp),
     &            MEML(iqpgpar), MEMD(ialpha), MEMD(iarray), 
     &            MEMD(ivmat), MEMD(ibeta), MEMD(iwvec), MEMD(isavpar),
     &            MEMD(iainv), ier)

c Set the new parameter values and sigmas

      DO ivpar = 1, nvpar
         ifpar = MEMI(iparnum+ivpar-1)
         CALL fppval(ifpar, MEMD(iparval+(ivpar-1)*6), 'a', istat)
         CALL fppval(ifpar, MEMD(iparval+(ivpar-1)*6+5), 's', istat)
      ENDDO

c Save the eigenvalues and eigenvectors

      CALL fpeftp(nvpar, MEMI(iparnum))
      CALL fpevec(nvpar, MEMD(ivmat))
      CALL fpeval(nvpar, MEMD(iwvec))

c  Now write out the FIT history package (not done for other types (non-`fit')
c  of calls to LVMFIT)

      IF (.NOT.qercal) CALL wfthis(ier, ftstat)

c Free the memory for the temporary arrays

      CALL udmfre(iparval, 7, istat)
      CALL udmfre(itparval, 7, istat)
      CALL udmfre(iparnum, 4, istat)
      CALL udmfre(itparnum, 4, istat)
      CALL udmfre(iparind, 4, istat)
      CALL udmfre(iqzrnmp, 1, istat)
      CALL udmfre(iqpgpar, 1, istat)
      CALL udmfre(ialpha,  7, istat)
      CALL udmfre(iarray,  7, istat)
      CALL udmfre(ivmat, 7, istat)
      CALL udmfre(ibeta, 7, istat)
      CALL udmfre(iwvec, 7, istat)
      CALL udmfre(isavpar, 7, istat)
      CALL udmfre(iainv, 7, istat)


      RETURN
      END