types_hybrid.f90 7.11 KB
Newer Older
Matthias Redies's avatar
Matthias Redies committed
1
2
3
4
5
6
7
8
9
10
11
12
13
MODULE m_types_hybrid
   IMPLICIT NONE

   TYPE t_hybrid
      LOGICAL                ::  l_hybrid = .false.
      LOGICAL                ::  l_subvxc = .false.
      LOGICAL                ::  l_calhf = .false.
      LOGICAL                ::  l_addhf = .false.
      INTEGER                ::  ewaldlambda
      INTEGER                ::  lexp = 0
      INTEGER                ::  bands1 !Only read in
      INTEGER                ::  nbasp
      INTEGER                ::  maxbasm1
14
      INTEGER                ::  max_indx_p_1
Matthias Redies's avatar
Matthias Redies committed
15
      INTEGER                ::  maxlmindx
16
      INTEGER, ALLOCATABLE   ::  num_radfun_per_l(:,:)
Matthias Redies's avatar
Matthias Redies committed
17
      INTEGER, ALLOCATABLE   ::  select1(:,:)
Matthias Redies's avatar
Matthias Redies committed
18
19
      INTEGER, ALLOCATABLE   ::  lcutm1(:)
      INTEGER, ALLOCATABLE   ::  lcutwf(:)
Matthias Redies's avatar
Matthias Redies committed
20
21
      INTEGER, ALLOCATABLE   ::  map(:,:)
      INTEGER, ALLOCATABLE   ::  tvec(:,:,:)
Matthias Redies's avatar
Matthias Redies committed
22
      INTEGER, ALLOCATABLE   ::  nbasm(:)
Matthias Redies's avatar
Matthias Redies committed
23
      !REAL, ALLOCATABLE      ::  radbasfn_mt(:,:,:,:)
Matthias Redies's avatar
Matthias Redies committed
24
      COMPLEX, ALLOCATABLE   ::  d_wgn2(:,:,:,:)
25
26
27
      INTEGER, ALLOCATABLE   ::  ne_eig(:)
      INTEGER, ALLOCATABLE   ::  nbands(:)
      INTEGER, ALLOCATABLE   ::  nobd(:,:)
Matthias Redies's avatar
Matthias Redies committed
28
      REAL, ALLOCATABLE      ::  div_vv(:,:,:)
29
   CONTAINS
Matthias Redies's avatar
Matthias Redies committed
30
      procedure :: set_num_radfun_per_l => set_num_radfun_per_l_hybrid
Matthias Redies's avatar
Matthias Redies committed
31
   END TYPE t_hybrid
Matthias Redies's avatar
Matthias Redies committed
32

Matthias Redies's avatar
Matthias Redies committed
33

Matthias Redies's avatar
Matthias Redies committed
34
   TYPE t_prodtype
Matthias Redies's avatar
Matthias Redies committed
35
36
37
38
      INTEGER, ALLOCATABLE :: l1(:,:,:)
      INTEGER, ALLOCATABLE :: l2(:,:,:)
      INTEGER, ALLOCATABLE :: n1(:,:,:)
      INTEGER, ALLOCATABLE :: n2(:,:,:)
39
   contains
Matthias Redies's avatar
Matthias Redies committed
40
41
42
      procedure  :: init   => init_prodtype
      procedure  :: free   => free_prodtype
      procedure  :: set_nl => set_nl_prodtype
Matthias Redies's avatar
Matthias Redies committed
43
44
45
   END TYPE t_prodtype

   TYPE t_hybdat
Matthias Redies's avatar
Matthias Redies committed
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
      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(:,:,:,:)
      TYPE(t_PRODTYPE)       :: prod
      INTEGER, ALLOCATABLE   :: pntgptd(:)
      INTEGER, ALLOCATABLE   :: pntgpt(:,:,:,:)
      INTEGER, ALLOCATABLE   :: nindxp1(:,:)
      COMPLEX, ALLOCATABLE   ::  stepfunc(:,:,:)
Matthias Redies's avatar
Matthias Redies committed
64
65
   contains
      procedure  :: set_stepfunction => set_stepfunction
Matthias Redies's avatar
Matthias Redies committed
66
67
   END TYPE t_hybdat

Matthias Redies's avatar
Matthias Redies committed
68
contains
Matthias Redies's avatar
Matthias Redies committed
69
   subroutine set_stepfunction(hybdat, cell, atoms, g, svol)
Matthias Redies's avatar
Matthias Redies committed
70
71
72
73
74
75
76
      use m_types_setup
      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
77
      real,          INTENT(in)    :: svol
Matthias Redies's avatar
Matthias Redies committed
78
79
80
81
82
83
84
85
86
87
88
89
      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
