      SUBROUTINE GIVENS (H,E,V,N,NEV,NVEC)
      IMPLICIT REAL*8 (A-H,O-X,Z)
      PARAMETER(NDETZ=50000,METZ=370)
C
C                       NSTART(I) : POSITION DU PREMIER ELEMENT DE
C                       LIGNE I
C
C                  H    MATRICE A DIAGONALISER RANGEE SOUS LA FORME D'UN
C                       DEMI MATRICE SUPERIEURE
C                  E    VALEURS PROPRES EN ORDRE CROISSANT
C                       RANGEES DANS UN VECTEUR DE DIMENSION  N
C
C                  V    MATRICES DES VECTEURS PROPRES
C                        DE DIMENSION NVEC
C
C                  N    DIMENSION DE LA MATRICE
C                  NEV   NOMBRE DE VALAURS PROPRES DEMANDEES
C                  NVEC  NOMBRE DE VECTEURS  PROPRES DEMANDES
C
      INTEGER AG,RN,ALF
      REAL*8 NORM,LAMBD,L,MULT
      DIMENSION H(1),E(1),V(1),B(NDETZ),C(NDETZ),P(NDETZ),Q(NDETZ),
     1R(NDETZ),W(NDETZ),VY(NDETZ+2),IN(NDETZ),Z(NDETZ)
      DIMENSION HS1(NDETZ),HS2(NDETZ)
C***********************************************************************
C     NSTART(I)=INDICE DU PREMIER ELEMENT DE LA LIGNE I D'UNE DEMI-MATRI
C     SUPERIEURE
      NSTART(I)=N*(N+1)/2-(N-I+1)*(N-I+2)/2+1
C***********************************************************************
C  SOIT I  LE NOMBRE DE DECIMALES POUR LA MACHINE UTILISEE. ON PREND
C  EPSI=10**(-(I+3))   ET   EPSDG=EPSV= 10**(-(I-2))
      I=15
      EPSI=10.0**(-(I+3))
      EPSV=10.0**(-(I-2))
      EPSDG=EPSV
C     EPSI=1.D-10
C     EPSDG=1.0D-5
C     EPSV=1.D-5
      ITEVM=3
      JOYM=15
C       MODM1 = 2**15 - 1
      MODM1 = 32767
C DLGMAX= PUISSANCE DE 10 MAXIMALE
      DLGMAX=36.D0
      RN=MODM1 - 2
      ALF=259
      AGNES=2.0**(-14)
      NP1=N+1
      NM1=N-1
      NM2=N-2
      NG=1
      IF(NM2)99,9,200
  200 CONTINUE
C TRANSFERT DE LA PREMIERE LIGNE DE H DANS HS1
      DO 2 I=1,N
    2 HS1(I)=H(I)
C
C     DEBUT DE LA TRIDIAGONALISATION
C
C     HS1 CONTIENT LA LIGNE IR  A TRIDIAGONALISER
C
      DO 801 IR=1,NM2
      C(IR)=HS1(IR)
      IP1=IR+1
      IP2=IR+2
C
C     DETERMINATION DES ROTATIONS ANNULANT LES ELEMENTS IR+2,..,N
C     LE SINUS DE L'ANGLE DE ROTATION EST STOCKE A LA PLACE DE L'ELEMENT
C     ANNULE
      DO 802 I=IP2,N
      T=HS1(I)
      IF(DABS(T).LT.1.D-8) THEN
      HS1(I)=1.
      HS2(I-IP1)=0.
      ELSE
      S=HS1(IP1)
      SS=DSQRT(S*S+T*T)
      HS1(IP1)=SS
      S=S/SS
      T=T/SS
      HS1(I)=S
      HS2(I-IP1)=T
      ENDIF
  802 CONTINUE
C
C
C     ISH3 : INDICE-IP1 DU PREMIER ELEMENT DE LA LIGNE IP1
C
      ISH3=NSTART(IP1)-IP1
C
      DO 805 K=IP2,N
      KP1=K+1
C
C     ISH4 :INDICE-K DU PREMIER ELEMENT DE LA LIGNE K
      ISH4=NSTART(K)-K
