C==== PROGRAMM FOR CALCULATION OF ATOMIC LEVELS ==old=====
C=============WITH RESPECT TO AUGER DECAY==============
C== =========== WITH RPAE CORRELATIONS ===========     
C=====authors: L.V.Chernysheva, M.Ya.Amusia,
C         V.K.Ivanov, S.G.Shapiro, V.G.Yarzhemsky=======
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      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 AUGER(NC,FZ1,FZ2,FZ3,LV1,EXPI,
     *       EKIN,RPAE,NE,S,NW1,EPS,
     *       CO,LAMI1,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,ME,ME1,ME2,PR,
     *       AL,BL,MA,OMEGA,WL,WLC,DELOM,OMEGA1,OMEGA2,
     *       OM2,C,Q,DV1,DV2,ARB,ARB1,ARB2,
     *       R1,R2,R3,R4,R5,R6,R7,R9,R8)

      INTEGER SSS,AS,S,EXPI,RPAE,
     *        LI(S),U1(S),SPI(S),NNLK(S),
     *        LLK(NC),SSK(NC),K1(NC),KZ(NC),
     *        FZ1(NC),FZ2(NC),FZ3(NC),LV1(NC),
     *        K(NC),I3(NC),IMIN(NC),LV(50),LK(NC),
     *        NO(20),NO1(20)
      REAL*8 Z,R,BET,H,ALFA,RO1,EOM,B2,B3,EPS(NC),
     *       OM,OM1,SA,A,B,A1,A2,A3,Y1,BBK1,B4,
     *       D3(NC,NW1),D4(NC,NW1),D5(NC,NW1),D6(NC,NW1),
     *       ME(NW1,1),ME1(NW1),ME2(NW1),CO(NC),
     *       LAMF1,LAMF2,PR(*),EKIN(NC),        
     *       FME(NC*NW1),FMEA(NC*NW1),
     *       OMEGA(NC,NW1),OMEGA1(NC),OMEGA2(NC),DELOM(NW1), 
     *       WL(NC),WLC(NC,NW1),OM2(NC),
     *       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,*)

      WLC=0.
      DO 1 I=1,NC
      LLK(I)=0
      SSK(I)=0
      CLS(I)=1.
      B1(I)=0.5
        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(' ========AUGER DECAY=======  '/
     *        '   WITH RPAE CORRELATIONS  '/
     *        '  IN  ',I4,' TRANSITIONS ')
       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, 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=FZ3(I)
C          IF(EXPI.NE.0) THEN
C            LAMI(AS)=LAMI1(I)
C          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)
      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
      i102= IDINT(R8(NE+9,LA)) 
      SSK(I)=I102
      i103= IDINT(R8(NE+10,LA))
      WRITE(6, 100) R8(2,LA),R8(NE+8,LA),i102,i103
      WRITE(*, 100) R8(2,LA),R8(NE+8,LA),i102,i103
  100 FORMAT(' WITH ELECTRON ORBITAL MOMENTUM ', F4.1/
     *       ' AND SPIN                       ', F4.1/
     *       ' TERM 2S+1,L           ',2I6)
   60  CONTINUE
C========AUGER MATRIX ELEMENTS==============================
                                                         
C  === CALCULATIONS OF AUGER MATRIX ELEMENTS=======

      N7=0
C     NN1=(KZ(NC)+K(NC)-S-1)*2
      NN1=NN1*2
      DO 110  I=1,NC
      WRITE(6, 101)I
      WRITE(*, 101)I
 101  FORMAT('=============================='/
     *       ' CHANNEL ',I4)
       WRITE(6,111)LV1(I)
       WRITE(*,111)LV1(I)
  111  FORMAT('================================'/
     *        '  MOMENTUM TRANSFERED TO ATOM',I6)

        LF1=LI(FZ1(I))
C        IF (EXPI.EQ.0) THEN
        LAMF1=LAMI(FZ1(I))
C        ELSE
C        LAMF1=LAMFF1(I)
C        END IF
        WRITE(6,132)LF1,LAMF1,FZ1(I)
 132  FORMAT('  INITIAL VACANCY f1'/
     *       '    L    ENERGY      ZONE '/I5,E15.8,I5)
C----------
        LF2=LI(FZ2(I))
C        IF (EXPI.EQ.0) THEN
        LAMF2=LAMI(FZ2(I))
C        ELSE
C        LAMF2=LAMFF2(I)
C        END IF
        WRITE(6,133)LF2,LAMF2,FZ2(I)
 133  FORMAT('  final VACANCY f2 '/
     *       '    L    ENERGY      ZONE '/I5,E15.8,I5)
