* === =============================================================*
      SUBROUTINE Rpama1(Nb,Na, Nch,Nxc, Kd, Nc,Nd,Nl, Lkg,Ku0,Ku2,
     *                 Ha,Hb, C1,Ch, Rz3,
     *                 Nur,  
     *                 Mng, IRP,
     *                 AA,BB,UU,VV,WW,G,WC,CX, FIC,FID, 
     *                 Bz,FC, P0,DP,
     *                 EG, AMC,AMS,DHR,DHV,
     *                 R,RV,Xg,Xei,Xej,U,UI,Wc1,Wc2,Wc3,Wc4,WK)
*  -  -------------------------------------------------------------*
      PARAMETER  (kf=100,kch=7)
      IMPLICIT    REAL*8 (A-H,O-Z)
      CHARACTER   Fic(*)*15,Fid(*)*15

      DIMENSION   Nc(Nch),Nd(Nch), Nl(Nch),Nsi(kch),Nsj(kch),
     *        Mni(3),Mnj(3), Mng(3,kch), Ku0(Nch),Ku2(Nch),
     *              Mw1(3),Mw2(3),
     *            Xei(Nb,*),Xej(Nb,*),
     *            Amc(*),Ams(*),
     *            Lki(kf),Lkj(kf), Lkg(Nch),
     *           Ee(kf),Cn(kf), Ed(7,kch),
     *          U(NUR,NUR), UI(NUR,NUR),
     *          FC(*),P0(*),DP(*),
     *        AA(*),BB(*),UU(*),VV(*),WW(*),WC(*),CX(*),
     *        EG(*), R(NB,*),RV(NB,*), Xg(NB,*),
     *       Wc1(NB,*),Wc2(NB,*),Wc3(NB,*),Wc4(NB,*),
     *        WK(NB,*),
     *        DHR(3,*),DHV(3,*),
     *        G(450),BZ(4),B(4), 
     *        Z(36000),QQ(36000),P(530),DR(750),DV(750),
     *       CSR(7,750),CSV(7,750),NZ0(10),NZ(10),NZ2(10),
     *         NNL(10),NNP(10),NND(10),   EGG(10),
     *         DRR(10),DRI(10),DVR(10),DVI(10)
* --- -------------------------------------------------------------*

      B(1)=1.D 00
      DO 5 Ich=1,Nch
        Nci=Nc(Ich)
        Ndi=Nd(Ich)
        Nei=Nci+Ndi
        Nxi=Nci*Nl(Ich)+Ndi
c             Write(10,*) 'Nxi.. ',Nci,Nl(Ich),Ndi
        Lgi=Lkg(Ich)
C = = = = =  Reading of contin. WF - 1 = = = = = = = = = = = = =
        OPEN(21,FILE=Fic(Ich),STATUS='OLD')
        READ(21,*) Nsi(Ich),P0(Ich),Dp(Ich)
C = = = = =  Nsi-ionezed shell
        READ(21,535) Ncw,(Mni(n),n=1,3)
        Mdi=Mni(3)-Mng(3,Ich)
        Lki(1)=1
        DO 10 Ic=1,Nc(Ich)
c          jf=Nl(Ich)*(Ic-1)+1
          ki=Lki(Ic)
          CALL Rewfc(Nb,Nl(Ich),Nxc,Ee(Ic), 
     *         Amc(ki),Ams(ki), Xei(1,ki),21)
          Lki(Ic+1)=Lki(Ic)+Nl(Ich)*Nxc
   10     CONTINUE
        CLOSE(21)

        DO 15 Ic=Nci+1,Nci+Ndi
   15       Lki(Ic+1)=Lki(Ic)+Nxc
c01         LC(1)=0
c01         DO 10 I=2,NL
c01   10       LC(I)=LC(I-1)+NXC
C = = = = = = = = READING DISCRETE WF - 1 = = = = = = = = = = =
c01          NNL(Ich)=NL
c01          NNP(Ich)=NC
c01          NND(Ich)=ND
        IF(Ndi.GT.0) THEN
          OPEN(22,FILE=Fid(Ich),STATUS='OLD')
          CALL Refb(Nb,Lki(Nci+1),Ee(Nci+1),Cn(Nci+1),Xei,22)
          CLOSE(22)
          END IF
        DO 11 i=1,Nd(Ich)
   11     Ed(i,Ich)=Ee(Nci+i)