C
C
C     ON FAIT LES ROTATIONS ENTRE LES LIGNES IR+1 ET K K=IR+2,...,N
C
      S=HS1(K)
      T=HS2(K-IP1)
      IF(T) 820,821,820
  820 CONTINUE
      IH4K=ISH4+K
      IH3K=ISH3+K
      IH3P=ISH3+IP1
      U=H(IH3P)
      L=H(IH3K)
      TT=H(IH4K)
C
      H(IH3P)= (U*S+L*T)*S+(L*S+TT*T)*T
      H(IH3K) =-(U*S+L*T)*T+(L*S+TT*T)*S
      H(IH4K) = (U*T-L*S)*T+ (-L*T+TT*S)*S
C
C
      IF(KP1-N) 840,840,841
  840 CONTINUE
C
      DO 807 LL=KP1,N
      IH3L=ISH3+LL
      IH4L=ISH4+LL
      U=H(IH3L)
      L=H(IH4L)
      H(IH3L)= U*S+L*T
      H(IH4L)=-U*T+L*S
  807 CONTINUE
C
  821 CONTINUE
C
      IF(KP1-N) 823,823,841
  823 CONTINUE
      IH3K=ISH3+K
      DO 808 LL=KP1,N
      S=HS1(LL)
      T=HS2(LL-IP1)
      IF(T) 822,808,822
  822 CONTINUE
      IH4L=ISH4+LL
      U=H(IH3K)
      L=H(IH4L)
      H(IH3K)= U*S+L*T
      H(IH4L)= -U*T+L*S
  808 CONTINUE
  841 CONTINUE
C
C     FIN DE ROTATION DE LA LIGNE K
C
  805 CONTINUE
      B(IR)=HS1(IP1)
C
C     ON STOCKE DANS HS2 LE COSINUS DE LA ROTATION OU LE COSINUS PLUS
C     3. (SI LE SINUS EST NEGATIF)
      DO 3410 K=IP2,N
      S=HS1(K)
      IF(S.GE.0.D0) GO TO 3410
      HS2(K-IP1)=HS2(K-IP1)+3.0D00
 3410 CONTINUE
C
C     ON TRANSFERE LA LIGNE SUIVANTE DANS HS1
      DO 3050 K=IP1,N
 3050 HS1(K)=H(ISH3+K)
C   LES COSINUS DES ROTATIONS STOCKES DANS HS2 SONT TRANSFERES DANS H
      ISH1=NSTART(IR)-IR
      DO 3020 K=IP2,N
 3020 H(ISH1+K)=HS2(K-IP1)
  801 CONTINUE
C
      C(NM1)=H(NSTART(NM1))
      B(NM1)=H(NSTART(NM1)+1)
      C(N)=H(NSTART(N))
      B(N)=0.D0
      GO TO 850
    9 CONTINUE
      nn1=1
      nn2=2
      nn3=3
      C(NM1)=H(nn1)
      B(NM1)=H(nn2)
      C(N)=H(nn3)
      B(N)=0.D0