C-------------
       CO(I)=4.*3.1459*13.605/DFLOAT((2*LV1(I)+1)*(2*LF1+1))
        IF (EXPI.EQ.0) THEN  
           OM2(I)=LAMF2-LAMF1
        WRITE(6,136)  
  136   FORMAT('   THEORETIC')   
        ELSE
            OM2(I)=EKIN(I)
        WRITE(6,137)  
  137   FORMAT('  EXPERIMENTAL ')   
        END IF
       WRITE(6,158)OM2(I),CO(I)
       WRITE(*,158)OM2(I),CO(I)
  158  FORMAT('  ENERGY '/
     *        '  Ekin=Ef2-Ef1      CO '/2E15.8)

         N1=K(I)
         N2=KZ(I)
         N3=FZ3(I)
         N4=LI(N3)
         N5=LK(I)
         N6=KZ(I)-S
         N8=I-1
         WRITE(6, 105)
         WRITE(*, 105)
  105    FORMAT( 60('=')/)
           WRITE(6, 113)FZ1(I),FZ2(I),FZ3(I),N2,N1                        
 113      FORMAT( 60('=')/'    ZONES FOR '/                                         
     *   '  f1, f2, f3, f4, k '/ 5I4/                             
     *   '  MATRIX ELEMENTS ')                             

C	STOP	                                                        
       CALL MAEL5(ALFA,BET,NE5,H,FZ3(I),FZ2(I),FZ1(I),
     * N2,N1,N4,LF2,LF1,N5,LV1(I),R1,PR,                                   
     * ME,FME(N6),FMEA(N6),ME2,ME1,R8,R2,R5,R6,R7)
       WRITE(6, 155)                       
 155   FORMAT(' E elec,Ry',10X,'direct',10X,'exchange',
     *  6X,'combined ')
         DO 112 J=1,N1                                             
       WRITE(6, 165)LAMK(I,J),FME(N6+J-1),FMEA(N6+J-1),ME2(J)
 112      CONTINUE                                                  
 165     FORMAT(4E15.8)
        
C-------------------------
        IF(OM2(I).LT.0.) THEN 
	 GOTO 110
        END IF
C------- main condition --- om=om2---
        B4=OM2(I)
        DO 400 J=1,N1
        B3=LAMK(I,J)
        OM=B3-LAMI(N3)
        DELOM(J)=DABS(OM-OM2(I))
        IF(DELOM(J).LT.B4) THEN
        B4=DELOM(J)
        IW=J
        NO(I)=IW
C       WRITE(6,335)B3,OM,OM2(I),B4
C 335   FORMAT(7X,' LAMK',10X,'DEL',12X,' OM ',10X,'DLAMF'/4E15.8)
C	WRITE(6,341) J2,N6
  341   FORMAT( 'J2,N6 ',2I3)
        END IF
  400   CONTINUE
C----------------------------------
         WL(I)=0.
        B3=LAMK(I,IW)  
        OM=B3-LAMI(N3)  
        B4=OM-OM2(I)           
        WRITE(6,342)IW,B3,B4,EPS(I)
 342    FORMAT(2X,'N',5X,'EEl',14X,'DOM',
     *     10X,'EPS'/I3,3E15.8)
	  OMEGA1(I)=OM 
        IF(DABS(OM-OM2(I)).LT.EPS(I)) THEN
       WL(I)=CO(I)*(FME(IW+N6-1)**2+FMEA(IW+N6-1)**2-
     *         FME(IW+N6-1)*FMEA(IW+N6-1))
C        WRITE(6,344)I,IW,OM,OM2(I),FME(IW+N6-1),FMEA(IW+N6-1)
C  344    FORMAT(2I3,4E15.8)
        END IF
C       STOP    
       WRITE(6,340)IW,LAMK(I,IW),OM,OM2(I),WL(I)
       WRITE(*,340)IW,LAMK(I,IW),OM,OM2(I),WL(I)
  340   FORMAT(2X,'N',5X,'Eel',14X,'Ef4-Ef3',5X,'Ef2-Ef1',
     *    4X,'HF level width'/I3,4E15.8)
        N6=2*N6

        IF(RPAE.EQ.0) GOTO 110
