      SUBROUTINE MRQMIN(NDATA,A,LISTA,MFIT,COVAR,ALPHA,
     1                  NCA,ALAMDA,LOOPFACT,INIT)
C----------------------------------------------------------------------
C THIS IS TAKEN DIRECTLY FROM NUMERICAL RECIPES, P. 527,
C WITH SLIGHT MODIFICATIONS.
C ALAMDA < 0 IN NUM.REC. CORRESPONDS TO INIT = -1 HERE.
C ALAMDA = 0 IN NUM.REC. CORRESPONDS TO INIT =  1 HERE.
C ALAMDA > 0 IN NUM.REC. CORRESPONDS TO INIT =  0 HERE.
C----------------------------------------------------------------------

      IMPLICIT UNDEFINED (A-Z)
      INCLUDE 'PARAMETR.INC'
      INCLUDE 'ELLIPSE.INC'

      INTEGER*4 LISTA(7), MFIT, NCA, NDATA, INIT, J, K, KK, IHIT

      REAL*8    LOOPFACT, OCHISQ, ALAMDA
      REAL*8    A(7),ATRY(7),DA(7), DAA(7,1)
      REAL*8    DYDA(7,2)
      REAL*8    COVAR(7,7), ALPHA(7,7), BETA(7), UNCERT(7)


D     WRITE(PR,'(A,I2)') ' ENTERING MRQMIN; INIT = ',INIT
D     WRITE(PR,'(1X,A,7(G15.10))') 
D    1         'MRQMIN STARTS: A=',A(1),A(2),A(3),A(4),A(5)/RPDEG,
D    2          A(6)/RPDEG,A(7)/RPDEG

      IF (INIT.EQ.-1) THEN
D         WRITE(PR,'(A,G11.4)') ' MRQMIN:  INITIALIZING; CHISQ = ',CHISQ
          KK=MFIT+1
          DO J=1,MA
              IHIT=0
              DO K=1,MFIT
                  IF(LISTA(K).EQ.J)IHIT=IHIT+1
              END DO
              IF (IHIT.EQ.0) THEN
                  LISTA(KK)=J
                  KK=KK+1
              ELSE IF (IHIT.GT.1) THEN
                  PAUSE 'Improper permutation in LISTA'
              ENDIF
          END DO  
          IF (KK.NE.(MA+1)) PAUSE 'Improper permutation in LISTA'
          INIT=0

D         WRITE(PR,'(1X,A,F8.4,A,F10.3)')
D    1    'MRQMIN: 1ST CALL TO MRQCOF:  ALAMDA=',ALAMDA,'; CHISQ=',CHISQ
D         WRITE(OUTC,'(1X,F14.10,2X,F13.10,2X,F15.10,2X,F18.10,2X,
D    1       F15.10,2X,F15.10,2X,F15.10)') A(1),A(2),A(3),A(4),
D    2       A(5)/RPDEG,A(6)/RPDEG,A(7)/RPDEG

          CALL MRQCOF(NDATA,A,LISTA,MFIT,ALPHA,BETA,NCA)
D         WRITE(PR,*) 'MRQMIN:  BACK FROM 1ST CALL TO MRQCOF'
D         WRITE(PR,'(A,G15.0,1X,G15.10)') 
D    1          ' MRQMIN:  CHISQ, OCHISQ = ',CHISQ,OCHISQ
          OCHISQ=CHISQ
D         WRITE(PR,'(A,G15.10,1X,G15.10)') 
D    1          ' MRQMIN:  CHISQ, OCHISQ = ',CHISQ,OCHISQ
          DO J=1,MA
              ATRY(J)=A(J)
          END DO  
D         WRITE(PR,*) 'MRQMIN:  END OF INITIALIZATION'
D     ELSE
D         WRITE(PR,*) 'MRQMIN:  NO INITIALIZATION'
      ENDIF
      DO J=1,MFIT
          DO K=1,MFIT
              COVAR(J,K)=ALPHA(J,K)
          END DO  
          COVAR(J,J)=ALPHA(J,J)*(1.+ALAMDA)
          DA(J)=BETA(J)
      END DO  
      DO J=1,7
          DAA(J,1)=DA(J)        !BECAUSE GAUSSJ WANTS A 2-DIM ARRAY HERE
      END DO

D     WRITE(PR,*) 'MRQMIN:  CURVATURE MATRIX'
D     DO J=1,MFIT
D         WRITE(PR,'(7(2X,G10.3))') (ALPHA(J,K), K=1,MFIT)
D     END DO
D     WRITE(PR,*) 'MRQMIN:  -0.5*GRAD(CHI^2)'
D     WRITE(PR,'(7(2X,G15.10))') (BETA(J), J=1,MFIT)

      CALL GAUSSJ(COVAR,MFIT,NCA,DAA,1,1)
      DO J=1,7
          DA(J)=DAA(J,1)
      END DO
      IF(INIT.EQ.1)THEN
D         WRITE(PR,*) 'MRQMIN:  GOING TO COVSRT'
          CALL COVSRT(COVAR,NCA,LISTA,MFIT)
D         WRITE(PR,*) 'MRQMIN:  BACK FROM COVSRT; FINISHED' 
          RETURN
      ENDIF