90
                  hybdat%stepfunc(i,j,k) = stepfunction(cell, atoms, [i, j, k])/svol
Matthias Redies's avatar
Matthias Redies committed
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
               END DO
            END DO
         END DO
         call timestop("setup stepfunction")
      endif

   end subroutine set_stepfunction

   !private subroutine
   FUNCTION stepfunction(cell, atoms, g)
      USE m_types_setup
      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
115
      IF (abs(gnorm) < 1e-12) THEN
Matthias Redies's avatar
Matthias Redies committed
116
117
118
119
120
121
122
123
124
125
126
127
         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
128
               stepfunction = stepfunction - fgr*exp(-cmplx(0., tpi_const*dot_product(atoms%taual(:,icent), g)))
Matthias Redies's avatar
Matthias Redies committed
129
130
131
132
133
134
135
136
137
138
139
140
            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)

141
      gptnorm = norm2(matmul(gpt(:), bmat(:,:)))
Matthias Redies's avatar
Matthias Redies committed
142
143

   END FUNCTION gptnorm
144
145

   subroutine init_prodtype(prod, hybrid, atoms)
146
      use m_types_setup
147
148
149
150
151
152
153
      use m_judft
      implicit none
      class(t_prodtype)          :: prod
      type(t_hybrid), intent(in) :: hybrid
      type(t_atoms),  intent(in) :: atoms
      integer                    :: ok

Matthias Redies's avatar
Matthias Redies committed
154
      ALLOCATE (prod%l1(hybrid%max_indx_p_1, 0:maxval(hybrid%lcutm1), atoms%ntype), stat=ok)
155
156
157
158
159
160
161
162
163
164
165
166
167
      IF (ok /= 0) call judft_error('init_prodtype: failure allocation prod%l1')

      ALLOCATE (prod%l2, mold=prod%l1, stat=ok)
      IF (ok /= 0) call judft_error('init_prodtype: failure allocation prod%l2')

      ALLOCATE (prod%n1, mold=prod%l1, stat=ok)
      IF (ok /= 0) call judft_error('init_prodtype: failure allocation prod%n1')

      ALLOCATE (prod%n2, mold=prod%l1, stat=ok)
      IF (ok /= 0) call judft_error('init_prodtype: failure allocation prod%n2')
   end subroutine init_prodtype

   subroutine free_prodtype(prod)
168
      use m_types_setup
169
170
171
172
173
174
175
176
      implicit NONE
      class(t_prodtype)          :: prod

      IF(ALLOCATED(prod%l1)) DEALLOCATE (prod%l1)
      IF(ALLOCATED(prod%l2)) DEALLOCATE (prod%l2)
      IF(ALLOCATED(prod%n1)) DEALLOCATE (prod%n1)
      IF(ALLOCATED(prod%n2)) DEALLOCATE (prod%n2)
   end subroutine free_prodtype
Matthias Redies's avatar
Matthias Redies committed
177
178
179
180
181
182
183
184
185
186
187
188
189
190

   subroutine set_nl_prodtype(prod,n,l,itype,n1,l1,n2,l2)
      use m_types_setup
      implicit NONE
      class(t_prodtype)    :: prod
      integer, intent(in)  :: n, l, itype
      integer, intent(out) :: n1, l1, n2, l2

      l1 = prod%l1(n,l,itype) !
      l2 = prod%l2(n,l,itype) ! current basis-function product
      n1 = prod%n1(n,l,itype) ! = bas(:,n1,l1,itype)*bas(:,n2,l2,itype) = b1*b2
      n2 = prod%n2(n,l,itype) !

   end subroutine set_nl_prodtype
191
192

   subroutine set_num_radfun_per_l_hybrid(hybrid, atoms)
Matthias Redies's avatar
Matthias Redies committed
193
      use m_types_setup
194
195
196
      implicit NONE
      class(t_hybrid) :: hybrid
      type(t_atoms)   :: atoms
Matthias Redies's avatar
Matthias Redies committed
197
      integer :: itype, ilo
198
199
200
201
202
203
204
205
206
207

      ! there is always at least two: u and u_dot
      hybrid%num_radfun_per_l = 2
      DO itype = 1, atoms%ntype
         DO ilo = 1, atoms%nlo(itype)
            hybrid%num_radfun_per_l(atoms%llo(ilo, itype), itype) &
              = hybrid%num_radfun_per_l(atoms%llo(ilo, itype), itype) + 1
         END DO
      END DO
   end subroutine set_num_radfun_per_l_hybrid
Matthias Redies's avatar
Matthias Redies committed
208
END MODULE m_types_hybrid