C=============================================================
C    PROGRAM FOR CALCULATION OF PHOTOIONIZATION CROSS-SECTION
C    IN HF AND RPAE
C    AUTHORS:L.V.CHERNYSHEVA,M.YA.AMUSIA,N.A.CHEREPKOV
C    FORTRAN VERSION: L.V.CHERNYSHEVA,S.K.SEMENOV ,17.12.1991
C                VARIABLES
C      NC   - NO OF CHANNELS
C      IZ-  HOLES IN CHANNELS
C      EXPI=0,LAMI1=0 - HF-ENERGIES, EXPI=1 -LAMI1=EXPER.ENERGIES
C      RPAE=0 -HF, RPAE=1 - HF,RPAE
C      NRES-number of resonances (Nres=0 without resonances)
C      HR,OMR2,OMR3 -step, om min, om max (for resonances)
C      NE- NO OF POINTS IN RADIAL MESH
C      S- NO OF SHELLS
C      NW1 - MAX NUMBER OF FUNCTIONS IN FILE
C      CHAN(NES)= 1(to add) or 0(no add)
      SUBROUTINE PHOABS(NC,IZ,EXPI,LAMI1,CHAN,RPAE,
     *       NRES,HR,OMR2,OMR3,NE,S,NW1,
     *       U1,NNLK,SPI,LLK,SSK,K1,KZ,
     *       I3,K,LI,LK,LV,CLS,B1,LAMI,IMIN,
     *       D3,D4,D5,D6,XMAXK,XK0,DELXK,
     *       LAMK,LADK,FME,FMEA,
     *       AL,BL,DK1,MA,TOTCR1,TOTCR2,
     *       C,Q,DV1,DV2,ARB,ARB1,ARB2,
     *       SM1,SM2,SMC1,SMC2,MB1,MB2,OMEGA,
     *       R1,R2,R3,R4,R5,R6,R7,R9,R8)

      INTEGER SSS,AS,QQ,S,EXPI,RPAE,NRES,
     *        LI(S),U1(S),SPI(S),NNLK(S),
     *        LLK(NC),SSK(NC),K1(NC),KZ(NC),
     *        K(NC),IZ(NC),I3(NC),IMIN(NC),CHAN(NC),
     *        LV(50),LK(NC),I4(50)
      REAL*8 Z,R,BET,H,ALFA,RO1,EOM,HH,
     *       OM,OM1,OM2,SA,A,B,A1,A2,A3,Y1,
     *       P,P1,SB,BBK1,LAM1,BETA,KVINT,
     *       HR(NRES),OMR2(NRES),OMR3(NRES),
     *       D3(NC,NW1),D4(NC,NW1),D5(NC,NW1),D6(NC,NW1),
     *       FME(NC*NW1),FMEA(NC*NW1),TOTCR1(NW1),TOTCR2(NW1),
     *       SM1(NC,NW1),SM2(NC,NW1),SMC1(NC,NW1),SMC2(NC,NW1),
     *       MB1(NC,NW1),MB2(NC,NW1),OMEGA(NC,NW1),
     *       DK1(NC,NW1),LAMK(NC,NW1),LADK(NC,NW1),
     *       CLS(NC),B1(NC),LAMI(S),LAMI1(S),
     *       XMAXK(NC),XK0(NC),DELXK(NC),
     *       AL(*),BL((NC+1)*NC/2),
     *       C(*),Q(*),DV1(*),DV2(*),
     *       ARB(*),ARB1(*),ARB2(*),
     *       MA(*),DAT(15),AK(10),BK(10),
     *       R1(NE+15),R2(NE+15),R3(NE+15),R4(NE+15),
     *       R5(NE+15),R6(NE+15),R7(NE+15),R9(NE+15),R8(NE+15,*)

      DO 1 I=1,NC
      LLK(I)=0
      SSK(I)=0
      CLS(I)=1.
      B1(I)=0.5
      DO 2 J=1,NW1
   2  DK1(I,J)=0.0
   1  CONTINUE
      DO 5 I=1,NC*(NC+1)/2
      LV(I)=2
      AL(I)=1.D 00
    5 BL(I)=0.5
      LLL=0
      SSS=1
      LLLK=1
      J1=NC
      J3=NC
      J5=NC
      WRITE(6, 10 )NC
      WRITE(*, 10 )NC
  10  FORMAT('    PHOTOIONIZATION CROSS SECTION'/
     *       '    WITH CORRELATIONS IN THE RPAE'/
     *       '     WITHIN',I3,2X,'TRANSITIONS')
      IF(NRES.GT.0) WRITE(6, 20)
  20  FORMAT(' INCLUDING CONTOURS',
     *       ' OF AUTOIONIZATION RESONANCES')
      READ(10) (DAT(I),I=1,15)
      Z=DAT(7)
      NE5=NE+15
      R=DAT(2)
      H=DAT(4)
      BET=DAT(5)
      CALL VAR11(NE5,Z,R,BET,H,ALFA,RO1,R1)
      WRITE(6, 30)Z,S,NE,R,H,BET,ALFA
  30  FORMAT(' LS-COUPLING HF'/
     *       ' CHARGE OF NUCLEUS   ',F7.1/
     *       ' NUMBER OF SHELLS    ',I7/
     *       ' NUMBER OF POINTS    ',I7/
     *       ' R MAX               ',F7.1/
     *       ' STEP OF INTEGRATION ',E15.6/
     *       ' BETA                ',E15.6/
     *       ' ALFA                ',E15.6)
