Commit 61fa7f6d authored by Matthias Redies's avatar Matthias Redies

close the bracket

parent fcd82a1f
MODULE m_gaunt MODULE m_gaunt
!********************************************************************* !*********************************************************************
! Modified module to include old gaunt2 subroutine ! Modified module to include old gaunt_init subroutine
! the private arrays are allocated and computed in the first call to gaunt1 ! the private arrays are allocated and computed in the first call to gaunt1
! Daniel Wortmann ! Daniel Wortmann
!********************************************************************* !*********************************************************************
PRIVATE PRIVATE
INTEGER,SAVE :: lmaxdp INTEGER,SAVE :: lmaxdp
REAL,SAVE,ALLOCATABLE::w(:),yr(:,:) REAL,SAVE,ALLOCATABLE::w(:),yr(:,:)
PUBLIC gaunt1,gaunt2 PUBLIC gaunt1,gaunt_init
CONTAINS CONTAINS
REAL FUNCTION gaunt1(lp,l,ls,mp,m,ms,lmaxd) REAL FUNCTION gaunt1(lp,l,ls,mp,m,ms,lmaxd)
!********************************************************************* !*********************************************************************
...@@ -28,12 +28,9 @@ CONTAINS ...@@ -28,12 +28,9 @@ CONTAINS
n= (3*lmaxd)/4+1 n= (3*lmaxd)/4+1
! heck if this is first call to subroutine ! heck if this is first call to subroutine
IF ( .NOT. ALLOCATED(YR)) CALL gaunt2(lmaxd) IF(.NOT. ALLOCATED(YR)) CALL gaunt_init(lmaxd)
! heck if the previous call of the subroutine was with the same lmaxd ! heck if the previous call of the subroutine was with the same lmaxd
IF( lmaxd /= lmaxdp ) THEN IF(lmaxd > lmaxdp) call juDFT_error("Can't calc gaunt. lmaxd too high")
DEALLOCATE(yr,w)
CALL gaunt2(lmaxd)
END IF
gaunt1 = 0.0 gaunt1 = 0.0
IF (mp /= (m+ms)) RETURN IF (mp /= (m+ms)) RETURN
...@@ -50,8 +47,7 @@ CONTAINS ...@@ -50,8 +47,7 @@ CONTAINS
END FUNCTION END FUNCTION
! private subroutine for initializing the private arrays! ! private subroutine for initializing the private arrays!
SUBROUTINE gaunt2( & SUBROUTINE gaunt_init(lmaxd)
lmaxd)
!********************************************************************** !**********************************************************************
! sets up values needed for gaunt1 ! sets up values needed for gaunt1
! m. weinert january 1982 ! m. weinert january 1982
...@@ -64,12 +60,12 @@ CONTAINS ...@@ -64,12 +60,12 @@ CONTAINS
INTEGER, INTENT (IN) :: lmaxd INTEGER, INTENT (IN) :: lmaxd
REAL :: a,cd,cth,fac,fpi,rf,sgm,sth,t REAL :: a,cd,cth,fac,fpi,rf,sgm,sth,t
INTEGER :: k,l,lm,lomax,m,nn INTEGER :: k,l,lm,lomax,m
INTEGER :: n,lmax1d INTEGER :: n,lmax1d
REAL :: p(0:lmaxd+1,0:lmaxd+1),x((3*lmaxd)/4+1) REAL :: p(0:lmaxd+1,0:lmaxd+1),x((3*lmaxd)/4+1)
if (allocated(w)) return if (allocated(w)) return
!$ if (omp_in_parallel() .and. omp_get_num_threads() > 1) call juDFT_error("BUG IN GAUNT!!" !$ if (omp_in_parallel() .and. omp_get_num_threads() > 1) call juDFT_error("BUG IN GAUNT!!")
n = (3*lmaxd)/4+1 n = (3*lmaxd)/4+1
ALLOCATE(w(n), yr(n,(lmaxd+1)**2), source=0.0) ALLOCATE(w(n), yr(n,(lmaxd+1)**2), source=0.0)
...@@ -80,8 +76,7 @@ CONTAINS ...@@ -80,8 +76,7 @@ CONTAINS
rf = fpi** (1./3.) rf = fpi** (1./3.)
lomax = lmax1d - 1 lomax = lmax1d - 1
!---> obtain gauss-legendre points and weights !---> obtain gauss-legendre points and weights
nn = 2*n CALL grule(2*n,x,w)
CALL grule(nn,x,w)
!---> generate associated legendre functions for m.ge.0 !---> generate associated legendre functions for m.ge.0
DO k = 1,n DO k = 1,n
cth = x(k) cth = x(k)
...@@ -114,7 +109,5 @@ CONTAINS ...@@ -114,7 +109,5 @@ CONTAINS
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
RETURN
END SUBROUTINE END SUBROUTINE
END MODULE END MODULE
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment