| 1 | SUBROUTINE QLMN(L,MM,NN,Q) |
|---|
| 2 | |
|---|
| 3 | !PURPOSE: Compute Ql,m,n for spherical harmonics from lookup table |
|---|
| 4 | |
|---|
| 5 | INCLUDE '../INCLDS/COPYRIGT.FOR' |
|---|
| 6 | |
|---|
| 7 | !CALLING ARGUMENTS: |
|---|
| 8 | |
|---|
| 9 | INTEGER*4 L,MM,NN !order & subindices (m may be <0) |
|---|
| 10 | REAL*4 Q !Output value |
|---|
| 11 | |
|---|
| 12 | !INCLUDE STATEMENTS: |
|---|
| 13 | |
|---|
| 14 | REAL*4 QT |
|---|
| 15 | COMMON /QLMNVAL/QT(2109) |
|---|
| 16 | |
|---|
| 17 | |
|---|
| 18 | !LOCAL VARIABLES: |
|---|
| 19 | |
|---|
| 20 | REAL*8 SUM,TEMP,TEMP1 |
|---|
| 21 | INTEGER*4 LMN,I,J,M,N |
|---|
| 22 | |
|---|
| 23 | !FUNCTION DEFINITIONS: |
|---|
| 24 | |
|---|
| 25 | REAL*8 FACTLN !Compute ln-factorial & binominal coeffs. |
|---|
| 26 | |
|---|
| 27 | !DATA STATEMENTS: |
|---|
| 28 | |
|---|
| 29 | !CODE: |
|---|
| 30 | |
|---|
| 31 | M = ABS(MM) |
|---|
| 32 | N = ABS(NN) |
|---|
| 33 | IF ( N.GT.M ) THEN |
|---|
| 34 | I = M |
|---|
| 35 | M = N |
|---|
| 36 | N = I |
|---|
| 37 | END IF |
|---|
| 38 | IF ( MOD(N,2).EQ.0 .AND. MOD(L,2).EQ.0 ) THEN !Even L,N - do lookup |
|---|
| 39 | J = 0 |
|---|
| 40 | DO I=2,L,2 |
|---|
| 41 | J = J+(I/2)**2 !points to last term in L-2 block |
|---|
| 42 | END DO |
|---|
| 43 | J = J+1 |
|---|
| 44 | DO I=0,M-1 |
|---|
| 45 | J = J+(I+2)/2 !points to 1st term in M block |
|---|
| 46 | END DO |
|---|
| 47 | J = J+N/2 !offset to N term |
|---|
| 48 | ! PRINT '(A,I4,F12.8)',' J,Q ',J,QT(J) |
|---|
| 49 | Q = QT(J) |
|---|
| 50 | ELSE !Odd L or N - calculate Q |
|---|
| 51 | LMN = L-M-N |
|---|
| 52 | TEMP = 0.5D0*(FACTLN(L+N)+FACTLN(L+M)+ |
|---|
| 53 | 1 FACTLN(L-M)+FACTLN(L-N)) |
|---|
| 54 | SUM = 0.0D0 |
|---|
| 55 | DO I=0,L-N |
|---|
| 56 | IF ( (L-M-I).GE.0 .AND. (M+N+I).GE.0 ) THEN |
|---|
| 57 | TEMP1 = TEMP-FACTLN(I)-FACTLN(L-M-I)- |
|---|
| 58 | 1 FACTLN(L-N-I)-FACTLN(M+N+I) |
|---|
| 59 | TEMP1 = DEXP(TEMP1) |
|---|
| 60 | IF ( MOD(I,2).NE.0 ) TEMP1 = -TEMP1 |
|---|
| 61 | SUM = SUM+TEMP1 |
|---|
| 62 | END IF |
|---|
| 63 | END DO |
|---|
| 64 | Q = SUM/2.**(1.*L) |
|---|
| 65 | IF ( MOD(LMN,2).NE.0 ) Q = -Q |
|---|
| 66 | ! PRINT '(A,3I4,F12.8)',' l,m,n,Q(lmn)',L,M,N,Q |
|---|
| 67 | END IF |
|---|
| 68 | IF ( MM.LT.0 .AND. MOD(L+NN,2).NE.0 ) Q = -Q |
|---|
| 69 | IF ( NN.LT.0 .AND. MOD(L+MM,2).NE.0 ) Q = -Q |
|---|
| 70 | RETURN |
|---|
| 71 | END |
|---|
| 72 | |
|---|
