
C == TO SOLVE SELF-CONSISTENT FIELD HARTREE-FOCK ==
C===== EQUATIONS========================
      SUBROUTINE DH2(ALFA,BET,H,Z,
     *EPS,GAM,TETA,ALM3,R1,R2,R3,R4,R5,R6,
     *R8,MU,C3,ALA,ALA1,ALA2,ALM7,
     * NE5,IS,NU,IG,KK,
     *ISIGM1,ISIGM2,IN,IL,IQ,DIR,UD,KSU1,DZ,ZK,ETOT)
C========================================
      REAL*8ALFA,BET,H,Z,EPS,GAM( NU),
     *TETA(IS),B,C,D,P,RR1,MU,ETOT,
     * ALM7(IS),
     *TETMAX,A1,
     *ALM3(IS),R2(NE5 ),
     * R1( NE5), R3( NE5),R4( NE5),R5( NE5),
     *R6( NE5),R8(NE5,*),C3(IS),ALA(IS),ALA1(IS),
     *  ALA2(IS),DZ,Z1
      INTEGER   KK(NU),ISIGM1(NU),DIR(IS),
     *ISIGM2(NU),IN(IS),IL(IS),IQ(IS),UD(IS),ZK
      NE=NE5-15
       DO 10   I=1,IS
  10   ALM3(I)=0.0
      Z1=Z
      Z=Z+DZ
   20 IS1=0
      R2(NE+4)=0.D 00
      WRITE(6,30) Z
      WRITE(*,30) Z
  30  FORMAT(/' CURRENT NUCLEUS CHARGE=',E15.6)
      DO 40 I=1,IS
  40  ALM7(I)=0.0
C======1 cycle=====
  50  IS1=IS1+2
      IF(IS1.GT.IS) IS1=IS1-1
      DO 60 I=1,IS1
      ISIGM=I
      IA=1
 51   CALL MAIN1(ALFA,BET,H,Z,EPS,GAM,TETA,
     * R1,R2,R3,R4,R5,R6,R8,C3,ALA,ALA1,ALA2,
     * ALM7,MU,IS,NE5,IQ,ISIGM,IN,IL,
     * IG,NU,ISIGM1,ISIGM2,KK,UD,KSU1)
      ALM3(I)=R5(1)
      CALL COLUMN(NE5,R5,R8(1,I))
      WRITE(*,61)I,TETA(I),R5(1)
  61  FORMAT(' I1',I3,' TETA',E15.6,' E',E15.6)
C     IF(IA.EQ.1)THEN
C     IA=2
C     GO TO 51
C     END IF
  60  CONTINUE
      IF(IS1.LT.IS) GOTO 50
      WRITE(*,62)
  62  FORMAT(' end of 1 cycle   ')
C===2 cycle=====
      DO 80 IJ=1,IS
      I=IS1-IJ+1
C     I=IJ
      ISIGM=I
      CALL MAIN1(ALFA,BET,H,Z,EPS,GAM,TETA,
     * R1,R2,R3,R4,R5,R6,R8,C3,ALA,ALA1,ALA2,
     * ALM7,MU,IS,NE5,IQ,ISIGM,IN,IL,
     * IG,NU,ISIGM1,ISIGM2,KK,UD,KSU1)
      CALL COLUMN(NE5,R5,R8(1,I))
      ALM3(I)=R5(1)
      WRITE(*,81)I,TETA(I),R5(1)
  81  FORMAT(' I2',I3,' TETA',E15.6,'  E',E15.6)
  80  CONTINUE
C  70  CONTINUE
C===3 cycle=======
      NKL=0
  90  TETMAX=0.
      DO 100 IJ =1,IS1
      I=IS1-IJ+1
      ISIGM=I
C      DO 110 IJJ=1,IS
       IF(DABS(TETA(I)).GT.EPS.OR.(IJ.EQ.IS1)) THEN
