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

      PARAMETER   (Nxi=25,Nr=2000)
      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(Nxi,Nxi),CV(Nxi), LK(*), XSR(Nxi*Nr)
*\___\_______________________________________________________________*

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


       WRITE(*,320) NLI,ISH,LK(1)
  320  FORMAT( ' NLI=',5I3)
      B(1)=1.D 00
      DO 5 I=2,4
    5    B(I)=0.D 00

       dc = 1.d0
      CALL VEVR(NX*NB,X(1,NLI),XSR)
      CALL VEQC(NX,0.D 00,CX1)
      EPS1=EPS/10.D 00
       IPA=1
c       ITR=0

       Dx1 = 0.d0
       Dx2 = 0.d0
        write(*,*) ' itr = ',itr

       IF(itr.EQ.0) GOTO 306

       if(itr.EQ.2) then
         IPA=0
         GOTO 306
         endif

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

  300 E1=E

          GOTO 301
C****************************************
*        GOTO 306
         WRITE(*,*) EPS

  100     continue

         DX=(Cn_Is-CN(ISH))/CN(ISH)

       if ( ik .eq. 2 .or. ik .eq. 1) c_t = -(Cn_Is-c121)*(e-e1)

c       write (*,*) ' c_t =', c_t
c       write (10,*) ' c_t =', c_t

        if( c_t .gt. 0.d0 ) then

           write(10,*) ' Cn_Is,CN(ISH) = ', Cn_Is,CN(ISH),dx
          DX=-(Cn_Is-CN(ISH))/CN(ISH)

           else
            DX=(Cn_Is-CN(ISH))/CN(ISH)
          endif

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

C==  ik=0 (нулевой цикл), энергия E берется, как входной параметр
C==  процедуры
C==  ik=1 (первый цикл), энергия E вычисляется по формуле 
C==  E=E1*(...) - (1)< где Dx вычисляется по формуле, следующей 
C==  после метки 100

       IF(IK.LE.1) GOTO 305
C==

       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
         c121=Cn_Is
         if ( ik .eq. 0 ) c121 = cn(ish)

       if (ik.ge.2) then
        DX1=DX
        DX2=DX
        endif

       E=E1*(1.D 00+0.002D 00*DX/DABS(DX))

       WRITE(*,517)
 517  FORMAT(' SUMX = ')

       GOTO 306
  301 DC=0.D 00
       WRITE(*,*) X(NB-1,1)
       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(*,*) ' itr,ipa = ',itr,ipa

      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,Nx+2),
     *       DD,R(1,2),R(1,3),PP,QQ,PQV(1,1),PQV(1,2),
     *       PQV(1,3),PQV(1,JKK),X(1,NLI))


        IF( itr .eq. 2 .and. DABS(DdX).LT.EPS) RETURN

       IK=IK+1

      CX2=CX(1,8)
      WRITE(*,*) ' E = ', E
      WRITE(*,*) ' CX = '
      WRITE(*,995) (CX(1,I+Nx+1),I=1,NX)

      Cn_Is=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))
       WRITE(*,999) Cn_Is
      CII=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
     *   DD,R(1,2),R(1,7),PQV(1,5),PQV(1,6),XSR,X(1,NLI))
       WRITE(*,994) CII

      DO 997 I=1,NSH
      C55=FOVI(NX,NX,NA,NB,HA,HB,RZ3,
     *   DD,R(1,2),R(1,7),PQV(1,5),PQV(1,6),X(1,LK(I)),X(1,NLI))

  997       WRITE(*,998) ISH,I,C55

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

 998   FORMAT( ' I_ov ',I3,'-',I3, E15.6)

      if (itr.ne.2) then
       WRITE(*,512)
 512   FORMAT('  ICX= ')
       READ(*,*) ICX
       endif

cc      write(*,*) ' dx, 1, 2 = ', ddx, dx1, dx2
cc      write(10,*) ' E, 1, 2 = ', e, e1, e2
cc      write(10,*) ' dx, 1, 2 = ', ddx, dx1, dx2
cc      write(10,*) ' --------= '

      IF(ITR.EQ.2) THEN
c        IF(DABS(E).LT.DABS(E00)/2.D 00) RETURN
c        IF(DABS(DX).LT.EPS) GOTO 308
c         IF(MI.NE.0.AND.DABS(DX).GT.DABS(DX1)) GOTO 308
         CALL EITD(MI,DE0,DX1,DX2,DdX,E1,E2,E)

         GOTO 306
        END IF

       IF(ITR.EQ.0) GOTO 100

  995 FORMAT( 5E13.4)
  996   FORMAT( ' CNO=',E15.5)
 999   FORMAT( ' Norm_new = ', E15.7)
 994   FORMAT( ' I(Xnew*X)= ', E15.7)
      IF(ICX.EQ.5) RETURN
C      IF(ICX.EQ.1) GOTO 100
      IF(ICX.EQ.1) GOTO 300
C************

  302 RETURN
      END
