End of file
Contents
Index



F 4.14 Solving Linear Systems via Householder Transformations


      SUBROUTINE SHOUSE (A, LDA, M, N, D, X, IERR)

C*****************************************************************
C                                                                *
C  SUBROUTINE SHOUSE  solves a linear minimization problem by    *
C  applying Householder transformations, i.e., the euclidean     *
C  norm of A(ORG)*X-B is minimized. Here A is an (M+1)x(N+2)     *
C  matrix A(0:M,0:N+1) with M >= N that contains A(ORG) of       *
C  dimensions (M+1)x(N+1) in the columns 0, ..., N; B(0:M) is a  *
C  vector of length M+1 stored in the (N+1)st column of A, and X *
C  is the solution vector of length N+1.                         *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  A     : 2-dimensional array A(0:LDA,0:N+1) that contains the  *
C          (M+1)x(N+1) matrix A in columns 0 to N, and the       *
C          (M+1)-vector B in column N+1                          *
C  LDA   : leading dimension of A as defined in the calling      *
C          program (LDA has to be >= M)                          *
C  M     : M+1 = number of rows in A (M has to be >= N)          *
C  N     : N+1 = number of columns in A                          *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  X     : (N+1)-vector X(0:N) containing the solution vector    *
C  IERR  : error parameter:                                      *
C          = 0 : everything is o.k.                              *
C          = 1 : numerically the matrix A is not of full rank,   *
C                => no unique solution exists                    *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETER:                                          *
C  ====================                                          *
C                                                                *
C  D     : (N+1)-VECTOR D(0:N), which contains the diagonal      *
C          elements of A during the factorization                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Ilona Westermann                                   *
C  date     : 01.09.1987                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER LDA, M, N, IERR
      DOUBLE PRECISION A(0:LDA,0:N+1), D(0:N), X(0:N)
      IERR = 0
      FMACHP = 1.0D0
   10 FMACHP = 0.5D0 * FMACHP
      IF (MACHPD(1.0D0 + FMACHP) .EQ. 1) GOTO 10
      FMACHP = 8.0D0 * FMACHP
C
C  Householder transformation:
C
      DO 100 I=0,N
C
C  calculating the essential parameters of the
C  transforming Householder matrices
C
          RADI = A(I,I) * A(I,I)
          DO 40 K=I+1,M
              RADI = RADI + A(K,I) * A(K,I)
   40     CONTINUE
          IF (RADI .LT. FMACHP) THEN
              IERR = 1
              RETURN
          ENDIF
          AIBETR = DSQRT(RADI) * DSIGN(1.0D0,A(I,I))
          AK = 1.0D0 / (RADI + AIBETR * A(I,I))
          A(I,I) = A(I,I) + AIBETR
C
C  update the matrix A and the vector B, stored in the last column of A,
C  by using the new Householder matrix and starting from the left
C
          D(I) = -AIBETR
          DO 100 K=I+1,N+1
              FACTOR = 0.0D0
              DO 50 J=I,M
                  FACTOR = FACTOR + A(J,K) * A(J,I)
   50         CONTINUE
              FACTOR = FACTOR * AK
              DO 100 J=I,M
                  A(J,K) = A(J,K) - FACTOR * A(J,I)
  100 CONTINUE
C
C  determine the solution vector by backsubstitution
C
      DO 80 I=N,0,-1
         SUM = 0.0D0
         DO 70 K=I+1,N
            SUM = SUM + A(I,K) * X(K)
   70    CONTINUE
         X(I) = (A(I,N+1) - SUM) / D(I)
   80 CONTINUE
      RETURN
      END


Begin of file
Contents
Index