*//////////////////////////////////////////////////////////////////*
      SUBROUTINE Syder3(NA,NB, Mi, MiB,NX,NXA,IX0, CXN,
     *                ER,DX,COD,  CU,CV, CVI,CH,GG,
     *                AA,BB,VV,UU,WW,WC,CP,CQ,CX,
     *             C0, CAA,
     *                DD,R1,R2,PP,QQ,P,Q,U,V, QX,X)
*  -  -------------------------------------------------------------*
      IMPLICIT    REAL*8 (A-H,O-Z)
      DIMENSION  AA(NA),BB(NA),VV(NA),CP(NA),CQ(NA),CX(NA),
     *       UU(NA,1),WW(NA,NA),WC(NXA,NXA),DD(NX,*),
     *       P(NB),Q(NB),U(NX,NX,NB),V(NX,NB),X(NB,*),
     *       R1(NB),R2(NB),PP(NB,NX,NX),QQ(NB,NX),C(850),
     *     GG(2),   CU(NX,NX),CV(*),
     *       CVI(*),  QX(NX,NX,NB)
     *       ,C0(*),AC0(20),   CAA(NA,NX), CB(20)
* === =============================================================*

      NA1=NA+1
      NP=0
      HC=1.D 00/CH
      NX2=NX*NX
      NXB=NX*NX*NB

      CALL VEQC(NXA*NXA,0.D 00,WC)
      CALL VEQC(NX*NB,0.D 00,V)
      CALL VEQC(NXB,0.D 00,U)
      CALL VEQC(NXB,0.D 00,QX)

        DO 3 J=1,NX
           U(J,J,NB)=0.D 00
           QX(J,J,NB)=1.D 00
C           QX(J,J,NB)=X(NB,J)
           V(J,NB)=0.D 00
C           V(J,NB)=X(NB,J)
    3      CONTINUE

      CALL Progbp(NX,NA,NB,HC,ER,PP,QQ,R1,R2,DD,
     *              CU,CV,CVI,C,C(401),U,V,QX)


      IPA=1
*=================== Selax
      DO 5 IX=1,NX
         DO 10 J=1,NA
            Q(J)=QQ(J,IX)
    9        WC(J+NP,1+NP)=UU(J,NA1)*GG(2)
   10       CONTINUE
         CQ(1+NP)=V(IX,NA+2)
   14      DO 15 I=2,NA
            CQ(I+NP)=0.D 00
            WC(I+NP,I+NP)=AA(I-1)
            WC(I-1+NP,I+NP)=WC(I-1+NP,I+NP)+BB(I-1)
            DO 20 J=1,NA
   20          CQ(I+NP)=CQ(I+NP)+Q(J)*WW(J,I-1)/VV(J)
   15       CONTINUE

         NP1=0
         DO 25 JX=1,NX
            DO 30 J=1,NA
               IF(IX.NE.IX0.OR.IPA.EQ.1) WC(J+NP1,1+NP)=
     *        WC(J+NP1,1+NP)
     *                  +UU(J,NA)*GG(1)*U(JX,IX,NA+2)
   30          P(J)=PP(J,JX,IX)-ER*R2(J)*DD(JX,IX)
            IF(JX.EQ.IX) THEN
             DO 35 J=1,NA
   35           P(J)=P(J)+ER*R2(J)*R1(J)
             END IF

            DO 40 I=1,NA
               CP(I)=0.D 00
               DO 45 J=1,NA
   45             CP(I)=CP(I)+P(J)*WW(J,I)
   40          CONTINUE

            DO 50 I=2,NA
               DO 55 J=1,I-1
   55             WC(J+NP1,I+NP)=WC(J+NP1,I+NP)+CP(I-J)
   50          CONTINUE
            NP1=NP1+NA
   25       CONTINUE
            NP=NP+NA
    5       CONTINUE
*==============================
 100         FORMAT( 5E12.4)

      CALL INVM(NXA,QK,WC)

      NP=0
      DO 60 IX=1,NX

         DO 65 I=1,NA
            CB(I)=FSMV(NXA,CQ,WC(1,I+NP))
C             WRITE(10,*) 'CB_I',I,CB(I)
            DO 67 JX=1,NX
              CAA(I,JX)= 0.0D 00
              DO 68 KX=1,NX
   68           CAA(I,JX)=CAA(I,JX)+
     *              QX(JX,KX,NA+2)*WC(1+NA*(KX-1),I+NP)

   67         CONTINUE
   65       CONTINUE

         CVI(IX)=CB(1)
         AC0(IX)=CB(1)
         DO 69 JX=1,NX
   69       U(JX,IX,1)=CAA(1,JX)
         DO 71 I=1,NA
            DO 73 JX=1,NX
   73          QX(JX,IX,I)=VV(I)*FSMV(NA,CAA(1,JX),UU(1,I))
   71       V(IX,I)=VV(I)*FSMV(NA,CB,UU(1,I))
         DO 72 JX=1,NX
   72       QX(JX,IX,NA1)=QX(JX,IX,NA)*GG(1)/VV(NA)
         V(IX,NA1)=V(IX,NA)*GG(1)/VV(NA)
         NP=NP+NA
   60    CONTINUE


      DO 61 I=NA+2,NB
         CALL MTXM(NX,NX,NX,QX(1,1,I-1),U(1,1,I),U(1,1,I-1))
CC         CALL VVS2(NX2,U(1,1,I-1),QX(1,1,I-1))
         CALL VMIV(NX2,U(1,1,I-1),QX(1,1,I))
         CALL MTXM(NX,1,NX,V(1,I-1),U(1,1,I),CQ)
         CALL VMIV(NX,CQ,V(1,I))
   61    CONTINUE

      IF(MiB.LE.0) THEN
        CALL BOUNC0(NX,IX0, Mi,COD, C0,
     *       QX(1,1,NB-1),V(1,NB-1),U(1,1,1),CVI,
     *         WC,CU,CQ,CV, CB )
        END IF
      IF(MiB.EQ.1) THEN
        CALL BOUNC1(NX,IX0, Mi,COD, C0,
     *       QX(1,1,NB-1),V(1,NB-1),U(1,1,1),CVI,
     *         WC,CU,CQ,CV, CB )
        END IF
      IF(MiB.GE.5) THEN
        IF(MiB.EQ.5) THEN
           CALL Polma(Na,Nb, Im, Xm,X(1,Ix0))
             ELSE
c03             Im=MiB*10
             Im=MiB
           END IF
        X0=X(Im,IX0)-V(IX0,Im)
        CALL Bouncs(Nx,IX0,Mi, COD, X0,QX(1,IX0,Im), 
     *      QX(1,1,NB),QX(1,1,NB-1),V(1,NB),V(1,NB-1), CU,CV, CB)
        END IF
C       STOP

      DO 75 IX=1,NX
         CX(1+NA*(IX-1))=AC0(IX)+ FSMV(NX,CB,U(1,IX,1))
   75    CONTINUE

      DO 90 J=1,NB
        DO 85 IX=1,NX
            X(J,IX)=V(IX,J)+FSMV(NX,CB,QX(1,IX,J))
   85    CONTINUE
   90       CONTINUE
C       WRITE(10,*) ' X1',(X(I,1) , I=1,NA+2)
C        STOP

      RETURN
      END