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          166 :   SUBROUTINE lhglpts(&
      14              :        &                   sphhar,atoms,&
      15          166 :        &                   rx,nsp,&
      16              :        &                   sym,&
      17          166 :        &                   ylh)
      18              :     !
      19              :     USE m_ylm
      20              :     USE m_types_sym
      21              :     USE m_types_sphhar
      22              :     USE m_types_atoms
      23              : 
      24              :     IMPLICIT NONE
      25              : 
      26              :     TYPE(t_sym),INTENT(IN)         :: sym
      27              :     TYPE(t_sphhar),INTENT(IN)      :: sphhar
      28              :     TYPE(t_atoms),INTENT(IN)       :: atoms
      29              :     !     ..
      30              :     !     .. Scalar Arguments ..
      31              :     INTEGER, INTENT (IN) :: nsp
      32              :     !     ..
      33              :     !     .. Array Arguments ..
      34              :     REAL,    INTENT (IN) :: rx(:,:) !(3,dimension%nspd)
      35              :     REAL,    INTENT (OUT):: ylh(:,0:,:) !(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      36              :     !     ..
      37              :     !     .. Local Scalars ..
      38              :     REAL s
      39              :     INTEGER k,lh,mem,nd,ll1,lm
      40              :     !     ..
      41              :     !     .. Local Arrays ..
      42          166 :     COMPLEX ylm( (atoms%lmaxd+1)**2 )
      43              :     !     ..
      44          336 :     DO  nd = 1,sym%nsymt
      45        33332 :        DO  k = 1,nsp
      46              : 
      47              :           CALL ylm4(&
      48              :                &                atoms%lmaxd,rx(:,k),&
      49        32996 :                &                ylm)
      50              : 
      51      1977278 :           DO lh = 0,sphhar%nlh(nd)
      52      1944112 :              s = 0
      53      1944112 :              ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
      54      5569372 :              DO mem = 1,sphhar%nmem(lh,nd)
      55      3625260 :                 lm = ll1 + sphhar%mlh(mem,lh,nd)
      56      5569372 :                 s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
      57              :              ENDDO
      58      1977108 :              ylh(k,lh,nd) = s
      59              :           ENDDO
      60              : 
      61              :        ENDDO
      62              :     ENDDO
      63          166 :     RETURN
      64              :   END SUBROUTINE lhglpts
      65              : END MODULE m_lhglpts