Blame view

fvn_fnlib/dbesjn.f90 2.89 KB
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
1
  function dbesjn(n,x,factor,big)
8d883e8a1   wdaniau   Integration of ki...
2
      use fvn_common
e1aefab23   daniau   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   cwaterkeyn   ChW 11/09: ANSI c...
14
      !
e80b2ec78   wdaniau   Increase factor d...
15
16
      ! 2009 : increasing factor defult value to 150
      !
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
17
      real(dp_kind) :: dbesjn
e1aefab23   daniau   git-svn-id: https...
18
      integer :: n
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
19
      real(dp_kind) :: x
e1aefab23   daniau   git-svn-id: https...
20
      integer, optional :: factor
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
21
      real(dp_kind), optional :: big
e1aefab23   daniau   git-svn-id: https...
22
23
  
      integer :: tfactor
f6bacaf83   cwaterkeyn   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   daniau   git-svn-id: https...
27
28
29
30
      integer :: i,start
      logical :: iseven
  
      ! Initialization of optional parameters
e80b2ec78   wdaniau   Increase factor d...
31
      tfactor=150
e1aefab23   daniau   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   cwaterkeyn   ChW 11/09: ANSI c...
53
      else if (absx > real(n,dp_kind)) then
e1aefab23   daniau   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   cwaterkeyn   ChW 11/09: ANSI c...
73
          start=2*((n+int(sqrt(real(n*tfactor,sp_kind))))/2) ! even start
e1aefab23   daniau   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