C====CALCULATION OF A WAVE FUNCTION =============
C====== IN CONTINUUM SPECTRUM====================
C================================================
      SUBROUTINE MAIN23(ALFA,BET,H,Z,AKAP,EPS,TETA,
     *R1,R2,R3,R4,R5,R6,R9,R10,R8,ALA,ALA1,ALA2,ALM3,C3,
     *GAM,GAM1,GAM2,MU,IS,NE5,IL,KK,ISIGM1,ISIGM2,
     *IN,IQ,NU,IG,ISIGM,SPI,ORT,L1,SS1)
C================================================
      REAL*8  ALFA,BET,H,Z,RO1,EPS,MU,AKAP,
     * GAM(1),GAM1(1),GAM2(IS),TETA(IS),B,C,D,P,T,
     * U,V,GAMA,TAU1,TAU2,ALM1,ALM2,
     * TETMAX,A1,B1,A2,OMEGA,ALM3(IS),
     * ALM4,ALM5,ALM6,FA,KVINT,
     * C5,ALA(IS),ALA1(IS),ALA2(IS),C3(IS),
     * R1(NE5),R2(NE5),R3(NE5),R4(NE5),
     * R5(NE5),R6(NE5),R9(NE5),R10(NE5),R8(NE5,*)
      INTEGER KSI,IL(*),KK(*),ISIGM1(*),IN(*),IQ(*),
     * ISIGM2(*),SPI(IS),ORT(IS),L1,SS1
      NE=NE5-15
      IRA=IS-1
      DO 1 J=1,IRA
      ALA(J)=0.0
      ALA1(J)=0.0
      ALA2(J)=0.0
      ALM3(J)=0.0
      TETA(J)=0.0
      C3(J)=1.0
    1 CONTINUE
      KF=1
      KF1=1
      IN1=IN(ISIGM)
      IL1=IL(ISIGM)
      IQ1=IQ(ISIGM)
      ALM4=0.0
      ALM5=0.0
      ALM6=0.0
      IRA=NE+2
      DO 301 J=1,IRA
      R2(J)=0.0
      R3(J)=0.0
  301 CONTINUE
      R5(1)=-AKAP**2/DABS(MU)
      R2(1)=AKAP**2/DABS(MU)
      CALL DIREC3(ALFA,BET,H,R1,IS-1,ISIGM,IG,NU,
     *GAM,GAM1,GAM2,IQ,KK,ISIGM1,ISIGM2,
     *R4,R5,R3,R6,R8,NE5)
      DO 302 J=1,NE
      R3(J)=R3(J)-Z
  302 CONTINUE
      D=DFLOAT( IL1*(IL1+1))
      P=ALFA*BET
      T=BET**2/4.
      DO 2 J=1,NE
      B=2.0*R1(J+2)*R3(J)
      C=(ALFA*R1(J+2)+BET)**2
      B=B*MU
      R3(J)=(D+B-AKAP**2*R1(J+2)**2+(P*R1(J+2)+T)/C)/C
    2 CONTINUE
  444 IRA=NE+2
      DO 397 J=1,IRA
397   R4(J)=0.0
      IF(DABS(MU-1.D 00).LE.1.D-04)
     *CALL EXCH3(ALFA,BET,H,IS,R1,ISIGM,IG,NU,IL,ALA2,
     *ALM3,IQ,GAM,GAM1,KK,ISIGM1,ISIGM2,
     *SPI,R2,R5,R4,R6,R10,R9,R8,NE5)
      DO 3971 J=1,IRA
