PROGRAM BESSELC
C======================================================================
C BESSEL FUNCTION GENERATOR FOR HELMHOLTZ EQUATION
C THIS PROGRAM COMPUTES BESSEL AND NEUMANN FUNCTIONS OF
C J0, N0, J1, AND N1.
C CODED BY EIJI FUKUMORI 1996 JAPAN
C======================================================================
IMPLICIT REAL*8 ( A-H , O-Z )
COMPLEX*16 H0, H1
PI = 4.D0 * DATAN( 1.D0 )
OPEN ( 1, FILE='BESSEL.FUN', STATUS = 'UNKNOWN' )
WRITE(1,'(9X,1X,1HZ,9X,2HJ0,9X,2HN0,9X,2HJ1,9X,2HN1)')
DO I = 1 , 150
X = DFLOAT(I)/10.D0
CALL BESSEL ( PI, X , H0, H1 )
WRITE(1,'(5F11.6)') X,H0, H1
END DO
CLOSE (1)
STOP
END
C
C
SUBROUTINE BESSEL ( PI, X , H0, H1 )
IMPLICIT REAL*8 ( A-H , O-Z )
COMPLEX*16 H0, H1
PARAMETER ( EULER = 0.5772156649015D0, ALLOWANC=1.D-16 )
C--------- BJ0, BJ1
X22 = (X/2.D0) **2
PRODUCT = 1.D0
SIGNCH = 1.D0
FACT = 1.D0
SUM0 = 0.D0
SUM1 = 0.D0
M = 1
CHECK = 1.D0
DO WHILE ( DABS(CHECK) .GT. ALLOWANC )
FACT = FACT * DFLOAT(M)
PRODUCT = PRODUCT * X22
SIGNCH = -SIGNCH
DELTA0 = SIGNCH*PRODUCT/(FACT*FACT)
SUM0 = SUM0 + DELTA0
IF ( SUM0 .EQ. 0.D0 ) THEN
CHECK = DELTA0
ELSE
CHECK = DELTA0 / SUM0
END IF
SUM1 = SUM1 + SIGNCH*PRODUCT/(FACT*FACT*DFLOAT(M+1))
M = M + 1
IF ( M .GT. 1000 ) STOP
END DO
BJ0 = 1.D0 + SUM0
BJ1 = (X/2.D0) * ( 1.D0 + SUM1 )
C
C-------- BN0, BN1
PRODUCT = 1.D0
SIGNCH = 1.D0
FACT = 1.D0
SUM0 = 0.D0
SUM1 = 0.D0
M = 1
CHECK = 1.D0
DO WHILE ( DABS(CHECK) .GT. ALLOWANC )
FACT = FACT * DFLOAT(M)
PRODUCT = PRODUCT * X22
SIGNCH = -SIGNCH
C..............SUM OF 1/1 + 1/2 + 1/3 +.......+ 1/M
SUMM = 0.D0
DO I = 1 , M
SUMM = SUMM + 1.D0 / DFLOAT(I)
END DO
DELTA0 = SIGNCH*PRODUCT/(FACT*FACT) * 2.D0*SUMM
SUM0 = SUM0 + DELTA0
IF ( SUM0 .EQ. 0.D0 ) THEN
CHECK = DELTA0
ELSE
CHECK = DELTA0 / SUM0
END IF
SUM1 = SUM1 + SIGNCH*PRODUCT/(FACT*FACT*DFLOAT(M+1)) *
* (2.D0*SUMM+1.D0/DFLOAT(M+1))
M = M + 1
IF ( M .GT. 1000 ) STOP
END DO
BN0 = (2.D0/PI)*BJ0*(EULER+DLOG(X/2.D0)) - 1.D0/PI*SUM0
BN1 = (2.D0/PI)*BJ1*(EULER+DLOG(X/2.D0)) - X/(2.D0*PI) -
* 1.D0/PI*(X/2.D0)*SUM1 - 2.D0/(PI*X)
C----------- ASSEMBLE THEM INTO COMPLEX NUMBERS
H0 = DCMPLX(BJ0,BN0)
H1 = DCMPLX(BJ1,BN1)
RETURN
END