int_nv.F90 4.11 KB
Newer Older
1 2 3 4 5 6
MODULE m_intnv
  !     ************************************************
  !     calculates the integral of charge density 
  !     and potential in the unit cell
  !     ************************************************
CONTAINS
7 8
  SUBROUTINE int_nv(ispin,stars,vacuum,atoms,sphhar,&
       cell,sym,input,oneD,vpot,den,RESULT)
9 10 11 12 13 14

    USE m_intgr, ONLY : intgr3,intgz0
    USE m_types
    IMPLICIT NONE
    !     ..
    !     .. Scalar Arguments ..
15 16
    REAL  RESULT
    INTEGER,INTENT(IN)        :: ispin
17 18 19 20 21 22 23 24
    TYPE(t_stars),INTENT(IN)  :: stars
    TYPE(t_vacuum),INTENT(IN) :: vacuum
    TYPE(t_atoms),INTENT(IN)  :: atoms
    TYPE(t_sphhar),INTENT(IN) :: sphhar
    TYPE(t_cell),INTENT(IN)   :: cell
    TYPE(t_sym),INTENT(IN)    :: sym
    TYPE(t_input),INTENT(IN)  :: input
    TYPE(t_oneD),INTENT(IN)   :: oneD
25
    TYPE(t_potden),INTENT(IN) :: vpot,den
26

27
  
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
    !     ..
    !     .. Local Scalars ..
    REAL dpdot,facv,tis,tmt,tvac,tvact
    INTEGER i,ip,ivac,j,k2,lh,n,npz,nat
    LOGICAL tail
    !     ..
    !     .. Local Arrays ..
    REAL dpj(atoms%jmtd),dpz(vacuum%nmzd)
    !     ..
    !     ..
    !     -----> CALCULATE DENSITY-POTENTIAL INTEGRALS
    !
    !  ******************* INTERSTITIAL REGION**********************
    !
    !  -> warping has been moved to vgen and visxc resp. ...gustav
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
44
    tis = cell%omtil * REAL( DOT_PRODUCT(vpot%pw_w(:stars%ng3,ispin),den%pw(:stars%ng3,ispin)))
45 46

    WRITE (6,FMT=8020) tis
Matthias Redies's avatar
Matthias Redies committed
47
8020 FORMAT (/,10x,'interstitial :',t40,ES20.10)
48 49 50 51 52 53 54 55 56 57

    RESULT = RESULT + tis
    !
    !   ******************M.T. SPHERES*******************
    !
    tmt = 0.
    nat = 1
    DO n = 1,atoms%ntype
       DO lh = 0,sphhar%nlh(atoms%ntypsy(nat))
          DO j = 1,atoms%jri(n)
58
             dpj(j) = den%mt(j,lh,n,ispin)*vpot%mt(j,lh,n,ispin)
59 60 61 62 63 64 65
          ENDDO
          CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),dpdot)
          tmt = tmt + dpdot*atoms%neq(n)
       ENDDO
       nat = nat + atoms%neq(n)
    ENDDO
    WRITE (6,FMT=8030) tmt
Matthias Redies's avatar
Matthias Redies committed
66
8030 FORMAT (/,10x,'muffin tin spheres :',t40,ES20.10)
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
    RESULT = RESULT + tmt
    !
    ! *********** VACUUM REGION**************
    !
    IF (input%film .AND. .NOT.oneD%odi%d1) THEN
       npz = vacuum%nmz + 1
       tail = .TRUE.
       IF (sym%zrfs .OR. sym%invs) THEN
          facv = 2.0
       ELSE
          facv = 1.0
       END IF
       tvac = 0.
       tvact = 0.
       !     set array dpz to zero
       dpz=0.0
       DO ivac = 1,vacuum%nvac
          DO ip = 1,vacuum%nmz
85
             dpz(npz-ip) = den%vacz(ip,ivac,ispin)*vpot%vacz(ip,ivac,ispin)
86 87 88 89 90
             !         --->  WARPING REGION
          ENDDO
          DO  k2 = 2,stars%ng2
             DO  ip = 1,vacuum%nmzxy
                dpz(npz-ip) = dpz(npz-ip) +&
91 92
                     &                       stars%nstr2(k2)*den%vacxy(ip,k2-1,ivac,ispin)*&
                     &                          CONJG(vpot%vacxy(ip,k2-1,ivac,ispin))
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
             ENDDO
          ENDDO
          CALL intgz0(dpz,vacuum%delz,vacuum%nmz,tvac,tail)
          tvact = tvact + cell%area*tvac*facv
       ENDDO
       WRITE (6,FMT=8040) tvact
8040   FORMAT (/,10x,'vacuum :',t40,f20.10)
       RESULT = RESULT + tvact
    ELSEIF (oneD%odi%d1) THEN
       !-odim
       npz = vacuum%nmz +1
       tail = .TRUE.
       tvac = 0.
       tvact = 0.
       !     set array dpz to zero
       dpz=0.0
       DO  ip = 1,vacuum%nmz
          dpz(npz-ip) = (cell%z1+vacuum%delz*(ip-1))*&
111
               &                    den%vacz(ip,vacuum%nvac,ispin)*vpot%vacz(ip,vacuum%nvac,ispin)
112 113 114 115 116 117
          !          ---> WARPING REGION
       ENDDO
       DO  k2 = 2,oneD%odi%nq2
          DO  ip = 1,vacuum%nmzxy
             dpz(npz-ip) = dpz(npz-ip)+&
                  &             (cell%z1+vacuum%delz*(ip-1))*&
118 119
                  &             den%vacxy(ip,k2-1,vacuum%nvac,ispin)*&
                  &             CONJG(vpot%vacxy(ip,k2-1,vacuum%nvac,ispin))
120 121 122 123 124 125 126 127 128 129 130 131 132
          ENDDO
       ENDDO

       CALL intgz0(dpz,vacuum%delz,vacuum%nmz,tvac,tail)
       tvact = tvact + cell%area*tvac
       WRITE (6,FMT=8041) tvact
8041   FORMAT (/,10x,'vacuum :',t40,f20.10)
       RESULT = RESULT + tvact
       !+odim
    END IF

  END SUBROUTINE int_nv
END MODULE m_intnv