* ZED ======================================================Z04=*
      SUBROUTINE RPAD0(N0,NCH,NCM, NZ0,NZ2,NL,
     *              NP,ND,P0,DP, EG,ED,P,
     *                 C,CLB,A,R, S,B,B1,B2,W,
     *    DHR,DHV,DRR,DRI,DVR,DVI)
* 98  ----------------------------------------------------------*
      IMPLICIT    REAL*8 (A-H,O-Z)
      DIMENSION   NL(NCH),JP(10), NZ0(NCH),NZ2(NCH),
     *        NP(NCH),ND(NCH), P0(NCH), DP(NCH),EG(NCH), ED(5,NCH),
     *        P(NCM,NCH),
     *     C(N0),CLB(N0,N0),A(N0,N0),R(N0,N0), S(N0,N0),
     *      B(N0,*),B1(N0,*),B2(N0,*),W(N0),
     *        DHR(N0),DHV(N0),
     *            DRR(*),DRI(*), DVR(*),DVI(*)
     *        ,V1(7700),V2(7700),Z(7700), NZ(10)
     *      ,IB(2000),IND(3000),CB(2000)
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
      DO 5 ICH=1,NCH
         NZ(ICH)=2*NZ2(ICH)
         DO 10 IP=1,NP(ICH)
            P(IP,ICH)=P0(ICH)+DP(ICH)*(IP-1)
C            WRITE(8,*)  P(IP,ICH)
   10       CONTINUE
    5    CONTINUE

      DO 15 ICH=1,NCH
        write(*,517)
c!!         IF(Ich.NE.4) GOTO 300
c!!         IF(Ich.NE.5) GOTO 300
          WRITE(10,520) Ich
        write(10,517)

        DO 20 IP=1,NP(ICH)
          PIP=P(IP,ICH)
          PIP=PIP+1.D-06
          IF(IP.EQ.NP(ICH)) PIP=PIP-DP(ICH)*0.05
          IF(IP.EQ.1)       PIP=PIP+DP(ICH)*0.05
          EI=PIP*PIP/2.D 00
          OM=EI-EG(ICH)
          NB=1

          DO 25 JCH=1,NCH
             N1=NZ0(JCH)+1
             N2=N1+NZ2(JCH)
                NN=NP(JCH)
C       NN=NZ2(JCH)
             OM1=P(1,JCH)**2/2.D00-EG(JCH)
             OM2=P(NN,JCH)**2/2.D00-EG(JCH)
C       WRITE(8,*) NN,N1,N2
C       WRITE(8,*) ICH,JCH,OM,OM1,OM2,JP(1),JP(2)

             IF(OM.LT.OM1.OR.OM.GT.OM2) THEN
               JP(JCH)=0
                 ELSE
                 JP(JCH)=1
                 DMI=DABS(OM-OM1)
                 DO 30 II=2,NP(JCH)
                    WRITE(8,*) II,JP(JCH),DMI
                    DOM=DABS(OM-P(II,JCH)**2/2.D00+EG(JCH))
                    IF(DOM.LT.DMI) THEN
                      DMI=DOM
                      JP(JCH)=II
                      END IF
   30               CONTINUE

c                     IB0=NZ0(JCH)+(JP(JCH)-1)*NL(JCH)
             DO 31 II=1,NL(JCH)*3
   31           IB(NB+II-1)=NZ0(JCH)
C             write(10,*) nb,(ib(nb+ii-1),ii=1,nl(jch))
                    END IF
C         WRITE(8,*) ICH,JCH,OM,OM1,OM2,JP(1),JP(2)
              CALL SIMC0(NL(JCH),NP(JCH),ND(JCH),JP(JCH),IB(NB),
     *              OM,EG(JCH),
     *             ED(1,JCH),P(1,JCH),DP(JCH),
     *             CB(NB), C(N1),V1,Z(N2),Z(N1))
         IF(JP(JCH).NE.0) NB=NB+3*NL(JCH)

c       WRITE(8,*) ICH,JCH,N0,NU
c       WRITE(8,205) (S(I),I=1,NU)
   25            CONTINUE

C         CALL CQDMA(NL,NP,ND,JP,OM,EG,E(NC+1),P,DP,
C     *              C,V1,S(N2+1),S)
c       WRITE(8,200) N0,NU
c       WRITE(8,205) (S(I),I=1,NU)
  200  FORMAT( ' S-FIN: ',2I6)
  205  FORMAT( 5E13.3)
         IF(NB.GT.1) NB=NB-1
                     JS=NZ0(ICH)+(JP(ICH)-1)*NL(ICH)
            CALL RPAS0(N0,NB,NL(ICH),JS, IB, IND, Z,CLB,CB,
     *                 A,B,R,S,W,B1,B2,DHR,DHV,DRR,DRI,DVR,DVI)
             NU=2*N0
C             CALL RPASIW(N0,NU,NCH,ICH, NZ0,NZ,NL,JP,
C     *                 Z,C,CLB,A,R,DHR,DHV,DRR,DRI,DVR,DVI)
C         CALL CSRPA(NU,NU2,NL,JP,
C     *                 S,CLB,A,DHR,DHV,DRR,DRI,DVR,DVI)
         WRITE(30+Ich,565) EI
        CSR=0.D00
        CSV=0.D00
         DO 45 K=1,NL(ICH)
            WRITE(30+Ich,570) DRR(K),DRI(K)
            WRITE(30+Ich,570) DVR(K),DVI(K)
            CSR=CSR+DRR(K)**2+DRI(K)**2
            CSV=CSV+DVR(K)**2+DVI(K)**2
   45       CONTINUE
         CSR=2.689D 00*2.D 00*OM*CSR
         CSV=2.689D 00*2.D 00/OM*CSV
c          WRITE(10,580) EI,CSR,CSV
          WRITE(10,580) EI,om,CSR,CSV
          WRITE(*,580) EI,om,CSR,CSV
   20    CONTINUE
  300      CONTINUE
   15    CONTINUE
  517 FORMAT( 4X,'E, a.u.',5X,' Om, a.u.',8X,'  C.S.(L)',7X,' C.S.(V)')
  520 FORMAT( /60('-')/' Channel ',I2,':'/30(' -'))
c  Ionised shell -',I2,
c     *       ';  Final m =',I2,';')
  565 FORMAT( 15X, E15.8)
  570 FORMAT( 4E15.6)
  580 FORMAT( E11.3,E14.4,3X,2E15.4)
c  580 FORMAT( E15.3,5X,2E15.4)
      END