C========================================
C  =======EXCHANGE POTENTIAL=============
C  =======IN HARTREE-FOCK EQUATIONS======
      SUBROUTINE EXCH3(ALFA,BET,H,IS,R1,
     *ISIGM,IG,NU,L,ALM2,ALM3,IQ,GAM,GAM1,KK,ISIGM1,ISIGM2,
     *SPI,R2,R3,R4,R6,R10,R9,R8,NE5)
      REAL*8 ALFA,BET,H,R1(NE5),R2(NE5),P,P1,NOR,R8(NE5,*),R9(NE5),
     *R3(NE5),R4(NE5),R10(NE5),R6(NE5),ALM3(1),GAM(1),GAM1(1),GAMA,
     *ALM2(1)
      INTEGER KK(1),ISIGM1(1),ISIGM2(1),IQ(1),L(IS),
     *         SPI(IS)
      NE=NE5-15
      IS1=IS-1
      IF(ISIGM2(NU+2).EQ.0) GOTO 13
      DO 1 I=1,IS1
      ALM3(I)=0.
      IF(L(I).EQ.L(IS).AND.SPI(I).EQ.SPI(IS)) THEN
      CALL COLUMN(NE5,R8(1,I),R6)
      IA=IS+1
      IF(I.EQ.ISIGM2(NU+1)) IA=IS+2
      CALL COLUMN(NE5,R8(1,IA),R3)
      CALL SIMPS2(ALFA,BET,H,P,R1,R2,R6,R3,R9,NE5,0)
      ALM3(I)=-2.*P/DSQRT(R6(2))
      END IF
  1   CONTINUE
  13  IF(IG.LT.1) GOTO 11
      DO 3 J=1,IG
      IA=ISIGM1(J)
      CALL COLUMN(NE5,R8(1,IA),R3)
      NOR=R3(2)
      DO 4 IW=1,NE
   4  R6(IW+1)=R3(IW+2)*R2(IW+2)
      CALL POT(ALFA,BET,H,R1,R6,KK(J),NE5)
      GAMA=2.*GAM(J)/NOR/DFLOAT(IQ(ISIGM))
      DO 5 IW= 1,NE
      R10(IW+2)=R6(IW+1)
   5  R4(IW+1)=R4(IW+1)+GAMA*R6(IW+1)*R3(IW+2)
      IF(ISIGM2(NU+2).EQ.0) GOTO 3
      IF(GAM1(J).EQ.0.0) GOTO 3
      DO 6 I=1,IS1
C      IF(L(I).NE.L(IS)) GOTO 6
      IF(L(I).EQ.L(IS).AND.SPI(I).EQ.SPI(IS)) THEN
      IF(I.EQ.ISIGM1(NU+1).AND.I.EQ.IA) GOTO 6
      CALL COLUMN(NE5,R8(1,I),R6)
      P1=DSQRT(R6(2))
      DO 7 IW=1,NE
   7  R6(IW+1)=R6(IW+2)
      CALL SIMPS2(ALFA,BET,H,P,R1,R3,R10,R6,R9,NE5,0)
      ALM3(I)=ALM3(I)+2.*P*GAM1(J)/NOR/P1
      END IF
   6  CONTINUE
   3  CONTINUE
      IF(ISIGM2(NU+2).NE.0) GOTO 14
  11    DO 12 I=1,IS1
  12  ALM3(I)=ALM2(I)
  14  CONTINUE
C     WRITE(*,100) (ALM3(I),I=1,IS)
C     WRITE(6,100) (ALM3(I),I=1,IS)
C 100  FORMAT('  EXCH OFF.PARAM ALM3= '/ 5(X,4E13.5/))
        DO 8 J=1,IS1
      IF(ALM3(J).EQ.0.0) GOTO 8
      CALL COLUMN(NE5,R8(1,J),R6)
      DO 9 IW=1,NE
   9  R4(IW+1)=R4(IW+1)+ALM3(J)*R1(IW+2)*R6(IW+2)/R6(2)
   8  CONTINUE
      P=H**2/12.
      DO 10 J=1,NE
  10  R4(J+1)=P*R1(J+2)*R4(J+1)/(ALFA*R1(J+2)+BET)**2
      RETURN
      END
