*\ = \===============================================================*
      SUBROUTINE DESYD(NX,NA,NB,IX,NSH,ISH,itr,
     *           LK,E,CH,RZ2,HA,HB,EPS,RZ3,
     *           GG,B,DD,AA,BB,VV,UU,WW,WC,PP,QQ,CX1,CN,
     *           CX,PQV,R,X)
*\___\_______________________________________________________________*

      IMPLICIT    REAL*8 (A-H,O-Z)
      DIMENSION   GG(2),B(4),DD(NX,NX),AA(NA),BB(NA),VV(NA),
     *     UU(NA,*),WW(NA,*),WC(NA,NA),PP(NB,NX,NX),QQ(NB,NX),
     *     CX1(NX),CN(*),CX(NA,*),PQV(NB,*),R(NB,*), X(NB,*),
     *     CU(100),CV(10), LK(*),Z(3),FZ(3), X0(26000)
*\___\_______________________________________________________________*

         WRITE(*,*) EPS
      ik=0
      NLI=LK(ISH)
      MI=0
      DE0=0.01D 00


       WRITE(*,320) NLI,ISH,LK(1)
  320  FORMAT( ' NLI=',5I3)
      CALL VEVR(NX*NB,X(1,NLI),X0)
      B(1)=1.D 00
      DO 5 I=2,4
    5    B(I)=0.D 00
      CALL VEQC(NX,0.D 00,CX1)
      EPS1=EPS/10.D 00
      EPS=1.D-06
       IF(CN(ISH).NE.0.D 00) EPN=EPS*DSQRT(CN(ISH))

cc       IPA=1
       IPA=0

       if(itr.EQ.0) then
         ipa = 0
         goto 306
         endif
       goto 306

      WRITE(*,518)
 518  FORMAT(' IPA= ')
      READ(*,*) IPA
      WRITE(*,310)
 310  FORMAT(' ITR = ')

  300 E1=E
          GOTO 301
C****************************************
*        GOTO 306

         WRITE(*,*) EPS

  100   DX=(C12-CN(ISH))/CN(ISH)
        WRITE(*,*) C12,CN(ISH)
        WRITE(*,*) E,DX
        DXX1=C12-CN(ISH)
        DXX2=DXX1/CN(ISH)
        WRITE(*,*) DXX1,CN(ISH),DXX2
        IF(DABS(DX).LT.EPS) RETURN

       IF(ik.eq.0) GOTO 306
       IF(IK.LE.1) GOTO 305

       DC=DX*DX1
       IF(DC.LT.0.D 00) THEN
        E2=E1
        DX2=DX1
        E1=E
        DX1=DX
        E=(E1+E2)/2.D 00
        GOTO 306
        END IF
       DC=DX*DX2
       IF(DC.LT.0.D 00) THEN
        E1=E
        DX1=DX
        E=(E1+E2)/2.D 00
        GOTO 306
        END IF

  305   E1=E
        DX1=DX
        DX2=DX
         if(ik.gt.0)
     *     E=E1*(1.D 00+0.002D 00*DX/DABS(DX))

       WRITE(*,517)
 517  FORMAT(' SUMX = ')
C      READ(*,*) IP
C        IP=0
*      IF(IP.EQ.2) RETURN
       GOTO 306
  301 DC=0.D 00
       WRITE(*,513)
  513  FORMAT( ' EE =')
       READ(*,*) E
  306    ER=E*RZ2
      NXA=NA*NX
       JKK=3+NX*NX
       CALL VEQC(NX*NX,0.D 00,CU)
       CALL VEQC(NX,0.D 00,CV)
       WRITE(*,*) CH
       WRITE(*,320) NLI
      write(*,*) '1 ipa, mi', ipa,mi
cc      read(*,*) i_q

      CALL DESY0(NA,NB,IPA,NX,NXA,IX,
     *                ER, Ddx, CU,CV,CH,GG,
     *                AA,BB,VV,UU,WW,WC,
     *              CX(1,1),CX(1,2),CX(1,12),
     *       DD,R(1,2),R(1,3),PP,QQ,PQV(1,1),PQV(1,2),
     *       PQV(1,3),PQV(1,JKK),X(1,NLI))

        WRITE(*,*) NSH,ISH

          write(10,*) 'Ddx, Ddx1 = ', Ddx, Ddx1
          write(10,*) ' itr,ik, s_zn = ', itr,ik, s_zn 
          write(*,*) ' itr,ik, s_zn = ', itr,ik, s_zn 
          write(*,*) ' De0 = ', De0
          s_zn = Ddx*Ddx1

