      SUBROUTINE riera(N,A,Z,D,E,NDIM,ierr)
C*
C*            DIAGONALIZACION DE UNA MATRIZ SIMETRICA
C*            PARA DETALLES MATEMATICOS Y COMPUTACIONALES VER:
C*            R.S.MARTIN,C.REINSCH YJ.H.WILKINSON ; "LINEAR ALGEBRA"
C*                 II/2 ED. SPRINGER-VERLAG
C*            H.BOWDLER,R.S.MARTIN,C.REINSCH Y J.H.WILKINSON ; "LINEAR
C*            ALGEBRA" II/3 ED. SPRINGER-VERLAG.
C*
      IMPLICIT REAL*8 (A-H,O-Z)
      DOUBLE PRECISION MATCHE
C*
      DIMENSION A(ndim*ndim),Z(NDIM,NDIM)
      DIMENSION D(ndim),E(ndim)
      allocatable ii(:)
      allocate(ii(n))
C*
C*
 1000 FORMAT (5X,'OCCHIO DIAGONALIZZA COL SEDERE')
C*
C*
C*            PARAMETROS DEPENDIENTES DE LA MAQUINA UTILIZADA-
C*            MATCHE =2**(-NUMERO DE BITS DE LA MANTISA)
C*            TOL=ETA/MATCHE
C*            ETA = EL MENOR NUMERO POSITIVO REPRESENTABLE EN LA
C*            CALCULADORA
C*            RUTINA ESCRITA PARA I.B.M. 370 158/168
C*
      ierr=0
      MATCHE=2.D0**(-56)
      TOL=2.D0**(-72)
C*
C*            ADAPTACION DE LA RUTINA A LA FORMA DEL GAUSSIAN-70
C*
      IF (N.EQ.1) GO TO 999
      K=1
      JJ=0
c     write(6,*)'riera n,ndim',n,ndim
      DO 10 J=1,N
      IJ=JJ
      DO 11 I=1,J
      IJ=IJ+1
      A(K)=A(IJ)
c     write(6,*)'j,i,ij,jj',j,i,ij,jj
 11   K=K+1
 10   JJ=JJ+NDIM
C*
C*            TRIDIAGONALIZACION DE HOUSEHOLDER
C*
      I=N
      IZ=(I*I+I)/2
 101  L=I-1
      IZ=IZ-I
      H=0.D0
      IF(L) 105,105,103
 103  DO 104 K=1,L
      IZK=IZ+K
      F=A(IZK)
      D(K) =F
 104  H=H+F*F
      IF(H-TOL) 105,105,106
 105  E(I)=0.D0
      H=0.D0
      GO TO 115
 106  G=DSQRT(H)
      IF(F) 108,107,107
 107  G=-G
 108  E(I)=G
      H=H-F*G
      IZL=IZ+L
      FG=F-G
      A(IZL)=FG
      D(L)=FG
      F=0.D0
      JKK=1
      DO 112 J=1,L
      G =0.D0
      JKK=JKK+J-1
      JK=JKK
      DO 111 K=1,L
      G=G+A(JK)*D(K)
      IF (K-J) 109,110,110
 109  JK=JK+1
      GO TO 111
 110  JK=JK+K
 111  CONTINUE
      G=G/H
      E(J)=G
 112  F=F+G*D(J)
      HH=F/(H+H)
      JK=0
      DO 114 J=1,L
      F=D(J)
      G=E(J)-HH*F
      E(J)=G
      DO 113 K=1,J
      JK=JK+1
 113  A(JK)=A(JK)-F*E(K)-G*D(K)
 114  CONTINUE
 115  IZI=IZ+I
      D(I)=A(IZI)
      A(IZI)=H
      I=I-1
      IF (I) 116,116,101
 116  CONTINUE
C*
C*            CALCULO DE LOS VECTORES Y VALORES PROPIOS DE LA MATRIZ
C*            TRIDIAGONAL MEDIANTE EL ALGORITMO Q.L.
C*
      DO 202 I=1,N
      DO 201 J=1,N
      Z(J,I)=0.
      IF(I.EQ.J) Z(J,I)=1.
 201  CONTINUE
 202  CONTINUE
      DO 203 I=2,N
 203  E(I-1)=E(I)
      E(N)=0.D0
      B=0.D0
      F=0.D0
      DO 224 L=1,N
      J=0
      H=MATCHE * (DABS(E(L))+DABS(D(L)))
      IF(B-H) 204,205,205
 204  B=H
 205  DO 206 M=L,N
      IF(DABS(E(M))-B) 207,207,206
 206  CONTINUE
 207  IF(M-L) 208,223,208
 208  IF(J-30) 209,225,225
