Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_lhglpts
       8             :   !     **********************************************************
       9             :   !     calculates lattice harmonics on the gauss-legendre angular 
      10             :   !     mesh - r.pentcheva Feb'96
      11             :   !     **********************************************************
      12             : CONTAINS
      13          18 :   SUBROUTINE lhglpts(&
      14             :        &                   sphhar,atoms,&
      15          18 :        &                   rx,nsp,&
      16             :        &                   sym,&
      17          18 :        &                   ylh)
      18             :     !
      19             :     USE m_ylm
      20             :     USE m_types
      21             :     IMPLICIT NONE
      22             : 
      23             :     TYPE(t_sym),INTENT(IN)         :: sym
      24             :     TYPE(t_sphhar),INTENT(IN)      :: sphhar
      25             :     TYPE(t_atoms),INTENT(IN)       :: atoms
      26             :     !     ..
      27             :     !     .. Scalar Arguments .. 
      28             :     INTEGER, INTENT (IN) :: nsp 
      29             :     !     ..
      30             :     !     .. Array Arguments ..
      31             :     REAL,    INTENT (IN) :: rx(:,:) !(3,dimension%nspd)
      32             :     REAL,    INTENT (OUT):: ylh(:,0:,:) !(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      33             :     !     ..
      34             :     !     .. Local Scalars ..
      35             :     REAL s
      36             :     INTEGER k,lh,mem,nd,ll1,lm
      37             :     !     ..
      38             :     !     .. Local Arrays ..
      39          36 :     COMPLEX ylm( (atoms%lmaxd+1)**2 )
      40             :     !     ..
      41          36 :     DO  nd = 1,sym%nsymt
      42        6336 :        DO  k = 1,nsp
      43             : 
      44             :           CALL ylm4(&
      45             :                &                atoms%lmaxd,rx(:,k),&
      46        6300 :                &                ylm)
      47             : 
      48      107118 :           DO lh = 0,sphhar%nlh(nd)
      49      100800 :              s = 0
      50      100800 :              ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
      51      258300 :              DO mem = 1,sphhar%nmem(lh,nd)
      52      157500 :                 lm = ll1 + sphhar%mlh(mem,lh,nd)
      53      258300 :                 s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
      54             :              ENDDO
      55      107100 :              ylh(k,lh,nd) = s
      56             :           ENDDO
      57             : 
      58             :        ENDDO
      59             :     ENDDO
      60          18 :     RETURN
      61             :   END SUBROUTINE lhglpts
      62             : END MODULE m_lhglpts