      SUBROUTINE WNLIT(W, MDW, M, N, L, IPIVOT, ITYPE, H, SCALE, RNORM,
     * IDOPE, DOPE, DONE)
C     THIS IS A COMPANION SUBPROGRAM TO WNNLS( ).
C     THE DOCUMENTATION FOR WNNLS( ) HAS MORE COMPLETE
C     USAGE INSTRUCTIONS.
C
C     NOTE  THE M BY (N+1) MATRIX W( , ) CONTAINS THE RT. HAND SIDE
C           B AS THE (N+1)ST COL.
C
C
C     TRIANGULARIZE L1 BY L1 SUBSYSTEM, WHERE L1=MIN(M,L), WITH
C     COL INTERCHANGES.
C     REVISED SEPTEMBER 6, 1979.
C
      DIMENSION W(MDW,1), IPIVOT(1), ITYPE(1), H(1), SCALE(1), SPARAM(5)
      DIMENSION IDOPE(8), DOPE(4)
      LOGICAL INDEP, DONE, RECALC
      DATA TENM3 /1.E-3/, ZERO /0.E0/, ONE /1.E0/
C
      ME = IDOPE(1)
      MEP1 = IDOPE(2)
      KRANK = IDOPE(3)
      KRP1 = IDOPE(4)
      NSOLN = IDOPE(5)
      NIV = IDOPE(6)
      NIV1 = IDOPE(7)
      L1 = IDOPE(8)
C
      ALSQ = DOPE(1)
      EPENSQ = DOPE(2)
      FAC = DOPE(3)
      TAU = DOPE(4)
      NP1 = N + 1
      LB = MIN0(M-1,L)
      RECALC = .TRUE.
      RNORM = ZERO
      KRANK = 0
C     WE SET FACTOR=1.E0 SO THAT THE HEAVY WEIGHT ALAMDA WILL BE
C     INCLUDED IN THE TEST FOR COL INDEPENDENCE.
      FACTOR = 1.E0
      I = 1
      IP1 = 2
   10 IF (.NOT.(I.LE.LB)) GO TO 130
C
C     SET IR TO POINT TO THE I-TH ROW.
      IR = I
      LEND = L
      MEND = M
      ASSIGN 20 TO I99996
      GO TO 450
C
C     UPDATE-COL-SS-AND-FIND-PIVOT-COL
   20 ASSIGN 30 TO I99993
      GO TO 550
C
C     PERFORM-COL-INTERCHANGE
C
C     SET IC TO POINT TO I-TH COL.
   30 IC = I
      ASSIGN 40 TO I99990
      GO TO 510
C
C     TEST-INDEP-OF-INCOMING-COL
   40 IF (.NOT.(INDEP)) GO TO 110
C
C     ELIMINATE I-TH COL BELOW DIAG. USING MOD. GIVENS TRANSFORMATIONS
C     APPLIED TO (A B).
      J = M
      DO 100 JJ=IP1,M
         JM1 = J - 1
         JP = JM1
C     WHEN OPERATING NEAR THE ME LINE, USE THE LARGEST ELT.
C     ABOVE IT AS THE PIVOT.
         IF (.NOT.(J.EQ.MEP1)) GO TO 80
         IMAX = ME
         AMAX = SCALE(ME)*W(ME,I)**2
   50    IF (.NOT.(JP.GE.I)) GO TO 70
         T = SCALE(JP)*W(JP,I)**2
         IF (.NOT.(T.GT.AMAX)) GO TO 60
         IMAX = JP
         AMAX = T
   60    JP = JP - 1
         GO TO 50
   70    JP = IMAX
   80    IF (.NOT.(W(J,I).NE.ZERO)) GO TO 90
         CALL SROTMG(SCALE(JP), SCALE(J), W(JP,I), W(J,I), SPARAM)
         W(J,I) = ZERO
         CALL SROTM(NP1-I, W(JP,IP1), MDW, W(J,IP1), MDW, SPARAM)
   90    J = JM1
  100 CONTINUE
      KRANK = KRANK + 1
      GO TO 120
  110 GO TO 140
  120 I = IP1
      IP1 = IP1 + 1
      GO TO 10
  130 KRANK = L1
  140 CONTINUE
      KRP1 = KRANK + 1
      IF (.NOT.(KRANK.LT.ME)) GO TO 260
      FACTOR = ALSQ
C
C     DETERMINE THE RANK OF THE REMAINING EQUALITY CONSTRAINT
C     EQUATIONS.  REMOVE ANY REDUNDANT EQUATIONS.
      LP1 = L + 1
      RECALC = .TRUE.
      LB = MIN0(L+ME-KRANK,N)
      I = LP1
      IP1 = I + 1
  150 IF (.NOT.(I.LE.LB)) GO TO 250
      IR = KRANK + I - L
      LEND = N
      MEND = ME
      ASSIGN 160 TO I99996
      GO TO 450
C
C     UPDATE-COL-SS-AND-FIND-PIVOT-COL
  160 ASSIGN 170 TO I99993
      GO TO 550