D     WRITE(PR,*) 'MRQMIN:  PARAMETERS, INCREMENTS AFTER GAUSSJ'
D     DO J=1,MFIT
D         IF(LISTA(J).EQ.1) THEN
D             WRITE(PR,'(A,F9.4,1X,F14.10)') 
D    1             ' MRQMIN:  A, DA:     ',A(LISTA(J)), DA(J)
D         ELSE IF(LISTA(J).EQ.2) THEN
D             WRITE(PR,'(A,F7.5,1X,F13.10)') 
D    1             ' MRQMIN:  E, DE:     ',A(LISTA(J)), DA(J)
D         ELSE IF(LISTA(J).EQ.3) THEN
D             WRITE(PR,'(A,F10.5,1X,F15.10)') 
D    1             ' MRQMIN:  P, DP:     ',A(LISTA(J)), DA(J)
D         ELSE IF(LISTA(J).EQ.4) THEN
D             WRITE(PR,'(A,F12.4,1X,F18.10)') 
D    1             ' MRQMIN:  T, DT:     ',A(LISTA(J)), DA(J)
D         ELSE IF(LISTA(J).EQ.5) THEN
D             WRITE(PR,'(A,F9.4,1X,F15.10)') 
D    1             ' MRQMIN:  I, DI:     ',A(LISTA(J))/RPDEG, 
D    2             DA(J)/RPDEG
D         ELSE IF(LISTA(J).EQ.6) THEN
D             WRITE(PR,'(A,F9.4,1X,F15.10)') 
D    1             ' MRQMIN:  ASC, DASC: ',A(LISTA(J))/RPDEG, 
D    2             DA(J)/RPDEG
D         ELSE IF(LISTA(J).EQ.7) THEN
D             WRITE(PR,'(A,F9.4,1X,F15.10)') 
D    1             ' MRQMIN:  ARG, DARG: ',A(LISTA(J))/RPDEG, 
D    2             DA(J)/RPDEG
D         END IF
D     END DO

      DO J=1,MFIT
          ATRY(LISTA(J))=A(LISTA(J))+DA(J)
      END DO  


D     WRITE(PR,*) 'MRQMIN:  GOING TO MRQCOF WITH NEW PARAMETERS'
      CALL MRQCOF(NDATA,ATRY,LISTA,MFIT,COVAR,DA,NCA)
D     WRITE(PR,'(A,F15.10,2X,F15.10)') 
D    1     ' MRQMIN:  BACK FROM MRQCOF; CHISQ, OCHISQ = ',CHISQ,OCHISQ
      IF(CHISQ.LT.OCHISQ)THEN
D         WRITE(PR,*) 'MRQMIN:  PARAMETERS FOR IMPROVED SOLUTION:'
          ALAMDA=LOOPFACT*ALAMDA
          OCHISQ=CHISQ
          DO J=1,MFIT
              DO K=1,MFIT
                  ALPHA(J,K)=COVAR(J,K)
              END DO  
              BETA(J)=DA(J)
              A(LISTA(J))=ATRY(LISTA(J))
D             IF(LISTA(J).EQ.1) THEN
D                 WRITE(PR,'(A,F14.10)') 
D    1                 ' MRQMIN:  A:   ',A(LISTA(J))
D             ELSE IF(LISTA(J).EQ.2) THEN
D                 WRITE(PR,'(A,F13.10)') 
D    1                 ' MRQMIN:  E:   ',A(LISTA(J))
D             ELSE IF(LISTA(J).EQ.3) THEN
D                 WRITE(PR,'(A,F15.10)') 
D    1                 ' MRQMIN:  P:   ',A(LISTA(J))
D             ELSE IF(LISTA(J).EQ.4) THEN
D                 WRITE(PR,'(A,F18.10)') 
D    1                 ' MRQMIN:  T:   ',A(LISTA(J))
D             ELSE IF(LISTA(J).EQ.5) THEN
D                 WRITE(PR,'(A,F15.10)') 
D    1                 ' MRQMIN:  I:   ',A(LISTA(J))/RPDEG 
D             ELSE IF(LISTA(J).EQ.6) THEN
D                 WRITE(PR,'(A,F15.10)') 
D    1                 ' MRQMIN:  ASC: ',A(LISTA(J))/RPDEG
D             ELSE IF(LISTA(J).EQ.7) THEN
D                 WRITE(PR,'(A,F15.10)') 
D    1                 ' MRQMIN:  ARG: ',A(LISTA(J))/RPDEG
D             END IF
          END DO
D         WRITE(PR,*) ' MRQMIN:  NEW BETA:'
D         WRITE(PR,'(7(2X,G15.10))') (BETA(J),J=1,MFIT)
      ELSE
          ALAMDA=10.*ALAMDA/LOOPFACT
          CHISQ=OCHISQ
      ENDIF
D     WRITE(PR,'(A / A,3(G15.10,1X))') 
D    1    ' MRQMIN:  RETURNING TO ORBFIT; ',
D    2    'MRQMIN:  CHISQ, OCHISQ, ALAMDA = ',CHISQ,OCHISQ,ALAMDA
      RETURN
      END

