1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
!
!-----------------------------------------------------------------------
!
!Purpose:
! Return the real spherical harmonics corresponding to a set of
! direction cosines.
!
!Copyright:
! Copyright (C) 2004 Ecole Polytechnique de Montreal
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
! License as published by the Free Software Foundation; either
! version 2.1 of the License, or (at your option) any later version
!
!Author(s): A. Hebert
!
!Parameters: input
! L Legendre order.
! M azimuthal order.
! ZMU X-directed direction cosine.
! ETA Y-directed direction cosine.
! XI Z-directed direction cosine.
!
!Parameters: output
! PNOUT value of the spherical harmonics.
!
!-----------------------------------------------------------------------
!
REAL FUNCTION PNSH(L,M,ZMU,ETA,XI) RESULT(PNOUT)
!----
! FUNCTION ARGUMENTS
!----
INTEGER L,M
REAL ZMU,ETA,XI
!----
! LOCAL VARIABLES
!----
PARAMETER (PI=3.141592653589793)
DOUBLE PRECISION FACTOR,PHI,PNL,DZMU,COEF,ALPLGN
!
TEST=ZMU*ZMU+ETA*ETA+XI*XI
IF(ABS(TEST-1.0).GT.1.0E-5) THEN
CALL XABORT('PNSH: INVALID DIRECTION COSINES.')
ENDIF
PNOUT=0.0
IF((L.EQ.0).AND.(M.EQ.0)) THEN
PNOUT=1.0
ELSE IF((L.EQ.1).AND.(M.EQ.-1)) THEN
PNOUT=XI
ELSE IF((L.EQ.1).AND.(M.EQ.0)) THEN
PNOUT=ZMU
ELSE IF((L.EQ.1).AND.(M.EQ.1)) THEN
PNOUT=ETA
ELSE IF((L.EQ.2).AND.(M.EQ.-2)) THEN
PNOUT=SQRT(3.0)*ETA*XI
ELSE IF((L.EQ.2).AND.(M.EQ.-1)) THEN
PNOUT=SQRT(3.0)*ZMU*XI
ELSE IF((L.EQ.2).AND.(M.EQ.0)) THEN
PNOUT=0.5*(3.0*ZMU*ZMU-1.0)
ELSE IF((L.EQ.2).AND.(M.EQ.1)) THEN
PNOUT=SQRT(3.0)*ZMU*ETA
ELSE IF((L.EQ.2).AND.(M.EQ.2)) THEN
PNOUT=0.5*SQRT(3.0)*(ETA*ETA-XI*XI)
ELSE IF((L.EQ.3).AND.(M.EQ.-3)) THEN
PNOUT=SQRT(5./8.)*XI*(3.0*ETA*ETA-XI*XI)
ELSE IF((L.EQ.3).AND.(M.EQ.-2)) THEN
PNOUT=SQRT(15.0)*ETA*XI*ZMU
ELSE IF((L.EQ.3).AND.(M.EQ.-1)) THEN
PNOUT=SQRT(3./8.)*XI*(5.0*ZMU*ZMU-1.0)
ELSE IF((L.EQ.3).AND.(M.EQ.0)) THEN
PNOUT=0.5*ZMU*(5.0*ZMU*ZMU-3.0)
ELSE IF((L.EQ.3).AND.(M.EQ.1)) THEN
PNOUT=SQRT(3./8.)*ETA*(5.0*ZMU*ZMU-1.0)
ELSE IF((L.EQ.3).AND.(M.EQ.2)) THEN
PNOUT=SQRT(15.0/4.0)*ZMU*(ETA*ETA-XI*XI)
ELSE IF((L.EQ.3).AND.(M.EQ.3)) THEN
PNOUT=SQRT(5./8.)*ETA*(ETA*ETA-3.0*XI*XI)
ELSE IF((L.EQ.4).AND.(M.EQ.-4)) THEN
PNOUT=0.5*SQRT(35.)*ETA*XI*(ETA*ETA-XI*XI)
ELSE IF((L.EQ.4).AND.(M.EQ.-3)) THEN
PNOUT=0.5*SQRT(0.5*35.)*ZMU*XI*(3.*ETA*ETA-XI*XI)
ELSE IF((L.EQ.4).AND.(M.EQ.-2)) THEN
PNOUT=SQRT(5.)*(21.*ZMU*ZMU-3.)*ETA*XI/6.
ELSE IF((L.EQ.4).AND.(M.EQ.-1)) THEN
PNOUT=0.5*SQRT(2.5)*ZMU*XI*(7.*ZMU*ZMU-3.)
ELSE IF((L.EQ.4).AND.(M.EQ.0)) THEN
PNOUT=(35.*ZMU**4-30.*ZMU*ZMU+3.)/8.
ELSE IF((L.EQ.4).AND.(M.EQ.1)) THEN
PNOUT=0.5*SQRT(2.5)*ZMU*ETA*(7.*ZMU*ZMU-3.)
ELSE IF((L.EQ.4).AND.(M.EQ.2)) THEN
PNOUT=SQRT(5.)*(21.*ZMU*ZMU-3.)*(ETA*ETA-XI*XI)/12.
ELSE IF((L.EQ.4).AND.(M.EQ.3)) THEN
PNOUT=0.5*SQRT(0.5*35.)*ZMU*ETA*(ETA*ETA-3.*XI*XI)
ELSE IF((L.EQ.4).AND.(M.EQ.4)) THEN
PNOUT=SQRT(35.)*(ETA**4-6.*(ETA*XI)**2+XI**4)/8.
ELSE IF((L.EQ.5).AND.(M.EQ.-5)) THEN
PNOUT=21.*XI*(5.*ETA**4-10.*(ETA*XI)**2+XI**4)/(8.*SQRT(14.))
ELSE IF((L.EQ.5).AND.(M.EQ.-4)) THEN
PNOUT=0.5*105.*ZMU*ETA*XI*(ETA*ETA-XI*XI)/SQRT(35.)
ELSE IF((L.EQ.5).AND.(M.EQ.-3)) THEN
PNOUT=35.*(9*ZMU*ZMU-1.)*XI*(3.*ETA*ETA-XI*XI)/(8.*SQRT(70.))
ELSE IF((L.EQ.5).AND.(M.EQ.-2)) THEN
PNOUT=0.5*SQRT(105.)*ZMU*(3.*ZMU*ZMU-1.)*ETA*XI
ELSE IF((L.EQ.5).AND.(M.EQ.-1)) THEN
PNOUT=SQRT(15.)*XI*(21.*ZMU**4-14.*ZMU*ZMU+1.)/8.
ELSE IF((L.EQ.5).AND.(M.EQ.0)) THEN
PNOUT=ZMU*(63.*ZMU**4-70.*ZMU*ZMU+15.)/8.
ELSE IF((L.EQ.5).AND.(M.EQ.1)) THEN
PNOUT=SQRT(15.)*ETA*(21.*ZMU**4-14.*ZMU*ZMU+1.)/8.
ELSE IF((L.EQ.5).AND.(M.EQ.2)) THEN
PNOUT=0.25*SQRT(105.)*ZMU*(3.*ZMU*ZMU-1.)*(ETA*ETA-XI*XI)
ELSE IF((L.EQ.5).AND.(M.EQ.3)) THEN
PNOUT=35.*(9*ZMU*ZMU-1.)*ETA*(ETA*ETA-3.*XI*XI)/(8.*SQRT(70.))
ELSE IF((L.EQ.5).AND.(M.EQ.4)) THEN
PNOUT=105.*ZMU*(ETA**4-6.*(ETA*XI)**2+XI**4)/(8.*SQRT(35.))
ELSE IF((L.EQ.5).AND.(M.EQ.5)) THEN
PNOUT=21.*ETA*(ETA**4-10.*(ETA*XI)**2+5.*XI**4)/(8.*SQRT(14.))
ELSE
FACTOR=SQRT(1.0D0-ZMU*ZMU)
PHI=0.0D0
IF(XI.GE.0) THEN
PHI=ACOS(ETA/FACTOR)
ELSE IF(XI.LT.0) THEN
PHI=2.0D0*PI-ACOS(ETA/FACTOR)
ENDIF
COEF=SQRT(2.0D0*ALFACT(L-ABS(M))/ALFACT(L+ABS(M)))
DZMU=ZMU
PNL=ALPLGN(L,ABS(M),DZMU)
IF(M.GT.0) THEN
PNOUT=REAL(COEF*PNL*COS(M*PHI))
ELSE IF(M.EQ.0) THEN
PNOUT=REAL(PNL)
ELSE IF(M.LT.0) THEN
PNOUT=REAL(COEF*PNL*SIN(-M*PHI))
ENDIF
ENDIF
RETURN
!
CONTAINS
RECURSIVE DOUBLE PRECISION FUNCTION ALFACT(N) RESULT(OUT)
! return the factorial of N
INTEGER N
IF(N.LE.1) THEN
OUT=1.0D0
ELSE
OUT=N*ALFACT(N-1)
ENDIF
END FUNCTION ALFACT
END FUNCTION PNSH
|
