NU123952@VM1.NoDak.EDU (Mark A. Ordal) (05/16/91)
There's been some interest in Bessel Functions I (x) and K (x) so I've
n n
tacked them onto my earlier routines for J (x) and Y (x).
n n
The listing of the directory is given below. In a separate posting
I'm providing a commented listing. Note that the commented listing
WILL NOT DOWNLOAD to a 32k 48SX. (Maybe not at all as far as that
goes.) There seems to be some upper limit to how many comments are
allowed in a single 48SX download.
Dr. Mark A. Ordal
Physics Department
North Dakota State University
Fargo, ND 58105
NU123952@NDSUVM1
%%HP: T(3)A(D)F(.);
DIR
Jnx
\<< \-> n x
\<<
CASE n 0
SAME
THEN x
ASJ0
END n 1
SAME
THEN x
ASJ1
END n x
NRJN
END
\>>
\>>
Ynx
\<< \-> n x
\<<
CASE n 0
SAME
THEN x
ASY0
END n 1
SAME
THEN x
ASY1
END n x
NRYN
END
\>>
\>>
Inx
\<< \-> n x
\<<
CASE n 0
SAME
THEN x
ASI0
END n 1
SAME
THEN x
ASI1
END n x
NRIN
END
\>>
\>>
Knx
\<< \-> n x
\<<
CASE n 0
SAME
THEN x
ASK0
END n 1
SAME
THEN x
ASK1
END n x
NRKN
END
\>>
\>>
NRJN
\<< 10000000000
.0000000001 0 0 0 0
\-> n x u d t m s sj
\<< 2 x / 't'
STO
IF x n >
THEN x ASJ0
x ASJ1 1 n 1 -
FOR j j t
* OVER * 3 PICK -
ROT DROP
NEXT SWAP
DROP
ELSE 40 n *
\v/ IP n + 2 / IP 2 *
'm' STO 0 1 m
DO t *
OVER * 3 PICK - ROT
DROP
IF DUP
ABS u >
THEN d
* SWAP d * SWAP d
DUP 'sj' STO* 's'
STO*
END
IF m n
SAME
THEN
OVER 'sj' STO
END 'm'
DECR t * OVER * 3
PICK - ROT DROP
IF DUP
ABS u >
THEN d
* SWAP d * SWAP d
DUP 'sj' STO* 's'
STO*
END
IF m n
SAME
THEN
OVER 'sj' STO
END DUP
's' STO+ 'm' DECR
UNTIL m 1
<
END DROP
SWAP DROP NEG s 2 *
+ sj SWAP /
END
\>>
\>>
NRYN
\<< 0 \-> n x t
\<< 2 x / 't'
STO x ASY0 x ASY1 1
n 1 -
FOR j j t *
OVER * 3 PICK - ROT
DROP
NEXT SWAP
DROP
\>>
\>>
NRIN
\<< 10000000000
.0000000001 0 0 \-> n
x u d t si
\<< 2 x / 't'
STO 0 1 40 n * \v/ IP
n + 2 * 1
FOR j j t *
OVER * 3 PICK + ROT
DROP
IF DUP
ABS u >
THEN d *
SWAP d * SWAP d
'si' STO*
END
IF j n
SAME
THEN OVER
'si' STO
END -1
STEP SWAP
DROP si SWAP / x
ASI0 *
\>>
\>>
NRKN
\<< 10000000000
.0000000001 0 0 \-> n
x u d t sk
\<< 2 x / 't'
STO x ASK0 x ASK1 1
n 1 -
FOR j j t *
OVER * 3 PICK + ROT
DROP
NEXT SWAP
DROP
\>>
\>>
ASJ1
\<< 0 RCLF \-> x a
ff
\<<
IF x 3 <
THEN .5
-.56249985
.21093573
-.03954289
.00443319
-.00031761
.00001109 x 3 / SQ
6 JYIK x *
ELSE x JY1
RAD COS * x \v/ /
END ff STOF
\>>
\>>
ASY1
\<< 0 RCLF \-> x a
ff
\<<
IF x 3 <
THEN
-.6366198 .2212091
2.1682709
-1.3164827 .3123951
-.0400976 .0027873
x 3 / SQ 6 JYIK x
ASJ1 x .5 * LN * x
* 2 * \pi \->NUM / + x
/
ELSE x JY1
RAD SIN * x \v/ /
END ff STOF
\>>
\>>
ASI1
\<< 0 \-> x a
\<<
IF x ABS
3.75 <
THEN .5
.87890594 .51498869
.15084934 .02658733
.00301532 .00032411
x 3.75 / SQ 6 JYIK
x *
ELSE
.39894228
-.03988024
-.00362018
.00163801
-.01031555
.02282967
-.02895312
.01787654
-.00420059 3.75 x
ABS / 8 JYIK x ABS
DUP EXP SWAP \v/ / *
END
\>>
\>>
ASK1
\<< 0 \-> x a
\<<
IF x ABS 2
<
THEN 1
.15443144
-.67278579
-.18156897
-.01919402
-.00110404
-.00004686 x 2 / SQ
6 JYIK x / x ASI1 x
2 / LN * +
ELSE
1.25331414
.23498619 -.0365562
.01504268
-.00780353
.00325614
-.00068245 2 x / 6
JYIK x DUP NEG EXP
SWAP \v/ / *
END
\>>
\>>
ASJ0
\<< 0 RCLF \-> x a
ff
\<<
IF x 3 <
THEN 1
-2.2499997
1.2656208 -.3163866
.0444479 -.0039444
.00021 x 3 / SQ 6
JYIK
ELSE x JY0
RAD COS * x \v/ /
END ff STOF
\>>
\>>
ASY0
\<< 0 RCLF \-> x a
ff
\<<
IF x 3 <
THEN
.36746691 .60559366
-.74350384
.25300117
-.04261214
.00427916
-.00024846 x 3 / SQ
6 JYIK x ASJ0 x .5
* LN * 2 * \pi \->NUM /
+
ELSE x JY0
RAD SIN * x \v/ /
END ff STOF
\>>
\>>
ASI0
\<< 0 \-> x a
\<<
IF x ABS
3.75 <
THEN 1
3.5156229 3.0899424
1.2067492 .2659732
.0360768 .0045813 x
3.75 / SQ 6 JYIK
ELSE
.39894228 .01328592
.00225319
-.00157565
.00916281
-.02057706
.02635537
-.01647633
.00392377 3.75 x
ABS / 8 JYIK x ABS
DUP EXP SWAP \v/ / *
END
\>>
\>>
ASK0
\<< 0 \-> x a
\<<
IF x ABS 2
<
THEN
-.57721566 .4227842
.23069756 .0348859
.00262698 .0001075
.0000074 x 2 / SQ 6
JYIK x ASI0 x 2 /
LN NEG * +
ELSE
1.25331414
-.07832358
.02189568
-.01062446
.00587872 -.0025154
.00053208 2 x / 6
JYIK x DUP NEG EXP
SWAP \v/ / *
END
\>>
\>>
JYIK
\<< \-> t j
\<< 1 j
START t * +
NEXT
\>>
\>>
JY1
\<< 0 \-> x a
\<< 3 x / 'a'
STO .79788456
.00000156 .01659667
.00017105
-.00249511
.00113653
-.00020033 a 6 JYIK
-2.35619449
.12499612 .0000565
-.00637879
.00074348 .00079824
-.00029166 a 6 JYIK
x +
\>>
\>>
JY0
\<< 0 \-> x a
\<< 3 x / 'a'
STO .79788456
-.00000077
-.0055274
-.00009512
.00137237
-.00072805
.00014476 a 6 JYIK
-.78539816
-.04166397
-.00003954
.00262573
-.00054125
-.00029333
.00013558 a 6 JYIK
x +
\>>
\>>
END