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

Rev  Line  

[305]  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.