C
  850 CONTINUE
      NORM=DABS(C(1))+DABS(B(1))
      DO 10 I=2,N
      T=DABS(C(I))+DABS(B(I))+DABS(B(I-1))
      IF(NORM-T) 104,10,10
  104 NORM=T
   10 CONTINUE
      DO 11 I=1,N
   11 W(I)=B(I)*B(I)
      K=1
      L=-NORM
      MULT=NORM*EPSI
      DO 12 I=1,NEV
   12 E(I)=NORM
   13 U=E(K)
   14 LAMBD=0.5*(L+U)
      IF(LAMBD-L-MULT) 30,30,106
  106 IF(U-LAMBD-MULT) 30,30,107
  107 AG=0
      I=1
   16 S=C(I)-LAMBD
   18 IF(DABS(S)-1.D-21) 20,108,108
  108 IF(S) 110,110,109
  109 AG=AG+1
  110 I=I+1
      IF(I-N) 111,111,22
  111 S=C(I)-LAMBD-W(I-1)/S
      GO TO 18
   20 AG=AG+1
      I=I+2
      IF(I-N) 16,16,22
   22 IF(AG-N+K) 24,24,112
  112 L=LAMBD
      GO TO 14
   24 U=LAMBD
      IF(N-AG-NEV) 113,113,114
  113 M=N-AG
      GO TO 115
  114 M=NEV
  115 DO 26 I=K,M
   26 E(I)=LAMBD
      GO TO 14
   30 E(K)=LAMBD
      K=K+1
      IF(K-NEV) 13,13,116
  116 IF(NVEC) 40,999,40
   40 II=0
      INN=-N
      EPSIN=NORM*EPSDG
      DO 90 I=1,NVEC
      INN=INN+N
      IEPS=0
      VY(N+1)=0.
      VY(N+2)=0.
  402 T=E(I)
      IEPS=IEPS+1
      GO TO (430,404),IEPS
  404 J=I-II
      IF(J) 406,406,407
  406 S=NORM
      GO TO 408
  407 S=T-E(J)
  408 L=T
      DO 414 K=I,NEV
      U=E(K)
      IF(U-L - EPSIN) 410,416,416
  410 L=U
  414 CONTINUE
  416 TT=U-T
      IF(TT-S) 418,420,420
  418 S=TT
  420 U=DABS(T)
      IF(U-S) 422,424,424
  422 U=S
  424 T=T + U*EPSDG*0.1
      IR=0
  430 CONTINUE
      DO 44 J=1,N
      P(J)=0.
      Q(J)=B(J)
      R(J)=C(J)-T
      GO TO (42,44),IEPS
   42 VY(J)=1.0
   44 CONTINUE
      DO 50 J=1,NM1
      IF(DABS(R(J))+DABS(B(J))) 152,152,154
  152 IN(J)=0
      W(J)=0.
      R(J)=1.D-30
      GO TO 50
  154 CONTINUE
      IF(DABS(R(J))-DABS(B(J)))49,117,117
  117 MULT=B(J)/R(J)
      IN(J)=0
      GO TO 48
   49 MULT=R(J)/B(J)
      IN(J)=1
      R(J)=B(J)
      T=R(J+1)
      R(J+1)=Q(J)
      Q(J)=T
      P(J)=Q(J+1)
      Q(J+1)=0.
   48 W(J)=MULT
      Q(J+1)=Q(J+1)-MULT*P(J)
      R(J+1)=R(J+1)-MULT*Q(J)
      IF(DABS(R(J))-1.D-30) 118,118,50
  118 R(J)=1.D-30
   50 CONTINUE
      IF(DABS(R(N))-1.D-30)  119,119,120
  119 R(N)=1.D-30
  120 GO TO (1202,145),IEPS
 1202 IF(I-NVEC) 155,121,121
  155 IF(DABS(E(I+1)-E(I)) - EPSIN) 53,121,121
  121 IF(II) 122,55,122
  122 KK=1
      GO TO 54
   53 KK=2
   54 II=II+1
      IF(II-1) 123,55,123
  123 JOY=0
      IR=0
   51 JOY=JOY+1
      IF(JOY-JOYM) 124,95,95
  124 DO 52 J=1,N