C     WRITE(6, 31) QQ
C 31  FORMAT(' NO OF POINTS IN RESONANCES   ',I4)
C=================================
      WRITE(6, 40)
      WRITE(*, 40)
  40  FORMAT(' GROUND STATE CONFIGURATION')
C     *   ' ORBITAL   N ',
C     *'     L     Q   SPI    ENERGY          IN ZONES')
      DO 50 I=1, S
      CALL DISKO1(10,I,2,NE5,R8(1,I))
          LAMI(I)=R8(1,I)
         LI(I)=R8(2,I)
         U1(I)=R8(NE+5,I)
         NNLK(I)=R8(NE+6,I)
C         NNLK(4)=1
         SPI(I)=R8(NE+8,I)
C        SPI(I)=1
C      WRITE(6, 120) RPAE
       WRITE(6, 51)I,U1(I),LI(I),NNLK(I),SPI(I),LAMI(I),I
   51 FORMAT(' ',5I6,1X,E15.8,I6)
   50 CONTINUE

         DO 55 I=1,NC
         AS=IZ(I)
          IF(EXPI.NE.0) THEN
            LAMI(AS)=LAMI1(I)
          END IF
           LAMI1(I)=LAMI(AS)
C          SSK(I)=SPI(AS)
      WRITE(6, 56)I,U1(AS),LI(AS),NNLK(AS),SPI(AS),LAMI(AS)
      WRITE(*, 56)I,U1(AS),LI(AS),NNLK(AS),SPI(AS),LAMI(AS)
   56 FORMAT('  CHANNEL ',I6,' HOLE NLQS  ',4I3,' E= ',E15.6)
   55    CONTINUE
C ========GET WAVEFUNCTIONS OF EXCITED STATES==========
         NN1=0
         AS=S
         DO 60 I=1,NC
         LNO=11+I-1
         REWIND LNO
         READ (LNO) (DAT(J),J=1,15)
C        DAT(13)=11
         K(I)=DAT(13)+DAT(12)
         NN1=NN1+K(I)
         K1(I)=DAT(12)
         KZ(I)=AS+1
         XK0(I)=DAT(14)
         DELXK(I)=DAT(15)
      WRITE(6, 70)I
      WRITE(*, 70)I
  70  FORMAT( 60('=')/' EXCITED STATE   CHANNEL ',I6/
     *       '      Eel,RY              N/PHASE',
     *       '        IN ZONES')
      DO 80 J=1,K(I)
      LA=AS+J
      CALL DISKO1(LNO,J,2,NE5,R8(1,LA))
      R8(NE+2,LA)=0.0D 00
      LAMK(I,J)=R8(1,LA)
      DK1(I,J)=R8(NE+7,LA)
      IA=7
      IF(R8(1,LA).LT.0.D 00) IA=5
      WRITE(6, 90)J,R8(1,LA),R8(NE+IA,LA),LA
      WRITE(*, 90)J,R8(1,LA),R8(NE+IA,LA),LA
  90  FORMAT('  ',I2,2X,E15.8,4X,E15.8,2X,I6)
  80  CONTINUE
      LK(I)=R8(2,LA)
      AS=LA
      WRITE(6, 100) R8(2,LA),R8(NE+8,LA)
      WRITE(*, 100) R8(2,LA),R8(NE+8,LA)
  100 FORMAT(' WITH ELECTRON ORBITAL MOMENTUM ', F4.1/
     *       ' AND SPIN                       ', F4.1)
   60  CONTINUE