3971  R5(J)=R2(J)
 445  D=DFLOAT(IL1)+ 0.5
      P=H**2/12.
      M1=0
      DO 4 I3=1,NE
      J=NE-I3+1
      C=R3(J)
      R6(J+1)=C*P
      B=C*D
      IF(B.LT.0.0) M1=J
      D=C
    4 CONTINUE
      R6(NE+2)=R6(NE+1)
      DO 5 J=2,NE
      R6(J-1)=0.0
      R2(J)=0.0
      IA=J
      IF(R6(J+1).LT.1.D 00) GOTO 120
    5 CONTINUE
  120 IRA=M1-1
      IF(IA.GT.IRA) GOTO 501
      DO 21 J=IA,IRA
      A1=1.-R6(J)
      B1=2.+10.*R6(J+1)
      A2=1.-R6(J+2)
      OMEGA=R4(J+2)+10.*R4(J+1)+R4(J)
      IF(J.EQ.IA) GOTO 6
      B=B1-A1*V
      V=A2/B
      U=(A1*U+OMEGA)/B
      GOTO 7
    6 V=0.0
  100 U=V
      V=A2/(B1-A1*V)
      IF(DABS(V-U).GT.1.D-7)GOTO 100
      U=0.0
    7 CONTINUE
      R6(J)=V
      R2(J+1)=U
   21 CONTINUE
  501 CONTINUE
      GAMA=1.0
      RO1=U+V*GAMA
      DO 8 J=M1,NE
      A1=1.-R6(J)
      B1=2.+10.*R6(J+1)
      A2=1.-R6(J+2)
      OMEGA= R4(J+2)+10.*R4(J+1)+R4(J)
      R2(J+2)=GAMA
      V=RO1
      RO1=GAMA
      GAMA=(B1*RO1-A1*V-OMEGA)/A2
    8 CONTINUE
  555 IRA=M1-1
      DO 306 I3=1,IRA
      J=IRA-I3+1
      R2(J+2)=R2(J+3)*R6(J)+R2(J+1)
  306 CONTINUE
      A1=0.0
          IF(ORT(IS).EQ.3)  THEN
      ALM3(IS)=1.
      IF(DABS(MU-1.D 00).LT.1.D-04)
     * CALL OFFDI31(ALFA,BET,H,
     * ALA,ALA1,ALA2,ALM3,TETA,C3,SPI,
     * IS,NE5,ISIGM,IN,IL,KF1,
     * R1,R2,R4,R10,R8)
       KF1=KF1+1
      DO 307 I=1,IS-1
      IF(ORT(I).EQ.0) GOTO 307
      IF(DABS(TETA(I)).GT.EPS*10.D 00) GOTO 445
 307   CONTINUE
         END IF

      CALL ACCOBM(R2,R5,ALM4,ALM5,ALM6,
     *NE5,1,KF)
