hf_setup.F90 12.7 KB
Newer Older
1

Daniel Wortmann's avatar
Daniel Wortmann committed
2
MODULE m_hf_setup
Daniel Wortmann's avatar
Daniel Wortmann committed
3
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
4
  SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,results,jsp,eig_id_hf,&
Daniel Wortmann's avatar
Daniel Wortmann committed
5
       hybdat,irank2,it,l_real,vr0,eig_irr) 
Daniel Wortmann's avatar
Daniel Wortmann committed
6 7 8 9 10 11 12 13
    USE m_types
    USE m_eig66_io
    USE m_util
    USE m_checkolap
    USE m_read_core
    USE m_gen_wavf
    IMPLICIT NONE
    TYPE(t_hybrid),INTENT(INOUT):: hybrid
14
    TYPE(t_kpts),INTENT(IN)     :: kpts
Daniel Wortmann's avatar
Daniel Wortmann committed
15
    TYPE(t_dimension),INTENT(IN):: DIMENSION
16 17 18 19 20 21 22
    TYPE(t_atoms),INTENT(IN)    :: atoms
    TYPE(t_mpi),INTENT(IN)      :: mpi
    TYPE(t_noco),INTENT(IN)     :: noco
    TYPE(t_cell),INTENT(IN)     :: cell
    TYPE(t_oneD),INTENT(IN)     :: oneD
    TYPE(t_input),INTENT(IN)    :: input
    TYPE(t_sym),INTENT(IN)      :: sym
Daniel Wortmann's avatar
Daniel Wortmann committed
23
    TYPE(t_results),INTENT(INOUT):: results
24
    INTEGER,INTENT(IN)          :: irank2(:),it
Daniel Wortmann's avatar
Daniel Wortmann committed
25

26 27
    INTEGER,INTENT(IN)          :: jsp,eig_id_hf
    REAL, INTENT(IN)            :: vr0(:,:,:)
Daniel Wortmann's avatar
Daniel Wortmann committed
28 29
    LOGICAL,INTENT(IN)          :: l_real
    TYPE(t_hybdat),INTENT(INOUT):: hybdat
Daniel Wortmann's avatar
Daniel Wortmann committed
30 31
    REAL,ALLOCATABLE,INTENT(OUT):: eig_irr(:,:)
 
32

33
    INTEGER :: ok,nk,nrec1,i,j,ll,l1,l2,ng,itype,n,l,n1,n2,nn
Daniel Wortmann's avatar
Daniel Wortmann committed
34 35


36
    TYPE(t_mat),ALLOCATABLE :: zmat(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
37 38 39 40
    REAL,    ALLOCATABLE    ::  basprod(:)
    REAL                    ::  el_eig(0:atoms%lmaxd,atoms%ntype), ello_eig(atoms%nlod,atoms%ntype),bk(3)
    INTEGER                 ::  degenerat(DIMENSION%neigd2+1,kpts%nkpt)
    TYPE(t_lapw)            :: lapw
Daniel Wortmann's avatar
Daniel Wortmann committed
41
  
42 43
    LOGICAL :: skip_kpt(kpts%nkpt)
    INTEGER :: g(3)
44 45 46 47 48 49 50 51

#if defined(CPP_MPI)&&defined(CPP_NEVER)
    INTEGER :: sndreqd, rcvreqd, rcvreq(kpts%nkpt)
    INTEGER(KIND=MPI_ADDRESS_KIND) :: addr
    INTEGER :: ierr(3)
    INCLUDE 'mpif.h'
#endif

Daniel Wortmann's avatar
Daniel Wortmann committed
52 53
    skip_kpt=.FALSE.

54
    IF( hybrid%l_calhf ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
55
       !
56
       !             preparations for HF and hybrid functional calculation
Daniel Wortmann's avatar
Daniel Wortmann committed
57
       !
58
       CALL timestart("gen_bz and gen_wavf")
Daniel Wortmann's avatar
Daniel Wortmann committed
59

Daniel Wortmann's avatar
Daniel Wortmann committed
60
       ALLOCATE(zmat(kpts%nkptf),stat=ok)
Daniel Wortmann's avatar
Daniel Wortmann committed
61 62
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation z_c'
       ALLOCATE ( eig_irr(DIMENSION%neigd2,kpts%nkpt)      ,stat=ok )
Daniel Wortmann's avatar
Daniel Wortmann committed
63
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation eig_irr'
64
       ALLOCATE ( hybdat%kveclo_eig(atoms%nlotot,kpts%nkpt)  ,stat=ok )
Daniel Wortmann's avatar
Daniel Wortmann committed
65
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation hybdat%kveclo_eig'
66 67
       eig_irr = 0 ; hybdat%kveclo_eig = 0

Daniel Wortmann's avatar
Daniel Wortmann committed
68 69 70

       zmat(:)%l_real=l_real
      ! Reading the eig file
Daniel Wortmann's avatar
Daniel Wortmann committed
71
       DO nk = 1,kpts%nkpt
72
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
73 74
          ! jump to next k-point if this process is not present in communicator
          IF ( skip_kpt(nk) ) CYCLE
75
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
76
          nrec1 = kpts%nkpt*(jsp-1) + nk
77 78
          zmat(nk)%matsize1=dimension%nbasfcn
          zmat(nk)%matsize2=dimension%neigd2
79
          IF (l_real) THEN
80 81
             ALLOCATE(zmat(nk)%data_r(dimension%nbasfcn,dimension%neigd2))
             ALLOCATE(zmat(nk)%data_c(0,0))
Daniel Wortmann's avatar
Daniel Wortmann committed
82
          else
83 84
             ALLOCATE(zmat(nk)%data_c(dimension%nbasfcn,dimension%neigd2))
             ALLOCATE(zmat(nk)%data_r(0,0))
85 86 87 88
          ENDIF
          CALL judft_error("TODO,hs_setup")
          !CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybrid%ne_eig(nk),eig=eig_irr(:,nk), w_iks=results%w_iks(:,nk,jsp),&!kveclo=hybdat%kveclo_eig(:,nk),
          !     zmat=zmat(nk))
89
     
Daniel Wortmann's avatar
Daniel Wortmann committed
90
       END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
91 92
       !Allocate further space
       DO nk=kpts%nkpt+1,kpts%nkptf
93 94
          zmat(nk)%matsize1=dimension%nbasfcn
          zmat(nk)%matsize2=dimension%neigd2
Daniel Wortmann's avatar
Daniel Wortmann committed
95
          if (l_real) THEN
96
             ALLOCATE(zmat(nk)%data_r(dimension%nbasfcn,dimension%neigd2))
Daniel Wortmann's avatar
Daniel Wortmann committed
97
          else
98
             ALLOCATE(zmat(nk)%data_c(dimension%nbasfcn,dimension%neigd2))
Daniel Wortmann's avatar
Daniel Wortmann committed
99 100
          endif
       Enddo
Daniel Wortmann's avatar
Daniel Wortmann committed
101 102 103 104 105 106 107 108 109 110 111 112 113
       !
       !determine degenerate states at each k-point
       !
       ! degenerat(i) =1  band i  is not degenerat ,
       ! degenerat(i) =j  band i  has j-1 degenart states ( i, i+1, ..., i+j)
       ! degenerat(i) =0  band i  is  degenerat, but is not the lowest band
       !                  of the group of degenerate states
       IF ( mpi%irank == 0 ) THEN
          WRITE(6,*)
          WRITE(6,'(A)') "   k-point      |   number of occupied&
               &bands  |   maximal number of bands"
       END IF
       degenerat = 1
Daniel Wortmann's avatar
Daniel Wortmann committed
114
       hybrid%nobd      = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
115
       DO nk=1 ,kpts%nkpt
116
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
117 118
          ! jump to next k-point if this k-point is not treated at this process
          IF ( skip_kpt(nk) ) CYCLE
119
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
120 121
          DO i=1,hybrid%ne_eig(nk)
             DO j=i+1,hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
122 123
                IF( ABS(eig_irr(i,nk)-eig_irr(j,nk)) < 1E-07) THEN !0.015
                   degenerat(i,nk) = degenerat(i,nk) + 1
124
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
125 126 127
             END DO
          END DO

Daniel Wortmann's avatar
Daniel Wortmann committed
128
          DO i=1,hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
129 130 131 132 133 134 135
             IF( degenerat(i,nk) .NE. 1 .OR. degenerat(i,nk) .NE. 0 ) &
                  degenerat(i+1:i+degenerat(i,nk)-1,nk) = 0
          END DO


          ! set the size of the exchange matrix in the space of the wavefunctions

Daniel Wortmann's avatar
Daniel Wortmann committed
136 137
          hybrid%nbands(nk)=hybrid%bands1
          IF(hybrid%nbands(nk).GT.hybrid%ne_eig(nk)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
138
             IF ( mpi%irank == 0 ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
139
                WRITE(*,*) ' maximum for hybrid%nbands is', hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
140
                WRITE(*,*) ' increase energy window to obtain enough eigenvalues'
Daniel Wortmann's avatar
Daniel Wortmann committed
141
                WRITE(*,*) ' set hybrid%nbands equal to hybrid%ne_eig'
Daniel Wortmann's avatar
Daniel Wortmann committed
142
             END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
143
             hybrid%nbands(nk)=hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
144
          END IF
145

Daniel Wortmann's avatar
Daniel Wortmann committed
146 147 148
          DO i = hybrid%nbands(nk)-1,1,-1
             IF( (degenerat(i,nk) .GE. 1) .AND. (degenerat(i,nk)+i-1 .NE. hybrid%nbands(nk) ) ) THEN
                hybrid%nbands(nk) = i + degenerat(i,nk) - 1
Daniel Wortmann's avatar
Daniel Wortmann committed
149 150 151
                EXIT
             END IF
          END DO
152

Daniel Wortmann's avatar
Daniel Wortmann committed
153 154
          DO i = 1,hybrid%ne_eig(nk)
             IF(results%w_iks(i,nk,jsp) .GT. 0d0 ) hybrid%nobd(nk) = hybrid%nobd(nk) + 1
155

Daniel Wortmann's avatar
Daniel Wortmann committed
156
          END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
157
          IF (hybrid%nobd(nk)>hybrid%nbands(nk)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
158
             CALL judft_warn("More occupied bands than total no of bands!?")
Daniel Wortmann's avatar
Daniel Wortmann committed
159
             hybrid%nbands(nk)=hybrid%nobd(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
160
          ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
161
          PRINT *,"bands:",nk, hybrid%nobd(nk),hybrid%nbands(nk),hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
162
       END DO
163

164
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
165 166 167 168 169
       ! send results for occupied bands to all processes
       sndreqd = 0 ; rcvreqd = 0
       DO nk = 1,kpts%nkpt
          IF ( skip_kpt(nk) ) THEN
             rcvreqd = rcvreqd + 1
Daniel Wortmann's avatar
Daniel Wortmann committed
170
             CALL MPI_IRECV(hybrid%nobd(nk),1,MPI_INTEGER4, MPI_ANY_SOURCE,TAG_SNDRCV_HYBDAT%NOBD+nk, mpi,rcvreq(rcvreqd),ierr(1))
Daniel Wortmann's avatar
Daniel Wortmann committed
171 172 173 174
          ELSE
             i = MOD( mpi%irank + isize2(nk), mpi%isize )
             DO WHILE ( i < mpi%irank-irank2(nk) .OR. i >= mpi%irank-irank2(nk)+isize2(nk) )
                sndreqd = sndreqd + 1
Daniel Wortmann's avatar
Daniel Wortmann committed
175
                CALL MPI_ISSEND(hybrid%nobd(nk),1,MPI_INTEGER4,i, TAG_SNDRCV_HYBDAT%NOBD+nk,mpi, sndreq(sndreqd),ierr(1) )
Daniel Wortmann's avatar
Daniel Wortmann committed
176 177 178 179 180 181
                i = MOD( i + isize2(nk), mpi%isize )
             END DO
          END IF
       END DO
       CALL MPI_WAITALL( rcvreqd, rcvreq, MPI_STATUSES_IGNORE, ierr(1) )
       ! Necessary to avoid compiler optimization
Daniel Wortmann's avatar
Daniel Wortmann committed
182 183
       ! Compiler does not know that hybrid%nobd is modified in mpi_waitall
       CALL MPI_GET_ADDRESS( hybrid%nobd, addr, ierr(1) )
Daniel Wortmann's avatar
Daniel Wortmann committed
184
       rcvreqd = 0
185

186
#endif
187

Daniel Wortmann's avatar
Daniel Wortmann committed
188
       ! spread hybrid%nobd from IBZ to whole BZ
Daniel Wortmann's avatar
Daniel Wortmann committed
189 190
       DO nk = 1,kpts%nkptf
          i       = kpts%bkp(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
191
          hybrid%nobd(nk)= hybrid%nobd(i)
Daniel Wortmann's avatar
Daniel Wortmann committed
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
       END DO

       !
       ! generate eigenvectors z and MT coefficients from the previous iteration
       ! at all k-points
       !
       CALL gen_wavf(&
            &                 kpts%nkpt,kpts,it,sym,&
            &                 atoms,el_eig,&
            &                 ello_eig,cell,DIMENSION,&
            &                 hybrid,vr0,&
            &                 hybdat,&
            &                 noco,oneD,mpi,irank2,&
            &                 input,jsp,&
            &                 zmat)

       ! generate core wave functions (-> core1/2(jmtd,hybdat%nindxc,0:lmaxc,ntype) )
       CALL corewf(atoms,jsp,input,DIMENSION,vr0,&
            &                    hybdat%lmaxcd,hybdat%maxindxc,mpi,&
            &                    hybdat%lmaxc,hybdat%nindxc,hybdat%core1,hybdat%core2,hybdat%eig_c)
212

213
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
214 215
       ! wait until all files are written in gen_wavf
       CALL MPI_BARRIER(mpi%mpi_comm,ierr)
216
#endif
217

Daniel Wortmann's avatar
Daniel Wortmann committed
218 219 220 221 222 223 224 225 226 227 228 229 230 231
       !
       ! check olap between core-basis/core-valence/basis-basis
       !
       CALL checkolap(atoms,hybdat,hybrid,&
            &                      kpts%nkpt,kpts,&
            &                      DIMENSION,mpi,irank2,skip_kpt,&
            &                      input,sym,&
            &                      noco,cell,lapw,jsp)

       !
       ! set up pointer pntgpt
       !

       ! setup dimension of pntgpt
Daniel Wortmann's avatar
Daniel Wortmann committed
232
       ALLOCATE(hybdat%pntgptd(3))
Daniel Wortmann's avatar
Daniel Wortmann committed
233 234
       hybdat%pntgptd = 0
       DO nk = 1,kpts%nkptf
235
          CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,sym%zrfs)
Daniel Wortmann's avatar
Daniel Wortmann committed
236 237 238 239 240 241 242 243 244 245
          hybdat%pntgptd(1) = MAXVAL( (/ ( ABS(lapw%k1(i,jsp)),i=1,lapw%nv(jsp)), hybdat%pntgptd(1) /) )
          hybdat%pntgptd(2) = MAXVAL( (/ ( ABS(lapw%k2(i,jsp)),i=1,lapw%nv(jsp)), hybdat%pntgptd(2) /) )
          hybdat%pntgptd(3) = MAXVAL( (/ ( ABS(lapw%k3(i,jsp)),i=1,lapw%nv(jsp)), hybdat%pntgptd(3) /) )
       END DO

       ALLOCATE( hybdat%pntgpt(-hybdat%pntgptd(1):hybdat%pntgptd(1), -hybdat%pntgptd(2):hybdat%pntgptd(2),&
            &                         -hybdat%pntgptd(3):hybdat%pntgptd(3),kpts%nkptf),stat=ok )
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation pntgpt'
       hybdat%pntgpt = 0
       DO nk = 1,kpts%nkptf
246
          CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,sym%zrfs)
Daniel Wortmann's avatar
Daniel Wortmann committed
247 248 249 250 251 252 253 254 255 256 257 258 259 260
          DO i = 1,lapw%nv(jsp)
             g = (/ lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp) /)
             hybdat%pntgpt(g(1),g(2),g(3),nk) = i
          END DO
       END DO

       ALLOCATE ( basprod(atoms%jmtd),stat=ok )
       IF( ok .NE. 0 )STOP 'eigen_hf: failure allocation basprod'
       ALLOCATE ( hybdat%prodm(hybrid%maxindxm1,hybrid%maxindxp1,0:hybrid%maxlcutm1,atoms%ntype), stat= ok )
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation hybdat%prodm'
       ALLOCATE ( hybdat%prod(hybrid%maxindxp1,0:hybrid%maxlcutm1,atoms%ntype),stat= ok )
       IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation hybdat%prod'
       basprod = 0 ; hybdat%prodm = 0 ; hybdat%prod%l1 = 0 ; hybdat%prod%l2 = 0
       hybdat%prod%n1 = 0 ; hybdat%prod%n2 = 0
261 262
       ALLOCATE(hybdat%nindxp1(0:hybrid%maxlcutm1,atoms%ntype))
       hybdat%nindxp1 = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277
       DO itype = 1,atoms%ntype
          ng = atoms%jri(itype)
          DO l2 = 0,MIN(atoms%lmax(itype),hybrid%lcutwf(itype))
             ll = l2
             DO l1 = 0,ll
                IF(ABS(l1-l2).LE.hybrid%lcutm1(itype)) THEN
                   DO n2 = 1,hybrid%nindx(l2,itype)
                      nn = hybrid%nindx(l1,itype)
                      IF(l1.EQ.l2) nn = n2
                      DO n1 = 1,nn
                         ! Calculate all basis-function hybdat%products to obtain
                         ! the overlaps with the hybdat%product-basis functions (hybdat%prodm)
                         basprod(:ng) = ( hybdat%bas1(:ng,n1,l1,itype)*hybdat%bas1(:ng,n2,l2,itype) +hybdat%bas2(:ng,n1,l1,itype)*hybdat%bas2(:ng,n2,l2,itype)) / atoms%rmsh(:ng,itype)
                         DO l = ABS(l1-l2),MIN(hybrid%lcutm1(itype),l1+l2)
                            IF(MOD(l1+l2+l,2).EQ.0) THEN
278 279
                               hybdat%nindxp1(l,itype)    = hybdat%nindxp1(l,itype) + 1
                               n                  = hybdat%nindxp1(l,itype)
Daniel Wortmann's avatar
Daniel Wortmann committed
280 281 282 283 284 285 286
                               hybdat%prod(n,l,itype)%l1 = l1
                               hybdat%prod(n,l,itype)%l2 = l2
                               hybdat%prod(n,l,itype)%n1 = n1
                               hybdat%prod(n,l,itype)%n2 = n2
                               DO i = 1,hybrid%nindxm1(l,itype)
                                  hybdat%prodm(i,n,l,itype) = intgrf(basprod(:ng)*hybrid%basm1(:ng,i,l,itype), atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,hybdat%gridf)
                               END DO
287
                            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
288
                         END DO
289 290

                      END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
291 292 293 294 295 296 297 298 299 300 301 302 303 304
                   END DO
                END IF
             END DO
          END DO
       END DO
       DEALLOCATE(basprod)
       CALL timestop("gen_bz and gen_wavf")


    ELSE IF (hybrid%l_hybrid ) THEN ! hybrid%l_calhf is false

       ! Reading the eig file
       !DO nk = n_start,kpts%nkpt,n_stride
       DO nk = 1,kpts%nkpt,1
305 306
          CALL judft_error("TODO,hs_setup")
!          CALL read_eig(eig_id_hf,nk,jsp,el=el_eig, ello=ello_eig,neig=hybrid%ne_eig(nk),w_iks=results%w_iks(:,nk,jsp))
Daniel Wortmann's avatar
Daniel Wortmann committed
307
          hybrid%nobd(nk) = COUNT(results%w_iks(:hybrid%ne_eig(nk),nk,jsp) > 0.0 )
Daniel Wortmann's avatar
Daniel Wortmann committed
308
       END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
309
    
Daniel Wortmann's avatar
Daniel Wortmann committed
310
       hybrid%maxlmindx = MAXVAL((/ ( SUM( (/ (hybrid%nindx(l,itype)*(2*l+1), l=0,atoms%lmax(itype)) /) ),itype=1,atoms%ntype) /) )
Daniel Wortmann's avatar
Daniel Wortmann committed
311
       hybrid%nbands    = MIN( hybrid%bands1, DIMENSION%neigd )
Daniel Wortmann's avatar
Daniel Wortmann committed
312 313

    ENDIF ! hybrid%l_calhf
Daniel Wortmann's avatar
Daniel Wortmann committed
314 315
  END SUBROUTINE hf_setup
END MODULE m_hf_setup