C  === CALCULATIONS OF DIPOLE MATRIX ELEMENTS=======
      N7=0
C     NN1=(KZ(NC)+K(NC)-S-1)*2
      NN1=NN1*2
      DO 110  I=1,NC
         N1=K(I)
         N2=KZ(I)
         N3=IZ(I)
         N4=LI(N3)
         N5=LK(I)
         N6=KZ(I)-S
         N8=I-1
         WRITE(6, 105)I
         WRITE(*, 105)I
  105    FORMAT( 60('=')/
     *   ' CHANNEL ',I3,' DIPOLE MATRIX ELEMENTS ')
C     WRITE(6, 111)N2,N3,N1,N4,N5,N6,N8,NN1
 111  FORMAT(8I6)
         CALL MAEL1(ALFA,BET,NE5,H,N2,N3,N1,N4,N5,1,
     *        FME(N6),FMEA(N6),R1,R2,R5,R6,R8)
       WRITE(6,122)
 122   FORMAT('     Eel,RY   R-FORM     V-FORM  ')
      DO 112 J=1,N1
  112    WRITE(6, 121)LAMK(I,J),FME(N6+J-1),FMEA(N6+J-1)
  121 FORMAT(3F12.6)
      IF(SPI(I).NE.0) CLS(I)=1.D 00/DSQRT(2.D 00)
      DO 113 J=1,N1
         FME(N6+J-1)=FME(N6+J-1)*CLS(I)
  113    FMEA(N6+J-1)=FMEA(N6+J-1)*CLS(I)
        N6=2*N6
C-------------------------
        IF(RPAE.EQ.0) GOTO 110
C =====COLUMB MATRIX ====================
        DO 130  J=1,NC
          N10=IZ(J)
          WRITE(6, 131)I,J
          WRITE(*, 131)I,J
  131  FORMAT('   CHANNELS  ',2I4)
           IF(I.EQ.J) THEN
            NN2=N1
            NN3=LV(I)-1
          BBK1=B1(I)
          AL(I)=AL(I)*CLS(I)*CLS(I)
C        WRITE(6, 132)B1(I),AL(I),NN2,NN3
C 132   FORMAT(' B1,al nn2,nn3  ',2E15.5,2I3)
      CALL MAELO2(ALFA,BET,NE5,H,NN1,NN3,N1,N1,S,
     *                  IZ(I),IZ(J),LI(N3),LK(I),
     *                  LI(N10),LK(J),LAMI(N3),LAMI(N10),
     *                  AL(I),BK,BBK1,MA,KZ(I),KZ(J),
     *                   SSK(I),SSK(J),LLLK,1,
     *                  R1,R2,R3,R4,R5,R6,R7,R9,R8)
               ELSE
              NN2=K(J)
               IF(J.GT.I) THEN
                NN4=N7+J-I
                   ELSE
                  NN4=N8
                   N8=N8+NC-1-J
               END IF
              NN3=LV(NN4+NC)-1
       IF(SPI(N3).NE.SPI(N10)) THEN
         BBK1=0.D 00
         BK(1)=0.D 00
           ELSE
           BBK1=B1(J)
           BK(1)=BL(NN4)
         END IF
           AK(1)=AL(NN4+NC)*CLS(I)*CLS(I)
      CALL MAELO2(ALFA,BET,NE5,H,NN1,NN3,N1,NN2,S,
     *        IZ(I),IZ(J),LI(N3),LK(I),
     *        LI(N10),LK(J),LAMI(N3),LAMI(N10),
     *        AK,BK,BBK1,MA,KZ(I),KZ(J),
     *        SSK(I),SSK(J),LLLK,1,
     *        R1,R2,R3,R4,R5,R6,R7,R9,R8)
            END IF
 130       CONTINUE
         N7=N7+NC-I
 110  CONTINUE