C????????????
c01             NZ(Ich+1)=NZ(Ich)+NCU*2
c01             NZ0(Ich+1)=NZ0(Ich)+NCU*2
c01             NZ2(Ich)=NCU
c01          WRITE(10,518)
c01          WRITE(10,520) Mni(1)
c01          WRITE(10,519) (Mni(2)+KD*(I-1),I=1,NL(Ich))
  519     FORMAT( 4X,'   E',5(11X,I3))


c01         WRITE(10,522)
c01         WRITE(10,519) (Mni(2)+KD*(I-1),I=1,NL(Ich))
C??????????????????



C = = = = = = = Channel 2 = = = = = = = = = = = = = = = = = =
        DO 25 Jch=Ich,Nch
           Write(*,*) ' Ich=',Ich,'   Jch=',Jch
           Write(*,*) ' Ku2(Ich)=',Ku2(Ich),' Ku2(Jch)=',Ku2(Jch)
          Ncj=Nc(Jch)
          Ndj=Nd(Jch)
          Nej=Ncj+Ndj
c01          Nuj=Ncj*Nl(Jch)+Ndj
          Lgj=Lkg(Jch)
          IF(Jch.EQ.Ich) THEN
ccc             Write(10,*) 'Nxi*Nb*Nxc= ',Nxi,Nb,Nxc
            CALL Vevr(Nxi*Nb*Nxc,Xei,Xej)
            DO 26 ii=1,Nej
   26         Lkj(ii)=Lki(ii)
              ELSE

C = = = = = = = = Reading of contin. WF - J = = = = = = = = = = = = =
              OPEN(23,FILE=Fic(Jch),STATUS='OLD')
              READ(23,*) Nsj(Jch),P0(Jch),Dp(Jch)
C = = = = = = = Nsj/i - ionezed shell
              READ(23,535) Ncw,(Mnj(n),n=1,3)
              Mdj=Mnj(3)-Mng(3,Jch)
              Lkj(1)=1
              DO 30 Jc=1,Nc(Jch)
                kj=Lkj(Jc)
                CALL Rewfc(Nb,Nl(Jch),Nxc,Ee(Jc), 
     *                    Amc(kj),Ams(kj), Xej(1,kj),23)
                Lkj(Jc+1)=Lkj(Jc)+Nl(Jch)*Nxc
   30           CONTINUE
              CLOSE(23)

              IF(Ndj.GT.0) THEN
                DO 35 Jc=Ncj+1,Ncj+Ndj
   35             Lkj(Jc+1)=Lkj(Jc)+Nxc
                OPEN(22,FILE=Fid(Jch),STATUS='OLD')
                CALL Refb(Nb,Lkj(Ncj+1),Ee(Ncj+1),Cn(Ncj+1),Xej,22)
                CLOSE(22)
                END IF
              END IF


        DO 12 i=1,Nd(Jch)
   12     Ed(i,Jch)=Ee(Ncj+i)



*= = = = = = = Kulonovskaya matritza:
          Nui=0
          DO 45 Iei=1,Nei
            write(*,*) 'Iei= ',Iei
            Li0=Lki(Iei)
            IF(Iei.LE.Nci) Lq=Nl(Ich)
            IF(Iei.GT.Nci) Lq=1

            DO 50 i=1,Lq
              Li=Li0+Nxc*(i-1)
              Nui=Nui+1
c01              JCU=1
C===================== (Xf2,Y/Mne/|V|Xf1,Xfe)
c                     CALL Cuif(NA,NB, MF1,MF2,MFE, MNE, KD, 
c     *              C1,CH, BZ,F,GG,B, AA,BB,VV,UU,WW,WC,CX,
c     *              R2, XF1,XF2,XFE, QQ,WK,Z)

CC================== Ich=JCH
              IF(Ich.EQ.JCH) THEN
CC==                Wc1:  (ij|V|m,Y_n)= (m,Y_n|V|ij):
                CALL Cuif(NA,NB,
     *                 Mng(1,Ich),Mni,Mng(1,Jch), Mni, Kd,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 Xg(1,Lgi),Xei(1,Li),Xg(1,Lgj),Wc1,WK,Z)

