* ZED =============================================96/02===*
      SUBROUTINE DHFDH5(NSH,IOS,NST,NA,NB,MMA,MLN,LK,MI,ND,Z1,Z2,RZ,
     *             EPS,RP,AHF,BHF,AA,BB,UU,VV,WW,RR,X,E,CN,
     *             CX,WC,PP,PPS,PQV,QQ,Z,XC)
* V 1 ---------------------------------------------- 1 ----*
      IMPLICIT    REAL*8 (A-H,O-Z)
      DIMENSION   MLN(3,*),LK(*),MI(*),
     *    RP(*),AHF(NSH,NSH),BHF(NSH,NSH),
     *    AA(NA,MMA),BB(NA,MMA),UU(NA,*),VV(NA,MMA),
     *    WW(NA,NA),WC(NA,NA),CX(NA,3),
     *    RR(NB,*),X(NB,*),PQV(NB,*),PP(*),PPS(*),QQ(*),Z(*),
     *    E(10),CX1(10),B(4),G(50),DD(100),
     *    LC(10),CN(10),  BZ(4),ED(10)
      NA1=NA+1

c      IF(MI(1).EQ.1)  CALL HAFE1(NA1,NB,HB,RP,RR)
      IF(MI(1).EQ.2)  CALL Cotr0(NA1,NB,HB,RP,RR)
c      IF(MI(1).EQ.3)  CALL HAFE3(NA1,NB,HB,RP,RR)
C      IF(MI(1).EQ.4)  CALL HAFE4(NA1,NB,HB,RP,RR)
      CALL HAFA0(NA,NB,MMA,RP(1),HA,RR,AA,BB,UU,VV,G,BZ)
      IF(MI(1).GE.3) CALL VEQC(3,0.D 00,BZ)

*      IF(MI(1).GE.3) BZ(1)=0.D 00
C      RP(3)=1.02D 00
C      RP(2)=1.0D 00
C      CALL FOMAD(NA,NB,3,HA,HB,RP,RR,AA,BB,UU,VV,G)
      WRITE(10,500) Z1,Z2,RZ,NSH
      DO 10 I=1,NSH
   10    WRITE(10,505) I,(MLN(J,I),J=1,3)
      WRITE(10,510)
      DO 15 I=1,NSH
   15    WRITE(10,515) I,(AHF(J,I),J=1,NSH)
      DO 20 I=1,NSH
   20    WRITE(10,520) I,(BHF(J,I),J=1,NSH)
      WRITE(10,525) RP(2),NB,RP(1),NA,EPS
      CALL VEVR(NA*NA,UU,WW)
      CALL INVM(NA,DET,WW)
      KD=2
      IF(DABS(Z1-Z2).GT.1.D-05) KD=1
      RZ2=RZ*RZ/2.D 00
      RZ3=RZ2*RZ/4.D 00
      AS=RZ*(Z1+Z2)
      AD=RZ*(Z2-Z1)
      IF(DABS(AD).GT.1.D-05) KD=1
         LC(1)=LK(NSH)
         DO 25 IL=2,ND
   25       LC(IL)=LC(IL-1)+MLN(3,NSH)
         DO 26 IL=1,ND
   26       LK(NSH+IL)=LK(NSH+IL-1)+MLN(3,NSH)
         NX=MLN(3,NSH)
         WRITE(*,*) EPS,BZ(1),BZ(2)
C         call vevr(nd,e(nsh),ed)

          ed(1) = e(nsh-1)/2.d0
        write(*,*) ' ed1= ',ed(1),e(1),nsh

         CALL DHFDI5(NSH,IOS,NST,NA,NB,NX,KD,mi(3),MLN,LK,LC,ND, EPS,
     *          ED,HB,HA,AS,AD,RZ2,RZ3,AHF,BHF,
     *          AA,BB,VV,UU,WW, G,B,BZ,RR,X,XC,CN,CX,WC,DD,CX1,
     *          PQV,PP,PPS,QQ,Z)
C       if(is.ge.0) goto 25
C         IF(MI(4).EQ.1) THEN
C           DO 26 IK=1,NSH
C              IF(IS.NE.IK.AND.JOR(IK,IS).EQ.1) THEN
C                NLS=LK(IS)
C                NLK=LK(IK)
C                CSK=FOVI(NX,NX,NA,NB,HA,HB,RZ3,DD,RR(1,2),RR(1,7),
C     *                    PQV(1,5),PQV(1,6),X(1,NLS),X(1,NLK))
C                WRITE(*,*) CSK,CN(IS),CN(IK)
C                CC=CSK/CN(IK)
C                DO 64 IN=1,NX
C                   KS=NLS+IN-1
C                   KK=NLK+IN-1
C                   DO 65 J=1,NB
C   65                 X(J,KS)=X(J,KS)-CC*X(J,KK)
C   64              CONTINUE
C      C12=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
C     *   DD,RR(1,2),RR(1,7),PQV(1,5),PQV(1,6),X(1,NLK),X(1,NLS))
C                CN(IS)=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
C     *                      DD,RR(1,2),RR(1,7),
C     *                      PQV(1,5),PQV(1,6),X(1,NLS),X(1,NLS))
C                WRITE(*,*) C12,CN(IS)
C                END IF
C   26         CONTINUE
C           END IF
c   25    CONTINUE
      DO 30 I=1,NSH
  30     WRITE(10,530) I,E(I)
      IF(MI(2).EQ.1) THEN
         DO 35 I=NSH,nsh+nd-1
            C12=1.D 00/DSQRT(CN(I))
            CN(I)=1.D 00
C            NX=MLN(3,I)
   35       CALL VCM1(NX*NB,C12,X(1,LK(I)))
         END IF
         CALL WIFD(ND,NB,NX,LC,ED,CN(NSH),X,11)
  500 FORMAT( 20X' DIATOMIC MOLECULE'/15X,
     *    ' HARTREE-FORK WAVE FUNCTIONS',/18X,
     *    ' SELF CONSISTENT FIELD',//
     *    ' NUCLEI CHARGES:       Z1 =',
     *      F6.3/23X,'Z2 =',F6.3//
     *    ' INTERNUCLEI DISTANCE: RZ  =',F7.4/
     *    ' NUMBER OF THE SHELLS: NSH =',I3//
     *    ' IDENTIFICATION OF THE SHELLS :'//
     *    5X,'N SHELL    M    L0   N OF P.W.'/)
  505 FORMAT(4X,I4,3X,3(I6))
  510 FORMAT(/' HARTREE-FOCK COEFFICIENTS:')
  515 FORMAT(/' A(',I2,', *)',3E15.5/,2(10X,3E15.5/))
  520 FORMAT(/' B(',I2,', *)',3E15.5/,2(10X,3E15.5/))
  525 FORMAT(//' INTEGRATION UP TO',10X,'RB =',F7.2/
     *    ' NO. INTEGRATION POINTS     NB =',I5//
     *    ' ANALITICAL APPROXIMATION :'/
     *    ' UP TO',20X,'  RA =',F9.3/
     *    ' WITH NUMBER OF POINTS      NA =',I5/
     *    '   ACCURACY   '10X'    EPS=',E10.2/60('=')/7X,
     *    ' R E S U L T S :'//3X,'N SHELL',10X,'ENEGIES')
  530 FORMAT(4X,I3,7X,E16.8)
      END