visxc.f90 3.95 KB
Newer Older
1 2 3 4 5 6
      MODULE m_visxc
!     ******************************************************
!     subroutine generates the exchange-correlation potential
!     in the interstitial region    c.l.fu
!     ******************************************************
      CONTAINS
7
      SUBROUTINE visxc(ifftd,stars,noco,xcpot,input,den,vxc,vx,exc)
8 9 10 11 12 13 14 15 16 17 18 19 20 21

!     ******************************************************
!     instead of visxcor.f: the different exchange-correlation 
!     potentials defined through the key icorr are called through 
!     the driver subroutine vxcall.f,for the energy density - excall
!     subroutines vectorized
!     in case of TOTAL = .TRUE. calculates the ex.-corr. energy density
!     ** r.pentcheva 08.05.96
!     ********************************************************************
      USE m_types
      USE m_fft3d
      IMPLICIT NONE
!     ..
!     .. Scalar Arguments ..
Gregor Michalicek's avatar
Gregor Michalicek committed
22 23 24
      INTEGER, INTENT (IN)         :: ifftd
      TYPE(t_stars),INTENT(IN)     :: stars
      TYPE(t_noco),INTENT(IN)      :: noco
25
      CLASS(t_xcpot),INTENT(IN)    :: xcpot
Gregor Michalicek's avatar
Gregor Michalicek committed
26 27
      TYPE(t_input),INTENT(IN)     :: input
      TYPE(t_potden),INTENT(IN)    :: den
28 29
      TYPE(t_potden),INTENT(INOUT) :: vxc,exc,vx
      
30 31 32 33 34 35 36
           
!     ..
!     .. Local Scalars ..
      INTEGER i,k,js,nt
      REAL    chdens,magmom
!     ..
!     .. Local Arrays
37
      COMPLEX fg3(stars%ng3)
38
      REAL, ALLOCATABLE :: mx(:),my(:)
39
      REAL, ALLOCATABLE :: e_xc(:),vcon(:),v_xc(:,:),v_x(:,:)
40 41 42 43
      REAL, ALLOCATABLE :: af3(:,:),bf3(:)
!
!     ---> allocate arrays
!
44
      ALLOCATE ( e_xc(0:ifftd-1),vcon(0:ifftd-1),v_xc(0:ifftd-1,input%jspins),&
45
           af3(0:ifftd-1,input%jspins),bf3(0:ifftd-1) )
46

47
      ALLOCATE( v_x(0:ifftd-1,input%jspins) )
48 49 50 51
!
!     transform charge density to real space
!
      DO js = 1,input%jspins
52
         CALL fft3d(af3(0,js),bf3, den%pw(1,js), stars,+1)
53 54 55 56 57 58
      ENDDO

      IF (noco%l_noco) THEN 

        ALLOCATE (mx(0:ifftd-1),my(0:ifftd-1))

59
        CALL fft3d(mx,my, den%pw(:,3), stars,+1)
60
        DO i=0,27*stars%mx1*stars%mx2*stars%mx3-1
61 62 63 64 65 66 67 68 69 70 71 72 73 74
          chdens= (af3(i,1)+af3(i,2))/2.
          magmom= mx(i)**2 + my(i)**2 + ((af3(i,1)-af3(i,2))/2.)**2
          magmom= SQRT(magmom)
          af3(i,1)= chdens + magmom
          af3(i,2)= chdens - magmom
        END DO

        DEALLOCATE (mx,my)

      END IF

!
!     calculate the exchange-correlation potential in  real space
!
75 76
      nt=ifftd
      CALL xcpot%get_vxc(input%jspins,af3,v_xc,v_x)
77 78 79 80 81
      
!
!     ---> back fft to g space and add to coulomb potential for file nrp
!

82
      IF (ALLOCATED(exc%pw_w)) THEN
83 84 85 86

         DO js = 1,input%jspins

           DO i=0,ifftd-1
87
             vcon(i)=stars%ufft(i)*v_xc(i,js)
88 89
             bf3(i)=0.0
           ENDDO
90
           CALL fft3d(vcon,bf3, fg3, stars,-1)
91 92 93
           fg3=fg3*stars%nstr

           DO k = 1,stars%ng3
94
              vxc%pw_w(k,js) = vxc%pw_w(k,js) + fg3(k)
95 96 97
           ENDDO   

           DO i=0,ifftd-1
98
             vcon(i)=stars%ufft(i)*v_x(i,js)
99 100
             bf3(i)=0.0
           ENDDO
101
           CALL fft3d(vcon,bf3, fg3, stars,-1)
102 103 104
           fg3=fg3*stars%nstr

           DO k = 1,stars%ng3
105
              vx%pw_w(k,js) = vx%pw_w(k,js) + fg3(k)
106 107 108 109 110
           ENDDO   

         ENDDO
!
!     calculate the ex.-cor energy density in real space
111 112
         !
         CALL xcpot%get_exc(input%jspins,af3,e_xc)
113 114

         DO i=0,ifftd-1
115
           vcon(i)=stars%ufft(i)*e_xc(i)
116 117 118 119 120
           bf3(i)=0.0
         ENDDO
!
!         ---> back fft to g space
!
121
         CALL fft3d(vcon,bf3, exc%pw_w(:,1), stars,-1)
122
         exc%pw_w(:,1)=exc%pw_w(:,1)*stars%nstr
123 124 125 126 127
!
      END IF ! input%total

      DO js = 1,input%jspins
         bf3(0:ifftd-1)=0.0
128
         CALL fft3d(v_xc(0,js),bf3, fg3, stars,-1)
129
         DO k = 1,stars%ng3
130
            vxc%pw(k,js) = vxc%pw(k,js) + fg3(k)
131 132
         ENDDO
         
133
         CALL fft3d(v_x(0,js),bf3, fg3, stars,-1)
134
         DO k = 1,stars%ng3
135
            vx%pw(k,js) = vx%pw(k,js) + fg3(k)
136 137 138 139 140 141
         ENDDO      
      
      ENDDO

      END SUBROUTINE visxc
      END MODULE m_visxc