C     ==========================================
      DO 140 I=1,NC
         J=K(I)
         J1=K1(I)
C     WRITE(6,*) LAMK(I,J),LAMK(I,J1+1),LAMK(I,J-1),J,J1
         IF(J.GT.J1+1) THEN
           XMAXK(I)=DSQRT(LAMK(I,J))
             ELSE
             XMAXK(I)=1.D-05
             XK0(I)=1.D-05
             DELXK(I)=1.D-05
           END IF
  140  CONTINUE
C==========================================
      N8=0
      N9=NC
 150  DO 350 I=1,NW1
      TOTCR1(I)=0.0D 00
      TOTCR2(I)=0.0D 00
 350  CONTINUE

         DO 160 JN=1,N9
         I2=JN
        IF(RPAE.EQ.1) THEN
         IF(N8.GE.1) I2=I3(JN)
         WRITE(6, 141)I2
         WRITE(*, 141)I2
  141    FORMAT( 60('=')/' CHANNEL     ',I6/
     *          '   DIPOLE MATRIX ELEMENTS WITH CORREL.'/
     *          '    Eph,RY    RE L-FORM  RE V-FORM ',
     *          ' IM L-FORM  IM V-FORM    DETER. ')
         END IF
         JJ1=QQ
         IF(N8.EQ.0) JJ1=K(JN)
         IF(N8.EQ.0.AND.NRES.NE.0) JJ1=K1(JN)
         NF=0
C----------------
         IF(JN.EQ.1.AND.N8.EQ.1) THEN
C           WRITE(6,175)
C  175      FORMAT( 30(' =')/' CORRECTED ENERGIES'/)
           DO 180 I=1,NC
              DO 190 J=1,K1(I)
  190            LAMK(I,J)=LADK(I,J)
C              WRITE(6,185) I,(LADK(I,J),J=1,K1(I))
C  185         FORMAT(' CHAN.',I2,':'/2(5F11.7))
  180      CONTINUE
           END IF
C ==============================
         DO 200 JJ=1,JJ1
            IC1=0
C-------------
            IF(N8.EQ.0) THEN
              IDOP=0
              JN1=JN
              A1=LAMK(JN,JJ)
              A2=LAMI1(JN)
              A3=LAMK(JN,JJ+1)
              OM=A1-A2
              J2=JJ
              OM1=OM
            IF(JJ.GT.K1(JN)) OM=OM+(-1)**NF*5.D-02*(A3-A1)
            IF(A1.LT.0.D 00) IC1=JJ
              GOTO 210
              END IF
