*DECK ALST2F
      SUBROUTINE ALST2F(MDIM,M,N,A,UD)
*
*-----------------------------------------------------------------------
*
*  TO OBTAIN THE Q*U DECOMPOSITION OF THE MATRIX A USING HOUSEHOLDER
*  TRANSFORMATIONS.
*
*  INPUT PARAMETERS:
*    MDIM - THE DIMENSIONED COLUMN LENGTH OF A
*    M    - THE NUMBER OF ROWS IN A.
*    N    - THE NUMBER OF COLUMNS IN A. N.LE.M IS ASSUMED.
*    A    - THE MATRIX A.
*
*  OUTPUT PARAMETER:
*    A  - THE DECOMPOSED MATRIX.
*         LET V(J)(I)=0      FOR I=1,...,J-1
*         AND V(J)(I)=A(I,J) FOR I=J,...,M, THEN
*
*             Q = PRODUCT(J=1,...,N)(I-BETA(J)*V(J)*V(J)-TRANSPOSE)
*
*         WHERE BETA(J)=1/(UD(J)*ABS(A(J,J)))
*         A(I,J) FOR I.LT.J GIVES THE OFF-DIAGONAL ELEMENTS OF U.
*    UD - THE DIAGONAL OF U.
*
*  SCRATCH SPACE ALLOCATED - NONE.
*
*  ERROR STATES -
*
*    1 - MDIM.LT.M.
*    2 - N.LT.1.
*    3 - N.GT.M.
*    4 - A IS RANK-DEFICIENT. (RECOVERABLE)
*
*  P.A. BUSINGER, NUM. MATH. 7, 269-276 (1965).
*
*-----------------------------------------------------------------------
*
      DOUBLE PRECISION A(MDIM,N),UD(N)
      DOUBLE PRECISION S,BE,DSQRT
      CHARACTER HSMG*131
*
* ... CHECK THE INPUT.
*
      IF(MDIM.LT.M) CALL XABORT('ALST2F: MDIM.LT.M')
      IF(N.LT.1) CALL XABORT('ALST2F: N.LT.1')
      IF(N.GT.M) THEN
         WRITE(HSMG,'(18HALST2F: N.GT.M (N=,I3,3H M=,I3,2H).)') N,M
         CALL XABORT(HSMG)
      ENDIF
*
      DO 30 L=1,N
      S=0.D0
      DO 10 I=L,M
 10   S=S+A(I,L)**2
      IF(S.EQ.0.0D0) THEN
         CALL XABORT('ALST2F: A IS RANK-DEFICIENT')
      ENDIF
      UD(L)=DSQRT(S)
      IF(A(L,L).GE.0.0D0) UD(L)=-UD(L)
      BE=S-A(L,L)*UD(L)
      A(L,L)=A(L,L)-UD(L)
      IF(L.EQ.N) GO TO 50
      DO 30 J=L+1,N
      S=0.D0
      DO 20 I=L,M
 20   S=S+A(I,L)*A(I,J)
      S=S/BE
      DO 30 I=L,M
 30   A(I,J)=A(I,J)-S*A(I,L)
 50   RETURN
      END
