Blame view
fvn_fnlib/dbesjn.f90
2.89 KB
f6bacaf83 ChW 11/09: ANSI c... |
1 |
function dbesjn(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 : ! Jn+1(x)=2n/x * Jn(x) - Jn-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 |
! |
e80b2ec78 Increase factor d... |
15 16 |
! 2009 : increasing factor defult value to 150 ! |
f6bacaf83 ChW 11/09: ANSI c... |
17 |
real(dp_kind) :: dbesjn |
e1aefab23 git-svn-id: https... |
18 |
integer :: n |
f6bacaf83 ChW 11/09: ANSI c... |
19 |
real(dp_kind) :: x |
e1aefab23 git-svn-id: https... |
20 |
integer, optional :: factor |
f6bacaf83 ChW 11/09: ANSI c... |
21 |
real(dp_kind), optional :: big |
e1aefab23 git-svn-id: https... |
22 23 |
integer :: tfactor |
f6bacaf83 ChW 11/09: ANSI c... |
24 25 26 |
real(dp_kind) :: tbig,tsmall,som real(dp_kind),external :: dbesj0,dbesj1 real(dp_kind) :: two_on_x,bjnm1,bjn,bjnp1,absx |
e1aefab23 git-svn-id: https... |
27 28 29 30 |
integer :: i,start logical :: iseven ! Initialization of optional parameters |
e80b2ec78 Increase factor d... |
31 |
tfactor=150 |
e1aefab23 git-svn-id: https... |
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
if(present(factor)) tfactor=factor tbig=1d10 if(present(big)) tbig=big tsmall=1./tbig if (n==0) then dbesjn=dbesj0(x) return end if if (n==1) then dbesjn=dbesj1(x) return end if if (n < 0) then write(*,*) "Error in dbesjn, n must be >= 0" stop end if absx=abs(x) if (absx == 0.) then dbesjn=0. |
f6bacaf83 ChW 11/09: ANSI c... |
53 |
else if (absx > real(n,dp_kind)) then |
e1aefab23 git-svn-id: https... |
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
! For x > n upward reccurence is stable two_on_x=2./absx bjnm1=dbesj0(absx) bjn=dbesj1(absx) do i=1,n-1 bjnp1=two_on_x*bjn*i-bjnm1 bjnm1=bjn bjn=bjnp1 end do dbesjn=bjnp1 else ! For x <= n 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=J0+2J2+2J4+2J6+.... two_on_x=2./absx |
f6bacaf83 ChW 11/09: ANSI c... |
73 |
start=2*((n+int(sqrt(real(n*tfactor,sp_kind))))/2) ! even start |
e1aefab23 git-svn-id: https... |
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 |
som=0. iseven=.false. bjnp1=0. bjn=1. do i=start,1,-1 ! begin downward rec bjnm1=two_on_x*bjn*i-bjnp1 bjnp1=bjn bjn=bjnm1 ! Action to prevent overflow if (abs(bjn) > tbig) then bjn=bjn*tsmall bjnp1=bjnp1*tsmall dbesjn=dbesjn*tsmall som=som*tsmall end if if (iseven) then som=som+bjn end if iseven= .not. iseven if (i==n) dbesjn=bjnp1 end do som=2.*som-bjn dbesjn=dbesjn/som end if ! if n is odd and x <0 if ((x<0.) .and. (mod(n,2)==1)) dbesjn=-dbesjn end function |