* === =============================================================*
      SUBROUTINE Msb40(NSG,NA,NB,NCH,NUR,ID,INC, Mie,
     *                 NL,NC,ND,  MNG,MLN,LG,IRP,
     *                 AA,BB,UU,VV,WW,WC,CX, FIC,FID, FC, P0,DP,
     *                 Z1,Z2,RZ,RP,EG, Ech,AMC,AMS,DHR,DHV,MNC,
     *                 R,RV,XG,XE1,XE2,U,UI,Wc1,Wc2,Wc3,Wc4,WK)
*  -  -------------------------------------------------------------*
      IMPLICIT    REAL*8 (A-H,O-Z)
      CHARACTER   FIC(*)*12,FID(*)*12
      DIMENSION   MNG(3,*),MLN(3),  MR1(3),MR2(3),
     *        ID(*),INC(5), NSI(10), FC(*),P0(*),DP(*),
     *        AA(*),BB(*),UU(*),VV(*),WW(*),WC(*),CX(*),
     *        RP(5),EG(*), Ech(*), R(NB,*),RV(NB,*), XG(NB,*),
     *       XE1(NB,*),XE2(NB,*),U(NUR,NUR), UI(NUR,NUR),
     *       Wc1(NB,*),Wc2(NB,*),Wc3(NB,*),Wc4(NB,*),
     *        WK(NB,*),EE(530),MNE(130),AMC(*),AMS(*),
     *        DHR(3,*),DHV(3,*),MNC(*), CN(450),
     *        G(450),BZ(4),LG(15),B(4), LE(450), LC(450),
     *        Z(45000),QQ(45000),P(530),DR(1750),DV(1750),
     *       CSR(7,1750),CSV(7,1750),STV(750),NZ0(10),NZ(10),NZ2(10),
     *         NNL(10),NNP(10),NND(10),  ED(5,10), EGG(10),
     *         LE2(300),LC2(300),DRR(10),DRI(10),DVR(10),DVI(10)
* --- -------------------------------------------------------------*
      WRITE(10,500) Z1,Z2,RZ,NSG
      CALL VEQC(NUR*NUR,0.D 00,U)
      KD=2
      IF(DABS(Z1-Z2).GT.1.D-03) KD=1
      B(1)=1.D 00
      RZ3=RZ**3/8.D 00
      R3R=RZ**3/8.D 00*RZ/2.D 00
      R3V=RZ/4.D 00*RZ/2.D 00

      DO 3 I=1,NSG
    3    WRITE(10,505) I,(MNG(J,I),J=1,3),EG(I)
      WRITE(10,506) Nch
      MMA=5
      CALL HAFI2(NA,NB,HA,HB,RP,R)
      CALL HAFV2(NA,NB,HA,HB,RP,RV)
      CALL HAFA0(NA,NB,MMA,RP(1),HA,R,AA,BB,UU,VV,G,BZ)
      CALL VEVR(NA*NA,UU,WW)
      CALL INVM(NA,DET,WW)
      PI2=-2.D 00*3.14159D 00
      CH=12.D 00/HB**2
      RZ2=RZ*RZ/2.D 00
      C1=PI2*RZ2
      CD=2.D 00*DSQRT(0.333333333D 00*3.141593D 00)

c       WRITE(10,508)
      WRITE(10,518)

      NZ(1)=0
      NZ0(1)=0

      DO 40 ICH=1,NCH
C = = = = =  READING CONTIN. WF - 1 = = = = = = = = = = = = =
         OPEN(21,FILE=FIC(ICH),STATUS='OLD')
         READ(21,*) NSI(ICH),P0(ICH),DP(ICH)
cc         OPEN(30+Ich,FILE=FIR(Ich),STATUS='NEW')
         WRITE(30+Ich,501) Z1,Z2,RZ,NSG
  501 FORMAT( 2F8.2,F14.4/12x,I3)
         DO 4 I=1,NSG
    4    WRITE(30+Ich,504) (MNG(J,I),J=1,3),EG(I)