cc        if( itr .eq. 0 .and. ik .gt. 0 
        if( itr .le. 1 .and. ik .gt. 0 
     *      .and. s_zn .lt. 0.d0) then
           return
         endif


        Ddx1 = Ddx

C       IF(DABS(CX2-CX(1,8)).GT.EPS) THEN

       ik = ik+1
      C12=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
     *   DD,R(1,2),R(1,7),PQV(1,5),PQV(1,6),X(1,NLI),X(1,NLI))
       yyy=DSQRT(C12)
        WRITE(*,*) 'Nsh, Ksh =',NSH,ISH
        WRITE(*,*) ' E , c12= ', E, c12
        WRITE(10,*) ' E , c12= ', E, c12


        if( itr .le. 1) then
          call eitdb(Mi,De0,Dx1,Dx2,Ddx,E1,E2,E)
          goto 306
         endif

c02       DO 711 IJK=1,NSH
       DO 711 IJK=1,ISH
cc          IF(MLN(1,IJK).EQ.MLN(1,NSH).AND.
cc     *        MLN(2,IJK).EQ.MLN(2,NSH)) THEN
             CNS=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
     *                      DD,R(1,2),R(1,7),
     *             PQV(1,5),PQV(1,6),X(1,LK(IJK)),X(1,NLI))
            CNS=CNS/YYY
c          WRITE(*,713) IJK,NLI,CNS
          WRITE(*,713) ijk,nli,CNS,LK(IJK),LK(NLI)
  713    format( ' ort',2I4,E15.6,2i5)
          WRITE(10,*) CNS
cc          END IF
  711     CONTINUE
      CX2=CX(1,8)
       WRITE(*,*) E
      WRITE(6,*) (CX(1,I+11),I=1,NX)
      WRITE(*,*) (CX(1,I+11),I=1,NX)
*       WRITE(*,*) (CC1(I),I=1,NSH)

       WRITE(*,999) C12
       WRITE(*,*) C12
      CII=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
     *   DD,R(1,2),R(1,7),PQV(1,5),PQV(1,6),X0,X(1,NLI))
       WRITE(*,*) CII

cc       IF(ITR.EQ.0.AND.DABS(E).LT.1.D+03) GOTO 100

 998   FORMAT( ' C53 =', E15.6)
       WRITE(*,512)
 512  FORMAT('  ICX= ')

       write(*,*) ' ipa, mi', ipa,mi
cc      read(*,*) i_q

cc      if (itr.EQ.0) then
         call eitd(Mi,De0,Dx1,Dx2,Ddx,E1,E2,E)

        IF(DABS(DX1).LT.EPS) GOTO 302
         goto 306

cc        endif

c       goto 301

      IF(ITR.EQ.1) THEN
        DX=(C12-CN(ISH))/CN(ISH)
        IF(MI.GT.3.AND.DX2*DX1.GT.0.D 00.AND.DX.LT.0.D 00.
     *     AND.DX*DX1.GT.0.D 00.AND.DABS(DX).GT.DABS(DX1)) GOTO 302
C     *     AND.DX*DX1.GT.0.D 00.AND.DX.GT.DX1) GOTO 305
        IF(DABS(DX).LT.EPS) GOTO 302
         CALL EITN(MI,DX1,DX2,DX,E1,E2,E)
        MI=MI+1
        GOTO 306
        END IF

cc        IF(IPA.EQ.1) CALL TEN0(MI,EPN,CN(ISH),C12,Z,FZ,E)

        IF(MI.EQ.10) GOTO 306
        IF(MI.EQ.20) RETURN

         goto 306

      READ(*,*) ICX
*      ICX=1
       IF(ITR.EQ.0) GOTO 100

 999   FORMAT( ' NORM =', E15.6)
****************

cc        WRITE(*,992)
cc  992    FORMAT( ' MII - SR ')
cc        READ(*,*) MII
cc        IF(MII.EQ.1)  CALL VVSR(NB*NX,0.5D 00,X0,X(1,NLI))

************
      IF(ICX.EQ.5) RETURN
C      IF(ICX.EQ.1) GOTO 100
      IF(ICX.EQ.1) GOTO 300
C************
  302 RETURN
      END