c01	          IF(Mng(1,Ich).NE.0.OR.Mni(1).NE.0) THEN
	        IF(Mng(1,Ich).NE.0) THEN
CC==                  (mj|V|i,Y_n)= (i,Y_n|V|mj):
                DO 13 Imi=1,3
                  Mw1(Imi)=Mng(Imi,Jch)
   13             Mw2(Imi)=Mni(Imi)
                Mw1(1)=-Mw1(1)
                Mw2(1)=-Mw2(1)
CC==              Wc2:    (-i,i|V|m,-Y_ni)= (m,-Y_ni|V|-i,i):
                CALL Cuif(NA,NB,
     *               Mw1,Mni,Mng(1,Ich),Mw2,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               Xg(1,Lgj),Xei(1,Li),Xg(1,Lgi),Wc2,WK,Z)
CC==              Wc3:    (m,-i|V|i,-Y_ni)= (i,-Y_n|V|m,-i):
CC==                      =  (m,-Y_ni|V|i,-i):
                CALL Cuif(NA,NB,
     *               Mni,Mng(1,Ich),Mw1,Mw2,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               Xei(1,Li),Xg(1,Lgi),Xg(1,Lgj),Wc3,WK,Z)

CC==              Wc4:    (m,-i|V|-Y_n,i)= (i,-Y_n|V|-i,m):
                CALL Cuif(NA,NB,
     *               Mw1,Mng(1,Ich),Mni,Mw2,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               Xg(1,Lgj),Xg(1,Lgi),Xei(1,Li),Wc4,WK,Z)


CC==   (Y_n(-)j|V|im(-))
                     END IF
                     END IF
CC============ Ich=JCH

CC============ Ich.ne.JCH

ccc            write(*,*) 'I, li= ',I,Li,Li0

              IF(Ich.NE.JCH) THEN
CC==                Wc1:  (ij|V|m,Y_n)= (m,Y_n|V|ij):
                CALL Cuif(NA,NB,
     *                 Mng(1,Ich),Mni,Mng(1,Jch), Mnj, Kd,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 Xg(1,Lgi),Xei(1,Li),Xg(1,Lgj),Wc1,WK,Z)

CC==                Wc2:  (ji|V|m,Y_n)= (m,Y_n|V|ji):
                CALL Cuif(NA,NB,
     *                 Mng(1,Jch),Mni,Mng(1,Ich), Mnj, Kd,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 Xg(1,Lgj),Xei(1,Li),Xg(1,Lgi),Wc2,WK,Z)

CC==                Wc3:  (mj|V|i,Y_n)= (i,Y_n|V|mj):
                CALL Cuif(NA,NB,
     *               Mni,Mng(1,Ich),Mng(1,Jch),Mnj,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               Xei(1,Li),Xg(1,Lgi),Xg(1,Lgj),Wc3,WK,Z)

CC==                Wc4:  (mj|V|Y_n,i)= (Y_n,i|V|mj):
c           Write(10,*) ' Ich=',Ich,'   Jch=',Jch
c           write(10,*) ' cc3 ',Lgj,Lgi,Li,LJ
c           Write(10,*) ' Mln=',(Mng(j,Jch),j=1,3),(Mng(j,Ich),j=1,3)
c           Write(10,*) ' Mln=',(Mni(j),j=1,3),(Mnj(j),j=1,3)
                CALL Cuif(NA,NB,
     *               Mng(1,Jch),Mng(1,Ich),Mni,Mnj,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               Xg(1,Lgj),Xg(1,Lgi),Xei(1,Li),Wc4,WK,Z)
                END IF

              Nuj=0
              DO 55 Jei=1,Nej
ccc                Write(*,*) 'Jei Lkj(Jei) =',Jei, Lkj(Jei)
                Lj0=Lkj(Jei)
                IF(Jei.LE.Ncj) Lq=Nl(Jch)
                IF(Jei.GT.Ncj) Lq=1

                DO 60 j=1,Lq
                  Lj=Lj0+Nxc*(j-1)
                  Nuj=Nuj+1

                  IF(Ich.EQ.Jch) THEN
