hf_setup.F90 12.6 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 37 38 39 40


    TYPE(t_zmat),ALLOCATABLE :: zmat(:)
    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 77 78 79 80
          nrec1 = kpts%nkpt*(jsp-1) + nk
          zmat(nk)%nbasfcn=dimension%nbasfcn
          zmat(nk)%nbands=dimension%neigd2
          if (l_real) THEN
             ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2))
Daniel Wortmann's avatar
Daniel Wortmann committed
81
             ALLOCATE(zmat(nk)%z_c(0,0))
Daniel Wortmann's avatar
Daniel Wortmann committed
82 83
          else
             ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
Daniel Wortmann's avatar
Daniel Wortmann committed
84
             ALLOCATE(zmat(nk)%z_r(0,0))
Daniel Wortmann's avatar
Daniel Wortmann committed
85
          endif
Daniel Wortmann's avatar
Daniel Wortmann committed
86 87
          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))
88
     
Daniel Wortmann's avatar
Daniel Wortmann committed
89
       END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
90 91 92 93 94 95 96 97 98 99
       !Allocate further space
       DO nk=kpts%nkpt+1,kpts%nkptf
          zmat(nk)%nbasfcn=dimension%nbasfcn
          zmat(nk)%nbands=dimension%neigd2
          if (l_real) THEN
             ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2))
          else
             ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
          endif
       Enddo
Daniel Wortmann's avatar
Daniel Wortmann committed
100 101 102 103 104 105 106 107 108 109 110 111 112
       !
       !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
113
       hybrid%nobd      = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
114
       DO nk=1 ,kpts%nkpt
115
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
116 117
          ! jump to next k-point if this k-point is not treated at this process
          IF ( skip_kpt(nk) ) CYCLE
118
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
119 120
          DO i=1,hybrid%ne_eig(nk)
             DO j=i+1,hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
121 122
                IF( ABS(eig_irr(i,nk)-eig_irr(j,nk)) < 1E-07) THEN !0.015
                   degenerat(i,nk) = degenerat(i,nk) + 1
123
                END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
124 125 126
             END DO
          END DO

Daniel Wortmann's avatar
Daniel Wortmann committed
127
          DO i=1,hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
128 129 130 131 132 133 134
             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
135 136
          hybrid%nbands(nk)=hybrid%bands1
          IF(hybrid%nbands(nk).GT.hybrid%ne_eig(nk)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
137
             IF ( mpi%irank == 0 ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
138
                WRITE(*,*) ' maximum for hybrid%nbands is', hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
139
                WRITE(*,*) ' increase energy window to obtain enough eigenvalues'
Daniel Wortmann's avatar
Daniel Wortmann committed
140
                WRITE(*,*) ' set hybrid%nbands equal to hybrid%ne_eig'
Daniel Wortmann's avatar
Daniel Wortmann committed
141
             END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
142
             hybrid%nbands(nk)=hybrid%ne_eig(nk)
Daniel Wortmann's avatar
Daniel Wortmann committed
143
          END IF
144

Daniel Wortmann's avatar
Daniel Wortmann committed
145 146 147
          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
148 149 150
                EXIT
             END IF
          END DO
151

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

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

163
#if defined(CPP_MPI)&&defined(CPP_NEVER)
Daniel Wortmann's avatar
Daniel Wortmann committed
164 165 166 167 168
       ! 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
169
             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
170 171 172 173
          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
174
                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
175 176 177 178 179 180
                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
181 182
       ! 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
183
       rcvreqd = 0
184

185
#endif
186

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

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

Daniel Wortmann's avatar
Daniel Wortmann committed
217 218 219 220 221 222 223 224 225 226 227 228 229 230
       !
       ! 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
231
       ALLOCATE(hybdat%pntgptd(3))
Daniel Wortmann's avatar
Daniel Wortmann committed
232 233
       hybdat%pntgptd = 0
       DO nk = 1,kpts%nkptf
Daniel Wortmann's avatar
Daniel Wortmann committed
234
          CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,sym%zrfs)
Daniel Wortmann's avatar
Daniel Wortmann committed
235 236 237 238 239 240 241 242 243 244
          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
Daniel Wortmann's avatar
Daniel Wortmann committed
245
          CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,sym%zrfs)
Daniel Wortmann's avatar
Daniel Wortmann committed
246 247 248 249 250 251 252 253 254 255 256 257 258 259
          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
260 261
       ALLOCATE(hybdat%nindxp1(0:hybrid%maxlcutm1,atoms%ntype))
       hybdat%nindxp1 = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
       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
277 278
                               hybdat%nindxp1(l,itype)    = hybdat%nindxp1(l,itype) + 1
                               n                  = hybdat%nindxp1(l,itype)
Daniel Wortmann's avatar
Daniel Wortmann committed
279 280 281 282 283 284 285
                               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
286
                            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
287
                         END DO
288 289

                      END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
290 291 292 293 294 295 296 297 298 299 300 301 302 303
                   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
Daniel Wortmann's avatar
Daniel Wortmann committed
304 305
          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))
          hybrid%nobd(nk) = COUNT(results%w_iks(:hybrid%ne_eig(nk),nk,jsp) > 0.0 )
Daniel Wortmann's avatar
Daniel Wortmann committed
306
       END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
307
    
Daniel Wortmann's avatar
Daniel Wortmann committed
308
       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
309
       hybrid%nbands    = MIN( hybrid%bands1, DIMENSION%neigd )
Daniel Wortmann's avatar
Daniel Wortmann committed
310 311

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