C---------------
            IC1=0
            I2=I3(JN)
            JN1=I2
            LAM1=LAMI1(I2)
            KI=K(I2)
            KI1=K1(I2)
            OM=OM2+HH*DFLOAT(JJ-1)
            OM1=OM
            A=DABS(OM-LAMK(I2,KI1+1)+LAM1)
            DO 220 I=KI1+1,KI
               B=DABS(OM-LAMK(I2,I)+LAM1)
               IF(B.LE.A) THEN
                 J2=I
                 A=B
                 END IF
  220          CONTINUE
            A1=LAMK(I2,J2)
  210         IF(RPAE.EQ.0)  GOTO 230
       NN5=4.*NW1*NW1*NC*NC/NE5+2
           IF(JJ.EQ.IC1) THEN
              J3=0
  211       CALL DISNN(OM,OM1,A,SA,J2,NC,JN1,NN1,K,K1,
     *        IMIN,LAMI1,LAMK,XK0,DELXK,XMAXK,LLLK,R8,
     *        R8(1,NN5),MA,C,Q,DV1,DV2,ARB,ARB1,ARB2)
            EOM=OM+LAMI1(JN)
        WRITE(6, 214)OM,EOM,SA,A
        WRITE(*, 214)OM,EOM,SA,A
  214   FORMAT(' OM,E (NEW)',F9.5,E15.6,' A,1-B ',2F10.5)
              IF(DABS((OM-OM1-SA)/OM1).GT.1D-03.
     *                             AND.J3.LT.5) THEN
                J3=J3+1
                GOTO 211
                END IF
              WRITE(6, 212)
 212          FORMAT( 30(' -'))
              END IF
            CALL CQDN(OM,0.D+00,NC,JN1,K,K1,XK0,DELXK,
     *                XMAXK,LAMI1,LAMK,J2,C,Q,DV1,DV2)
            CALL INVMAN(K,K1,XK0,DELXK,XMAXK,LAMI1,
     *           IMIN,OM,LLLK,J2,NC,JN1,NN1,C,Q,DV1,DV2,
     *           MA,Y1,R8(1,1),R8(1,NN5),ARB,ARB1,ARB2)
             IF(J2.LE.K1(JN).AND.JN.LE.NC)
     *          LADK(JN,J2)=EOM
        CALL MECO(K,NC,IMIN(JN1),FME,FMEA,R8(1,1),R8(1,NN5),
     *        D3(JN,JJ),D4(JN,JJ),D5(JN,JJ),D6(JN,JJ),NN1)
       WRITE(6, 215)OM1,D3(JN,JJ),D4(JN,JJ),
     *           D5(JN,JJ),D6(JN,JJ),Y1
       WRITE(*, 215)OM1,D3(JN,JJ),D4(JN,JJ),
     *           D5(JN,JJ),D6(JN,JJ),Y1
 215   FORMAT(' ',6F10.5)
 230           CONTINUE
C======================
C         IF(JJ.EQ.1) THEN
C         WRITE(6,500) (FME(ILI),ILI=1,NN1)
C         WRITE(6,500) (FMEA(ILI),ILI=1,NN1)
C         END IF
C500      FORMAT( 5E12.4)
C======================
            IF(N8.GE.1) GOTO 235
            N6=KZ(JN)-S
            P=FME(J2+N6-1)**2
            P1=FMEA(J2+N6-1)**2
            CALL FCROS1(OM1,A1,LLL,P,P1,SA,SB)
            SM1(JN,JJ)=SA
            SM2(JN,JJ)=SB
              IF(RPAE.EQ.0)  THEN
            D3(JN,JJ)=FME(J2+N6-1)
            D5(JN,JJ)=0.
            D4(JN,JJ)=FMEA(J2+N6-1)
            D6(JN,JJ)=0.
            OMEGA(JN,JJ)=OM1
            GOTO 200
            END IF
 235        P=D3(JN,JJ)**2+D5(JN,JJ)**2
            P1=D4(JN,JJ)**2+D6(JN,JJ)**2
            IF(IC1.NE.0) THEN
              P=P/A
              P1=P1/A
              OM1=OM
              END IF
            CALL FCROS1(OM1,A1,LLL,P,P1,SA,SB)
            SMC1(JN,JJ)=SA
            SMC2(JN,JJ)=SB
            OMEGA(JN,JJ)=OM1
C======================
C     WRITE(6, 300)OMEGA(JN,JJ),
C    * SMC1(JN,JJ),SMC2(JN,JJ)
            IF(N8.GE.1) THEN
               DK1(JN,JJ)=KVINT(OM1,R5(I4(I2)+K1(I2)),
     *            R6(I4(I2)+K1(I2)),1,K(I2)-K1(I2))
              END IF
            MB1(JN,JJ)=0.0
            MB2(JN,JJ)=0.0
      IF(JJ.GT.K1(JN).AND.JN.LE.NC) NF=NF+1
  200  CONTINUE
C===============================================
  160  CONTINUE
C     STOP
C ====BETA CALCULATIONS,     TABLE OF RESULTS ========
      DO 231 JN=1,N9
         IF(N8.EQ.0.AND.NRES.NE.0) GOTO 314
      LAML=LAMI1(JN)
      JJ1=K(JN)
C----------
      IF(N8.GE.1) THEN
        LAML=LAM1
        JJ1=QQ
