LCOV - code coverage report
Current view: top level - cdn - eparas.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 71 71 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.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_eparas
       8             :   !***********************************************************************
       9             :   ! Calculates qlo, enerlo and sqlo, which are needed to determine the 
      10             :   ! new energy parameters.
      11             :   ! Philipp Kurz 99/04
      12             :   !***********************************************************************
      13             :   ! also the 'normal' energy parameters are now included...
      14             :   !
      15             :   ! if (l_mcd) then mcd contains mcd spectrum: first index = polarization
      16             :   ! second = core level ; third = band index                  gb.2001
      17             :   ! corrected to work also for multiple LO's of same l at the same atom
      18             :   !                                                           gb.2005
      19             :   !*************** ABBREVIATIONS *****************************************
      20             :   ! qlo     : charge density of one local orbital at the current k-point
      21             :   ! sqlo    : qlo integrated over the Brillouin zone
      22             :   ! enerlo  : qlo*energy integrated over the Brillouin zone
      23             :   !***********************************************************************
      24             :   !
      25             : CONTAINS
      26        1848 :   SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
      27             :                     usdus,regCharges,dos,l_mcd,mcd)
      28             :     USE m_types
      29             :     IMPLICIT NONE
      30             :     TYPE(t_usdus),         INTENT(IN)    :: usdus
      31             :     TYPE(t_mpi),           INTENT(IN)    :: mpi
      32             :     TYPE(t_atoms),         INTENT(IN)    :: atoms
      33             :     TYPE(t_eigVecCoeffs),  INTENT(IN)    :: eigVecCoeffs
      34             :     TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
      35             :     TYPE(t_dos),           INTENT(INOUT) :: dos
      36             :     TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
      37             :     !     ..
      38             :     !     .. Scalar Arguments ..
      39             :     INTEGER, INTENT (IN) :: noccbd,jsp     
      40             :     INTEGER, INTENT (IN) :: ne,ikpt  ,skip_t
      41             :     LOGICAL, INTENT (IN) :: l_mcd,l_evp
      42             :     !     ..
      43             :     !     .. Array Arguments ..
      44             :     REAL,    INTENT (IN)  :: eig(:)!(dimension%neigd),
      45             :     REAL,    INTENT (IN)  :: we(noccbd) 
      46             : 
      47             :     !     ..
      48             :     !     .. Local Scalars ..
      49             :     INTEGER i,l,lo,lop ,natom,nn,ntyp,m
      50             :     INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index
      51             :     REAL fac
      52             :     COMPLEX suma,sumb,sumab,sumba
      53             :     !     ..
      54             :     !     .. Local Arrays ..
      55        3696 :     REAL qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
      56        3696 :     REAL qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
      57             :     !     ..
      58             :     !
      59             :     !---> initialize ener, sqal, enerlo and sqlo on first call
      60             :     !
      61             : 
      62        1848 :     IF ((ikpt.LE.mpi%isize).AND..NOT.l_evp) THEN
      63          80 :        regCharges%ener(:,:,jsp) = 0.0
      64          80 :        regCharges%sqal(:,:,jsp) = 0.0
      65          80 :        regCharges%enerlo(:,:,jsp) = 0.0
      66          80 :        regCharges%sqlo(:,:,jsp) = 0.0
      67          80 :        dos%qal(:,:,:,ikpt,jsp) = 0.0
      68             :     END IF
      69             : 
      70             :     !--->    l-decomposed density for each occupied state
      71             :     !
      72             :     !         DO 140 i = (skip_t+1),ne    ! this I need for all states
      73       25228 :     DO i = 1,ne              ! skip in next loop
      74             :        nt1 = 1
      75       68186 :        DO n = 1,atoms%ntype
      76       66338 :           fac = 1./atoms%neq(n)
      77       66338 :           nt2 = nt1 + atoms%neq(n) - 1
      78      331690 :           DO l = 0,3
      79      265352 :              suma = CMPLX(0.,0.)
      80      265352 :              sumb = CMPLX(0.,0.)
      81      265352 :              ll1 = l* (l+1)
      82     1326760 :              DO m = -l,l
      83     1061408 :                 lm = ll1 + m
      84     1326760 :                 IF ( .NOT.l_mcd ) THEN
      85     3947904 :                    DO natom = nt1,nt2
      86     1459248 :                       suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
      87     2488656 :                       sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
      88             :                    ENDDO
      89             :                 ELSE
      90             :                    suma = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.) 
      91             :                    sumb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
      92       96000 :                    DO natom = nt1,nt2
      93       32000 :                       suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
      94       32000 :                       sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
      95       32000 :                       sumab= sumab + eigVecCoeffs%acof(i,lm,natom,jsp) *CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
      96       64000 :                       sumba= sumba + eigVecCoeffs%bcof(i,lm,natom,jsp) *CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
      97             :                    ENDDO
      98      352000 :                    DO icore = 1, mcd%ncore(n)
      99      992000 :                       DO ipol = 1, 3
     100      960000 :                          index = 3*(n-1) + ipol
     101             :                          mcd%mcd(index,icore,i,ikpt,jsp)=mcd%mcd(index,icore,i,ikpt,jsp) + fac*(&
     102             :                               suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1)  +&
     103             :                               sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2)  +&
     104             :                               sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1)  +&
     105     1280000 :                               sumba* CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,2)  ) 
     106             :                       ENDDO
     107             :                    ENDDO
     108             :                 ENDIF     ! end MCD
     109             :              ENDDO
     110      331690 :              dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
     111             :           ENDDO
     112       89718 :           nt1 = nt1 + atoms%neq(n)
     113             :        ENDDO
     114             :     ENDDO
     115             :     !
     116             :     !--->    perform Brillouin zone integration and summation over the
     117             :     !--->    bands in order to determine the energy parameters for each
     118             :     !--->    atom and angular momentum
     119             :     !
     120       16632 :     DO l = 0,3
     121       18424 :        DO n = 1,atoms%ntype
     122      210872 :           DO i = (skip_t+1),noccbd
     123      186904 :              regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i)
     124      203480 :              regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)
     125             :           ENDDO
     126             :        ENDDO
     127             :     ENDDO
     128             : 
     129             :     !---> initialize qlo
     130             : 
     131        5992 :     qlo(:,:,:,:) = 0.0
     132        5992 :     qaclo(:,:,:) = 0.0
     133        5992 :     qbclo(:,:,:) = 0.0
     134             : 
     135             :     !---> density for each local orbital and occupied state
     136             : 
     137             :     natom = 0
     138       10136 :     DO ntyp = 1,atoms%ntype
     139        6756 :        DO nn = 1,atoms%neq(ntyp)
     140        4908 :           natom = natom + 1
     141       12456 :           DO lo = 1,atoms%nlo(ntyp)
     142        3404 :              l = atoms%llo(lo,ntyp)
     143        3404 :              ll1 = l* (l+1)
     144       10344 :              DO m = -l,l
     145        6940 :                 lm = ll1 + m
     146      254938 :                 DO i = 1,ne
     147             :                    qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +REAL(&
     148             :                         eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))+&
     149      244594 :                         eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp)) )
     150             :                    qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + REAL(&
     151             :                         eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))+&
     152      251534 :                         eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp)) )
     153             :                 ENDDO
     154             :              ENDDO
     155       21696 :              DO lop = 1,atoms%nlo(ntyp)
     156       10096 :                 IF (atoms%llo(lop,ntyp).EQ.l) THEN
     157       17284 :                    DO m = -l,l
     158      499532 :                       DO i = 1,ne
     159             :                          qlo(i,lop,lo,ntyp) = qlo(i,lop,lo,ntyp) +  REAL(&
     160      251534 :                               CONJG(eigVecCoeffs%ccof(m,i,lop,natom,jsp))*eigVecCoeffs%ccof(m,i,lo,natom,jsp))
     161             :                       ENDDO
     162             :                    ENDDO
     163             :                 ENDIF
     164             :              ENDDO
     165             :           ENDDO
     166             :        ENDDO
     167             :     ENDDO
     168             : 
     169             :     !---> perform brillouin zone integration and sum over bands
     170             : 
     171       10136 :     DO ntyp = 1,atoms%ntype
     172        7932 :        DO lo = 1,atoms%nlo(ntyp)
     173        1940 :           l = atoms%llo(lo,ntyp)
     174             :           ! llo > 3 used for unoccupied states only
     175        1940 :           IF( l .GT. 3 ) CYCLE
     176      138156 :           DO i = 1,ne
     177             :              dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) )* (&
     178        1940 :                   qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp)     )
     179             :           END DO
     180       13612 :           DO lop = 1,atoms%nlo(ntyp)
     181        1940 :              IF (atoms%llo(lop,ntyp).EQ.l) THEN
     182      138156 :                 DO i = 1,ne
     183       68108 :                    regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
     184       68108 :                    regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
     185             :                    dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) ) *&
     186       70048 :                         qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
     187             :                 ENDDO
     188             :              ENDIF
     189             :           ENDDO
     190             :        END DO
     191             :     END DO
     192             : 
     193        1848 :   END SUBROUTINE eparas
     194             : END MODULE m_eparas

Generated by: LCOV version 1.13