types_hybrid.f90 3.37 KB
Newer Older
Matthias Redies's avatar
Matthias Redies committed
1
MODULE m_types_hybinp
Matthias Redies's avatar
Matthias Redies committed
2 3
   IMPLICIT NONE

4

Matthias Redies's avatar
Matthias Redies committed
5

Matthias Redies's avatar
Matthias Redies committed
6
   TYPE t_hybdat
Matthias Redies's avatar
Matthias Redies committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
      INTEGER                :: lmaxcd, maxindxc
      INTEGER                :: maxfac
      REAL, ALLOCATABLE      :: gridf(:,:)
      INTEGER, ALLOCATABLE   :: nindxc(:,:)
      INTEGER, ALLOCATABLE   :: lmaxc(:)
      REAL, ALLOCATABLE      :: core1(:,:,:,:), core2(:,:,:,:)
      REAL, ALLOCATABLE      :: eig_c(:,:,:)
      INTEGER, ALLOCATABLE   :: kveclo_eig(:,:)
      REAL, ALLOCATABLE      :: sfac(:), fac(:)
      REAL, ALLOCATABLE      :: gauntarr(:,:,:,:,:,:)
      REAL, ALLOCATABLE      :: bas1(:,:,:,:), bas2(:,:,:,:)
      REAL, ALLOCATABLE      :: bas1_MT(:,:,:), drbas1_MT(:,:,:)
      REAL, ALLOCATABLE      :: prodm(:,:,:,:)
      INTEGER, ALLOCATABLE   :: pntgptd(:)
      INTEGER, ALLOCATABLE   :: pntgpt(:,:,:,:)
      INTEGER, ALLOCATABLE   :: nindxp1(:,:)
Matthias Redies's avatar
Matthias Redies committed
23
      COMPLEX, ALLOCATABLE   :: stepfunc(:,:,:)
Matthias Redies's avatar
Matthias Redies committed
24 25
   contains
      procedure  :: set_stepfunction => set_stepfunction
Matthias Redies's avatar
Matthias Redies committed
26 27
   END TYPE t_hybdat

Matthias Redies's avatar
Matthias Redies committed
28
contains
Matthias Redies's avatar
Matthias Redies committed
29
   subroutine set_stepfunction(hybdat, cell, atoms, g, svol)
30 31
      use m_types_cell
      use m_types_atoms
Matthias Redies's avatar
Matthias Redies committed
32 33 34 35 36 37
      use m_judft
      implicit none
      class(t_hybdat),INTENT(INOUT) :: hybdat
      type(t_cell),  INTENT(in)    :: cell
      type(t_atoms), INTENT(in)    :: atoms
      integer,       INTENT(in)    :: g(3)
Matthias Redies's avatar
Matthias Redies committed
38
      real,          INTENT(in)    :: svol
Matthias Redies's avatar
Matthias Redies committed
39 40 41 42 43 44 45 46 47 48 49 50
      integer :: i, j, k, ok

      if (.not. allocated(hybdat%stepfunc)) then
         call timestart("setup stepfunction")
         ALLOCATE (hybdat%stepfunc(-g(1):g(1), -g(2):g(2), -g(3):g(3)), stat=ok)
         IF (ok /= 0) then
            call juDFT_error('wavefproducts_inv5: error allocation stepfunc')
         endif

         DO i = -g(1), g(1)
            DO j = -g(2), g(2)
               DO k = -g(3), g(3)
Matthias Redies's avatar
cleanup  
Matthias Redies committed
51
                  hybdat%stepfunc(i,j,k) = stepfunction(cell, atoms, [i, j, k])/svol
Matthias Redies's avatar
Matthias Redies committed
52 53 54 55 56 57 58 59 60 61
               END DO
            END DO
         END DO
         call timestop("setup stepfunction")
      endif

   end subroutine set_stepfunction

   !private subroutine
   FUNCTION stepfunction(cell, atoms, g)
62 63
      USE m_types_cell
      USE m_types_atoms
Matthias Redies's avatar
Matthias Redies committed
64 65 66 67 68 69 70 71 72 73 74 75 76
      USE m_constants
      IMPLICIT NONE

      TYPE(t_cell), INTENT(IN)    :: cell
      TYPE(t_atoms), INTENT(IN)   :: atoms

      INTEGER, INTENT(IN) :: g(3)
      COMPLEX             :: stepfunction  !Is real in inversion case
      REAL                :: gnorm, gnorm3, r, fgr
      INTEGER             :: itype, ieq, icent

      gnorm = gptnorm(g, cell%bmat)
      gnorm3 = gnorm**3
Matthias Redies's avatar
Matthias Redies committed
77
      IF (abs(gnorm) < 1e-12) THEN
Matthias Redies's avatar
Matthias Redies committed
78 79 80 81 82 83 84 85 86 87 88 89
         stepfunction = 1
         DO itype = 1, atoms%ntype
            stepfunction = stepfunction - atoms%neq(itype)*atoms%volmts(itype)/cell%omtil
         END DO
      ELSE
         stepfunction = 0
         icent = 0
         DO itype = 1, atoms%ntype
            r = gnorm*atoms%rmt(itype)
            fgr = fpi_const*(sin(r) - r*cos(r))/gnorm3/cell%omtil
            DO ieq = 1, atoms%neq(itype)
               icent = icent + 1
Matthias Redies's avatar
Matthias Redies committed
90
               stepfunction = stepfunction - fgr*exp(-cmplx(0., tpi_const*dot_product(atoms%taual(:,icent), g)))
Matthias Redies's avatar
Matthias Redies committed
91 92 93 94 95 96 97 98 99 100 101 102
            ENDDO
         ENDDO
      ENDIF

   END FUNCTION stepfunction

   PURE FUNCTION gptnorm(gpt, bmat)
      IMPLICIT NONE
      REAL                :: gptnorm
      INTEGER, INTENT(IN)  :: gpt(3)
      REAL, INTENT(IN)     :: bmat(3, 3)

103
      gptnorm = norm2(matmul(gpt(:), bmat(:,:)))
Matthias Redies's avatar
Matthias Redies committed
104 105

   END FUNCTION gptnorm
106

Matthias Redies's avatar
Matthias Redies committed
107
END MODULE m_types_hybinp