C
C     PERFORM-COL-INTERCHANGE
C
C     ELIMINATE ELEMENTS IN THE I-TH COL.
  170 J = ME
  180 IF (.NOT.(J.GT.IR)) GO TO 200
      JM1 = J - 1
      IF (.NOT.(W(J,I).NE.ZERO)) GO TO 190
      CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM)
      W(J,I) = ZERO
      CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM)
  190 J = JM1
      GO TO 180
C
C     SET IC=I=COL BEING ELIMINATED
  200 IC = I
      ASSIGN 210 TO I99990
      GO TO 510
C
C     TEST-INDEP-OF-INCOMING-COL
  210 IF (INDEP) GO TO 240
C
C     REMOVE ANY REDUNDANT OR DEPENDENT EQUALITY CONSTRAINTS.
      JJ = IR
  220 IF (.NOT.(IR.LE.ME)) GO TO 230
      W(IR,1) = ZERO
      CALL SCOPY(N, W(IR,1), 0, W(IR,1), MDW)
      RNORM = RNORM + SCALE(IR)*W(IR,NP1)**2/ALSQ
      W(IR,NP1) = ZERO
      SCALE(IR) = ONE
      IR = IR + 1
      GO TO 220
C
C     REDUCE ME TO REFLECT ANY DISCOVERED DEPENDENT EQUALITY
C     CONSTRAINTS.
  230 ME = JJ - 1
      MEP1 = ME + 1
      GO TO 270
  240 I = IP1
      IP1 = IP1 + 1
      GO TO 150
  250 CONTINUE
  260 CONTINUE
  270 CONTINUE
      IF (.NOT.(KRANK.LT.L1)) GO TO 410
C
C     TRY TO DETERMINE THE VARIABLES KRANK+1 THROUGH L1 FROM THE
C     LEAST SQUARES EQUATIONS.  CONTINUE THE TRIANGULARIZATION WITH
C     PIVOT ELEMENT W(MEP1,I).
C
      RECALC = .TRUE.
C
C     SET FACTOR=ALSQ TO REMOVE EFFECT OF HEAVY WEIGHT FROM
C     TEST FOR COL INDEPENDENCE.
      FACTOR = ALSQ
      KK = KRP1
      I = KK
      IP1 = I + 1
  280 IF (.NOT.(I.LE.L1)) GO TO 400
C
C     SET IR TO POINT TO THE MEP1-ST ROW.
      IR = MEP1
      LEND = L
      MEND = M
      ASSIGN 290 TO I99996
      GO TO 450
C
C     UPDATE-COL-SS-AND-FIND-PIVOT-COL
  290 ASSIGN 300 TO I99993
      GO TO 550
C
C     PERFORM-COL-INTERCHANGE
C
C     ELIMINATE I-TH COL BELOW THE IR-TH ELEMENT.
  300 IRP1 = IR + 1
      J = M
      DO 320 JJ=IRP1,M
         JM1 = J - 1
         IF (.NOT.(W(J,I).NE.ZERO)) GO TO 310
         CALL SROTMG(SCALE(JM1), SCALE(J), W(JM1,I), W(J,I), SPARAM)
         W(J,I) = ZERO
         CALL SROTM(NP1-I, W(JM1,IP1), MDW, W(J,IP1), MDW, SPARAM)
  310    J = JM1
  320 CONTINUE
C
C     TEST IF NEW PIVOT ELEMENT IS NONZERO. IF NOT, THE COL IS
C     DEPENDENT.
      T = SCALE(IR)*W(IR,I)**2
      IF (.NOT.(FAC*T+EPENSQ.EQ.EPENSQ)) GO TO 330
      INDEP = .FALSE.
      GO TO 360
C
C     COL TEST PASSED. NOW MUST PASS ROW NORM TEST TO BE CLASSIFIED
C     AS INDEPENDENT.
  330 RN = ZERO
      DO 350 I1=IR,M
         DO 340 J1=IP1,N
            RN = AMAX1(RN,SCALE(I1)*W(I1,J1)**2)
  340    CONTINUE
  350 CONTINUE
      INDEP = FAC*T + RN.NE.RN
C
C     IF INDEPENDENT, SWAP THE IR-TH AND KRP1-ST ROWS TO MAINTAIN THE
C     TRIANGULAR FORM.  UPDATE THE RANK INDICATOR KRANK AND THE
C     EQUALITY CONSTRAINT POINTER ME.
  360 IF (.NOT.(INDEP)) GO TO 380
      IF (.NOT.(IR.NE.KRP1)) GO TO 370
      CALL SSWAP(NP1, W(KRP1,1), MDW, W(IR,1), MDW)
      CALL SSWAP(1, SCALE(KRP1), 1, SCALE(IR), 1)
      ITEMP = ITYPE(KRP1)
      ITYPE(KRP1) = ITYPE(IR)
      ITYPE(IR) = ITEMP
  370 ME = MEP1
      MEP1 = ME + 1
      KRANK = KRP1
      KRP1 = KRANK + 1
      GO TO 390
  380 GO TO 420
  390 I = IP1
      IP1 = IP1 + 1
      GO TO 280
  400 CONTINUE
  410 CONTINUE
  420 CONTINUE