C      VY(J)=RAN(ALF)
      VY(J)=RAND()
   52 CONTINUE
   55 ITEV=0
   56 ITEV=ITEV+1
      DO 66 JI=1,N
      K=N-JI+1
   62 T=VY(K)
      TNUM= T-VY(K+1)*Q(K)-VY(K+2)*P(K)
      TDEN=R(K)
      IF(DABS(TNUM).GT.1.D-30) THEN
      DLTNUM=DLOG(DABS(TNUM))
      ELSE
      DLTNUM=-30.D0
      END IF
      IF((DLTNUM-DLOG(DABS(TDEN))).GT.DLGMAX) THEN
      DO 64 J=1,N
   64 VY(J)=VY(J)*1.D-5
      GO TO 62
      END IF
      VY(K)=TNUM/TDEN
   66 CONTINUE
      IF(ITEV-1) 145,145,131
  131 S=E(I)
      TT=DABS((C(1)-S)*VY(1) + B(1)*VY(2))
      T=DABS(VY(1))
      DO 135 J=2,N
      U =DABS(B(J-1)*VY(J-1) + (C(J)-S)*VY(J) + B(J)*VY(J+1))
      IF(TT-U ) 132,133,133
  132 TT=U
  133 U =DABS(VY(J))
      IF(T-U ) 134,135,135
  134 T=U
  135 CONTINUE
      S=TT/T
      IF(S-EPSV) 136,136,139
  136 IF(ITEV-2) 69,69,137
  137 WRITE(6,100) I,ITEV
      GO TO 69
  139 WRITE(6,101) I,EPSV,ITEV ,TT,T,S
      IF(ITEV-ITEVM) 145,69,69
  145 DO 68 J=1,NM1
      IF(IN(J)) 144,144,67
  144 VY(J+1)=VY(J+1)-W(J)*VY(J)
      GO TO 68
   67 T=VY(J)
      VY(J)=VY(J+1)
      VY(J+1)=T-W(J)*VY(J+1)
   68 CONTINUE
      GO TO 56
   69 CONTINUE
      T=1./T
      DO 98 J=1,N
   98 VY(J)=VY(J)*T
      IF(II-1) 77,147,72
   72 JI=I-II+1
      M=I-1
      T=0.
      DO 70 J=1,N
      U=VY(J)
   70 T=T + U*U
      T=1./T
      AG=1
      IKK=N*(JI-2)
      DO 75 K=JI,M
      IKK=IKK+N
      S=0.
      DO 73 J=1,N
      JVK=IKK+J
   73 S=S+VY(J)*V(JVK)
      TT=S*Z(K)
      DO 74 J=1,N
      JVK=IKK+J
   74 VY(J) = VY(J)-TT*V(JVK)
      U=S*TT*T
      T=T/(1.-U)
      IF(U-0.75) 75,75,76
   76 AG=2
   75 CONTINUE
      GO TO (160,143),AG
  143 ITEV=1
      IR=IR+1
      GO TO (145,1432),IR
 1432 GO TO (402,51),IEPS
  160 IF(JOY-2) 147,147,146
  146 WRITE(6,100) I,II,JOY,IR
  147 S=0.
      DO 162 J=1,N
      JVI=INN+J
      U=VY(J)
      S=S + U*U
  162 V(JVI)=U
      Z(I)=1./S
C
C
      GO TO (78,90),KK
   77 DO 777 J=1,N
      JVI=INN+J
  777 V(JVI)=VY(J)
   78 CONTINUE
      II=0
   90 CONTINUE
      NBL1=0
      IF(NM2)85,85,81
   81 DO 84 J=1,NM2
      K=N-J-1
      KS=J+2
      KP=K+1
      M=K+2
      IR=N+1
      IS=J+1
      ISH1=NSTART(K)-K
C
      DO 83 KK=M,N
      IS=IS-1
      IR=IR-1
      T=H(ISH1+IR)
      IF(T.GT.1.5D0) GO TO 3460
      IF(T.EQ.0.D0) GO TO 83
      S=DSQRT(1.D0-T*T)
      GO TO 3470
 3460 T=T-3.0D0
      S=-DSQRT(1.0D0-T*T)
 3470 CONTINUE
      INN=-N
      DO 89 JOY=1,NVEC
      INN=INN+N
      KPJOY=INN+KP
      IRJOY=INN+IR
      U=V(KP JOY)
      L=V(IR JOY)
      V(KP JOY)=U*S-L*T
      V(IR JOY)=U*T+L*S
   89 CONTINUE
   83 CONTINUE
   84 CONTINUE
   85 CONTINUE
      INN=-N
      DO 87 JOY=1,NVEC
      INN=INN+N
      S=0.
      DO 86 J=1,N
      JJOY=INN+J
   86 S=S+V(J JOY)*V(J JOY)
      S=1./DSQRT(S)
      DO 88 J=1,N
      JJOY=INN+J
   88 V(J JOY)=V(J JOY)*S
   87 CONTINUE
  999 RETURN
   95 WRITE(6,102)I,II,JOYM
      CALL EXIT
  100 FORMAT(1H0,10I5)
  101 FORMAT(1H0,I4,E16.8,I3,3E18.8)
  102 FORMAT(1H0,I4,I3)
      RETURN
 99   CONTINUE
      E(1)=H(1)
      V(1)=1.0
      RETURN
      END

