source: trunk/fsource/texturesubs/qlmninit.for @ 315

Last change on this file since 315 was 315, checked in by toby, 10 years ago

new scons file for compiling (needs linux & win work); update macbin's; changes to texture to work on Mac; minor cleanup to GSASIIpwd

File size: 1.5 KB
Line 
1      SUBROUTINE QLMNINIT
2
3!PURPOSE: Compute Ql,m,n for spherical harmonics up to L=34 - only does even orders
4!     and only even N terms - by R.I. Sheldon & modified by R. Von Dreele for GSAS
5
6      INCLUDE       '../INCLDS/COPYRIGT.FOR' 
7
8!CALLING ARGUMENTS:         
9
10!INCLUDE STATEMENTS:
11                             
12      REAL*4        QT                 
13      COMMON /QLMNVAL/QT(2109)
14
15!LOCAL VARIABLES:
16
17      REAL*8        SUM,TEMP,TEMP1     
18      INTEGER*4     I,LMN,M,MM         
19
20!FUNCTION DEFINITIONS:                     
21
22      REAL*8        FACTLN              !Compute ln-factorial & binominal coeffs.
23
24!DATA STATEMENTS:
25
26!CODE: 
27     
28      J = 1
29      QT(1) = 1.0     
30      DO L=2,34,2
31        DO M=0,L
32          DO N=0,M,2
33            J = J+1
34            LMN = L-M-N
35            TEMP = 0.5D0*(FACTLN(L+N)+FACTLN(L+M)+
36     1        FACTLN(L-M)+FACTLN(L-N))
37            SUM = 0.0D0
38            DO I=0,L-N
39              IF ( (L-M-I).GE.0 .AND. (M+N+I).GE.0 ) THEN
40                TEMP1 = TEMP-FACTLN(I)-FACTLN(L-M-I)-
41     1            FACTLN(L-N-I)-FACTLN(M+N+I)
42                TEMP1 = DEXP(TEMP1)
43                IF ( MOD(I,2).NE.0 ) TEMP1 = -TEMP1
44                SUM = SUM+TEMP1
45              END IF
46            END DO
47            QT(J) = SUM/2.**(1.*L)
48            IF ( MOD(LMN,2).NE.0 ) QT(J) = -QT(J)
49!            PRINT '(A,3I4,F12.8)',' l,m,n,Q(lmn)',L,M,N,QT(J)
50          END DO
51        END DO
52      END DO
53      RETURN
54      END
55
Note: See TracBrowser for help on using the repository browser.