da_asslegpol.inc

1 subroutine da_asslegpol (l, m, sinlat, coslat, alp)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9    integer, intent(in)            :: l       ! Legendre wavenumber.
10    integer, intent(in)            :: m       ! Fourier wavenumber.
11    real,    intent(in)            :: sinlat  ! sin(latitude).
12    real,    intent(in)            :: coslat  ! cos(latitude).
13    real,    intent(out)           :: alp     ! Associated Legendre Polynomial.
14 
15    integer                        :: i, loop
16    real                           :: half_co
17    real                           :: alp1, alp2
18 
19    half_co = 0.5 * coslat
20 
21    ! Calculate ALP:
22 
23    if (l < m) then
24       alp = 0.0
25    else
26       alp = 1.0
27       do i = m+1, 2*m
28          alp = alp * real(i) * half_co
29       end do
30       if (mod(m,2) /= 0) then
31          alp = -alp
32       end if
33 
34       if (l > m) then
35          alp1 = alp
36          alp = real(2*m+1) * sinlat * alp1
37          if (l /= m+1) then
38             do loop = m+2,l
39                alp2 = alp1
40                alp1 = alp
41                alp = (real(2*loop-1) * sinlat * alp1 - real(loop-1+m) * alp2) &
42                   / real(loop-m)
43             end do
44          end if
45       end if
46    end if
47 
48 end subroutine da_asslegpol
49 
50