SUBROUTINE MRQMIN(X,Y,SIG,NDATA,A,MA,LISTA,MFIT,
     *          COVAR,ALPHA,NCA,CHISQ,FUNCS,ALAMDA,ISTAT)
*
*  Module number: FOS/HRS UTILITY
*
*  Module name: mrqmin
*
*  Keyphrase:
*  ----------
*	non-linear least squares fit
*  Description:
*  ------------
*	NUMERICAL RECIPE ROUTINE.
*	This routine preforms a non-linear least squares for using
*	the Levenberg-Marquardt method to reduc the value of
*	chi squared.
*
*  FORTRAN name: mrqmin.for
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  	none
*
*  Subroutines Called:
*  -------------------
*  Others:
*	MRQCOF, GAUSSJ
*
*  History:
*  --------
*  Version      Date        Author          Description
*	1	SEPT 87	  D. Lindler	Conversion of Num. Rec. routine
*-------------------------------------------------------------------------------
C
C INPUT PARAMETERS
C
C	X,Y,SIG - X, Y AND SIGMA VECTORS (REAL*8)
C	NDATA - NUMBER OF POINTS IN X,Y AND SIG (INTEGER)
C	A - COEF. OF FIT (REAL*8)
C	MA - NUMBER OF COEFFICIENTS IN A (INTEGER)
C	LISTA - VECTOR LIST OF COEF. NUMBER TO FIT (INTEGER)
C	MFIT - NUMBER OF COEF. TO FIT (LENGTH OF LISTA) (INTEGER)
C	NCA - DIMENSIONS OF COVAR AND ALPHA
C	FUNCS - FUNCTION TO FIT (SPECIFED BY)
C		SUBROUTINE FUNCS(X,A,YFIT,DYDA,MA)
C			THIS EVALUATES THE FUNCTION YFIT AT SCALAR
C			VALUE X USING THE MA COEF. IN A.  DYDA IS A
C			VECTOR OF PARTIAL DIREVATIVES WITH RESPECT TO
C			EACH COEF.
C 	ALAMDA - REAL*8 SCALAR
C		ON FIRST CALL SET ALAMDA<0 FOR INITIALIZATION
C		SUBSEQUENT CALLS USE ALAMDA RETURNED BY PREVIOUS
C			ITERATION
C		ON LAST CALL SET ALAMBDA TO 0.0 TO COMPUTE COVARIANCE
C			AND CURVATURE MATRIX
C
C OUTPUT PARAMETERS
C
C	A - UPDATED COEFFICIENTS FOR FIT
C	COVAR - COVARIANCE MATRIX (REAL*8)
C	ALPHA - CURVATURE MATRIX (REAL*8)
C	CHISQ - CHI SQUARED OF FIT (REAL*8)
C	ALAMDA - UPDATED VALUE
C-----------------------------------------------------------------------
        DOUBLE PRECISION X,Y,SIG,A,COVAR,ALPHA,ATRY,BETA,DA,ALAMDA,
     *          CHISQ,OCHISQ
        INTEGER NDATA,MA,NCA,KK,MFIT,J,K,LISTA,ISTAT,IHIT,FUNCS
        DIMENSION X(NDATA),Y(NDATA),SIG(NDATA),A(MA),LISTA(MA),
     *    COVAR(NCA,NCA),ALPHA(NCA,NCA),ATRY(100),BETA(100),DA(100)
        ISTAT=0
        IF(ALAMDA.LT.0.)THEN
                KK=MFIT+1
                DO 12 J=1,MA
                        IHIT=0
                        DO 11 K=1,MFIT
                                IF(LISTA(K).EQ.J)IHIT=IHIT+1
11                      CONTINUE
                        IF (IHIT.EQ.0) THEN
                                LISTA(KK)=J
                                KK=KK+1
                        ENDIF
12              CONTINUE
                ALAMDA=0.001
                CALL MRQCOF(X,Y,SIG,NDATA,A,MA,LISTA,MFIT,ALPHA,BETA,
     *                          NCA,CHISQ,FUNCS)
                OCHISQ=CHISQ
                DO 13 J=1,MA
                        ATRY(J)=A(J)
13              CONTINUE
        ENDIF
        DO 15 J=1,MFIT
                DO 14 K=1,MFIT
                        COVAR(J,K)=ALPHA(J,K)
14              CONTINUE
                COVAR(J,J)=ALPHA(J,J)*(1.+ALAMDA)
                DA(J)=BETA(J)
15      CONTINUE
        CALL GAUSSJ(COVAR,MFIT,NCA,DA,1,1,ISTAT)
        IF(ISTAT.GT.0)GO TO 999
        IF(ALAMDA.EQ.0.)THEN
                CALL COVSRT(COVAR,NCA,MA,LISTA,MFIT)
                GO TO 999
        ENDIF
        DO 16 J=1,MFIT
                ATRY(LISTA(J))=A(LISTA(J))+DA(J)
16      CONTINUE
        CALL MRQCOF(X,Y,SIG,NDATA,ATRY,MA,LISTA,MFIT,COVAR,DA,
     *               NCA,CHISQ,FUNCS)
        IF(CHISQ.LT.OCHISQ)THEN
                ALAMDA=0.1*ALAMDA
                OCHISQ=CHISQ
                DO 18 J=1,MFIT
                        DO 17 K=1,MFIT
                                ALPHA(J,K)=COVAR(J,K)
17                      CONTINUE
                        BETA(J)=DA(J)
                        A(LISTA(J))=ATRY(LISTA(J))
18              CONTINUE
        ELSE
                ALAMDA=10.*ALAMDA
                CHISQ=OCHISQ
        ENDIF
999     RETURN
        END