C
C      ________________________________________________________
C     |                                                        |
C     |COMPUTE AN ORTHONORMAL BASIS FOR A COLLECTION OF VECTORS|
C     |                                                        |
C     | INPUT:                                                 |
C     |                                                        |
C     |      A     --FACTORIZATION COMPUTED BY SUBROUTINE QR   |
C     |                   OF THE ARRAY OF VECTORS              |
C     |                                                        |
C     |      LB    --LEADING (ROW) DIMENSION OF ARRAY B        |
C     |                                                        |
C     |      C     --CUTOFF                                    |
C     |                                                        |
C     | OUTPUT:                                                |
C     |                                                        |
C     |      B     --ORTHONORMAL BASIS (CAN IDENTIFY WITH A)   |
C     |                                                        |
C     |      N     --NUMBER OF VECTORS IN THE BASIS            |
C     |                                                        |
C     |    BUILTIN FUNCTIONS: ABS,MIN0                         |
C     |    PACKAGE SUBROUTINES: HSR3                           |
C     |________________________________________________________|
C
      SUBROUTINE BASIS(B,LB,N,A,C)
      INTEGER I,J,K,L,LB,M,N,O
      REAL  A(1),B(LB,1),C,T
      T = A(1)
      IF ( ABS(T) .EQ. 3230 ) GOTO 10
      WRITE(6,*) 'ERROR: MUST FACTOR ARRAY OF VECTORS USING'
      WRITE(6,*) 'SUBROUTINE QR BEFORE USING SUBROUTINE BASIS'
      WRITE(6,*) 'TO COMPUTE A BASIS'
      STOP
10    M = A(2)
      N = A(3)
      IF ( LB .GE. M ) GOTO 20
      WRITE(6,*) 'ERROR: THE LEADING DIMENSION OF ARGUMENT B IN'
      WRITE(6,*) 'SUBROUTINE BASIS MUST BE GREATER THAN OR EQUAL'
      WRITE(6,*) 'TO THE NUMBER OF COMPONENTS IN EACH BASIS VECTOR'
      STOP
20    K = 4
      L = MIN0(M,N) - 1
      IF ( L .EQ. 0 ) GOTO 50
      O = M + 1
      DO 40 J = 1,L
           IF ( ABS(A(J+K-1)) .LE. C ) GOTO 110
           DO 30 I = J,M
30              B(I,J) = A(I+K)
40         K = K + O
50    J = L + 1
      IF ( ABS(A(K+L)) .LE. C ) GOTO 110
      IF ( N .LT. M ) GOTO 80
C     ------------------------------------
C     |*** VECTORS SPAN ENTIRE SPACE  ***|
C     |*** RETURN THE IDENTITY MATRIX ***|
C     ------------------------------------
      N = M
      DO 70 J = 1,M
           DO 60 I = 1,M
60              B(I,J) = 0.
70         B(J,J) = 1.
      RETURN
C     -----------------------------------
C     |*** COMPUTE ORTHONORMAL BASIS ***|
C     -----------------------------------
80    DO 90 I = N,M
90         B(I,N) = A(I+K)
100   CALL HSR3(B,LB,M,N)
      RETURN
C     --------------------------------
C     |*** ZERO DEPENDENT COLUMNS ***|
C     --------------------------------
110   DO 120 K = J,N
           DO 120 I = 1,M
120             B(I,K) = 0.
      N = J - 1
      IF ( N .GT. 0 ) GOTO 100
      RETURN
      END