C =====COLUMB MATRIX ====================
        DO 130  J=1,NC
          N10=FZ3(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,
     *                  FZ3(I),FZ3(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,
     *        FZ3(I),FZ3(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
          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/
     *          '   MATRIX ELEMENTS WITH CORREL.'/
     *          '    Eph,RY    RE L-FORM  RE V-FORM ',
     *          ' IM L-FORM  IM V-FORM    DETER. ')
         END IF
         IF(N8.EQ.0) JJ1=K(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---------------
           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
            OMEGA(JN,JJ)=OM1
C+++++++++++++++++++++++++++++++++++++++++++
        N6=KZ(JN)-S
        IF(RPAE.EQ.1)THEN
        B2=OMEGA(JN,JJ)
        B=DABS(B2-OM2(JN))
C         WRITE(6,337)B2,OM2(JN),B
C         WRITE(*,337)B2,OM2(JN),B
C 337     FORMAT(' OM, OM2 DIFFER  '/3E15.8)
        IF(ABS(B2-OM2(JN)).LT.EPS(JN)) THEN
         WRITE(6,338)JJ,B3,B,EPS(JN)
         WRITE(*,338)JJ,B3,B,EPS(JN)
 338    FORMAT(/7X,' LAMK',11X,'DELOM',12X,' EPS ',/I3,3E15.8)
        NO1(JN)=JJ
        WLC(JN,JJ)=CO(JN)*
     *  (D3(JN,JJ)**2+D5(JN,JJ)**2+D4(JN,JJ)**2+D6(JN,JJ)**2
     *   -D3(JN,JJ)*D4(JN,JJ)-D5(JN,JJ)*D6(JN,JJ))
        WRITE(6,251)JJ,B3,B2,OM2(JN),WLC(JN,JJ)
        WRITE(*,251)JJ,B3,B2,OM2(JN),WLC(JN,JJ)
 251    FORMAT(2X,'N',5X,'Eel',14X,'Ef4-Ef3',5X,'Ef2-Ef1',4X,
     *         'RPAE level width '/I3,4E15.8/)
        OMEGA2(JN)=B2
        ELSE
        WLC(JN,JJ)=0.
	END IF
C--------------
        END IF   
  200  CONTINUE
C===============================================
  160  CONTINUE
C     STOP
 314  CONTINUE
C =======    TABLE OF RESULTS===================
       WRITE(6,301)
       WRITE(*,301)
  301  FORMAT(/ '=========AUGER DECAY================')
       IF(EXPI.EQ.0) THEN
       WRITE(6,336)
  336  FORMAT('  THEORETICAL Ef2-Ef1')
       ELSE
       WRITE(6,337)
  337  FORMAT('  EXPERIMENTAL Ef2-Ef1')
       END IF
       WRITE(6,302)Z,S
  302  FORMAT('  CHARGE OF NUCLEUS       ',E15.8/
     *        '  NUMBER OF SHELLS        ',I7/
C     *        '  ACCURACY                ',E15.8/
     *        '             LEVEL WIDTH ' /
     * ' CHAN N ',4X,' Ef2-Ef1 ',4X,' Ef4-Ef3 ',
     *   10X,'HF(eV)',5X,'  EPS')
       SUM1=0.
       SUM2=0.
         DO 330 I=1,NC 
         IW=NO(I)
       SUM1=SUM1+WL(I)
       WRITE(6, 321)I,IW,OM2(I),OMEGA1(I),WL(I),EPS(I)
       WRITE(*, 321)I,IW,OM2(I),OMEGA1(I),WL(I),EPS(I)
 321  FORMAT(1X,2I3,4E15.8)
 330  CONTINUE 
       WRITE(6, 331)SUM1
       WRITE(*, 331)SUM1
 331   FORMAT('TOTAL LEVEL WIDTH IN HF   ',E15.8/)
       IF(RPAE.NE.0)THEN
       WRITE(6,335)
       WRITE(*,335)
 335   FORMAT(' CHAN N ',4X,' Ef2-Ef1   ',
     *         4X,'Ef4-Ef3',10X,'RPAE (eV)',' EPS')
         DO 332 I=1,NC
       IW=NO1(I)
       SUM2=SUM2+WLC(I,IW)
       WRITE(6, 333)I,IW,OM2(I),OMEGA2(I),WLC(I,IW),EPS(I)
       WRITE(*, 333)I,IW,OM2(I),OMEGA2(I),WLC(I,IW),EPS(I)
 333   FORMAT(1X,2I3,4E15.8)
 332   CONTINUE 
       WRITE(6, 334)SUM2
       WRITE(*, 334)SUM2
 334   FORMAT('TOTAL LEVEL WIDTH IN RPAE   ',E15.8)
       END IF
      RETURN
      END
                 