Last change
on this file since 305 was
305,
checked in by vondreele, 12 years ago

remove pypowder & powsubs  no longer needed
add texturesubs & pytexture

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 lnfactorial & 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 = LMN 

35  TEMP = 0.5D0*(FACTLN(L+N)+FACTLN(L+M)+ 

36  1 FACTLN(LM)+FACTLN(LN)) 

37  SUM = 0.0D0 

38  DO I=0,LN 

39  IF ( (LMI).GE.0 .AND. (M+N+I).GE.0 ) THEN 

40  TEMP1 = TEMPFACTLN(I)FACTLN(LMI) 

41  1 FACTLN(LNI)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.0**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.