C=== Nsi-ionezed shell

         READ(21,535) NC,(MNC(J),J=1,3)
         LE(1)=1
         NXC=MNC(3)
         IF(INC(ICH).NE.0.AND.INC(ICH).LT.NC) NC=INC(ICH)
	   DO 70 IC=1,NC
            CALL REWFC(NB,NL,NXC,EE(IC),AMC(LE(IC)),AMS(LE(IC)),
     *                        XE1(1,LE(IC)),21)
            LE(IC+1)=LE(IC)+NL*NXC
   70       CONTINUE
         CLOSE(21)
         ND=ID(ICH)
         DO 75 IC=NC+1,NC+ND
   75       LE(IC+1)=LE(IC)+NXC
         LC(1)=0
         DO 10 I=2,NL
   10       LC(I)=LC(I-1)+NXC
C = = = = = = = = READING DISCRETE WF - 1 = = = = = = = = = = =
          NNL(ICH)=NL
          NNP(ICH)=NC
          NND(ICH)=ND
         IF(ND.GT.0) THEN
           OPEN(22,FILE=FID(ICH),STATUS='OLD')
           CALL REFB(NB,LE(NC+1),EE(NC+1),CN(NC+1),xe1,22)
           CLOSE(22)
           END IF
         DO 11 I=1,ND
   11       ED(I,ICH)=EE(NC+I)
C = = = = = = = = = = = = = = = = = = = = = = = = = = = =
         M1=MNG(1,NSI(ICH))
         L1=MNG(2,NSI(ICH))

         NE=NC+ND
         NCU=ND+NC*NL
             NZ(ICH+1)=NZ(ICH)+NCU*2
             NZ0(ICH+1)=NZ0(ICH)+NCU*2
             NZ2(ICH)=NCU
C         ICU=1
c01          WRITE(10,518)
c01          WRITE(10,520) MNC(1)

          WRITE(10,520) Ich,Nsi(Ich),MNC(1)
c01  519     FORMAT( 4X,'   E',5(11X,I3))
          IF(MiE.EQ.0) THEN
            EGG(Ich)=Eg(Nsi(Ich))
            WRITE(10,524) EGG(Ich)
              ELSE
              EGG(Ich)=Ech(Ich)
              WRITE(10,523) EGG(Ich)
              END IF

         WRITE(30+Ich,502) Nsi(Ich),MiE
  502    FORMAT( 12x,I3,15x,I2)
         WRITE(30+Ich,504) (Mnc(i),i=1,3),Egg(Ich)
         WRITE(30+Ich,503) Nl,P0(Ich),Dp(Ich)

          WRITE(10,519) (MNC(2)+KD*(I-1),I=1,NL)
          WRITE(10,512)
C = = = = = = HARTREE - FOCK = = = = = = = = = = = = = = = =
         DO 15 IC=1,NE
c             WRITE(10,515) EE(IC)
         IF(IRP.EQ.2)   read(12,565) EE(IC)
c02            WRITE(11,565) EE(IC)
            WRITE(30+Ich,565) EE(IC)

            STR=0.D 00
            STV(IC)=0.D 00
             CALL VEQC(NL,0.D 00,CSR(1,IC))
             CALL VEQC(NL,0.D 00,CSV(1,IC))
            LE0=LE(IC)
            IF(IC.LE.NC) LQ=NL
            IF(IC.GT.NC) LQ=1

            DO 5 I=1,LQ
               M2=MNC(1)
               L2=MNC(2)
               NX=MNC(3)
               LX=LE0+LC(I)
            IF(IRP.EQ.2) then
                read(12,570) (AMC(J),J=LX,LX+NX-1)
                read(12,570) (AMS(J),J=LX,LX+NX-1)
              end if
                WRITE(30+Ich,570) (AMC(J),J=LX,LX+NX-1)
                WRITE(30+Ich,570) (AMS(J),J=LX,LX+NX-1)
               LIX=LG(NSI(ICH))
               MII=NSI(ICH)
C                 WRITE(10,*) MII,CD
c01           EGG(ICH)=EG(MII)

cc??     *           HA,HB,R3R,EGg(Ich),EE(IC),CD,DHR(1,I),CSR(I,IC),
              CALL Hfcsr(NA,NB,NX,NX,L1,L2,M1,M2,KD,
     *           HA,HB,R3R,EG(MII),EE(IC),CD,DHR(1,I),CSR(I,IC),
     *           R,XG(1,LIX),XE1(1,LX),WK,WK(1,11),FC)
              CALL Hfcsv(NA,NB,NX,NX,L1,L2,M1,M2,KD,
     *           HA,HB,R3V,EG(MII),EE(IC),CD,DHV(1,I),CSV(I,IC),
     *           RV,XG(1,LIX),XE1(1,LX),WK,WK(1,8),FC)
