SUBROUTINE ZMRQSP(X,Y,SIG,NDATA,XA,A,MA,LISTA,MFIT,
     *          COVAR,ALPHA,NCA,CHISQ,ALAMDA,STATUS)
*
*  Module number: FOS/HRS UTILITY
*
*  Module name: ZMRQSP
*
*  Keyphrase:
*  ----------
*       non-linear least squares spline fit
*  Description:
*  ------------
*       NUMERICAL RECIPE ROUTINE modified to use spline function
*       This routine preforms a non-linear least squares for using
*       the Levenberg-Marquardt method to reduc the value of
*       chi squared.
*
*  FORTRAN name: ZMRQSP.for
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*       none
*
*  Subroutines Called:
*  -------------------
*  Others:
*       ZMRQS1, 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       XA - VECTOR OF NODE X-POSITIONS
C       A - COEF. OF FIT (REAL*8) (NODE Y-POSITIONS)
C       MA - NUMBER OF COEFFICIENTS IN A, NUMBER OF NODES (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       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-----------------------------------------------------------------------
	IMPLICIT NONE
        DOUBLE PRECISION X,Y,SIG,A,COVAR,ALPHA,ATRY,BETA,DA,ALAMDA,
     *          CHISQ,OCHISQ,XA
        INTEGER NDATA,MA,NCA,KK,MFIT,J,K,LISTA,STATUS,IHIT
        DIMENSION X(NDATA),Y(NDATA),SIG(NDATA),XA(MA),A(MA),LISTA(MA),
     *    COVAR(NCA,NCA),ALPHA(NCA,NCA),ATRY(30),BETA(30),DA(30)
        STATUS=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 ZMRQS1(X,Y,SIG,NDATA,XA,A,MA,LISTA,MFIT,ALPHA,BETA,
     *                          NCA,CHISQ,STATUS)
                IF(STATUS.NE.0)GO TO 999
                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,STATUS)
        IF(STATUS.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 ZMRQS1(X,Y,SIG,NDATA,XA,ATRY,MA,LISTA,MFIT,COVAR,DA,
     *               NCA,CHISQ,STATUS)
        IF(STATUS.NE.0)GO TO 999
        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
        STATUS=0
999     RETURN
        END