      SUBROUTINE DERI21 (A,NVAR,MINEAR,NFIRST,VNERT,PNERT
     1                  ,B,NCUT)
      implicit double precision (A-H,O-Z)
      include 'MOP6FILE'
      dimension A(MINEAR,NVAR),VNERT(NVAR,NVAR),PNERT(NVAR),B(MINEAR,*)
************************************************************************
*
*     LEAST-SQUARE ANALYSIS OF A SET OF NVAR POINTS {A} :
*
*     PRODUCE A SUBSET OF NCUT ORTHONORMALIZED VECTORS B, OPTIMUM IN A
*     LEAST-SQUARE SENSE WITH RESPECT TO THE INITIAL SPACE {A}.
*     EACH NEW HIERARCHIZED VECTOR B EXTRACTS A MAXIMUM PERCENTAGE FROM
*     THE REMAINING DISPERSION OF THE SET {A} OUT OF THE PREVIOUS
*     {B} SUBSPACE.
*   INPUT
*     A(MINEAR,NVAR): ORIGINAL SET {A}.
*     NFIRST        : MAXIMUM ALLOWED SIZE OF THE BASIS B.
*   OUTPUT
*     VNERT(NVAR,NVAR)  : EIGENVECTORS OF A'* A.
*     PNERT(NVAR)     : SQUARE ROOT OF THE ASSOCIATED EIGENVALUES
*                     IN DECREASING ORDER.
*     B(MINEAR,NCUT): OPTIMUM ORTHONORMALIZED SUBSET {B}.
*
************************************************************************
      dimension WORK(4)
C
C     VNERT = A' * A
      CUTOFF=0.85D0
      SUM2=0.D0
      call MTXMC(A,NVAR,A,MINEAR,WORK)
      do 10 I=1,(NVAR*(NVAR+1))/2
  10      WORK(I)=-WORK(I)
C     DIAGONALIZE IN DECREASING ORDER OF EIGENVALUES
      if (ABS(WORK(1)).LT.1.D-28 .AND. NVAR.EQ.1) then
      PNERT(1)=SQRT(-WORK(1))
      VNERT(1,1)=1.D0
      WORK(1)=1.D15
      NCUT=1
      go to 50
      else
      call HQRII(WORK,NVAR,NVAR,PNERT, VNERT)
C     FIND NCUT ACCORDING TO CUTOFF, BUILD WORK = VNERT * (PNERT)**-0.5
      SUM=0.D0
      do 20 I=1,NVAR
   20 SUM=SUM-PNERT(I)
      L=1
      do 40 I=1,NFIRST
         SUM2=SUM2-PNERT(I)/SUM
         PNERT(I)=SQRT(-PNERT(I))
         do 30 J=1,NVAR
            WORK(L)=VNERT(L,1)/PNERT(I)
   30    L=L+1
         if (SUM2.GE.CUTOFF) then
            NCUT=I
            go to 50
         end if
   40 continue
      NCUT=NFIRST
C     ORTHONORMALIZED BASIS
C     B(MINEAR,NCUT) = A(MINEAR,NVAR)*WORK(NVAR,NCUT)
      end if
   50 call MXM (A,MINEAR,WORK,NVAR,B,NCUT)
      return
      end
