MINICERN/mathlib/gen/e/slv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:27  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE SLV  (M,N,QR,ALPHA,IPIVOT,R,Y,Z)
  11       DIMENSION  QR(M,N),ALPHA(N),R(M),Y(N),IPIVOT(N),Z(N)
  12 C
  13 C        USING THE VECTORS U, WHOSE NON-ZERO COMPONENTS ARE
  14 C        STORED ON AND BELOW THE MAIN DIAGONAL OF QR(M,N), SLV
  15 C        APPLIES THE N TRANSFORMATIONS (I - BETA UT) TO THE
  16 C        RIGHT HAND SIDE R(M).  FROM THE REDUCED MATRIX GIVEN IN
  17 C        ALPHA(N) AND THE UPPER RIGHT TRIANGULAR PART OF QR,
  18 C        SLV THEN COMPUTES BY BACK-SUBSTITUTION, AN APPROXIMATE
  19 C        SOLUTION TO THE LINEAR SYSTEM.  THE COMPONENTS OF THE
  20 C        SOLUTION VECTOR ARE STORED IN Y(N) IN THE ORDER PRESCRIBED
  21 C        BY IPIVOT(N).
  22 C
  23       DO 10  J=1,N
  24       GAMMA=PROD1(QR(1,J),R,J,M)/(ALPHA(J)*QR(J,J))
  25       DO 5  I=J,M
  26  5    R(I)=R(I)+GAMMA*QR(I,J)
  27  10   CONTINUE
  28       Z(N)=R(N)/ALPHA(N)
  29       NIT=N-1
  30       DO 15  I=1,NIT
  31       L=N-I
  32       LA=L+1
  33  15   Z(L)=-PROD2(QR,Z,M,LA,N,L,-R(L))/ALPHA(L)
  34       DO 20  I=1,N
  35       JU=IPIVOT(I)
  36  20   Y(JU)=Z(I)
  37       RETURN
  38       END