Blame view
fvn_fnlib/besin.f90
2.36 KB
f6bacaf83 ChW 11/09: ANSI c... |
1 |
function besin(n,x,factor,big) |
8d883e8a1 Integration of ki... |
2 |
use fvn_common |
e1aefab23 git-svn-id: https... |
3 4 5 6 7 8 9 10 11 12 13 |
implicit none ! This function compute the rank n Bessel J function ! using recurrence relation : ! In+1(x)=-2n/x * In(x) + In-1(x) ! ! Two optional parameters : ! factor : an integer that is used in Miller's algorithm to determine the ! starting point of iteration. Default value is 40, an increase of this value ! will increase accuracy. Starting point ~ nearest even integer of sqrt(factor*n) ! big : a real that determine the threshold for taking anti overflow counter measure ! default value is 1e10 |
f6bacaf83 ChW 11/09: ANSI c... |
14 15 |
! real(sp_kind) :: besin |
e1aefab23 git-svn-id: https... |
16 |
integer :: n |
f6bacaf83 ChW 11/09: ANSI c... |
17 |
real(sp_kind) :: x |
e1aefab23 git-svn-id: https... |
18 |
integer, optional :: factor |
f6bacaf83 ChW 11/09: ANSI c... |
19 |
real(sp_kind), optional :: big |
e1aefab23 git-svn-id: https... |
20 21 |
integer :: tfactor |
f6bacaf83 ChW 11/09: ANSI c... |
22 23 |
real(sp_kind) :: tbig,tsmall real(sp_kind) :: two_on_x,binm1,bin,binp1,absx |
e1aefab23 git-svn-id: https... |
24 |
integer :: i,start |
f6bacaf83 ChW 11/09: ANSI c... |
25 |
real(sp_kind), external :: besi0,besi1 |
e1aefab23 git-svn-id: https... |
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
! Initialization of optional parameters tfactor=40 if(present(factor)) tfactor=factor tbig=1e10 if(present(big)) tbig=big tsmall=1./tbig if (n==0) then besin=besi0(x) return end if if (n==1) then besin=besi1(x) return end if if (n < 0) then write(*,*) "Error in besin, n must be >= 0" stop end if absx=abs(x) if (absx == 0.) then besin=0. else ! We use Miller's Algorithm ! as upward reccurence is unstable. ! This is adapted from Numerical Recipes ! Principle : use of downward recurrence from an arbitrary ! higher than n value with an arbitrary seed, ! and then use the normalization formula : ! 1=I0-2I2+2I4-2I6+.... however it is easier to use a ! call to besi0 two_on_x=2./absx |
f6bacaf83 ChW 11/09: ANSI c... |
60 |
start=2*((n+int(sqrt(real(n*tfactor,sp_kind))))/2) ! even start |
e1aefab23 git-svn-id: https... |
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
binp1=0. bin=1. do i=start,1,-1 ! begin downward rec binm1=two_on_x*bin*i+binp1 binp1=bin bin=binm1 ! Action to prevent overflow if (abs(bin) > tbig) then bin=bin*tsmall binp1=binp1*tsmall besin=besin*tsmall end if if (i==n) besin=binp1 end do besin=besin*besi0(x)/bin end if ! if n is odd and x <0 if ((x<0.) .and. (mod(n,2)==1)) besin=-besin end function |