C      GOTO 245
        END IF
C----------
      N10=IZ(JN)
      DO 232 I=1,NC
      N3=IZ(I)
      N4=LI(N3)
      N11=0
      N12=0
      IF(ABS(LK(I)-LK(JN)).EQ.2.AND.
     *LAMI1(I).EQ.LAMI1(JN))THEN
      IF(LK(I).LT.LK(JN))THEN
      N11=N4-1
      N12=N4+2
      ELSE
      N11=N4+2
      N12=N4-1
      END IF
      JJ1=K(JN)
      IF(N8.GE.1)JJ1=QQ
      DO 233 JJ=1,JJ1
      DO 234 JW=1,JJ1
      IF(DABS(OMEGA(JN,JJ)-OMEGA(I,JW)).LT.0.001)THEN
      MB1(JN,JJ)=BETA(D3(I,JW),D5(I,JW),D3(JN,JJ),
     *D5(JN,JJ),DK1(I,JW),DK1(JN,JJ),N11,N12,N4)
      MB2(JN,JJ)=BETA(D4(I,JW),D6(I,JW),D4(JN,JJ),
     *D6(JN,JJ),DK1(I,JW),DK1(JN,JJ),N11,N12,N4)

C     WRITE(6, 237)JJ,JW,N11,N12,N4,D3(I,JW),D5(I,JW),
C    *D3(JN,JJ),D5(JN,JJ),DK1(I,JW),DK1(JN,JJ),
C    *  D4(I,JW),D6(I,JW),
C    *  D4(JN,JJ),D6(JN,JJ),MB1(JN,JJ),MB2(JN,JJ)
 237  FORMAT(' l-1,l+1,ll ',5I3/
     *       ' ME         ',4E15.8/
     *       ' PHASE      ',2E15.8/
     *       ' ME         ',4E15.8/
     *       ' BETA r,v   ',2E15.8)
      END IF
 234  CONTINUE
 233  CONTINUE
      END IF
 232  CONTINUE
 245  I2=JN
      IF(N8.GE.1) I2=I3(JN)
      N10=IZ(I2)
      WRITE(6, 250)I2,Z,LAMI1(I2),U1(N10),LI(N10),LK(I2),SPI(N10)
      WRITE(*, 250)I2,Z,LAMI1(I2),U1(N10),LI(N10),LK(I2),SPI(N10)
 250  FORMAT(' ======CHANNEL',I2,'-----------------------'/
     *   '     Z=',F5.1,3X, ' TRANSITION',
     *      ' E=',E13.6/25X,' N=',I3,' L=',I3,' --> L=',I2,' SPI=',I3)
      IF(NC.EQ.1) GOTO 260
      IF(N8.NE.0) WRITE(6, 270)
      IF(N8.NE.0) WRITE(*, 270)
 270  FORMAT(12X,'   IN RESONANCE')
 260  CONTINUE
      IF(N8.EQ.0) THEN
      WRITE(6, 280 )
      WRITE(*, 280 )
 280  FORMAT('               CROSS SECTION'/
     *       '   Eph,RY        HFL       HFV ',
     * 5X,'   RPAEL     RPAEV  ',
     *     '   BETAL  BETAV')
      ELSE
      WRITE(6, 285)
 285  FORMAT('                 CROSS SECTION'/
     * '   Eph,RY        RPAEL     RPAEV      PHASE ',
     * '  BETAL    BETAV ')
      END IF
      DO 290 JJ=1,JJ1
      IF(RPAE.EQ.0) THEN
      SMC1(JN,JJ)=0.0
      SMC2(JN,JJ)=0.0
      END IF
      IF(N8.EQ.0) THEN
      IF(NRES.EQ.0.OR.(NRES.NE.0.AND.JJ.LE.K1(JN)))
     * WRITE(6, 300)OMEGA(JN,JJ),SM1(JN,JJ),SM2(JN,JJ),
     * SMC1(JN,JJ),SMC2(JN,JJ),MB1(JN,JJ),MB2(JN,JJ)
      IF(NRES.EQ.0.OR.(NRES.NE.0.AND.JJ.LE.K1(JN)))
     * WRITE(*, 300)OMEGA(JN,JJ),SM1(JN,JJ),SM2(JN,JJ),
     * SMC1(JN,JJ),SMC2(JN,JJ),MB1(JN,JJ),MB2(JN,JJ)
