LCOV - code coverage report
Current view: top level - vgen - lhglpts.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 15 15 100.0 %
Date: 2024-03-29 04:21:46 Functions: 1 1 100.0 %

          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

Generated by: LCOV version 1.14