Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : BESSJ.FOR

 
Output of file : BESSJ.FOR contained in archive : FORTRN77.ZIP
SUBROUTINE BESSJ(X1,B1,Y1)
C
C SUBROUTINE TO FIND THE BESSEL FUNCTION OF INTEGER OR
C FRACTIONAL ORDER FOR ANY X GREATER THAN ZERO.
C
DIMENSION C(6), D(6), S(26)
DATA S/-3.375,54.4921875,-272.953125,354.375,-2.0625,13.7578125,
&-19.6875,-1.0625,1.875,-.375,.0030381944,-.4861111111,10.286458
&33333,-58.,78.75,.0005580357,-.4241071428,3.6026785714,
&-5.625,.0125,-.35,.75,.0416666666,.25,3.1415926535,1.57
&07963267/
Y1 = 0.0
IF(B1.LT.0.0) RETURN
2 IF(X1.GE.8.0) GO TO 51
C1 = B1 + 1.0
CALL GAMMA(C1,Z1)
TERM1 = (X1*0.5)** B1/Z1
P1 = 1.0
Y1 = TERM1
10 TERM1 = -TERM1*X1*X1/(4.0*(B1 + P1)*P1)
Y1 = Y1 + TERM1
P1 = P1 + 1.0
IF(ABS(Y1)*1.E-10.LT.ABS(TERM1)) GO TO 10
RETURN
51 IF(B1.GT.1.0) GO TO 53
IFLAG = 1
X = X1
B = B1
Y = Y1
GO TO 1
15 RETURN
53 IB1 = B1
A1 = B1 - FLOAT(IB1)
IFLAG = 2
X = X1
B = A1
XX1 = 0.
Y = XX1
GO TO 1
16 P1 = A1 - 1.0
IFLAG = 3
X = X1
B = P1
YY1 = 0
Y = YY1
GO TO 1
60 Y1 = 2.0*A1**X1/X1 - YY1
A1 = A1 + 1.0
IF(A1.EQ.B1)RETURN
YY1 = XX1
XX1 = Y1
GO TO 60
1 CONTINUE
A = B*B - 0.25
T = 1.0/X
T2 = T*T
C(1) = (((S(1)*A+S(2))*A+S(3))*A+S(4))*A
C(2) = ((S(5)*A+S(6))*A+S(7))*A
C(3) = (S(8)*A+S(9))*A
C(4) = S(10)*A
BBO = (((C(1)*T2+C(2))*T2+C(3))*T2+C(4))*T2*T2+1.0
BB = BBO*SQRT(2.*T/(S(25)*SQRT(1.-A*T2)))
D(1) = ((((S(11)*A+S(12))*A+S(13))*A+S(14))*A+S(15))*A
D(2) = (((S(16)*A+S(17))*A+S(18))*A+S(19))*A
D(3) = ((S(20)*A+S(21))*A + S(22))*A
D(4) = (S(23)*A + S(24))*A
D(5) = .5*A
AA = ((((D(1)*T2 + D(2))*T2+D(3))*T2+D(4))*T2 +D(5))*T2+1.0
AA = AA*X-(B + .5)*S(26)
Y = BB*COS(AA)
GO TO (15,16,60),IFLAG
END


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : BESSJ.FOR

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/