LCOV - code coverage report
Current view: top level - vgen - lhglptg.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 40 40 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : MODULE m_lhglptg
       2             :   !.....------------------------------------------------------------------
       3             :   !     calculates lattice harmonics and their gradients on the
       4             :   !       gauss-legendre angular mesh - r.p. and t.a.
       5             :   !     for gradient. t.a. 1996.
       6             :   !.....------------------------------------------------------------------
       7             : CONTAINS
       8         322 :   SUBROUTINE lhglptg(&
       9             :        &                   sphhar,atoms,&
      10         322 :        &                   rx,nsp,xcpot,sym,&
      11         322 :        &                   ylh,thet,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
      12             :     !
      13             :     USE m_polangle
      14             :     USE m_ylm
      15             :     USE m_dylm
      16             :     USE m_types
      17             :     IMPLICIT NONE
      18             : 
      19             :     CLASS(t_xcpot),INTENT(IN)   :: xcpot
      20             :     TYPE(t_sym),INTENT(IN)      :: sym
      21             :     TYPE(t_sphhar),INTENT(IN)   :: sphhar
      22             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      23             :     !     ..
      24             :     !     .. Scalar Arguments ..
      25             :     INTEGER, INTENT (IN) :: nsp  
      26             :     !     ..
      27             :     !     .. Array Arguments ..
      28             :     REAL,    INTENT (IN) :: rx(:,:)!(3,dimension%nspd)
      29             :     REAL,    INTENT (OUT):: thet(:) !nspd
      30             :     REAL,    INTENT (OUT):: ylh(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd),thet(nspd)
      31             :     REAL,    INTENT (OUT):: ylht1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      32             :     REAL,    INTENT (OUT):: ylht2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      33             :     REAL,    INTENT (OUT):: ylhtf(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      34             :     REAL,    INTENT (OUT):: ylhf1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      35             :     REAL,    INTENT (OUT):: ylhf2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      36             :     !     ..
      37             :     !     .. Local Scalars ..
      38             :     REAL s,st1,st2,sf1,sf2,stf,phi
      39             :     INTEGER k,lh,mem,nd,lm,ll1
      40             :     !     ..
      41             :     !     .. Local Arrays ..
      42         644 :     COMPLEX ylm( (atoms%lmaxd+1)**2 )
      43         644 :     COMPLEX dylmt1( (atoms%lmaxd+1)**2 ), dylmt2( (atoms%lmaxd+1)**2 )
      44         644 :     COMPLEX dylmf1( (atoms%lmaxd+1)**2 ), dylmf2( (atoms%lmaxd+1)**2 )
      45         644 :     COMPLEX dylmtf( (atoms%lmaxd+1)**2 )
      46             :     !     ..
      47             : 
      48             :     !.....------------------------------------------------------------------
      49             :     !     ..
      50         674 :     DO  nd = 1,sym%nsymt
      51             : 
      52       66766 :        DO  k = 1,nsp
      53             : 
      54             :           CALL ylm4(&
      55             :                &                   atoms%lmaxd,rx(:,k),&
      56       66092 :                &                   ylm)
      57             :           CALL pol_angle(&
      58             :                &                       rx(1,k),rx(2,k),rx(3,k),&
      59       66092 :                &                       thet(k),phi)
      60             : 
      61       66092 :           IF (xcpot%needs_grad()) THEN
      62             :              CALL dylm3(&
      63             :                   &                     atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
      64       66092 :                   &                     dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
      65             :           ENDIF
      66             : 
      67     1412076 :           DO  lh = 0,sphhar%nlh(nd)
      68     1345632 :              s   = 0
      69     1345632 :              st1 = 0
      70     1345632 :              st2 = 0
      71     1345632 :              sf1 = 0
      72     1345632 :              sf2 = 0
      73     1345632 :              stf = 0
      74     1345632 :              ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
      75             : 
      76     4050104 :              DO mem = 1,sphhar%nmem(lh,nd)
      77     2704472 :                 lm = ll1 + sphhar%mlh(mem,lh,nd)
      78     4050104 :                 s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
      79             :              ENDDO
      80             : 
      81     1345632 :              ylh(k,lh,nd) = s
      82             : 
      83     1411724 :              IF (xcpot%needs_grad()) THEN
      84             : 
      85     4050104 :                 DO mem = 1,sphhar%nmem(lh,nd)
      86     2704472 :                    lm = ll1 + sphhar%mlh(mem,lh,nd)
      87     2704472 :                    s   = s   + REAL( sphhar%clnu(mem,lh,nd)* ylm(lm) )
      88     2704472 :                    st1 = st1 + REAL( sphhar%clnu(mem,lh,nd)*dylmt1(lm) )
      89     2704472 :                    st2 = st2 + REAL( sphhar%clnu(mem,lh,nd)*dylmt2(lm) )
      90     2704472 :                    sf1 = sf1 + REAL( sphhar%clnu(mem,lh,nd)*dylmf1(lm) )
      91     2704472 :                    sf2 = sf2 + REAL( sphhar%clnu(mem,lh,nd)*dylmf2(lm) )
      92     4050104 :                    stf = stf + REAL( sphhar%clnu(mem,lh,nd)*dylmtf(lm) )
      93             :                 ENDDO
      94             : 
      95     1345632 :                 ylht1(k,lh,nd) = st1
      96     1345632 :                 ylht2(k,lh,nd) = st2
      97     1345632 :                 ylhf1(k,lh,nd) = sf1
      98     1345632 :                 ylhf2(k,lh,nd) = sf2
      99     1345632 :                 ylhtf(k,lh,nd) = stf
     100             : 
     101             :              ENDIF
     102             : 
     103             :           ENDDO
     104             :        ENDDO
     105             :     ENDDO
     106             : 
     107         322 :     RETURN
     108             :   END SUBROUTINE lhglptg
     109             : END MODULE m_lhglptg

Generated by: LCOV version 1.13