LCOV - code coverage report
Current view: top level - global - od_phasy.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 31 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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_od_phasy
       8             :       CONTAINS
       9           0 :       SUBROUTINE od_phasy(
      10           0 :      >                  ntypd,n3d,natd,lmaxd,ntype,neq,lmax,
      11           0 :      >                  taual,bmat,kv3,k,odi,ods,
      12           0 :      <                  pylm)
      13             : c*********************************************************************
      14             : c calculates 4pi*i**l/nop(3)*sum(R){exp(iRG(taual-taur)*conjg(ylm(RG)) }
      15             : c but for chiral groups of symmetries, as in phasy1.F    
      16             : c     Y.Mokrousov   august,2003
      17             : c ********************************************************************
      18             :       USE m_constants
      19             :       USE m_ylm
      20             :       USE m_od_chirot
      21             :       USE m_types, ONLY : od_inp, od_sym
      22             : 
      23             :       IMPLICIT NONE
      24             : c
      25             : C     .. Scalar Arguments ..
      26             :       INTEGER, INTENT (IN) :: ntypd,n3d,natd,lmaxd
      27             :       INTEGER, INTENT (IN) :: ntype,k
      28             : C     ..
      29             : C     .. Array Arguments ..
      30             :       INTEGER, INTENT (IN) :: neq(ntypd),lmax(ntypd),kv3(3,n3d)
      31             :       REAL,    INTENT (IN) :: bmat(3,3),taual(3,natd)
      32             :       COMPLEX, INTENT (OUT):: pylm( (lmaxd+1)**2, ntypd )
      33             : c-odim
      34             :       TYPE (od_inp), INTENT (IN) :: odi
      35             :       TYPE (od_sym), INTENT (IN) :: ods
      36             : c+odim
      37             : C     ..
      38             : C     .. Local Scalars ..
      39             :       COMPLEX sf
      40             :       REAL x
      41             :       INTEGER j,l,m,n,na,lm
      42             : C     ..
      43             : C     .. Local Arrays ..
      44           0 :       COMPLEX ciall(0:lmaxd),ylm( (lmaxd+1)**2 )
      45             :       REAL rg(3)
      46           0 :       COMPLEX phas(ods%nop)
      47           0 :       REAL kr(3,ods%nop)
      48             : 
      49             : C     ..
      50             : C     .. Intrinsic Functions ..
      51             :       INTRINSIC cmplx,conjg,cos,sin
      52             : C     ..
      53             : 
      54           0 :       ciall(0) = fpi_const/ods%nop
      55             : 
      56           0 :       DO 10 l = 1,lmaxd
      57           0 :          ciall(l) = ciall(0)*ImagUnit**l
      58           0 :    10 CONTINUE
      59           0 :       na = 1
      60           0 :       DO 70 n = 1,ntype
      61           0 :          DO lm = 1, (lmax(n)+1)**2
      62           0 :                pylm(lm,n) = cmplx(0.,0.)
      63             :          ENDDO
      64           0 :          CALL od_chirot(odi,ods,bmat,kv3(1,k),kr,phas)         
      65           0 :          DO 60 j = 1,ods%nop
      66             :             rg(1) = kr(1,j)*bmat(1,1) + kr(2,j)*bmat(2,1) +
      67           0 :      +              kr(3,j)*bmat(3,1)
      68             :             rg(2) = kr(1,j)*bmat(1,2) + kr(2,j)*bmat(2,2) +
      69           0 :      +              kr(3,j)*bmat(3,2)
      70             :             rg(3) = kr(1,j)*bmat(1,3) + kr(2,j)*bmat(2,3) +
      71           0 :      +              kr(3,j)*bmat(3,3)            
      72             :             CALL ylm4(
      73             :      >                lmax(n),rg,
      74           0 :      <                ylm)
      75             :             x = tpi_const* (kr(1,j)*taual(1,na) + kr(2,j)*taual(2,na) +
      76           0 :      +                                        kr(3,j)*taual(3,na))
      77           0 :             sf = cmplx(cos(x),sin(x))*phas(j)
      78             :       
      79           0 :             DO l = 0,lmax(n)
      80           0 :                DO m = -l,l
      81           0 :                   lm = l*(l+1) + m + 1 
      82             :                   pylm(lm,n) = pylm(lm,n) +
      83           0 :      +                          ciall(l)*sf*conjg(ylm(lm))
      84             :                ENDDO
      85             :             ENDDO
      86           0 :    60    CONTINUE
      87           0 :          na = na + neq(n)
      88           0 :    70 CONTINUE
      89             : 
      90           0 :       RETURN
      91             :       END SUBROUTINE od_phasy
      92             :       END MODULE m_od_phasy

Generated by: LCOV version 1.13