      SUBROUTINE DECOM2(M, N, M1, ETA, TOL, QR, D, N1, IPIVOT, SING,
     * MMPNN)
      INTEGER IPIVOT(N)
      REAL C, D(1), DM, DS, ETA, QR(MMPNN,N), RSJ, TOL, TOL2
      DOUBLE PRECISION SUM
      LOGICAL FINIS, FSUM, SING
      N1 = 0
      SING = .TRUE.
      FSUM = .TRUE.
      MV = 1
      MH = M1
      MS = M
      MP1 = M + 1
      FINIS = .FALSE.
      IF (TOL.GT.0.0) TOL2 = TOL
      DO 10 J=1,N
        D(J) = 0.0
        IPIVOT(J) = J
   10 CONTINUE
C STEP NUMBER NS OF THE DECOMPOSITION.
      DO 350 NS=1,N
        K = M + NS
        IF (NS.EQ.M1+1) GO TO 20
        GO TO 30
   20   IF (M1.EQ.M) GO TO 200
        MV = M1 + 1
        MH = M
        FSUM = .TRUE.
   30   IF (.NOT.FINIS) GO TO 40
        GO TO 150
C PIVOT SEARCH.
   40   DS = 0.0
        NP = NS
        DO 90 J=NS,N
          IF (FSUM) GO TO 50
          GO TO 70
   50     SUM = 0.0
          DO 60 L=MV,MH
            SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,J))
   60     CONTINUE
          D(J) = SUM
   70     IF (DS.LT.D(J)) GO TO 80
          GO TO 90
   80     DS = D(J)
          NP = J
   90   CONTINUE
        IF (FSUM) DM = DS
        IF (DS.LT.ETA*DM) GO TO 100
        FSUM = .FALSE.
        GO TO 110
  100   FSUM = .TRUE.
  110   IF (FSUM) GO TO 40
        IF (NP.NE.NS) GO TO 120
        GO TO 140
C COLUMN INTERCHANGE.
  120   IK = IPIVOT(NP)
        IPIVOT(NP) = IPIVOT(NS)
        IPIVOT(NS) = IK
        D(NP) = D(NS)
        KM1 = K - 1
        DO 130 L=1,KM1
          C = QR(L,NP)
          QR(L,NP) = QR(L,NS)
          QR(L,NS) = C
  130   CONTINUE
C END COLUMN INTERCHANGE.
C END PIVOT SEARCH.
C RETURN HERE IF N1 = 0.  EITHER INPUT MATRIX QR EQUALS ZERO OR
C MATRIX OF CONSTRAINTS EQUALS ZERO.
  140   IF (NS.EQ.1 .AND. DS.EQ.0.0) RETURN
        GO TO 160
  150   MS = K - 1
        MH = K - 1
  160   IF (FINIS) GO TO 170
        C = 0.0
        GO TO 180
  170   C = 1.0
  180   SUM = DBLE(C)
        DO 190 L=MV,MH
          SUM = SUM + DBLE(QR(L,NS))*DBLE(QR(L,NS))
  190   CONTINUE
        D(NS) = SUM
        DS = D(NS)
        IF (TOL.EQ.0.0) TOL2 = (FLOAT(N)*ETA)**2*D(M1+1)
        IF (.NOT.FINIS .AND. NS.GT.M1 .AND. DS.LE.TOL2) GO TO 200
        GO TO 290
  200   FINIS = .TRUE.
        MV = M + 1
        DO 280 NP=NS,N
          IF (1.GT.M1) GO TO 250
          DO 210 L=1,M1
            QR(L,NP) = 0.0
  210     CONTINUE
          DO 240 J=1,M1
            SUM = 0.0
            DO 220 L=1,M
              SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,NP))
  220       CONTINUE
            C = SUM
            C = C/D(J)
            DO 230 L=1,M1
              QR(L,NP) = QR(L,NP) - C*QR(L,J)
  230       CONTINUE
  240     CONTINUE
  250     MPN1 = M + N1
          DO 270 JJ=MP1,MPN1
            J = (M + 1) + (M + N1) - JJ
            SUM = 0.0
            DO 260 L=J,MPN1
              LMM = L - M
              SUM = SUM + DBLE(QR(J,LMM))*DBLE(QR(L,NP))
  260       CONTINUE
            QR(J,NP) = -SUM
  270     CONTINUE
  280   CONTINUE
        GO TO 150
C RETURN HERE IF MATRIX OF CONSTRAINTS IS FOUND TO BE SINGULAR.
  290   IF (DS.EQ.0.0) RETURN
        QR(K,NS) = -1.0
        NSP1 = NS + 1
        IF (NSP1.GT.N) GO TO 340
C BEGIN ORTHOGONALIZATION.
        DO 330 J=NSP1,N
          SUM = 0.0
          DO 300 L=MV,MH
            SUM = SUM + DBLE(QR(L,J))*DBLE(QR(L,NS))
  300     CONTINUE
          RSJ = SUM
          RSJ = RSJ/DS
          QR(K,J) = RSJ
          DO 310 L=1,MS
            QR(L,J) = QR(L,J) - RSJ*QR(L,NS)
  310     CONTINUE
          IF (.NOT.FINIS) GO TO 320
          GO TO 330
  320     D(J) = D(J) - DS*RSJ*RSJ
  330   CONTINUE
C END ORTHOGONALIZATION.
  340   IF (.NOT.FINIS) N1 = N1 + 1
  350 CONTINUE
C END STEP NUMBER NS.
      SING = .FALSE.
C NORMAL RETURN.
      RETURN
      END