CC==                (mm|V|ii)=(mn|U|ij) (i=j,m=n))
                    Cu1=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc1,wk)
c                   Write(10,*) ' cu1 =',Cu1,Rz3,Na,Nb,Nxc, Ha,Hb,Lj
c              Write(10,*) 'Wc1 =',Wc1(3,2),Wc1(10,2),Wc1(300,2)
c              Write(10,*) 'Wc1 =',Wc1(3,1),Wc1(10,1),Wc1(300,1)
c              Write(10,*) 'R3 =',R(3,3),r(10,3),r(300,3)
c              Write(10,*) 'R6 =',R(3,6),r(10,6),r(300,6)
c              Write(10,*) 'X =',Xej(3,1),Xej(10,2),Xej(300,3)

                    IF(Mng(1,Ich).EQ.0.AND.Mni(1).EQ.0) THEN
                      U(Ku2(Jch)+Nuj,Ku0(Ich)+Nui)=Cu1
                      U(Ku0(Jch)+Nuj,Ku2(Ich)+Nui)=Cu1
	              ELSE
c01  ================CC==   (nj|V|im)
CC== = = = = = = = =  (mn|V|ij)

                    Cu2=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc2,wk)
                    Cu3=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc3,wk)
                    Cu4=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc4,wk)

                      U(Ku2(Jch)+Nuj,Ku0(Ich)+Nui)=
     *                         Cu1+2.D 00*Cu3-Cu2
                      U(Ku0(Jch)+Nuj,Ku2(Ich)+Nui)=
     *                         Cu1+2.D 00*Cu3-Cu2

                    U(Ku0(Jch)+Nuj,Ku0(Ich)+Nui)=2.D 00*Cu3-Cu4
                    U(Ku0(Ich)+Nui,Ku0(Jch)+Nuj)=2.D 00*Cu3-Cu4

                    U(Ku2(Jch)+Nuj,Ku2(Ich)+Nui)=2.D 00*Cu3-Cu4
                    U(Ku2(Ich)+Nui,Ku2(Jch)+Nuj)=2.D 00*Cu3-Cu4

c          U(Ku2(Jch)+Nuj,Ku0(Ich)+Nui)=(2*CC1-CC2)
c *(-1)**MD
c          U(Ku0(Jch)+Nuj,Ku2(Ich)+Nui)=(2*CC1-CC2)
c *(-1)**MD

c01          U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(Ich)+ICU)=(2*CC1-CC2)*(-1)**MD
c01          U(NZ0(JCH)+JCU,NZ0(Ich)+NZ2(Ich)+ICU)=(2*CC1-CC2)*(-1)**MD
                      END IF
                    END IF

c                 IF(Ich.EQ.JCH) GOTO 101
**                 IF(Ich.NE.JCH) THEN

c01                  IF(Ich.NE.JCH.OR.(M1.NE.0.AND.MD.EQ.0)) THEN
                  IF(Ich.NE.Jch) THEN
                    Cu1=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc1,wk)
                    Cu2=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc2,wk)
                    Cu3=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc3,wk)
                    Cu4=Fcun(Na,Nb, Nxc, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), Xej(1,Lj),Wc4,wk)

                    Czx=2.D 00
                    IF(Mng(1,Ich).EQ.0) Czx=1.D 00

                    U(Ku2(Jch)+Nuj,Ku0(Ich)+Nui)=2.D 00*Cu1-Cu2
                  U(Ku0(Ich)+Nui,Ku2(Jch)+Nuj)=(2.D 00*Cu1-Cu2)*Czx

                    U(Ku0(Jch)+Nuj,Ku2(Ich)+Nui)=2.D 00*Cu1-Cu2
                  U(Ku2(Ich)+Nui,Ku0(Jch)+Nuj)=(2.D 00*Cu1-Cu2)*Czx

                    U(Ku0(Jch)+Nuj,Ku0(Ich)+Nui)=2.D 00*Cu3-Cu4
                  U(Ku0(Ich)+Nui,Ku0(Jch)+Nuj)=(2.D 00*Cu3-Cu4)*Czx