C
C     IF PSEUDORANK IS LESS THAN L, APPLY HOUSEHOLDER TRANS.
C     FROM RIGHT.
      IF (.NOT.(KRANK.LT.L)) GO TO 440
      DO 430 I=1,KRANK
         J = KRP1 - I
         CALL H12(1, J, KRP1, L, W(J,1), MDW, H(J), W, MDW, 1, J-1)
  430 CONTINUE
  440 NIV = KRANK + NSOLN - L
      NIV1 = NIV + 1
      IF (L.EQ.N) DONE = .TRUE.
C
C  END OF INITIAL TRIANGULARIZATION.
      IDOPE(1) = ME
      IDOPE(2) = MEP1
      IDOPE(3) = KRANK
      IDOPE(4) = KRP1
      IDOPE(5) = NSOLN
      IDOPE(6) = NIV
      IDOPE(7) = NIV1
      IDOPE(8) = L1
      RETURN
  450 CONTINUE
C
C     TO UPDATE-COL-SS-AND-FIND-PIVOT-COL
C
C     THE COL SS VECTOR WILL BE UPDATED AT EACH STEP. WHEN
C     NUMERICALLY NECESSARY, THESE VALUES WILL BE RECOMPUTED.
C
      IF (.NOT.(IR.NE.1 .AND. (.NOT.RECALC))) GO TO 470
C     UPDATE COL SS =SUM OF SQUARES.
      DO 460 J=I,LEND
         H(J) = H(J) - SCALE(IR-1)*W(IR-1,J)**2
  460 CONTINUE
C
C     TEST FOR NUMERICAL ACCURACY.
      MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1
      RECALC = HBAR + TENM3*H(MAX).EQ.HBAR
C
C     IF REQUIRED, RECALCULATE COL SS, USING ROWS IR THROUGH MEND.
  470 IF (.NOT.(RECALC)) GO TO 500
      DO 490 J=I,LEND
         H(J) = ZERO
         DO 480 K=IR,MEND
            H(J) = H(J) + SCALE(K)*W(K,J)**2
  480    CONTINUE
  490 CONTINUE
C
C     FIND COL WITH LARGEST SS.
      MAX = ISAMAX(LEND-I+1,H(I),1) + I - 1
      HBAR = H(MAX)
  500 GO TO 590
  510 CONTINUE
C
C     TO TEST-INDEP-OF-INCOMING-COL
C
C     TEST THE COL IC TO DETERMINE IF IT IS LINEARLY INDEPENDENT
C     OF THE COLS ALREADY IN THE BASIS.  IN THE INIT TRI
C     STEP, WE USUALLY WANT THE HEAVY WEIGHT ALAMDA TO
C     BE INCLUDED IN THE TEST FOR INDEPENDENCE.  IN THIS CASE THE
C     VALUE OF FACTOR WILL HAVE BEEN SET TO 1.E0 BEFORE THIS
C     PROCEDURE IS INVOKED.  IN THE POTENTIALLY RANK DEFICIENT
C     PROBLEM, THE VALUE OF FACTOR WILL HAVE BEEN
C     SET TO ALSQ=ALAMDA**2 TO REMOVE THE EFFECT OF THE HEAVY WEIGHT
C     FROM THE TEST FOR INDEPENDENCE.
C
C     WRITE NEW COL AS PARTITIONED VECTOR
C             (A1)  NUMBER OF COMPONENTS IN SOLN SO FAR = NIV
C             (A2)  M-NIV COMPONENTS
C     AND COMPUTE  SN = INVERSE WEIGHTED LENGTH OF A1
C                  RN = INVERSE WEIGHTED LENGTH OF A2
C     CALL THE COL INDEPENDENT WHEN RN .GT. TAU*SN
      SN = ZERO
      RN = ZERO
      DO 540 J=1,MEND
         T = SCALE(J)
         IF (J.LE.ME) T = T/FACTOR
         T = T*W(J,IC)**2
         IF (.NOT.(J.LT.IR)) GO TO 520
         SN = SN + T
         GO TO 530
  520    RN = RN + T
  530    CONTINUE
  540 CONTINUE
      INDEP = RN.GT.TAU**2*SN
      GO TO 580
  550 CONTINUE
C
C     TO PERFORM-COL-INTERCHANGE
C
      IF (.NOT.(MAX.NE.I)) GO TO 560
C     EXCHANGE ELEMENTS OF PERMUTED INDEX VECTOR AND PERFORM COL
C     INTERCHANGES.
      ITEMP = IPIVOT(I)
      IPIVOT(I) = IPIVOT(MAX)
      IPIVOT(MAX) = ITEMP
      CALL SSWAP(M, W(1,MAX), 1, W(1,I), 1)
      H(MAX) = H(I)
  560 GO TO 570
  570 GO TO I99993, (30, 170, 300)
  580 GO TO I99990, (40, 210)
  590 GO TO I99996, (20, 160, 290)
      END
