LCOV - code coverage report
Current view: top level - xc-pot - vxcepbe.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 7 7 100.0 %
Date: 2024-03-28 04:22:06 Functions: 1 1 100.0 %

          Line data    Source code
       1             : MODULE m_vxcepbe
       2             : !.....-----------------------------------------------------------------
       3             : !.....epbe(easy_pbe) exchange-correlation potential in hartree.
       4             : !     vxcepbe - easypbe
       5             : !.....------------------------------------------------------------------
       6             : CONTAINS
       7        1932 :    SUBROUTINE vxcepbe( &
       8             :       xcpot,jspins,mirm,irmx, &
       9        1932 :       rh,agr,agru,agrd, &
      10        1932 :       g2ru,g2rd,gggr,gggru,gggrd, &
      11        1932 :       vx,vxc)
      12             : 
      13             :       Use m_easypbe
      14             :       USE m_types_xcpot_data
      15             : 
      16             :       IMPLICIT NONE
      17             : 
      18             : ! .. Arguments ..
      19             :       TYPE(t_xcpot_data),INTENT(IN)::xcpot
      20             :       INTEGER, INTENT (IN) :: irmx,jspins,mirm
      21             :       REAL,    INTENT (IN) :: rh(mirm,jspins)
      22             :       REAL,    INTENT (IN) :: agr(mirm),agru(mirm),agrd(mirm)
      23             :       REAL,    INTENT (IN) :: g2ru(mirm),g2rd(mirm),gggr(mirm)
      24             :       REAL,    INTENT (IN) :: gggru(mirm),gggrd(mirm)
      25             :       REAL,    INTENT (OUT):: vx(mirm,jspins),vxc(mirm,jspins)
      26             : 
      27             : ! .. local variables ..
      28             :       INTEGER :: lcor,lpot,i
      29             :       REAL :: ro,rou,rod,xcptu,xcptd, &
      30             :               vxlu,vclu,vxld,vcld,vxgu,vcgu,vxgd,vcgd
      31             :       REAL :: up,agrup,delgrup,uplap,dn,agrdn,delgrdn,dnlap, &
      32             :               agrt,delgrt, &
      33             :               exlsd,vxuplsd,vxdnlsd,eclsd,vcuplsd,vcdnlsd, &
      34             :               expbe,vxuppbe,vxdnpbe,ecpbe,vcuppbe,vcdnpbe, &
      35             :               vxupsr,vxdnsr
      36             : 
      37             :       REAL, PARAMETER :: sml = 1.e-14
      38             :       REAL, PARAMETER :: smlc = 2.01e-14
      39             :       LOGICAL         :: l_hse
      40        1932 :       l_hse=(xcpot%is_hse)
      41             : 
      42             : !$OMP PARALLEL DO DEFAULT(none) &
      43             : !$OMP SHARED(irmx,rh,xcpot,jspins,l_hse) &
      44             : !$OMP SHARED(agr,agru,agrd,g2ru,g2rd,gggr,gggru,gggrd) &
      45             : !$OMP SHARED(vx,vxc) &
      46             : !$OMP PRIVATE(rou,rod,vxlu,vclu,vxld,vcld,vxgu,vcgu,vxgd,vcgd) &
      47             : !$OMP PRIVATE(vxupsr,vxdnsr,ro,lcor,lpot,up,agrup,delgrup) &
      48             : !$OMP PRIVATE(uplap,dn,agrdn,delgrdn,dnlap,agrt,delgrt) &
      49             : !$OMP PRIVATE(exlsd,vxuplsd,vxdnlsd,eclsd,vcuplsd,vcdnlsd) &
      50             : !$OMP PRIVATE(expbe,vxuppbe,vxdnpbe,ecpbe,vcuppbe,vcdnpbe) &
      51        1932 : !$OMP PRIVATE(xcptu,xcptd)
      52             :       DO i = 1,irmx
      53             : 
      54             :          IF (jspins == 1) THEN
      55             :             rou=rh(i,1)/2
      56             :             rou=max(rou,sml)
      57             :             rod=rou
      58             :          ELSE
      59             :             rou=rh(i,1)
      60             :             rod=rh(i,jspins)
      61             :             rou=max(rou,sml)
      62             :             rod=max(rod,sml)
      63             :          ENDIF
      64             : 
      65             :          !.....
      66             :          !       vxlu,vxld,vxgu,vxgd: exchange potential in ry.(local,grad),
      67             :          !c        (up,dw).
      68             :          !       vclu,vcld,vcgu,vcgd: correl. potential in ry.(local,grad),
      69             :          !c        (up,dw).
      70             :          !       all later in hartree.
      71             :          !.....
      72             :          vxlu   = 0.0e0
      73             :          vclu   = 0.0e0
      74             :          vxld   = 0.0e0
      75             :          vcld   = 0.0e0
      76             :          vxgu   = 0.0e0
      77             :          vcgu   = 0.0e0
      78             :          vxgd   = 0.0e0
      79             :          vcgd   = 0.0e0
      80             :          vxupsr = 0.0e0
      81             :          vxdnsr = 0.0e0
      82             : 
      83             :          !.....
      84             :          ro=rou+rod
      85             : 
      86             :          IF (ro > smlc) THEN
      87             : 
      88             :             lcor    = 1
      89             :             lpot    = 1
      90             :             up      = rou
      91             :             agrup   = agru(i)
      92             :             delgrup = gggru(i)
      93             :             uplap   = g2ru(i)
      94             :             dn      = rod
      95             :             agrdn   = agrd(i)
      96             :             delgrdn = gggrd(i)
      97             :             dnlap   = g2rd(i)
      98             :             agrt    = agr(i)
      99             :             delgrt  = gggr(i)
     100             : 
     101             :             CALL easypbe(xcpot, &
     102             :                          up,agrup,delgrup,uplap,dn,agrdn,delgrdn,dnlap, &
     103             :                          agrt,delgrt,lcor,lpot, &
     104             :                          exlsd,vxuplsd,vxdnlsd,eclsd,vcuplsd,vcdnlsd, &
     105             :                          expbe,vxuppbe,vxdnpbe,ecpbe,vcuppbe,vcdnpbe, &
     106             :                          vxupsr,vxdnsr)
     107             : 
     108             :             vxlu=vxuplsd
     109             :             vclu=vcuplsd
     110             :             vxgu=vxuppbe-vxuplsd
     111             :             vcgu=vcuppbe-vcuplsd
     112             : 
     113             :             vxld=vxdnlsd
     114             :             vcld=vcdnlsd
     115             :             vxgd=vxdnpbe-vxdnlsd
     116             :             vcgd=vcdnpbe-vcdnlsd
     117             : 
     118             :          END IF ! ro > smlc
     119             : 
     120             :          xcptu = vxlu + vclu + vxgu + vcgu
     121             :          xcptd = vxld + vcld + vxgd + vcgd
     122             : 
     123             :          IF (l_hse)then
     124             :             vx(i,1)       = vxupsr * 2
     125             :             vx(i,jspins)  = vxdnsr * 2
     126             :          ELSE
     127             :             vx(i,1)       = (vxlu + vxgu)*2
     128             :             vx(i,jspins)  = (vxld + vxgd)*2
     129             :          END IF
     130             : 
     131             :          vxc(i,1)      = xcptu*2    ! transform to Ry, will be converted
     132             :          vxc(i,jspins) = xcptd*2    ! back to htr in calling routine
     133             : 
     134             :       END DO
     135             : !$OMP END PARALLEL DO
     136             : 
     137        1932 :    END SUBROUTINE vxcepbe
     138             : END MODULE m_vxcepbe

Generated by: LCOV version 1.14