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

          Line data    Source code
       1             :       MODULE m_phasy1
       2             : !     ********************************************************************
       3             : !     calculate 4pi*i**l/nop(3)*sum(R){exp(iRG(taual-taur)*conjg(ylm(RG)) }
       4             : !     e. wimmer   oct.1984
       5             : !     ********************************************************************
       6             :       CONTAINS
       7      759596 :       SUBROUTINE phasy1(atoms,stars,sym, cell,k, pylm)
       8             : 
       9             :       USE m_constants
      10             :       USE m_ylm
      11             :       USE m_spgrot
      12             :       USE m_types
      13             :       IMPLICIT NONE
      14             : !
      15             : !     .. Scalar Arguments ..
      16             :       TYPE(t_atoms),INTENT(IN)::atoms
      17             :       TYPE(t_stars),INTENT(IN)::stars
      18             :       TYPE(t_sym),INTENT(IN)  ::sym
      19             :       TYPE(t_cell),INTENT(IN) ::cell
      20             :       INTEGER, INTENT (IN) :: k
      21             : !     ..
      22             : !     .. Array Arguments ..
      23             :       COMPLEX, INTENT (OUT):: pylm(:,:)
      24             : !     ..
      25             : !     .. Local Scalars ..
      26             :       COMPLEX sf,csf
      27             :       REAL x
      28             :       INTEGER j,l,m,n,na,lm,ll1
      29             : !     ..
      30             : !     .. Local Arrays ..
      31     1519192 :       COMPLEX ciall(0:atoms%lmaxd)
      32     1519192 :       COMPLEX phas(sym%nop)
      33             :       REAL rg(3)
      34     1519192 :       INTEGER kr(3,sym%nop)
      35      759596 :       COMPLEX, ALLOCATABLE :: ylm(:,:)
      36             : !     ..
      37             : 
      38      759596 :       ciall(0) = fpi_const/sym%nop
      39     7254374 :       DO l = 1,atoms%lmaxd
      40     7254374 :          ciall(l) = ciall(0)*ImagUnit**l
      41             :       ENDDO
      42             : 
      43             :       CALL spgrot(&
      44             :      &           sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab,&
      45             :      &           stars%kv3(:,k),&
      46      759596 :      &           kr,phas)
      47      759596 :       ALLOCATE ( ylm( (atoms%lmaxd+1)**2, sym%nop ) )
      48     4853170 :       DO j = 1,sym%nop
      49     4093574 :           rg=matmul(kr(:,j),cell%bmat)
      50             :           CALL ylm4(&
      51             :      &              atoms%lmaxd,rg,&
      52     4853170 :      &              ylm(:,j) )!keep
      53             :       ENDDO
      54     4853170 :       ylm = conjg( ylm )
      55             : 
      56      759596 :       na = 1
      57     1999822 :       DO n = 1,atoms%ntype
      58   110251180 :          DO lm = 1, (atoms%lmax(n)+1)**2
      59   110251180 :                pylm(lm,n) = cmplx(0.,0.)
      60             :          ENDDO
      61    20940830 :          DO j = 1,sym%nop
      62     9850302 :             x = tpi_const* dot_product(real(kr(:,j)),atoms%taual(:,na))
      63     9850302 :             sf = cmplx(cos(x),sin(x))*phas(j)
      64    11090528 :             DO l = 0,atoms%lmax(n)
      65    92127458 :                ll1 = l*(l+1) + 1
      66    92127458 :                csf = ciall(l)*sf
      67   973212688 :                DO m = -l,l
      68   881085230 :                   lm = ll1 + m
      69   973212688 :                   pylm(lm,n) = pylm(lm,n) + csf*ylm(lm,j)
      70             :                ENDDO
      71             :             ENDDO
      72             :          ENDDO
      73     1999822 :          na = na + atoms%neq(n)
      74             :       ENDDO
      75      759596 :       DEALLOCATE ( ylm )
      76             : 
      77      759596 :       END SUBROUTINE phasy1
      78             :       END MODULE m_phasy1

Generated by: LCOV version 1.13