SUBROUTINE QRSLQF(QT,R,B,X,N)
C
C SUBROUTINE QRSLQF SOLVES THE SYSTEM  R*S = QT*B  FOR  S.
C
C
C ON INPUT:
C
C QT(1:N,1:N)  CONTAINS QT IN THE EQUATION ABOVE.
C
C R(1:N*(N+1)/2)  CONTAINS THE UPPER TRIANGLE OF  R  IN THE EQUATION
C     ABOVE, STORED BY ROWS.
C
C B(1:N)  CONTAINS  B  IN THE EQUATION ABOVE.
C
C N   IS THE DIMENSION OF THE PROBLEM.
C
C
C ON OUTPUT:
C
C QT  AND  R  ARE UNCHANGED.
C
C B   CONTAINS THE SOLUTION VECTOR S.
C
C X(1:N)  IS A WORK ARRAY WHICH CONTAINS QT*B ON OUTPUT.
C
C
C CALLS DDOT.
C
C ***** DECLARATIONS *****
C
C     FUNCTION DECLARATIONS
C
        DOUBLE PRECISION DDOT
C
C     LOCAL VARIABLES
C
        DOUBLE PRECISION TAU
        INTEGER INDEXR, I, J
C
C     SCALAR ARGUMENTS
C
        INTEGER N
C
C     ARRAY DECLARATIONS
C
        DOUBLE PRECISION QT(N,N),R(N*(N+1)/2),B(N),X(N)
C
C ***** END OF DECLARATIONS *****
C
C ***** FIRST EXECUTABLE STATEMENT *****
C
C X = QT*B.
C
        DO 10 I=1,N
          X(I) = DDOT(N,QT(I,1),N,B,1)
  10    CONTINUE
C
C COMPUTE S USING BACK SUBSTITUTION.
C
        INDEXR = N*(N+1)/2
        B(N) = X(N)/R(INDEXR)
        INDEXR = INDEXR - 1
        DO 30 I=N-1,1,-1
          TAU = X(I)
          DO 20 J=N,I+1,-1
            TAU = TAU - R(INDEXR)*B(J)
            INDEXR = INDEXR - 1
  20     CONTINUE
          B(I) = TAU/R(INDEXR)
          INDEXR = INDEXR - 1
  30    CONTINUE
        RETURN
C
C ***** END OF SUBROUTINE QRSLQF *****
        END

.