LCOV - code coverage report
Current view: top level - vgen - vvacxc.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 57 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_vvacxc
       2             :   !     ********************************************************************
       3             :   !     calculates 2-dim star function coefficients of exchange-correlation*
       4             :   !     potential in the vacuum regions  and adds them to the corresponding*
       5             :   !     coeffs of the coulomb potential            c.l.fu, r.podloucky     *
       6             :   !     ********************************************************************
       7             : CONTAINS
       8           0 :   SUBROUTINE vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,den,vxc,exc)
       9             : 
      10             :     !     ********************************************************************
      11             :     !     instead of vvacxcor.f: the different exchange-correlation 
      12             :     !     potentials defined through the key icorr are called through 
      13             :     !     the driver subroutine vxcall.f, subroutines vectorized
      14             :     !     in case of TOTAL = .TRUE. calculates the ex.-corr. energy
      15             :     !     density through the driver subroutine excall.f
      16             :     !     ** r.pentcheva 08.05.96
      17             :     !     ********************************************************************
      18             : 
      19             :     USE m_fft2d
      20             :     USE m_types
      21             :     IMPLICIT NONE
      22             :     CLASS(t_xcpot),INTENT(IN)     :: xcpot
      23             :     TYPE(t_input),INTENT(IN)     :: input
      24             :     TYPE(t_vacuum),INTENT(IN)    :: vacuum
      25             :     TYPE(t_noco),INTENT(IN)      :: noco
      26             :     TYPE(t_stars),INTENT(IN)     :: stars
      27             :     TYPE(t_potden),INTENT(IN)    :: den
      28             :     TYPE(t_potden),INTENT(INOUT) :: vxc,exc
      29             :     !     ..
      30             :     !     .. Scalar Arguments ..
      31             :     INTEGER, INTENT (IN) :: ifftd2
      32             :     !     ..
      33             :  
      34             :     !     ..
      35             :     !     .. Local Scalars ..
      36             :     INTEGER :: k,js,nt,irec2,nmzdiff,ivac,ip,i 
      37             :     REAL    :: rhti
      38             :     REAL    :: chdens,magmom 
      39             :     !     ..
      40             :     !     .. Local Arrays ..
      41           0 :     COMPLEX :: fgxy(stars%ng2-1)
      42           0 :     REAL    :: af2(0:ifftd2-1,input%jspins),bf2(0:ifftd2-1),fgz
      43           0 :     REAL,ALLOCATABLE :: mx(:),my(:) 
      44             :     !     warping region
      45           0 :     REAL    :: v_xc(0:ifftd2-1,input%jspins),e_xc(0:ifftd2-1)
      46           0 :     REAL    :: v_x (0:ifftd2-1,input%jspins)
      47             :     !     beyond warping region
      48           0 :     REAL    :: vxcz(vacuum%nmzd,input%jspins)
      49           0 :     REAL    :: vxz (vacuum%nmzd,input%jspins)
      50             : 
      51           0 :     IF (noco%l_noco) THEN
      52           0 :        ALLOCATE (mx(0:ifftd2-1),my(0:ifftd2-1)) 
      53             :     END IF
      54             : 
      55           0 :     nt = ifftd2
      56           0 :     rhti = 0.
      57             :     !
      58             :     !     the charge density in vacuum is expanded in 2-dim stars on a mesh 
      59             :     !     in z-direction . The G||.ne.zero-components expand from 1 to nmzxy
      60             :     !     the G||.eq.zero-components expand from 1 to nmz
      61             :     !     first we calculate vxc in the warping region
      62             :     !
      63           0 :     DO  ivac = 1,vacuum%nvac
      64           0 :        DO ip = 1,vacuum%nmzxy
      65             :           !
      66             :           !         transform charge density to real space: 2-dim FFT
      67             :           !
      68           0 :           DO js = 1,input%jspins
      69             :              CALL fft2d(stars, af2(0,js),bf2, den%vacz(ip,ivac,js),rhti,&
      70           0 :                   den%vacxy(ip,1,ivac,js), vacuum%nmzxyd,+1)
      71             :           END DO
      72             : 
      73           0 :           IF (noco%l_noco) THEN 
      74             : 
      75             :              CALL fft2d(stars, mx,my, den%vacz(ip,ivac,3),den%vacz(ip,ivac,4),&
      76           0 :                                  den%vacxy(ip,1,ivac,3), vacuum%nmzxyd,1)
      77           0 :              DO i=0,9*stars%mx1*stars%mx2-1 
      78           0 :                 chdens= (af2(i,1)+af2(i,2))/2.  
      79           0 :                 magmom= mx(i)**2 + my(i)**2 + ((af2(i,1)-af2(i,2))/2.)**2 
      80           0 :                 magmom= SQRT(magmom) 
      81           0 :                 af2(i,1)= chdens + magmom 
      82           0 :                 af2(i,2)= chdens - magmom
      83             :              END DO
      84             : 
      85             :           END IF
      86             :           !
      87             :           !         calculate the exchange-correlation potential in  real space
      88             :           !
      89           0 :           CALL xcpot%get_vxc(input%jspins,af2,v_xc,v_x)
      90             : 
      91           0 :           DO  js = 1,input%jspins
      92             :              !
      93             :              !            ----> 2-d back fft to g space
      94             :              !
      95           0 :              bf2=0.0
      96           0 :              CALL fft2d(stars, v_xc(0,js),bf2, fgz,rhti,fgxy, 1,-1)
      97             :              !
      98             :              !            ----> and add vxc to coulomb potential
      99             :              !            the G||.eq.zero component is added to vz
     100             :              !
     101           0 :              vxc%vacz(ip,ivac,js) = fgz + vxc%vacz(ip,ivac,js)
     102             :              !
     103             :              !            the G||.ne.zero components are added to vxc%vacxy
     104             :              !
     105           0 :              DO irec2 = 1,stars%ng2-1
     106           0 :                 vxc%vacxy(ip,irec2,ivac,js) = vxc%vacxy(ip,irec2,ivac,js) + fgxy(irec2)
     107             :              ENDDO
     108             :           ENDDO
     109             :           !
     110             :           !i        calculate the exchange-correlation energy density in  real space
     111             :           !
     112           0 :           IF (ALLOCATED(exc%vacz)) THEN
     113           0 :              call xcpot%get_exc(input%jspins,af2,e_xc, mt_call=.False.)
     114             :              !
     115             :              !     ----> 2-d back fft to g space
     116             :              !
     117           0 :              bf2=0.0
     118           0 :              CALL fft2d(stars, e_xc,bf2, exc%vacz(ip,ivac,1),rhti,exc%vacxy(ip,1,ivac,1), vacuum%nmzxyd,-1)
     119             :           ENDIF
     120             : 
     121             :        ENDDO
     122             :        !
     123             :        !        calculate vxc for z now beyond warping region 
     124             :        !
     125           0 :        nmzdiff = vacuum%nmz - vacuum%nmzxy
     126             : 
     127           0 :        DO k=1,nmzdiff
     128             : 
     129           0 :           DO js=1,input%jspins
     130           0 :              af2(k-1,js) = den%vacz(vacuum%nmzxy+k,ivac,js)
     131             :           ENDDO
     132             : 
     133           0 :           IF (noco%l_noco) THEN
     134             : 
     135           0 :              mx(0)= den%vacz(vacuum%nmzxy+k,ivac,3)
     136           0 :              my(0)= den%vacz(vacuum%nmzxy+k,ivac,4)
     137           0 :              chdens= (af2(k-1,1)+af2(k-1,2))/2.
     138           0 :              magmom= mx(0)**2 + my(0)**2 + ((af2(k-1,1)-af2(k-1,2))/2.)**2
     139           0 :              magmom= SQRT(magmom)
     140           0 :              af2(k-1,1)= chdens + magmom
     141           0 :              af2(k-1,2)= chdens - magmom
     142             : 
     143             :           END IF
     144             : 
     145             :        ENDDO
     146             : 
     147           0 :        CALL xcpot%get_vxc(input%jspins,af2(0:nmzdiff-1,:),vxz,vxcz)
     148             :       
     149             :        !+gu
     150           0 :        DO  js=1,input%jspins
     151           0 :           DO k=vacuum%nmzxy+1,vacuum%nmz
     152           0 :              vxc%vacz(k,ivac,js) = vxc%vacz(k,ivac,js) + vxcz(k-vacuum%nmzxy,js)
     153             :           ENDDO
     154             :        ENDDO
     155             :        !
     156           0 :        WRITE (6,FMT=8020) ivac, (vxc%vacz(vacuum%nmz,ivac,js),js=1,input%jspins)
     157             : 8020   FORMAT (/,5x,'vacuum zero for vacuum',i3,' = ',2f10.5)
     158             :        !
     159             :        !        calculate the ex.-corr. energy density now beyond warping region
     160             :        !
     161           0 :        IF (ALLOCATED(exc%vacz)) THEN
     162           0 :           CALL xcpot%get_exc(input%jspins,af2(0:nmzdiff-1,:),exc%vacz(vacuum%nmzxy+1:,ivac,1), mt_call=.False.)
     163             :        END IF
     164             :     ENDDO
     165           0 :     IF (noco%l_noco) THEN 
     166           0 :        DEALLOCATE (mx,my)
     167             :     END IF
     168             : 
     169           0 :   END SUBROUTINE vvacxc
     170             : END MODULE m_vvacxc

Generated by: LCOV version 1.13