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             :    USE m_constants
       7             :    USE m_ylm
       8             :    USE m_spgrot
       9             :    USE m_types
      10             : 
      11             :    IMPLICIT NONE
      12             : 
      13             : CONTAINS
      14     3167811 :    SUBROUTINE phasy1(atoms,stars,sym, cell,k, pylm)
      15             : 
      16             : !     .. Scalar Arguments ..
      17             :       TYPE(t_atoms),INTENT(IN)::atoms
      18             :       TYPE(t_stars),INTENT(IN)::stars
      19             :       TYPE(t_sym),INTENT(IN)  ::sym
      20             :       TYPE(t_cell),INTENT(IN) ::cell
      21             :       INTEGER, INTENT (IN) :: k
      22             : 
      23             : !     .. Array Arguments ..
      24             :       COMPLEX, INTENT (OUT):: pylm(:,:)
      25             : 
      26             : !     .. Local Scalars ..
      27             :       COMPLEX sf,csf
      28             :       REAL x
      29             :       INTEGER iOp,l,m,iType,iAtom,lm,ll1
      30             : 
      31             : !     .. Local Arrays ..
      32     3167811 :       COMPLEX ciall(0:atoms%lmaxd)
      33     3167811 :       COMPLEX phas(sym%nop)
      34             :       REAL rg(3)
      35     3167811 :       INTEGER kr(3,sym%nop)
      36     3167811 :       COMPLEX, ALLOCATABLE :: ylm(:,:)
      37             : 
      38     3167811 :       ciall(0) = fpi_const/sym%nop
      39    30014067 :       DO l = 1,atoms%lmaxd
      40    30014067 :          ciall(l) = ciall(0)*ImagUnit**l
      41             :       ENDDO
      42             : 
      43   427427627 :       pylm = CMPLX(0.0,0.0)
      44             : 
      45             :       CALL spgrot(sym%nop, sym%symor, sym%mrot, sym%tau, sym%invtab, &
      46     3167811 :                   stars%kv3(:,k), kr, phas)
      47             : 
      48    12671244 :       ALLOCATE ( ylm( (atoms%lmaxd+1)**2, sym%nop ) )
      49    14260939 :       DO iOp = 1,sym%nop !center/=0 only works for sym = 1
      50   177490048 :           rg=matmul(real(kr(:,iOp))+stars%center,cell%bmat)
      51    14260939 :           CALL ylm4(atoms%lmaxd, rg, ylm(:,iOp))!keep
      52             :       ENDDO
      53  1042357395 :       ylm = conjg( ylm )
      54             : 
      55     7820291 :       DO iType = 1,atoms%ntype
      56     4652480 :          iAtom = atoms%firstAtom(iType)
      57    30037485 :          DO iOp = 1,sym%nop
      58    88868776 :             x = tpi_const* dot_product(real(kr(:,iOp))+stars%center,atoms%taual(:,iAtom))
      59    22217194 :             sf = cmplx(cos(x),sin(x))*phas(iOp)
      60   232983740 :             DO l = 0,atoms%lmax(iType)
      61   206114066 :                ll1 = l*(l+1) + 1
      62   206114066 :                csf = ciall(l)*sf
      63  2198842598 :                DO m = -l,l
      64  1970511338 :                   lm = ll1 + m
      65  2176625404 :                   pylm(lm,iType) = pylm(lm,iType) + csf*ylm(lm,iOp)
      66             :                ENDDO
      67             :             ENDDO
      68             :          ENDDO
      69             :       ENDDO
      70     3167811 :       DEALLOCATE ( ylm )
      71             : 
      72     3167811 :    END SUBROUTINE phasy1
      73             : 
      74       21318 :    SUBROUTINE phasy2(atoms, stars, sym, cell, k, iType, iAtom, pylm2)
      75             :       ! phasy2 has i*RG in the sum of phasy1 and produces a vector
      76             :       ! routine built to be called with a specific atom (type)
      77             : 
      78             : !     .. Scalar Arguments ..
      79             :       TYPE(t_atoms),INTENT(IN)::atoms
      80             :       TYPE(t_stars),INTENT(IN)::stars
      81             :       TYPE(t_sym),INTENT(IN)  ::sym
      82             :       TYPE(t_cell),INTENT(IN) ::cell
      83             :       INTEGER, INTENT (IN) :: k, iType, iAtom
      84             : 
      85             : !     .. Array Arguments ..
      86             :       COMPLEX, INTENT (OUT):: pylm2(:,:,:)
      87             : 
      88             : !     .. Local Scalars ..
      89             :       COMPLEX sf,csf
      90             :       REAL x
      91             :       INTEGER iOp,l,m,lm,ll1,dir
      92             : 
      93             : !     .. Local Arrays ..
      94       21318 :       COMPLEX ciall(0:atoms%lmaxd)
      95       21318 :       COMPLEX phas(sym%nop)
      96       21318 :       REAL phasr(sym%nop)
      97             :       REAL rg(3)
      98       21318 :       INTEGER kr(3,sym%nop)
      99       21318 :       COMPLEX, ALLOCATABLE :: ylm(:)
     100             : 
     101       21318 :       ciall(0) = fpi_const/sym%nop
     102      191862 :       DO l = 1, atoms%lmax(iType)
     103      191862 :          ciall(l) = ciall(0)*ImagUnit**l
     104             :       ENDDO
     105             : 
     106    21083502 :       pylm2= CMPLX(0.0,0.0)
     107             : 
     108       21318 :       CALL spgrot(sym%nop,sym%symor,sym%mrot,sym%tau,sym%invtab,stars%kv3(:,k),kr,phas)
     109      106590 :       phasr=REAL(phas)
     110             : 
     111       63954 :       ALLOCATE (ylm( (atoms%lmaxd+1)**2))
     112      106590 :       DO iOp = 1,sym%nop
     113     6992304 :          ylm = cmplx(0.0,0.0)
     114     1364352 :          rg(:)=matmul(kr(:,iOp),cell%bmat)
     115       85272 :          CALL ylm4(atoms%lmaxd, rg(:), ylm(:))!keep
     116     6992304 :          ylm = conjg(ylm)
     117      341088 :          x = tpi_const* dot_product(real(kr(:,iOp)),atoms%taual(:,iAtom))
     118      362406 :          DO dir = 1,3
     119      255816 :             sf = cmplx(cos(x),sin(x))*phasr(iOp)*ImagUnit*rg(dir)
     120     2643432 :             DO l = 0,atoms%lmax(iType)
     121     2302344 :                ll1 = l*(l+1) + 1
     122     2302344 :                csf = ciall(l)*sf
     123    23279256 :                DO m = -l,l
     124    20721096 :                   lm = ll1 + m
     125    23023440 :                   pylm2(lm,dir,iOp) = pylm2(lm,dir,iOp) + csf*ylm(lm) !shouldn't iOp be iType in the first 2 terms?
     126             :                ENDDO
     127             :             ENDDO
     128             :          END DO ! direction
     129             :       END DO
     130       21318 :       DEALLOCATE ( ylm )
     131             : 
     132       21318 :    END SUBROUTINE phasy2
     133             : END MODULE m_phasy1