c            write(10,*) ' ich jch,lj',Ich, Jch,Lj
c            write(10,*) ' Cui',Cu1,Cu2,Cu3,Cu4

                    U(Ku2(Jch)+Nuj,Ku2(Ich)+Nui)=2.D 00*Cu3-Cu4
                  U(Ku2(Ich)+Nui,Ku2(Jch)+Nuj)=(2.D 00*Cu3-Cu4)*Czx
                    END IF

   60          CONTINUE

   55          CONTINUE
c01             ICU=ICU+1
   50        CONTINUE
   45        CONTINUE

         if(irp.eq.2) then
c01        read(12,*) NZ2(Ich),NZ2(JCH)
        DO 31 I=1,2*NZ2(Ich)
   31      read(12,580) (U(Ku0(Jch)+J,Ku0(Ich)+I),
     *               J=1,2*NZ2(JCH))
          if(Ich.ne.jch) then
        DO 32 I=1,2*NZ2(Ich)
           DO 33 J=1,2*NZ2(JCH)
   33         U(Ku0(Ich)+I,Ku0(Jch)+J)=U(Ku0(Jch)+J,Ku0(Ich)+I)
   32      continue
          end if
        end if

       IF(IRP.NE.0) THEN
        WRITE(11,*) Ku0(Jch),Ku0(Jch+1),Ku0(Ich),Ku0(Ich+1)
        DO 41 I=Ku0(Ich)+1,Ku0(Ich+1)
   41      WRITE(11,580) (U(J,I),J=Ku0(Jch)+1,Ku0(Jch+1))
        END IF

   25       CONTINUE

    5  CONTINUE
       IF(IRP.NE.0) THEN
         NU=NUR*2

cw         WRITE(10,517)
cw         CALL RPAD0(NUR,Nch,30, NZ0,NZ2, NNL,
cw     *               NNP,NND,   P0,DP,EG, ED,  R,
cw     *                 CSR, U,Xej,UI, Xei, Z,QQ,WK,CSV,
cw     *          DR,DV,DRR,DRI,DVR,DVI)
         END IF

  500 FORMAT( 20X' DIATOMIC MOLECULE'/15X,
     *    '  PHOTOIONISATION PARAMETERS'//
     *    ' NUCLEI CHARGES:       Z1 =',
     *      F6.3/23X,'Z2 =',F6.3//
     *    ' INTERNUCLEI DISTANCE: RZ  =',F7.4/
     *    ' NUMBER OF THE SHELLS: NSH =',I3//
     *    ' GROUND STATE :'//
     *    5X,'N SHELL    M    L0   N OF P.W.',5X,'ENERGIES'/)
  505 FORMAT(4X,I4,3X,3(I6),6X,E15.7)
  508 FORMAT( 60('=')/' CHANNEL NU.    M     L     NX'/)
  509 FORMAT( 3X,I4,8X,I2,2I6)
  510 FORMAT( 60('=')/' CHANNEL NU. ',I2,' :  M =',I2/)
  515 FORMAT( 60('=')/'  CROSS SECTION VALUES, E = ',F8.4)
  517 FORMAT( //' RPA RESULTS:')
c1 /9X,'E',10X,'RPA(L)',10X,'RPA(V)')

  518 FORMAT( ' HF RESULTS:')
  520 FORMAT( ' CHANNEL m =',I3/'R-FORM'/20X,'  L',10X,'Total')
  522 FORMAT( //'V-FORM'/20X,'  L',10X,'Total')

  521 FORMAT( 5E14.4)
  525 FORMAT( ' CHAN.=',I2,'   C.S.(V-FORM) =  ', E14.4)
  526 FORMAT( '   C.S. TOTAL (V-FORM) =', E14.4)
  530 FORMAT( //'  BETA CALCULATIONS(R-FORM) :')
  531 FORMAT( //'  BETA CALCULATIONS(V-FORM) :')
  535  FORMAT( I5/3I4)
  540 FORMAT( 60('=')/'  E =',E15.4)
  550 FORMAT( 2E15.7,5X, E15.7, 2I5)
  555 FORMAT( 3I7)
  560 FORMAT( I5,5X, 2E15.7)
  565 FORMAT( 15X, E15.8)
  570 FORMAT( 4E15.6)
  575 FORMAT( 5X,3E14.6,7X,E15.6)
  580 FORMAT( 5E17.9)
      END