C*
C              EL PROCESO SE CONCLUYE CON IND=1 SI ALGUN VALOR PROPIO
C              PRESISA MAS DE 30 ITERACIONES
C*
 209  J=J+1
      G=D(L)
      P=(D(L+1)-G)/(E(L)+E(L))
      PABS=DABS(P)
      if(pabs.lt.1.d-15)then
         ierr=1
         deallocate(ii)
         return
      endif
      R=DSQRT(PABS)*DSQRT(PABS+1.D0/PABS)
      IF(P.LT.0) THEN
         GOTO 210
      ELSE
         GOTO 211
      ENDIF
 210  D(L)=E(L)/(P-R)
      GO TO 212
 211  D(L)=E(L)/(P+R)
 212  H=G-D(L)
      I=L+1
 213  IF(I-N) 214,214,215
 214  D(I)=D(I)-H
      I=I+1
      GO TO 213
 215  F=F+H
      P=D(M)
      C=1.
      S=0.D0
      I=M-1
 217  IF(I-L) 222,216,216
 216  G=C*E(I)
      H=C*P
      IF(DABS(P)-DABS(E(I))) 219,218,218
 218  C=E(I)/P
      R=DSQRT(C*C+1.D0)
      E(I+1) =S*P*R
      S=C/R
      C=1.D0/R
      GO TO 220
 219  C=P/E(I)
      R=DSQRT(C*C+1.D0)
      E(I+1)=S*R*E(I)
      S=1.D0/R
      C=C/R
 220  P=C*D(I)-S*G
      D(I+1) =H+S*(C*G+S*D(I))
      DO 221 K=1,N
      H= Z(K,I+1)
      Z(K,I+1)=S*Z(K,I)+C*H
 221  Z(K,I)=C*Z(K,I)-S*H
      I=I-1
      GO TO 217
 222  E(L)=S*P
      D(L)=C*P
      IF(DABS(E(L))-B) 223,223,208
 223  D(L)=D(L)+F
 224  CONTINUE
      GO TO 226
 225  WRITE(6,1000)
      ierr=1
      deallocate(ii)
      RETURN
 226  CONTINUE
C*
C*            CALCULO DE LOS VECTORES PROPIOS DE LA MATRIZ ORIGINAL
C*
      IZ=0
      DO 301 I=2,N
      L=I-1
      IZ=IZ+I-1
      IZI=IZ+I
      H=A(IZI)
      IF(H) 302,301,302
 302  DO 303 J=1,N
      S=0.D0
      DO 304 K=1,L
      IZK=IZ+K
 304  S=S+A(IZK)*Z(K,J)
      S=S/H
      DO 305 K=1,L
      IZK=IZ+K
 305  Z(K,J)=Z(K,J)-S*A(IZK)
 303  CONTINUE
 301  CONTINUE
C*
C*            ORDENACION DE LOS VALORES Y VECTORES SEGUN  UN
C*            ORDEN CRECIENTE
C*
C              OREDENACION DE VALORES Y VECTORES
      N1 =N-1
      DO 401 I=1,N
 401  II(I)=I
      DO 402 I=1,N1
      I1=I+1
      P=D(I)
      DO 402 J=I1,N
      IF(D(J)-P) 403,402,402
 403  P=D(J)
      D(J)=D(I)
      D(I)=P
      K= II(J)
      II(J)=II(I)
      II(I)=K
 402  CONTINUE
      DO 404 I=1,N1
      K=II(I)
      I1=I+1
      DO 406 L=I1,N
      IF(II(L).NE.I) GO TO 406
      II(L)=K
      DO 405 J=1,N
      G= Z(J,K)
      Z(J,K)=Z(J,I)
 405  Z(J,I)=G
      GO TO 404
 406  CONTINUE
 404  CONTINUE
      deallocate(ii)
      RETURN
 999  D(1)=A(1)
      Z(1,1)=1.D0
      deallocate(ii)
      RETURN
      END