C     * DABS(TETA(IJJ)).LT.EPS*100.) GOTO 110
C       GOTO 120
C 110   CONTINUE
C      GOTO 130
C 120  CONTINUE
      CALL MAIN1(ALFA,BET,H,Z,EPS,GAM,TETA,
     * R1,R2,R3,R4,R5,R6,R8,C3,ALA,ALA1,ALA2,
     * ALM7,MU,IS,NE5,IQ,ISIGM,IN,IL,
     * IG,NU,ISIGM1,ISIGM2,KK,UD,KSU1)
      IRA=NE+2
      DO 140 IW1=1,IRA
 140  R2(IW1)=R5(IW1)
      CALL COLUMN(NE5,R8(1,I),R5)
      IF(DSIGN(1.D 00,R5(1)-ALM3(I)).EQ.
     *DSIGN(1.D 00,R2(1)-R5(1))) GOTO 160
      C=(R2(1)-R5(1))/(R2(1)-2.*R5(1)+ALM3(I))
      GOTO 150
 160  C=0.
 150    IF(DABS(C).GT.0.99) C=C*0.99
      R2(1)=C*R5(1)+(1.-C)*R2(1)
      ALM3(I)=R5(1)
      R5(1)=R2(1)
      DO 170 IW1=1,NE
 170  R5(IW1+2)=C*R5(IW1+2)+(1.-C)*R2(IW1+2)
      R5(2)=0.
      C=0.
      D=0.
      DO 180 IW1=1,NE
      P=D
      D=C
      C=(R5(IW1+2)   *R1(IW1+2)/
     *(ALFA*R1(IW1+2)+BET))**2
      A1=5.*C
      B=8.*D
      A1=(A1+B-P)*H/12.
 180  R5(2)=R5(2)+A1
      CALL COLUMN(NE5,R5,R8(1,I))
      END IF
      WRITE(*,181)I,TETA(I),R5(1)
 181  FORMAT(' I3',I3,' TETA',E15.6,' E',E15.6)
      TETMAX=DABS(TETA(I))+TETMAX
 100  CONTINUE
      NKL=0
      IF((TETMAX/DFLOAT(IS)).GT.EPS) GOTO 90
      DO 190 I=1,IS
      ISIGM=I
      CALL MAIN1(ALFA,BET,H,Z,EPS,GAM,TETA,
     * R1,R2,R3,R4,R5,R6,R8,C3,ALA,ALA1,ALA2,
     * ALM7,MU,IS,NE5,IQ,ISIGM,IN,IL,
     * IG,NU,ISIGM1,ISIGM2,KK,UD,KSU1)
      CALL COLUMN(NE5,R5,R8(1,I))
      NKL=1
      WRITE(*,192)I,TETA(I),R5(1)
 192  FORMAT(' I4',I3,' TETA',E15.6,'  E',E15.6)
      IF(DABS(TETA(I)).GT.EPS) GOTO 90
 190  CONTINUE
      Z=Z-DZ/ZK
      IF(Z1-Z.LE.1E-8.AND.DZ.NE.0.0D 00) GOTO 20
      Z=Z1
      ETOT=0.0
      DO 200 I=1,IS
      CALL COLUMN(NE5,R8(1,I),R5)
      DO 210 IW=1,NE
 210  R5(IW+2)=R5(IW+2)/DSQRT(R5(2))
      R5(1)=-R5(1)
      R5(NE+4)=R5(2)
      R5(NE+5)=DFLOAT(IN(I))
      R5(NE+6)=DFLOAT(IQ(I))
      R5(NE+7)=0.D 00
      R5(NE+8)=DFLOAT(DIR(I))
      R5(2)=DFLOAT(  IL(I))
      CALL COLUMN(NE5,R5,R8(1,I))
      DO 220 KK1=1,NE
 220  R2(KK1+1)=R1(KK1+2)*(R5(KK1+2)/
     *(ALFA*R1(KK1+2)+BET))**2
      CALL SIMPS2(ALFA,BET,H,RR1,R1,R5,R5,R2,R2,NE5,1)
      ETOT=ETOT+1./3.*DFLOAT(IQ(I))*
     *(R5(1)-2.*Z*RR1)
 200  CONTINUE
      RETURN
      END