c               WRITE(11,575) (DHR(J,I),J=1,3),CSR(I,IC)
c               WRITE(11,575) (DHV(J,I),J=1,3),CSV(I,IC)
c               Pause
            IF(IRP.EQ.2) then
               read(12,575) (DHR(J,I),J=1,3),CSR(I,IC)
               read(12,575) (DHV(J,I),J=1,3),CSV(I,IC)
                end if
               WRITE(30+Ich,575) (DHR(J,I),J=1,3),CSR(I,IC)
               WRITE(30+Ich,575) (DHV(J,I),J=1,3),CSV(I,IC)
c             write(11,*)  NZ0(ICH)+LX,NZ0(ICH)+LX+NZ2(ICH)
                MD=M2-M1
c                  DR(NZ0(ICH)+1+LX/nx)=DHR(MD+2,I)
c                  DR(NZ0(ICH)+1+LX/nx+NZ2(ICH))=DHR(MD+2,I)*(-1)**MD
c                  DV(NZ0(ICH)+1+LX/nx)=DHV(MD+2,I)
c                  DV(NZ0(ICH)+1+LX/nx+NZ2(ICH))=-DHV(MD+2,I)*(-1)**MD
c            IF(IC.LE.NC) THEN
c                  DR(NZ0(ICH)+1+LX/nx)=DR(NZ0(ICH)+1+LX/nx)
c     *       *DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
c                  DR(NZ0(ICH)+1+LX/nx+NZ2(ICH))=
c     *            DR(NZ0(ICH)+1+LX/nx+NZ2(ICH))
c     *       *DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
c                  DV(NZ0(ICH)+1+LX/nx)=DV(NZ0(ICH)+1+LX/nx)
c     *       /DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
c                  DV(NZ0(ICH)+1+LX/nx+NZ2(ICH))=
c     *            DV(NZ0(ICH)+1+LX/nx+NZ2(ICH))
c     *       /DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
cc            IF(IC.LE.NC) THEN
                  DR(NZ0(ICH)+1+LX/nx)=DHR(MD+2,I)
     *       *DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
                  DR(NZ0(ICH)+1+LX/nx+NZ2(ICH))=DHR(MD+2,I)*(-1)**MD
     *       *DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
                  DV(NZ0(ICH)+1+LX/nx)=DHV(MD+2,I)
     *       /DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
                  DV(NZ0(ICH)+1+LX/nx+NZ2(ICH))=-DHV(MD+2,I)*(-1)**MD
     *       /DSQRT((EE(IC)-EG(MII))/(EE(IC)-EGG(Ich)))
cc             END IF
C               L=MNE(2)+KD*(IL-1)
               STR=STR+CSR(I,IC)
               STV(IC)=STV(IC)+CSV(I,IC)
C               WRITE(10,520) I,CSR(I,IC)
C               WRITE(10,525) I,CSV(I,IC)
C                IF(M2.EQ.1) IA0=IA0+NL*NX
    5          CONTINUE
            WRITE(10,521) EE(IC),(CSR(I,IC),I=1,NL),STR
   15       CONTINUE

c01         WRITE(10,522)
         WRITE(10,522) (MNC(2)+KD*(I-1),I=1,NL)
         WRITE(10,512)

         DO 35 IC=1,NE
   35       WRITE(10,521) EE(IC),(CSV(I,IC),I=1,NL),STV(IC)
C           write(10,*) (dr(i),i=1,nz0(nch+1))
C           write(10,*) (dv(i),i=1,nz0(nch+1))

C = = = = RPAE APPROXIMATION = = = = = = = = = = = = = = = = = =
         IF(IRP.NE.0) THEN

           DO 55 JCH=ICH,NCH
              ICU=1
              NX2=NX
              NL2=NL