C         WRITE(6,562) M1,M2
C562      FORMAT(//' M1,M2=',2I5)
C         WRITE(6,561) (R2(J),J=1,200)
C561      FORMAT(5E15.4)
      KF=KF+1
      KF1=1
      IF(DABS(MU-1.D 00).GT.1.D-04)  GOTO 99991
      IF(DABS(ALM6).GT.EPS*1.D-01) GOTO 444

         IF(ORT(IS).NE.3)THEN
      ALM3(IS)=1.
      IF(DABS(MU-1.D 00).LT.1.D-04)
     * CALL OFFDI3(ALFA,BET,H,
     * R1,R2,R10,R8,ALA,ALA1,ALA2,ALM3,TETA,C3,SPI,
     * ORT,IS,NE5,ISIGM,IN,IL,KF1)
      DO 56 I=1,IS-1
      IF(ORT(I).EQ.0) GOTO 56
      IF(DABS(TETA(I)).GT.EPS*10.D 00.AND.ORT(IS).EQ.0) GOTO 444
   56 CONTINUE
      KF1=KF1+1
C     KF=1
         END IF
      WRITE( 6,888) (TETA(I),I=1,ISIGM)
      WRITE( *,888) (TETA(I),I=1,ISIGM)
888   FORMAT(' OVERLAPPING INTEGRALS = ',3E13.5/5(12X,4E13.5/))
99991 IA=0
      TETMAX=0.0
      IRA=IS-1
      DO 309 J=1,IRA
      IA=IA+IQ(J)
  309 CONTINUE
      OMEGA=Z-DFLOAT(IA)
      CALL PHASE(AKAP,C,OMEGA,R1,R2,IL1,NE5,IM1)
      KSI=IM1
      ALM2=R1(NE+1)
      ALM1=ALM2
      V=R2(NE+1)*DSQRT(ALM1/(ALFA*ALM1+BET))
      OMEGA=OMEGA*MU
      A2=(DFLOAT(IL1*(IL1+1))/ALM1-2.*
     *OMEGA)/ALM1-AKAP**2
      TAU2=(DABS(A2))**0.25
      T=V*TAU2
      B1=A2
      ALM1=R1(NE+2)
      KF=0
      IF((ALM1-ALM2).LT.0.2/AKAP) GOTO 14
      ALM1=(ALM1+ALM2)/2.0
      R2(NE+2)=KVINT(ALM1,R1,R2,NE+1,NE+2)
      WRITE(6,1111)
 1111 FORMAT( 23H STEP IS DIVIDED BY TWO)
   14 CONTINUE
      U=R2(NE+2)*DSQRT(ALM1/(ALFA*ALM1+BET))
      A2=(DFLOAT(IL1*(IL1+1))/ALM1-2.*
     * OMEGA)/ALM1-AKAP**2
      TAU2=(DABS(A2))**0.25
      TAU2=TAU2*U
      J=0
      ALM2=ALM1-ALM2
      P=ALM2**2/12.
      IA=1
      R5(NE+7)=1.0
      IC4=0
      C5=0.0
  115 A1=B1
      B1=A2
      TAU1=T
      T=TAU2
      RO1=ALM1
      GAMA=V
      V=U
      ALM1=ALM1+ALM2
      A2=(DFLOAT( IL1*(IL1+1))/ALM1-2.*
     *OMEGA)/ALM1-AKAP**2
      TAU2=(DABS(A2))**0.25
      U=((B1*P*10.0+2.0)*V-(1.0-A1*P)*
     *  GAMA)/(1.0-A2*P)
      TAU2=TAU2*U
C     WRITE(*,999)KSI
C999  FORMAT(' KSI',I5)
      IF( R2(NE+2)*U.LT.0.0.AND.KF.EQ.0.AND.ALM1.
     *LE.R1(NE+2)  )KSI=KSI-1
      KF=1
      IF(U*V.GE.0.0) GOTO 31
      C=(U*RO1-V*ALM1)/(U-V)
      KSI=KSI+1
      J=J+1
      IF(IC4.NE.1) GOTO 31

      FA=DFLOAT(KSI)*3.14159-AKAP*C-OMEGA/
     *AKAP*DLOG(2.0*C*AKAP)+3.14159/
     *2.*DFLOAT( IL1) -((OMEGA/AKAP)**2+
     *DFLOAT(IL1*(IL1+1)))/(2.*AKAP*C)
      IF(J.NE.6) GOTO 31
      J=0
      C5=R5(NE+7)
      R5(NE+7)=FA
   31 CONTINUE
      IF(IC4.EQ.1) GOTO 125
      IF( (TAU2-T)*(T-TAU1).GT.0.0) GOTO 115
      B=(GAMA-U)/(GAMA+U-V)
      C=B-1.0
      D=B+1.0
      B=DABS((GAMA*C*B+U*D*B)/2.0-D*C*V)
      C=TETMAX-B
      IF(IA.NE.4) GOTO 16
      TETMAX=B
      IA=0
   16 CONTINUE
      IA=IA+1
      J=0
      IF(DABS(C/10.0).GT.EPS) GOTO 115
      WRITE(6,   2222) ALM1,KSI
      WRITE(*,   2222) ALM1,KSI
 2222 FORMAT(' R NORM =',25X,E15.8,I9,' NODES ')
  125 IC4=1
      IF(J.NE.0) GOTO 115
      IF(R5(NE+7).LT.0.001.OR.KSI.GT.150.AND.
     *R5(NE+7).NE.1.) GOTO 130
      IF(DABS(C5-R5(NE+7)).GT.EPS) GOTO 115
  130 WRITE(6,   3333) ALM1,KSI,R5(NE+7)
 3333 FORMAT( ' R FINAL =',24X,
     *E15.8,I9,7H NODES /' PHASE  =',25X,E15.8)
      C=DSQRT(DABS(MU)/(3.1416*AKAP))/TETMAX
      DO 310 J=1,NE
      R5(J+2)=R2(J+2)*C
  310 CONTINUE
 4444 R5(NE+4)=C
      R5(NE+5)=0.D 00
      R5(NE+6)=DFLOAT(IQ(ISIGM))
      R5(1)=AKAP**2/DABS(MU)
      R5(2)=DFLOAT(IL(ISIGM))
      R5(NE+9)=DFLOAT(SS1)
      R5(NE+10)=DFLOAT(L1)
      CALL COLUMN(NE5,R5,R8(1,IS))
      RETURN
      END
