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

          Line data    Source code
       1             : MODULE m_rhonmt
       2             : CONTAINS
       3        1848 :   SUBROUTINE rhonmt(atoms,sphhar,we,ne,sym,eigVecCoeffs,denCoeffs,ispin)
       4             :     !     *************************************************************
       5             :     !     subroutine sets up the coefficients of non-sphereical
       6             :     !     muffin-tin density                          c.l.fu
       7             :     !     *************************************************************
       8             :     USE m_gaunt,ONLY:gaunt1
       9             :     USE m_types
      10             :     use m_constants
      11             :     IMPLICIT NONE
      12             :     TYPE(t_sym),          INTENT(IN)    :: sym
      13             :     TYPE(t_sphhar),       INTENT(IN)    :: sphhar
      14             :     TYPE(t_atoms),        INTENT(IN)    :: atoms
      15             :     TYPE(t_eigVecCoeffs), INTENT(IN)    :: eigVecCoeffs
      16             :     TYPE(t_denCoeffs),    INTENT(INOUT) :: denCoeffs
      17             : 
      18             :     INTEGER,           INTENT(IN)    :: ne, ispin
      19             : 
      20             :     REAL,    INTENT(IN) :: we(:)!(nobd)
      21             : 
      22             :     !     ..
      23             :     !     .. Local Scalars ..
      24             :     COMPLEX cconst,cil,cmv
      25             :     REAL coef
      26             :     INTEGER  :: jmem,l,lcond,lh,llp,llpmax,lm,lmp,lp,lphi,lplow,lplow0,lv
      27             :     INTEGER  :: mp,mv,na,natom,nb,nn,ns,nt,m
      28             : 
      29             :     !Initialize private variables in gaunt module before parallel region
      30        1848 :     !$      coef = gaunt1(0,0,0,0,0,0,atoms%lmaxd)
      31             : 
      32        3900 :     DO ns = 1,sym%nsymt
      33             :        !$OMP PARALLEL DO DEFAULT(SHARED) &
      34             :        !$OMP&  PRIVATE(lv,jmem,mv,cmv,l,lm,mp,m,llpmax,nt,na,nb,lplow0)&
      35             :        !$OMP&  PRIVATE(lphi,lplow,lcond,lp,cil,lmp,llp,coef,cconst&
      36        3900 :        !$OMP& ,natom,nn) 
      37             :        DO  lh = 1,sphhar%nlh(ns)
      38       27120 :           lv = sphhar%llh(lh,ns)
      39       82986 :           DO  jmem = 1,sphhar%nmem(lh,ns)
      40       51762 :              mv = sphhar%mlh(jmem,lh,ns)
      41       51762 :              cmv = conjg(sphhar%clnu(jmem,lh,ns))
      42      566124 :              DO  l = 0,atoms%lmaxd
      43     5192174 :                 m_loop: DO m = -l,l
      44     4653170 :                    lm = l* (l+1) + m
      45     4653170 :                    mp = m - mv
      46             :                    !     -----> set up the lower and upper limit of lp in such a way that
      47             :                    !     -----> lp+l+lv is even, lp<=l, and (lp,l,lv) satisfies the
      48             :                    !     -----> triangular relation
      49     4653170 :                    lplow0 = iabs(l-lv)
      50     4653170 :                    lphi = l - mod(lv,2)
      51     4653170 :                    lplow = max(lplow0,iabs(mp))
      52     4653170 :                    lcond = iabs(lphi-lplow)
      53     4653170 :                    lplow = lplow + mod(lcond,2)
      54     4653170 :                    IF (lplow.GT.lphi) CYCLE m_loop
      55     9137192 :                    DO  lp = lplow,lphi,2
      56     6513540 :                       cil = ImagUnit** (l-lp)
      57     6513540 :                       lmp = lp* (lp+1) + mp
      58     6513540 :                       IF (lmp.GT.lm) CYCLE m_loop
      59     5703456 :                       llp = (l* (l+1))/2 + lp
      60             :                       !     -----> gaunt's coefficient
      61     5703456 :                       coef = 2.*gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd)
      62     6401538 :                       IF (lmp.EQ.lm) coef = coef/2.
      63     5703456 :                       cconst = coef* (cil*cmv)
      64     5703456 :                       natom = 0
      65    22323446 :                       DO  nn = 1,atoms%ntype
      66    11966820 :                          llpmax = (atoms%lmax(nn)* (atoms%lmax(nn)+3))/2
      67    11966820 :                          IF (llp.LE.llpmax) THEN 
      68    11447060 :                             nt = natom
      69    25215048 :                             DO  na = 1,atoms%neq(nn)
      70    13767988 :                                nt = nt + 1
      71    25215048 :                                IF (atoms%ntypsy(nt).EQ.ns) THEN
      72   217466421 :                                   DO nb = 1,ne
      73             :                                      denCoeffs%uunmt(llp,lh,nn,ispin) = denCoeffs%uunmt(llp,lh,nn,ispin)&
      74   205969077 :                                           +we(nb)*real(cconst*eigVecCoeffs%acof(nb,lm,nt,ispin)*conjg(eigVecCoeffs%acof(nb,lmp,nt,ispin)))
      75             :                                      denCoeffs%ddnmt(llp,lh,nn,ispin) = denCoeffs%ddnmt(llp,lh,nn,ispin) +&
      76   205969077 :                                           we(nb)*real(cconst*eigVecCoeffs%bcof(nb,lm,nt,ispin)*conjg(eigVecCoeffs%bcof(nb,lmp,nt,ispin)))
      77             :                                      denCoeffs%udnmt(llp,lh,nn,ispin) = denCoeffs%udnmt(llp,lh,nn,ispin) +&
      78   205969077 :                                           we(nb)*real(cconst*eigVecCoeffs%acof(nb,lm,nt,ispin)*conjg(eigVecCoeffs%bcof(nb,lmp,nt,ispin)))
      79             :                                      denCoeffs%dunmt(llp,lh,nn,ispin) = denCoeffs%dunmt(llp,lh,nn,ispin) +&
      80   217466421 :                                           we(nb)*real(cconst*eigVecCoeffs%bcof(nb,lm,nt,ispin)*conjg(eigVecCoeffs%acof(nb,lmp,nt,ispin)))
      81             :                                   ENDDO
      82             :                                ENDIF
      83             :                             ENDDO
      84             :                          ENDIF
      85    17670276 :                          natom = natom + atoms%neq(nn)
      86             :                       ENDDO
      87             :                    ENDDO
      88             :                 ENDDO m_loop
      89             :              ENDDO
      90             :           ENDDO
      91             :        ENDDO
      92             :        !$OMP END PARALLEL DO
      93             :     ENDDO
      94             : 
      95        1848 :   END SUBROUTINE rhonmt
      96             : END MODULE m_rhonmt

Generated by: LCOV version 1.13