C=====================================
C  =======EXCHANGE POTENTIAL==for excited state==
C  =======IN HARTREE-FOCK DIRAC EQUATIONS======
C    line 45, 13.11.2000
      SUBROUTINE EXCHR3(ALFA,BET,H,NE5,AL0,IS,
     *ISIGM,NU,IG,IQ,GAM,KK,ISIGM1,ISIGM2,
     *IL,GAM1,ALM2,ALM3,
     *R1,R2,R4,R5,R6,R16,R9,R8,R12,R13,R14,R15)

      REAL*8 ALFA,BET,H,P,P1,NOR,GAMA,AL0,
     *   ALM2(*),ALM3(*),GAM(*),GAM1(*),
     *   R1(*),R2(*),R5(*),R4(*),
     *   R6(*),R16(*),R9(*),R8(NE5,*),
     *   R12(*),R13(*),R14(*),R15(*)
      INTEGER KK(*),ISIGM1(*),ISIGM2(*),IQ(*),IL(*)
      NE=NE5-15
C     IS1=IS-1
C     WRITE(*,2) ISIGM2(NU+2)
C2    FORMAT(' ISIGM2(NU+2)', I4)
      IF(ISIGM2(NU+2).EQ.0) GOTO 13
      DO 10 I=1,IS-1
       ALM3(I)=0.
      IF(IL(I).NE.IL(IS)) THEN
      CALL COLUMN(NE5,R8(1,I),R6)
      CALL COLUMN(NE5,R8(1,I+IS),R14)
      CALL COLUMN(NE5,R8(1,I+IS+IS),R9)
      CALL KSII(NE,AL0,R6(1),R9,R12)
      DO 20 IW=1,NE
      R6(IW+2)=R6(IW+2)
     * *R12(IW)+AL0*R14(IW)
      R2(IW+2)=R2(IW+2)
     * *R13(IW)+AL0*R15(IW)
 20   CONTINUE
      IA=IS+IS+IS+1
      IF(I.EQ.ISIGM2(NU+1)) IA=IS+IS+IS+2
      CALL COLUMN(NE5,R8(1,IA),R5)
      CALL SIMPS2(ALFA,BET,H,P,R1,R2,R6,R5,R9,NE5,0)
C     WRITE(6,2) R6(2)
C2    FORMAT(' exch-norm 1 ', E15.8)
      ALM3(I)=-2.*P/DSQRT(R6(2))
      END IF
  10  CONTINUE
  13  IF(IG.LT.1) GOTO 11
      DO 30 J=1,IG
      IA=ISIGM1(J)
      CALL COLUMN(NE5,R8(1,IA),R5)
      CALL COLUMN(NE5,R8(1,IA+IS),R14)
      CALL COLUMN(NE5,R8(1,IA+IS+IS),R9)
      CALL KSII(NE,AL0,R5(1),R9,R12)
C     WRITE(6,3) R5(2)
C3    FORMAT(' exch-norm 2 ', E15.8)
      NOR=R5(2)
      DO 40 IW=1,NE
      R6(IW+1)=R5(IW+2)*R2(IW+2)
     * *R13(IW)*R12(IW)+AL0**2*R14(IW)*R15(IW)
 40   CONTINUE
      CALL POT(ALFA,BET,H,R1,R6,KK(J),NE5)
      GAMA=2.*GAM(J)/NOR/DFLOAT(IQ(ISIGM))
      DO 50 IW= 1,NE
      R16(IW+2)=R6(IW+1)
      R4(IW+1)=R4(IW+1)+GAMA*R6(IW+1)*R5(IW+2)*R12(IW)*R13(IW)
  50  CONTINUE
      IF(ISIGM2(NU+2).EQ.0) GOTO 30
      IF(GAM1(J).EQ.0.0) GOTO 30
      DO 60 I=1,IS-1
      IF(IL(I).NE.IL(IS)) GOTO 60
      IF(I.EQ.ISIGM1(NU+1).AND.I.EQ.IA) GOTO 60
      CALL COLUMN(NE5,R8(1,I),R6)

      P1=DSQRT(R6(2))
      DO 70 IW=1,NE
  70   R6(IW+1)=R6(IW+2)
      CALL SIMPS2(ALFA,BET,H,P,R1,R5,R16,R6,R9,NE5,0)
      ALM3(I)=ALM3(I)+2.*P*GAM1(J)/NOR/P1
 60   CONTINUE
 30   CONTINUE
      IF(ISIGM2(NU+2).NE.0) GOTO 14
  11  CONTINUE
C     WRITE(*,75) (ALM3(I),I=1,IS)
C 75  FORMAT(' ALM3= ', 3(4E15.6/))
      DO 80 I=1,IS-1
  80  ALM3(I)=ALM2(I)
  14  CONTINUE
C     WRITE(*,76) (ALM3(I),I=1,IS)
C 76  FORMAT('  AALM3= ', 3(4E15.6/))
      DO 85 J=1,IS-1
      IF(ALM3(J).EQ.0.0) GOTO 85
      CALL COLUMN(NE5,R8(1,J),R6)
      DO 90 IW=1,NE
      R4(IW+1)=R4(IW+1)+ALM3(J)*R1(IW+2)*R6(IW+2)
     *  *R13(IW)/R6(2)
  90   CONTINUE
  85  CONTINUE
      P=H**2/12.
      DO 100 J=1,NE
 100  R4(J+1)=P*R1(J+2)*R4(J+1)/(ALFA*R1(J+2)+BET)**2
      RETURN
      END
