LCOV - code coverage report
Current view: top level - vgen - lhglptg.f90 (source / functions) Coverage Total Hit
Test: FLEUR test coverage Lines: 100.0 % 40 40
Test Date: 2025-06-14 04:34:23 Functions: 100.0 % 1 1

            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          552 :   SUBROUTINE lhglptg(&
       9              :        &                   sphhar,atoms,&
      10          552 :        &                   rx,nsp,dograds,sym,&
      11          552 :        &                   ylh,thet,phi,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
      12              :     !
      13              :     USE m_polangle
      14              :     USE m_ylm
      15              :     USE m_dylm
      16              :     USE m_types_sym
      17              :     USE m_types_sphhar
      18              :     USE m_types_atoms
      19              : 
      20              :     IMPLICIT NONE
      21              : 
      22              :     LOGICAL, INTENT(IN)         :: dograds
      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):: thet(:) !nspd
      33              :     REAL,    INTENT (OUT):: phi(:) !nspd
      34              :     REAL,    INTENT (OUT):: ylh(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd),thet(nspd)
      35              :     REAL,    INTENT (OUT):: ylht1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      36              :     REAL,    INTENT (OUT):: ylht2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      37              :     REAL,    INTENT (OUT):: ylhtf(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      38              :     REAL,    INTENT (OUT):: ylhf1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      39              :     REAL,    INTENT (OUT):: ylhf2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
      40              :     !     ..
      41              :     !     .. Local Scalars ..
      42              :     REAL s,st1,st2,sf1,sf2,stf
      43              :     INTEGER k,lh,mem,nd,lm,ll1
      44              :     !     ..
      45              :     !     .. Local Arrays ..
      46          552 :     COMPLEX ylm( (atoms%lmaxd+1)**2 )
      47          552 :     COMPLEX dylmt1( (atoms%lmaxd+1)**2 ), dylmt2( (atoms%lmaxd+1)**2 )
      48          552 :     COMPLEX dylmf1( (atoms%lmaxd+1)**2 ), dylmf2( (atoms%lmaxd+1)**2 )
      49          552 :     COMPLEX dylmtf( (atoms%lmaxd+1)**2 )
      50              :     !     ..
      51              : 
      52              :     !.....------------------------------------------------------------------
      53              :     !     ..
      54         1190 :     DO  nd = 1,sym%nsymt
      55              : 
      56       120958 :        DO  k = 1,nsp
      57              : 
      58              :           CALL ylm4(&
      59              :                &                   atoms%lmaxd,rx(:,k),&
      60       119768 :                &                   ylm)
      61              :           CALL pol_angle(&
      62              :                &                       rx(1,k),rx(2,k),rx(3,k),&
      63       119768 :                &                       thet(k),phi(k))
      64              : 
      65       119768 :           IF (dograds) THEN
      66              :              CALL dylm3(&
      67              :                   &                     atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
      68       119768 :                   &                     dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
      69              :           ENDIF
      70              : 
      71      3282802 :           DO  lh = 0,sphhar%nlh(nd)
      72      3162396 :              s   = 0
      73      3162396 :              st1 = 0
      74      3162396 :              st2 = 0
      75      3162396 :              sf1 = 0
      76      3162396 :              sf2 = 0
      77      3162396 :              stf = 0
      78      3162396 :              ll1 = sphhar%llh(lh,nd) * ( sphhar%llh(lh,nd) + 1 ) + 1
      79              : 
      80      9609968 :              DO mem = 1,sphhar%nmem(lh,nd)
      81      6447572 :                 lm = ll1 + sphhar%mlh(mem,lh,nd)
      82      9609968 :                 s = s + REAL( sphhar%clnu(mem,lh,nd) * ylm(lm) )
      83              :              ENDDO
      84              : 
      85      3162396 :              ylh(k,lh,nd) = s
      86              : 
      87      3282164 :              IF (dograds) THEN
      88              : 
      89      9609968 :                 DO mem = 1,sphhar%nmem(lh,nd)
      90      6447572 :                    lm = ll1 + sphhar%mlh(mem,lh,nd)
      91      6447572 :                    s   = s   + REAL( sphhar%clnu(mem,lh,nd)* ylm(lm) )
      92      6447572 :                    st1 = st1 + REAL( sphhar%clnu(mem,lh,nd)*dylmt1(lm) )
      93      6447572 :                    st2 = st2 + REAL( sphhar%clnu(mem,lh,nd)*dylmt2(lm) )
      94      6447572 :                    sf1 = sf1 + REAL( sphhar%clnu(mem,lh,nd)*dylmf1(lm) )
      95      6447572 :                    sf2 = sf2 + REAL( sphhar%clnu(mem,lh,nd)*dylmf2(lm) )
      96      9609968 :                    stf = stf + REAL( sphhar%clnu(mem,lh,nd)*dylmtf(lm) )
      97              :                 ENDDO
      98              : 
      99      3162396 :                 ylht1(k,lh,nd) = st1
     100      3162396 :                 ylht2(k,lh,nd) = st2
     101      3162396 :                 ylhf1(k,lh,nd) = sf1
     102      3162396 :                 ylhf2(k,lh,nd) = sf2
     103      3162396 :                 ylhtf(k,lh,nd) = stf
     104              : 
     105              :              ENDIF
     106              : 
     107              :           ENDDO
     108              :        ENDDO
     109              :     ENDDO
     110              : 
     111          552 :     RETURN
     112              :   END SUBROUTINE lhglptg
     113              : END MODULE m_lhglptg
        

Generated by: LCOV version 2.0-1