excepbe.f90 2.89 KB
Newer Older
Matthias Redies's avatar
Matthias Redies committed
1
MODULE m_excepbe
Matthias Redies's avatar
Matthias Redies committed
2 3 4 5
!.....-----------------------------------------------------------------
!.....epbe(easy_pbe) exchange-correlation energy density  in hartree.
!     excepbe - easypbe
!.....------------------------------------------------------------------
Matthias Redies's avatar
Matthias Redies committed
6 7 8 9 10 11
CONTAINS
   SUBROUTINE excepbe( &
      xcpot,jspins,mirm,irmx, &
      rh,agr,agru,agrd, &
      g2ru,g2rd,gggr,gggru,gggrd, &
      exc)
Matthias Redies's avatar
Matthias Redies committed
12

Matthias Redies's avatar
Matthias Redies committed
13 14
      USE m_easypbe
      USE m_types_xcpot_data
Matthias Redies's avatar
Matthias Redies committed
15

Matthias Redies's avatar
Matthias Redies committed
16
      IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
17 18

! .. Arguments ..
Matthias Redies's avatar
Matthias Redies committed
19 20 21 22 23 24 25
      TYPE(t_xcpot_data),INTENT(IN)::xcpot
      INTEGER, INTENT (IN) :: irmx,jspins,mirm
      REAL,    INTENT (IN) :: rh(mirm,jspins)
      REAL,    INTENT (IN) :: agr(mirm),agru(mirm),agrd(mirm)
      REAL,    INTENT (IN) :: g2ru(mirm),g2rd(mirm),gggr(mirm)
      REAL,    INTENT (IN) :: gggru(mirm),gggrd(mirm)
      REAL,    INTENT (OUT) :: exc(mirm)
Matthias Redies's avatar
Matthias Redies committed
26 27

! .. local variables ..
Matthias Redies's avatar
Matthias Redies committed
28 29 30 31 32 33 34
      INTEGER :: lcor,lpot,i
      REAL :: ro,rou,rod,xedl,cedl,xedg,cedg,xced
      REAL :: up,agrup,delgrup,uplap,dn,agrdn,delgrdn,dnlap, &
              agrt,delgrt, &
              exlsd,vxuplsd,vxdnlsd,eclsd,vcuplsd,vcdnlsd, &
              expbe,vxuppbe,vxdnpbe,ecpbe,vcuppbe,vcdnpbe, &
              vxupsr,vxdnsr
Matthias Redies's avatar
Matthias Redies committed
35

Matthias Redies's avatar
Matthias Redies committed
36 37
      REAL, PARAMETER :: sml = 1.e-14
      REAL, PARAMETER :: smlc = 2.01e-14
Matthias Redies's avatar
Matthias Redies committed
38

Matthias Redies's avatar
Matthias Redies committed
39 40 41 42 43
!$OMP parallel do default(private) &
!$OMP SHARED(xcpot,jspins,mirm,irmx) &
!$OMP SHARED(rh,agr,agru,agrd) &
!$OMP SHARED(g2ru,g2rd,gggr,gggru,gggrd) &
!$OMP SHARED(exc)
Matthias Redies's avatar
Matthias Redies committed
44
      DO i = 1,irmx
Matthias Redies's avatar
Matthias Redies committed
45

Matthias Redies's avatar
Matthias Redies committed
46
         IF (jspins == 1) THEN
Matthias Redies's avatar
Matthias Redies committed
47 48 49
            rou=rh(i,1)/2
            rou=max(rou,sml)
            rod=rou
Matthias Redies's avatar
Matthias Redies committed
50
         ELSE
Matthias Redies's avatar
Matthias Redies committed
51 52 53 54
            rou=rh(i,1)
            rod=rh(i,jspins)
            rou=max(rou,sml)
            rod=max(rod,sml)
Matthias Redies's avatar
Matthias Redies committed
55
         ENDIF
Matthias Redies's avatar
Matthias Redies committed
56

Matthias Redies's avatar
Matthias Redies committed
57
         ro=rou+rod
Matthias Redies's avatar
Matthias Redies committed
58

Matthias Redies's avatar
Matthias Redies committed
59 60 61 62 63 64 65 66
         !.....
         !       xedl,xedg: exchange energy density (local,grad.exp.) in ry.
         !       cedl,cedg: exchange energy density (local,grad.expnd.) in ry.
         !.....
         xedl = 0.0e0
         cedl = 0.0e0
         xedg = 0.0e0
         cedg = 0.0e0
Matthias Redies's avatar
Matthias Redies committed
67

Matthias Redies's avatar
Matthias Redies committed
68
         IF (ro > smlc) THEN
Matthias Redies's avatar
Matthias Redies committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83

            lcor=1
            lpot=1
            up=rou
            agrup=agru(i)
            delgrup=gggru(i)
            uplap=g2ru(i)
            dn=rod
            agrdn=agrd(i)
            delgrdn=gggrd(i)
            dnlap=g2rd(i)
            agrt=agr(i)
            delgrt=gggr(i)

            CALL easypbe (xcpot, &
Matthias Redies's avatar
Matthias Redies committed
84 85 86 87 88
                          up,agrup,delgrup,uplap,dn,agrdn,delgrdn,dnlap, &
                          agrt,delgrt,lcor,lpot, &
                          exlsd,vxuplsd,vxdnlsd,eclsd,vcuplsd,vcdnlsd, &
                          expbe,vxuppbe,vxdnpbe,ecpbe,vcuppbe,vcdnpbe, &
                          vxupsr,vxdnsr)
Matthias Redies's avatar
Matthias Redies committed
89 90 91 92 93 94

            xedl=exlsd
            cedl=eclsd
            xedg=expbe-exlsd
            cedg=ecpbe-eclsd

Matthias Redies's avatar
Matthias Redies committed
95
         ENDIF ! ro > smlc
Matthias Redies's avatar
Matthias Redies committed
96

Matthias Redies's avatar
Matthias Redies committed
97
         xced = (xedl+cedl+xedg+cedg)
Matthias Redies's avatar
Matthias Redies committed
98

Matthias Redies's avatar
Matthias Redies committed
99
         exc(i) = xced*2  ! in ry
Matthias Redies's avatar
Matthias Redies committed
100

Matthias Redies's avatar
Matthias Redies committed
101
      ENDDO
Matthias Redies's avatar
Matthias Redies committed
102
!$OMP end parallel do
Matthias Redies's avatar
Matthias Redies committed
103 104
   END SUBROUTINE excepbe
END MODULE m_excepbe