C = = = = = DETERMINING WF - 2 = = = = = = = = = = = = = = = = =
              IF(JCH.EQ.ICH) THEN
               CALL VEVR(NCU*NB*NX,XE1,XE2)
               NC2=NC
               ND2=ND
               LE2(1)=1
               DO 81 IC2=1,NC2
                  LE2(IC2+1)=LE2(IC2)+NL2*NX2
   81             CONTINUE
               DO 82 I3=1,3
   82             MLN(I3)=MNC(I3)
               DO 86 IC2=NC2+1,NC2+ND2
   86             LE2(IC2+1)=LE2(IC2)+NX2
               LC2(1)=0
               DO 91 IJ=2,NL2
   91             LC2(IJ)=LC2(IJ-1)+NX2
               MD2=MD

              ELSE
                 OPEN(23,FILE=FIC(JCH),STATUS='OLD')
* - - - - - - - -
                 READ(23,*) NSI(JCH),P0(JCH),DP(JCH)
                 READ(23,535) NC2,(MLN(J),J=1,3)
C                   M2=MNG(1,NSI(ICH))
C                   L1=MNG(2,NSI(ICH))
                 LE2(1)=1
                 NX2=MLN(3)
                 MD2=MLN(1)-MNG(1,NSI(JCH))

         IF(INC(JCH).NE.0.AND.INC(JCH).LT.NC2) NC2=INC(JCH)

                 DO 80 IC2=1,NC2
                    CALL REWFC(NB,NL2,NX2,EE(IC2),AMC(LE2(IC2)),
     *                AMS(LE2(IC2)),  XE2(1,LE2(IC2)),23)
                    LE2(IC2+1)=LE2(IC2)+NL2*NX2
   80               CONTINUE
                 CLOSE(23)

                 ND2=ID(JCH)
                 DO 85 IC2=NC2+1,NC2+ND2
   85               LE2(IC2+1)=LE2(IC2)+NX2
                 LC2(1)=0
                 DO 90 IJ=2,NL2
   90               LC2(IJ)=LC2(IJ-1)+NX2
                 IF(ND2.GT.0) THEN
                  OPEN(24,FILE=FID(JCH),STATUS='OLD')
                  CALL REFB(NB,LE2(NC2+1),EE(NC2+1),CN(NC2+1),XE2,24)
                  CLOSE(24)
                  END IF

               END IF
C          IF(JCH.EQ.ICH) THEN
C          END IF
               NE2=NC2+ND2
               N22=ND2+NC2*NL2
              MIJ=NSI(JCH)
              LIJ=LG(MIJ)
* - - - - - - - -
               IF(ICH.EQ.1) THEN
                 NZ(JCH+1)=NZ(JCH)+N22*2
                 NZ0(JCH+1)=NZ0(JCH)+N22*2
                 NZ2(JCH)=N22
                 END IF
               ICU=1

              if(irp.eq.1) then
               write(*,*) 'Ich, Jch= ',ICH,JCH
               DO 95 IC=1,NE
                  write(*,*) 'IC= ',IC
                  LE0=LE(IC)
                  IF(IC.LE.NC) LQ=NL
                  IF(IC.GT.NC) LQ=1
                  DO 105 I=1,LQ
                     LX=LE0+LC(I)
                     JCU=1

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
                     CALL Cuif(NA,NB,
     *                 MNC,MNG(1,MII),MNG(1,MIJ), MLN, KD,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 XE1(1,LX),XG(1,LIX),XG(1,LIJ),Wc1,WK,Z)
CC==   (mj|V|i,Y_n)= (i,Y_n|U|mj)

	         IF(MNG(1,MII).NE.0.OR.MNC(1).NE.0) THEN
                   DO 13 IMI=1,3
                      MR1(IMI)=MNC(IMI)
   13                 MR2(IMI)=MLN(IMI)
                   MR1(1)=-MR1(1)
                   MR2(1)=-MR2(1)
                         CALL Cuif(NA,NB,
     *               MR1,MNG(1,MIJ),MNG(1,MII),MR2,KD,
     *               C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *               XE1(1,LX),XG(1,LIJ),XG(1,LIX),Wc2,WK,Z)
CC==   (Y_n(-)j|V|im(-))
                     END IF
                     END IF
CC============ ICH=JCH

