NLSL: bessel.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

bessel.f90
Go to the documentation of this file.
1 c Version 1.4 10/10/94
2 c*********************************************************************
3 c
4 c MODIFIED BESSEL FUNCTIONS OF THE FIRST
5 c KIND OF INTEGER ORDER AND REAL ARGUMENT
6 c ---------------------------------------
7 c
8 c This double precision function subroutine calculates the
9 c value of the modified Bessel function of the first kind of
10 c integer order and strictly real argument via a backward
11 c recurrence scheme taken from "Numerical Recipes", W. H. Press,
12 c B. P. Flannery, S. A. Teulosky and W. T. Vetterling, 1st ed.,
13 c Cambridge Univ. Press, 1986.
14 c
15 c The differs from the standalone version in the addition of
16 c the parameter ierr. It is used to report non-convergence of
17 c Bessel function evaluations instead of halting when such
18 c errors occur.
19 c
20 c written by DJS 10-SEP-87
21 c Bug in small-argument Taylor series expansion fixed by DEB OCT-92
22 c
23 c
24 c Includes:
25 c rndoff.inc
26 c
27 c Uses:
28 c bessi0.f
29 c bessi1.f
30 c
31 c*********************************************************************
32 c
33 function bessi(n,z,ierr)
34 c
35 use rnddbl
36 c
37 implicit none
38 integer n,ierr
39 double precision bessi,z
40 c
41 double precision bessi0,bessi1
42 external bessi0,bessi1
43 c
44 integer iacc
45 double precision BIGNO,BIGNI,ONE
46 parameter(iacc=40,bigno=1.0d10,bigni=1.0d-10,one=1.0d0)
47 c
48 integer i,m,mmax
49 double precision x,phase,twobyx,bi,bip,bim
50 c
51 intrinsic abs
52 c
53 c#####################################################################
54 c
55 ierr=0
56 c
57 c---------------------------------------------------------------------
58 c get proper phase factor if argument is negative with the
59 c following rules
60 c n
61 c I (z) = I (z) and I (-z) = (-1) I (z)
62 c n -n n n
63 c---------------------------------------------------------------------
64 c
65 m=abs(n)
66 x=abs(z)
67 c
68 if ((z.lt.0.0d0).and.(mod(m,2).eq.1)) then
69 phase=-one
70 else
71 phase=one
72 end if
73 c
74 c---------------------------------------------------------------------
75 c return proper values if argument is zero
76 c---------------------------------------------------------------------
77 c
78 if (x.lt.rndoff) then
79 if (m.eq.0) then
80 bessi=one
81 else
82 bessi=0.0d0
83 end if
84 return
85 end if
86 c
87 c---------------------------------------------------------------------
88 c call bessi0 if n=0, bessi1 if n=1, or go through
89 c downward recurrence if n>1.
90 c---------------------------------------------------------------------
91 c
92 if (m.eq.0) then
93 bessi=phase*bessi0(x,ierr)
94 if (ierr.ne.0) return
95 else if (m.eq.1) then
96 bessi=phase*bessi1(x,ierr)
97 if (ierr.ne.0) return
98 else
99 bessi=0.0d0
100 twobyx=2.0d0/x
101 bip=0.0d0
102 bi=one
103 mmax=2*((m+int(sqrt(dble(iacc*m)))))
104 do i=mmax,1,-1
105 bim=bip+dble(i)*twobyx*bi
106 bip=bi
107 bi=bim
108 if (abs(bi).gt.bigno) then
109 bessi=bessi*bigni
110 bi=bi*bigni
111 bip=bip*bigni
112 end if
113 if (i.eq.m) bessi=bip
114 end do
115 bessi=phase*bessi*bessi0(x,ierr)/bi
116 if (ierr.ne.0) return
117 end if
118 c
119 return
120 end
121
122 c*********************************************************************
123 c
124 c MODIFIED BESSEL FUNCTION OF THE FIRST
125 c KIND OF ORDER ZERO AND REAL ARGUMENT
126 c -------------------------------------
127 c
128 c This double precision function subroutine calculates the
129 c modified Bessel function of the first kind of order zero
130 c and real argument by either the Taylor series expansion
131 c for small arguments or the first term of the asymptotic
132 c series for sufficiently large arguments.
133 c
134 c written by DJS 10-SEP-87
135 c
136 c Includes:
137 c rndoff.inc
138 c pidef.inc
139 c
140 c Uses:
141 c
142 c*********************************************************************
143 c
144 double precision function bessi0(z,ierr)
145 c
146 use rnddbl
147 use pidef
148 c
149 implicit none
150 double precision z
151 integer ierr
152 c
153 integer i,j
154 double precision x,y,smax,temp1,temp2,temp3,sum
155 c
156 integer NMAX
157 parameter(nmax=40)
158 c
159 double precision tser
160 dimension tser(nmax)
161 c
162 double precision CUTOFF,ONE
163 parameter(cutoff=20.0d0,one=1.0d0)
164 c
165 c######################################################################
166 c
167 y=abs(z)
168 c
169 c------------------------------------------------------------
170 c Set function value to unity if argument is too small
171 c------------------------------------------------------------
172 if (y.lt.rndoff) then
173 bessi0=one
174 c
175 c-------------------------------------------------------------
176 c Taylor series expansion for small to moderate arguments
177 c-------------------------------------------------------------
178 else if (y.le.cutoff) then
179 x=y*y*0.25d0
180 temp1=one
181 smax=one
182 i=1
183 10 temp1=(temp1/dble(i))*(x/dble(i))
184 if (i.gt.nmax) then
185 ierr=-1
186 return
187 end if
188 tser(i)=temp1
189 i=i+1
190 if (temp1.gt.smax) smax=temp1
191 if (temp1/smax.gt.rndoff) go to 10
192 c
193 bessi0=0.0d0
194 do j=i-1,1,-1
195 bessi0=bessi0+tser(j)
196 end do
197 bessi0=bessi0+one
198 c
199 c----------------------------------------------
200 c Asymptotic expansion for large arguments
201 c----------------------------------------------
202 else
203 x=0.125d0/y
204 sum=0.0d0
205 temp3=one
206 smax=one
207 i=1
208 30 temp1=dble(2*i-1)
209 temp2=(x*temp1)*(temp1/dble(i))
210 if (temp2.gt.one) go to 40
211 temp3=temp3*temp2
212 if (temp3.gt.smax) smax=temp3
213 if (temp3/smax.lt.rndoff) go to 40
214 sum=sum+temp3
215 i=i+1
216 go to 30
217 40 bessi0=dexp(y)*((sum+one)/dsqrt(y*(pi+pi)))
218 end if
219 c
220 return
221 end
222
223 c*********************************************************************
224 c
225 c MODIFIED BESSEL FUNCTION OF THE FIRST
226 c KIND OF ORDER ONE AND REAL ARGUMENT
227 c -------------------------------------
228 c
229 c This double precision function subroutine calculates the
230 c modified Bessel function of the first kind of order one
231 c and real argument by either the Taylor series expansion
232 c for small arguments or the first term of the asymptotic
233 c series for sufficiently large arguments.
234 c
235 c written by DJS 10-SEP-87
236 c
237 c Includes:
238 c rndoff.inc
239 c pidef.inc
240 c
241 c Uses:
242 c
243 c*********************************************************************
244 c
245 double precision function bessi1(z,ierr)
246 c
247 use rnddbl
248 use pidef
249 c
250 implicit none
251 double precision z
252 integer ierr
253 c
254 integer i,j
255 double precision x,y,smax,temp1,temp2,temp3,phase,sum
256 c
257 integer NMAX
258 parameter(nmax=40)
259 c
260 double precision series
261 dimension series(nmax)
262 c
263 double precision CUTOFF,ONE
264 parameter(cutoff=20.0d0,one=1.0d0)
265 c
266 c#####################################################################
267 c
268 if (z.gt.0.0d0) then
269 phase=one
270 y=z
271 else
272 phase=-one
273 y=-z
274 end if
275 c
276 c----------------------------------------------------------------------
277 c set answer to zero if argument is too small, otherwise
278 c----------------------------------------------------------------------
279 if (y.lt.rndoff) then
280 bessi1=0.0d0
281 c
282 c----------------------------------------------------------------------
283 c Use Taylor series expansion for small to moderate arguments or
284 c----------------------------------------------------------------------
285 else if (y.le.cutoff) then
286 x=y*y*0.25d0
287 temp1=one
288 smax=one
289 i=1
290 10 temp1=(temp1/dble(i))*(x/dble(i+1))
291 if (i.gt.nmax) then
292 ierr=-1
293 return
294 end if
295 series(i)=temp1
296 i=i+1
297 if (temp1.gt.smax) smax=temp1
298 if (temp1/smax.gt.rndoff) go to 10
299 bessi1=0.0d0
300 do j=i-1,1,-1
301 bessi1=bessi1+series(j)
302 end do
303 bessi1=phase*y*0.5d0*(bessi1+one)
304 c
305 c----------------------------------------------------------------------
306 c asymptotic expansion for large arguments
307 c----------------------------------------------------------------------
308 else
309 x=0.125d0/y
310 sum=3.0d0*x
311 temp3=sum
312 smax=one
313 i=2
314 30 temp1=dble(2*i-1)
315 temp1=temp1*temp1-4.0d0
316 temp2=(x*temp1)/dble(i)
317 if (temp2.gt.one) go to 40
318 temp3=temp3*temp2
319 if (temp3.gt.smax) smax=temp3
320 if (temp3/smax.lt.rndoff) go to 40
321 sum=sum+temp3
322 i=i+1
323 go to 30
324 40 bessi1=dexp(y)*(one-sum)/dsqrt(y*(pi+pi))
325 end if
326 c
327 return
328 end
bessi0
double precision function bessi0(z, ierr)
Definition: bessel.f90:145
rnddbl
Definition: rnddbl.f90:77
pidef::pi
double precision, parameter pi
Definition: pidef.f90:15
bessi1
double precision function bessi1(z, ierr)
Definition: bessel.f90:246
rnddbl::rndoff
double precision, parameter rndoff
Definition: rnddbl.f90:86
pidef
Definition: pidef.f90:12
bessi
double precision function bessi(n, z, ierr)
Definition: bessel.f90:34