C300  FORMAT(1X,F12.5,6E13.5)
 300  FORMAT(2X,F10.5,2(1X,2(E11.4)),
     * 2X,2(F6.3,1X))
       IF(JJ.EQ.K1(JN)) WRITE(6, 305)
 305   FORMAT( 55('-'))
       ELSE
       WRITE(6, 302)OMEGA(JN,JJ),SMC1(JN,JJ),
     *           SMC2(JN,JJ),DK1(JN,JJ),MB1(JN,JJ),MB2(JN,JJ)
       WRITE(*, 302)OMEGA(JN,JJ),SMC1(JN,JJ),
     *           SMC2(JN,JJ),DK1(JN,JJ),MB1(JN,JJ),MB2(JN,JJ)
 302   FORMAT(1X,F10.5,(1X,2(E13.5)),
     * 2X,F8.3,2(F6.3,3X))
C      WRITE(6, 310 ) JN,CHAN(JN)
C 310  FORMAT('CHAN',2I5)
       IF(CHAN(JN).NE.0)THEN
       TOTCR1(JJ)=TOTCR1(JJ)+SMC1(JN,JJ)
       TOTCR2(JJ)=TOTCR2(JJ)+SMC2(JN,JJ)
       END IF
       END IF
 290  CONTINUE

 231  CONTINUE
      IF(NRES.EQ.0.AND.RPAE.EQ.1) THEN
       WRITE(6, 364)
 364   FORMAT('    RANDOM PHASE APPROXIMATION')
         CALL CROSST(NC,NW1,K,K1,OMEGA,SMC1,SMC2,CHAN,
     *      R1,R2,R3,R4,R5,R6)
       END IF
      IF(NRES.EQ.0.AND.RPAE.EQ.0) THEN
       WRITE(6, 365)
 365   FORMAT('    HARTREE-FOCK APPROXIMATION')
         CALL CROSST(NC,NW1,K,K1,OMEGA,SM1,SM2,CHAN,
     *    R1,R2,R3,R4,R5,R6)
        END IF
       IF(NRES.NE.0) THEN
       WRITE(6, 360) (CHAN(I),I=1,NC)
       WRITE(*, 360) (CHAN(I),I=1,NC)
 360   FORMAT('              TOTAL CROSS SECTION  '/
     *        '     Eph,RY   RPAEL    RPAEV    '/
     *        '             IN CHANNELS ',10I3)
       DO 380 JJ=1,QQ
       WRITE(6, 370)JJ,OMEGA(1,JJ),TOTCR1(JJ),TOTCR2(JJ)
       WRITE(*, 370)JJ,OMEGA(1,JJ),TOTCR1(JJ),TOTCR2(JJ)
 370   FORMAT(1X,I3,F10.5,5X,2E15.8)
 380   CONTINUE
       END IF
 314     IF(N8.EQ.NRES) RETURN
      N8=N8+1
      N9=0
       OM2=OMR2(N8)
      DO 315 I=1,NC
         IF(DABS(LAMI1(I)).LT.OM2.AND.K(I).GT.K1(I)) THEN
           N9=N9+1
           I3(N9)=I
          END IF
  315 CONTINUE
      IF(N9.GT.0) THEN
      WRITE(6, 240 )N8
      WRITE(*, 240 )N8
  240 FORMAT('   INCLUDING CONTOURS OF AUTOIONIZATION'/
     *       '               RESONANCES',I4)
      JJ=1
      DO 320 I=1,NC
      I4(I)=JJ
       DO 330 J=1,K(I)
       R5(JJ)=LAMK(I,J)-LAMI1(I)
       R6(JJ)=DK1(I,J)
 330   JJ=JJ+1
 320   CONTINUE
       HH=HR(N8)
       QQ=IDNINT((OMR3(N8)-OM2)/HH)+1
       IF(QQ.GT.NW1)QQ=NW1
      GOTO 150
      END IF
      RETURN
      END
