lhglpts.f90 2 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
MODULE m_lhglpts
  !     **********************************************************
  !     calculates lattice harmonics on the gauss-legendre angular 
  !     mesh - r.pentcheva Feb'96
  !     **********************************************************
CONTAINS
  SUBROUTINE lhglpts(&
       &                   sphhar,atoms,&
       &                   rx,nsp,&
       &                   sym,&
       &                   ylh)
    !
    USE m_ylm
    USE m_types
    IMPLICIT NONE

    TYPE(t_sym),INTENT(IN)         :: sym
    TYPE(t_sphhar),INTENT(IN)      :: sphhar
    TYPE(t_atoms),INTENT(IN)       :: atoms
    !     ..
    !     .. Scalar Arguments .. 
    INTEGER, INTENT (IN) :: nsp 
    !     ..
    !     .. Array Arguments ..
    REAL,    INTENT (IN) :: rx(:,:) !(3,dimension%nspd)
    REAL,    INTENT (OUT):: ylh(:,0:,:) !(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
    !     ..
    !     .. Local Scalars ..
    REAL s
    INTEGER k,lh,mem,nd,ll1,lm
    !     ..
    !     .. Local Arrays ..
    COMPLEX ylm( (atoms%lmaxd+1)**2 )
    !     ..
    DO  nd = 1,sym%nsymt
       DO  k = 1,nsp

          CALL ylm4(&
               &                atoms%lmaxd,rx(:,k),&
               &                ylm)

          DO lh = 0,sphhar%nlh(nd)
             s = 0
             ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
             DO mem = 1,sphhar%nmem(lh,nd)
                lm = ll1 + sphhar%mlh(mem,lh,nd)
                s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
             ENDDO
             ylh(k,lh,nd) = s
          ENDDO

       ENDDO
    ENDDO
    RETURN
  END SUBROUTINE lhglpts
END MODULE m_lhglpts