CC============ ICH.ne.JCH
                 IF(ICH.NE.JCH.OR.(M1.NE.0.AND.MD.EQ.0)) THEN
                    DO 14 IMI=1,3
                      MR1(IMI)=MNG(IMI,MIJ)
   14                 MR2(IMI)=MLN(IMI)
                   IF(MD2.EQ.MD) THEN
                    MR1(1)=-MR1(1)
                    MR2(1)=-MR2(1)
                    END IF
                     CALL Cuif(NA,NB,
     *                 MNG(1,MII),MNC,MR1,MR2,KD,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 XG(1,LIX),XE1(1,LX),XG(1,LIJ),Wc1,WK,Z)
c           write(10,*) ' mij,   ',mij,mng(3,mij)
c           write(10,*) ' ich,jch WC  ',ich,jch,wc1(1,1),wc1(10,1)
	     IF(MII.NE.MIJ) 
     *               CALL Cuif(NA,NB,
     *                 MR1,MNC,MNG(1,MII),MR2,KD,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 XG(1,LIJ),XE1(1,LX),XG(1,LIX),Wc3,WK,Z)


                    MR1(1)=-MR1(1)
                    MR2(1)=-MR2(1)

                     CALL Cuif(NA,NB,
     *                 MR1,MNG(1,MII),MNC,MR2,KD,
     *                 C1,CH,BZ,FC,G,B,AA,BB,VV,UU,WW,WC,CX,R(1,2),
     *                 XG(1,LIJ),XG(1,LIX),XE1(1,LX),Wc2,WK,Z)
CC===   (mj|V|Y_n,i)=(Y_n,i|V|mj)
               END IF

                     DO 20 JC=1,NE2
c                  write(*,*) 'JC= ',JC
                        LEJ=LE2(JC)
                        IF(JC.LE.NC2) LQJ=NL2
                        IF(JC.GT.NC2) LQJ=1
                        DO 25 J=1,LQJ
                           LXJ=LEJ+LC2(J)
C01              WRITE(*,*) M1,M2
c01              WRITE(*,*) LX,LXJ,IC,JC,LE(IC),LE(JC)

              IF(ICH.EQ.JCH) THEN
                CC1=Fcun(Na,Nb, Nx2, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), XE2(1,LXJ),Wc1,wk)

CC==   (mj|V|in)=(in|U|mj)


	         IF(MNG(1,MII).EQ.0.AND.MNC(1).EQ.0) THEN
                 U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)=CC1
                 U(NZ0(ICH)+ICU,NZ0(JCH)+NZ2(JCH)+JCU)=CC1
CC                 U(NZ0(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)=CC1
	          ELSE
CC==   (nj|V|im)


                CC2=Fcun(Na,Nb, Nx2, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), XE2(1,LXJ),Wc2,wk)

          U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)=(2*CC1-CC2)*(-1)**MD
          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
                 IF(ICH.NE.JCH.OR.(M1.NE.0.AND.MD.EQ.0)) THEN


                CC4=Fcun(Na,Nb, Nx2, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), XE2(1,LXJ),Wc1,wk)


                CC3=Fcun(Na,Nb, Nx2, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), XE2(1,LXJ),Wc2,wk)

         U(NZ0(JCH)+JCU,NZ0(ICH)+ICU)=2*CC4*(-1)**MD-CC3
         U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)=
     *       2*CC4*(-1)**MD-CC3

            CZX=1.D 00
            IF(MD2.EQ.MD) CZX=1.D 00*(-1)**MD
	     IF(MII.NE.MIJ) THEN


                CC5=Fcun(Na,Nb, Nx2, Ha,Hb,Rz3,
     *                    R(1,3),R(1,6), XE2(1,LXJ),Wc3,wk)
          U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)=(2*CC4-CC5)
*CZX
          U(NZ0(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)=(2*CC4-CC5)
*CZX
c              write(11,*) mii,mij,md,md2
c                    WRITE(11,*) CC4,CC3,CC5
	         ELSE
          U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)=
     *       U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)+CC4
*(-1)**MD
          U(NZ0(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)=
     *       U(NZ0(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)+CC4
*(-1)**MD
  101         CONTINUE
c                    WRITE(11,*) CC4,CC3
	          END IF
         IF(ICH.NE.JCH) THEN
	      CZX=2.D 00
	     IF(MNG(1,MII).EQ.0.OR.MD.NE.0) CZX=1.D 00
	        U(NZ0(ICH)+ICU,NZ0(JCH)+NZ2(JCH)+JCU)=
     *         CZX*U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+ICU)
	        U(NZ0(ICH)+NZ2(ICH)+ICU,NZ0(JCH)+JCU)=
     *         CZX*U(NZ0(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)
         U(NZ0(ICH)+ICU,NZ0(JCH)+JCU)=
     *         CZX*U(NZ0(JCH)+JCU,NZ0(ICH)+ICU)
         U(NZ0(ICH)+NZ2(ICH)+ICU,NZ0(JCH)+NZ2(JCH)+JCU)=
     *         CZX*U(NZ0(JCH)+NZ2(JCH)+JCU,NZ0(ICH)+NZ2(ICH)+ICU)
             END IF

                    END IF
c       if(mnc(1).eQ.1) CLB(JCU,ICU)=-CLB(JCU,ICU)
*       if(mnc(1).ne.0) CLB(JCU,ICU)=-CLB(JCU,ICU)
   25          JCU=JCU+1

   20          CONTINUE
             ICU=ICU+1
  105        CONTINUE
   95        CONTINUE
         end if
         if(irp.eq.2) then
        read(12,*) NZ2(ICH),NZ2(JCH)
        DO 31 I=1,2*NZ2(ICH)
   31      read(12,580) (U(NZ0(JCH)+J,NZ0(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(NZ0(ICH)+I,NZ0(JCH)+J)=U(NZ0(JCH)+J,NZ0(ICH)+I)
   32      continue
          end if
        end if

       IF(IRP.NE.0) THEN
c02        WRITE(11,*) NZ2(ICH),NZ2(JCH)

cc        DO 30 I=1,2*NZ2(ICH)
cc   30      WRITE(11,580) (U(NZ0(JCH)+J,NZ0(ICH)+I),
cc     *               J=1,2*NZ2(JCH))
        END IF
   55       CONTINUE
            END IF
   40  CONTINUE
       IF(IRP.NE.0) THEN
         NU=NUR*2

         WRITE(10,517)
         CALL RPAD0(NUR,NCH,70, NZ0,NZ2, NNL,
     *               NNP,NND,   P0,DP,EGG, ED,  R,
     *                 CSR, U,XE2,UI, XE1, Z,QQ,WK,CSV,
     *          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//60('=')/
     *    ' Ground state HF results:'//
     *    ' Number of the shells: NSG =',I3//
     *    5X,'N shell    M    L0   N OF P.W.',4X,'HF Energies'/)
  505 FORMAT(4X,I4,3X,3(I6),6X,E15.7)
  504 FORMAT( 3X,3(I6),6X,E15.7)
  503 FORMAT( I6,2F10.3)
  506 FORMAT( 60('=')/' Number of channels included -',I3)
  508 FORMAT( 60('=')/' CHANNEL NU.    M     L     NX'/)
  509 FORMAT( 3X,I4,8X,I2,2I6)
  510 FORMAT( 60('=')/' CHANNEL NU. ',I2,' :  M =',I2/)

  512     FORMAT( 7x,' Total C.S.')
  515 FORMAT( 60('=')/'  CROSS SECTION VALUES, E = ',F8.4)
  517 FORMAT( /60('=')//' RPA results:')
  518 FORMAT( 60('=')//' Hartree-Fock results:')
  519 FORMAT( /30(' -'),/' R-form:'
     *       /15X,' Partial c.s. for L =',10X,/
     *    4X,'  E',5(9X,I3\))
  520 FORMAT( /60('-')/' Channel ',I2,':  Ionised shell -',I2,
     *       ';'/13x' Final m =',I2,';')
  522 FORMAT( /30(' -')/' V-form:'
     *       /15X,' Partial c.s. for L =',10X,/
     *    4X,'  E',5(9X,I3\))

  523 FORMAT( 13x,' Experimental threshold: E =',E15.7)
  524 FORMAT( 13x,' Theoretical  threshold: E =',E15.7)
c01  521 FORMAT( 5E14.4)

  521 FORMAT( 6E12.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