eigen.F90 19.4 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7
MODULE m_eigen
8
  USE m_juDFT
9 10
CONTAINS
  SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
11
       sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,banddos, noco,jij, oneD,hybrid,&
Daniel Wortmann's avatar
Daniel Wortmann committed
12
       it,eig_id,results,v)
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
    !*********************************************************************
    !     sets up and solves the eigenvalue problem for a basis of lapws.
    !
    ! nv,   nvd     ... actual length & dimension of EV without LO's
    ! nmat, nbasfcn                                   including LO's
    !        g. bihlmayer '96
    !**********************************************************************
    USE m_constants, ONLY : pi_const,sfp_const
    USE m_types
    USE m_lodpot
    USE m_tlmplm
    USE m_tlmplm_store
    USE m_apws
    USE m_hsmt
    USE m_hsint
    USE m_hsvac
    USE m_od_hsvac
    USE m_usetup
31
    USE m_pot_io
32
    USE m_eigen_diag
33 34
    USE m_eigen_hf_init
    USE m_eigen_hf_setup
35 36 37 38 39
    USE m_hsfock
    USE m_subvxc
    USE m_hsefunctional
    USE m_hybridmix    , ONLY: amix_pbe0,amix_hf
    USE m_util
40
    USE m_icorrkeys
41
    USE m_eig66_io, ONLY : open_eig, write_eig, close_eig,read_eig
42
    USE m_xmlOutput
43 44 45
#ifdef CPP_MPI
    USE m_mpi_bc_pot
#endif
46 47 48 49 50

    IMPLICIT NONE
    TYPE(t_results),INTENT(INOUT):: results
    TYPE(t_xcpot),INTENT(IN)     :: xcpot
    TYPE(t_mpi),INTENT(IN)       :: mpi
51
    TYPE(t_dimension),INTENT(IN) :: DIMENSION
52
    TYPE(t_oneD),INTENT(IN)      :: oneD
53
    TYPE(t_hybrid),INTENT(INOUT) :: hybrid
54 55 56 57 58
    TYPE(t_enpara),INTENT(INOUT) :: enpara_in
    TYPE(t_obsolete),INTENT(IN)  :: obsolete
    TYPE(t_input),INTENT(IN)     :: input
    TYPE(t_vacuum),INTENT(IN)    :: vacuum
    TYPE(t_noco),INTENT(IN)      :: noco
59
    TYPE(t_banddos),INTENT(IN)   :: banddos
60
    TYPE(t_jij),INTENT(IN)       :: jij
Daniel Wortmann's avatar
Daniel Wortmann committed
61
    TYPE(t_sym),INTENT(IN)       :: sym  
62 63 64 65
    TYPE(t_stars),INTENT(IN)     :: stars
    TYPE(t_cell),INTENT(IN)      :: cell
    TYPE(t_kpts),INTENT(IN)      :: kpts
    TYPE(t_sphhar),INTENT(IN)    :: sphhar
Daniel Wortmann's avatar
Daniel Wortmann committed
66 67
    TYPE(t_atoms),INTENT(INOUT)  :: atoms!in u_setup n_u might be modified
    TYPE(t_potden),INTENT(INOUT) :: v
68 69 70 71 72
#ifdef CPP_MPI
    INCLUDE 'mpif.h'
#endif
    !     ..
    !     .. Scalar Arguments ..
73
    INTEGER,INTENT(IN) :: it
74 75 76 77 78 79
    INTEGER,INTENT(INOUT):: eig_id
    !     ..
    !-odim
    !+odim
    !     ..
    !     .. Local Scalars ..
80
    INTEGER jsp,nk,nred,ne_all,n_u_in,ne_found
Daniel Wortmann's avatar
Daniel Wortmann committed
81 82 83 84
    INTEGER ne,matsize  ,nrec,lh0
    INTEGER nspins,isp,i,j,err
    INTEGER mlotot,mlolotot
    LOGICAL l_wu,l_file,l_real,l_zref
85
    INTEGER ::eig_id_hf=-1
86
    
87 88 89 90
    !     ..
    !     .. Local Arrays ..
    INTEGER, PARAMETER :: lmaxb=3
    INTEGER, ALLOCATABLE :: matind(:,:),kveclo(:)
91
    INTEGER, ALLOCATABLE :: nv2(:)
92
    REAL,    ALLOCATABLE :: bkpt(:)
93
    REAL,    ALLOCATABLE :: eig(:)
94

95
    COMPLEX, ALLOCATABLE :: vs_mmp(:,:,:,:)
96 97 98
    TYPE(t_tlmplm)  :: td
    TYPE(t_usdus)   :: ud
    TYPE(t_lapw)    :: lapw
99
    TYPE(t_enpara)  :: enpara
100 101
    TYPE(t_zMat)    :: zMat
    TYPE(t_hamOvlp) :: hamOvlp
102
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
103
    INTEGER fh,nn,n
104 105
    INTEGER ierr(3)

Daniel Wortmann's avatar
Daniel Wortmann committed
106

107 108
    !     .. variables for HF or hybrid functional calculation ..
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
109
    TYPE(t_hybdat)          :: hybdat
110
    INTEGER                 ::  comm(kpts%nkpt),irank2(kpts%nkpt),isize2(kpts%nkpt)
111 112 113
    REAL,    ALLOCATABLE    ::  eig_irr(:,:),vr0(:,:,:)

#ifdef CPP_MPI
Daniel Wortmann's avatar
Daniel Wortmann committed
114
    INTEGER   :: sndreqd,sndreq(mpi%isize*kpts%nkpt)
115 116 117
#endif
    !
    !
118
    ! --> Allocate
119
    !
120 121 122 123 124 125
    ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,DIMENSION%jspd),nv2(DIMENSION%jspd) )
    ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),eig(DIMENSION%neigd),bkpt(3) )
    ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),ud%uds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd) )
    ALLOCATE ( ud%dus(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),ud%duds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd))
    ALLOCATE ( ud%ulos(atoms%nlod,atoms%ntype,DIMENSION%jspd),ud%dulos(atoms%nlod,atoms%ntype,DIMENSION%jspd) )
    ALLOCATE ( ud%uulon(atoms%nlod,atoms%ntype,DIMENSION%jspd),ud%dulon(atoms%nlod,atoms%ntype,DIMENSION%jspd) )
Daniel Wortmann's avatar
Daniel Wortmann committed
126 127
    ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),&
         lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) )
128 129 130 131 132
    !
    ! --> some parameters first
    !
    !     determine the total number of lo's : nlotot
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
133 134 135
    mlotot =sum(atoms%nlo)
  
    mlolotot = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
136 137
    DO nn = 1, atoms%ntype
       mlolotot = mlolotot + atoms%nlo(nn)*(atoms%nlo(nn)+1)/2
138
    ENDDO
Daniel Wortmann's avatar
Daniel Wortmann committed
139
    ALLOCATE ( kveclo(atoms%nlotot) )
140
    !     ..
Daniel Wortmann's avatar
Daniel Wortmann committed
141
    
142
    l_real=sym%invs.AND..NOT.noco%l_noco
143
    IF (noco%l_soc.AND.l_real.AND.hybrid%l_hybrid ) THEN
144
       CALL juDFT_error('hybrid functional + SOC + inv.symmetry is not tested', calledby='eigen')
145
    END IF
146

Daniel Wortmann's avatar
Daniel Wortmann committed
147
    
148 149 150 151 152
    fh = 0
    !
    ! look, if WU diagonalisation
    !
    IF (it.LT.input%isec1) THEN
153
       IF (mpi%irank.EQ.0) WRITE (6,FMT=8110) it,input%isec1
154
8110   FORMAT (' IT=',i4,'  ISEC1=',i4,' standard diagonalization')
155
       l_wu = .FALSE.
156
    ELSE
157
       IF (mpi%irank.EQ.0) WRITE (6,FMT=8120) it,input%isec1
158
8120   FORMAT (' IT=',i4,'  ISEC1=',i4,' reduced diagonalization')
159
       l_wu = .TRUE.
160 161 162 163
    END IF
    !
    ! load potential from file pottot (=unit 8)
    !
164
    ALLOCATE ( vr0(atoms%jmtd,atoms%ntype,DIMENSION%jspd) ) ; vr0 = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
165 166 167 168 169
   
    !IF (mpi%irank.EQ.0) THEN
    !   CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
    !                      v%iter,v%mt,v%pw,v%vacz,v%vacxy)
    !END IF
170 171
#ifdef CPP_MPI
    CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,&
Daniel Wortmann's avatar
Daniel Wortmann committed
172
                    v%iter,v%mt,v%pw,v%vacz,v%vacxy)
173 174
#endif

175
999 CONTINUE
Daniel Wortmann's avatar
Daniel Wortmann committed
176
    IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber      '/),(/it,v%iter/),&
177
                                                    RESHAPE((/19,13,5,5/),(/2,2/)))
178

Daniel Wortmann's avatar
Daniel Wortmann committed
179
   
180 181 182
    !
    ! set energy parameters (normally to that, what we read in)
    !
Daniel Wortmann's avatar
Daniel Wortmann committed
183 184
    CALL lodpot(mpi,atoms,sphhar,obsolete,vacuum,&
            input, v%mt,v%vacz, enpara_in, enpara)
185
    !
186
   
Daniel Wortmann's avatar
Daniel Wortmann committed
187
    CALL eigen_hf_init(hybrid,kpts,atoms,input,dimension,hybdat,irank2,isize2)
188 189 190 191

    !---> set up and solve the eigenvalue problem
    !---> loop over energy windows

Daniel Wortmann's avatar
Daniel Wortmann committed
192
!check if z-reflection trick can be used
193

194
    l_zref=(sym%zrfs.AND.(SUM(ABS(kpts%bk(3,:kpts%nkpt))).LT.1e-9).AND..NOT.noco%l_noco) 
195

Daniel Wortmann's avatar
Daniel Wortmann committed
196 197

#if ( defined(CPP_MPI))
198
    IF (mpi%n_size > 1) l_zref = .FALSE.
199
    IF ( hybrid%l_calhf ) THEN
200
       CALL judft_error("BUG parallelization in HF case must be fixed")
Daniel Wortmann's avatar
Daniel Wortmann committed
201 202
       !n_start  = 1
       !n_stride = 1
203 204
    END IF
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
205 206
    !Count number of matrix columns on this PE
    n=0
207
    DO i=1+mpi%n_rank,DIMENSION%nbasfcn,mpi%n_size
Daniel Wortmann's avatar
Daniel Wortmann committed
208
       n=n+1
209
    ENDDO
Daniel Wortmann's avatar
Daniel Wortmann committed
210
    IF (mpi%n_size>1) THEN
211
       matsize = DIMENSION%nbasfcn * n
Daniel Wortmann's avatar
Daniel Wortmann committed
212
    ELSE
213 214 215 216 217
       IF (MOD(DIMENSION%nbasfcn,2)==0 ) THEN !same formula, division by 2 different to avail int overflow
          matsize = (DIMENSION%nbasfcn+1)*(DIMENSION%nbasfcn/2)
       ELSE
          matsize = ((DIMENSION%nbasfcn+1)/2)*DIMENSION%nbasfcn
       ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
218
    ENDIF
219 220
    IF (matsize<2) CALL judft_error("Wrong size of matrix",calledby="eigen",hint="Your basis might be too large or the parallelization fail or ??")
    ne = MAX(5,DIMENSION%neigd)
Daniel Wortmann's avatar
Daniel Wortmann committed
221

222
    IF (hybrid%l_hybrid.OR.hybrid%l_calhf) THEN
223
       eig_id_hf=eig_id
224
    ENDIF
225
    eig_id=open_eig(&
226 227 228 229
         mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
         atoms%nlod,atoms%ntype,atoms%nlotot,noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,&
         mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
         nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
230
         l_orb=banddos%l_orb)
231 232

    IF (l_real) THEN
233
       ALLOCATE ( hamOvlp%a_r(matsize), stat = err )
234
    ELSE
235
       ALLOCATE ( hamOvlp%a_c(matsize), stat = err )
236
    ENDIF
237 238 239 240 241
    IF (err.NE.0) THEN
       WRITE (*,*) 'eigen: an error occured during allocation of'
       WRITE (*,*) 'the Hamilton Matrix: ',err,'  size: ',matsize
       CALL juDFT_error("eigen: Error during allocation of Hamilton" //"matrix",calledby ="eigen")
    ENDIF
242
    IF (l_real) THEN
243
       ALLOCATE ( hamOvlp%b_r(matsize), stat = err )
244
    ELSE
245
       ALLOCATE ( hamOvlp%b_c(matsize), stat = err )
246
    ENDIF
247

248 249 250 251 252
    IF (err.NE.0) THEN
       WRITE (*,*) 'eigen: an error occured during allocation of'
       WRITE (*,*) 'the overlap Matrix: ',err,'  size: ',matsize
       CALL juDFT_error("eigen: Error during allocation of overlap " //"matrix",calledby ="eigen")
    ENDIF
253 254 255 256

    hamOvlp%l_real = l_real
    hamOvlp%matsize = matsize

257
    ALLOCATE (  matind(DIMENSION%nbasfcn,2) )
258 259 260 261 262 263 264
    !
    !--->    loop over spins
    nspins = input%jspins
    IF (noco%l_noco) nspins = 1
    !
    !  ..
    !  LDA+U
265
    n_u_in=atoms%n_u
266 267
    IF ((atoms%n_u.GT.0)) THEN
       ALLOCATE( vs_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,input%jspins) )
Daniel Wortmann's avatar
Daniel Wortmann committed
268
       CALL u_setup(sym,atoms,lmaxb,sphhar,input, enpara%el0(0:,:,:),v%mt,mpi, vs_mmp,results)
269 270 271 272 273 274 275
    ELSE
       ALLOCATE( vs_mmp(-lmaxb:-lmaxb,-lmaxb:-lmaxb,1,2) )
    ENDIF
    !
    !--->    loop over k-points: each can be a separate task

    DO jsp = 1,nspins
276
       CALL eigen_HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,eig_id_hf,&
Daniel Wortmann's avatar
Daniel Wortmann committed
277
         hybdat,irank2,it,l_real,vr0)  
278 279 280 281 282 283 284

       !
       !--->       set up k-point independent t(l'm',lm) matrices
       !
       CALL timestart("tlmplm")
       err=0
       j = 1 ; IF (noco%l_noco) j = 2
285 286 287 288
       ALLOCATE(td%tuu(0:DIMENSION%lmplmd,atoms%ntype,j),stat=err)
       ALLOCATE(td%tud(0:DIMENSION%lmplmd,atoms%ntype,j),stat=err)
       ALLOCATE(td%tdd(0:DIMENSION%lmplmd,atoms%ntype,j),stat=err)
       ALLOCATE(td%tdu(0:DIMENSION%lmplmd,atoms%ntype,j),stat=err)
Daniel Wortmann's avatar
Daniel Wortmann committed
289 290 291 292
       mlotot = MAX(mlotot,1) 
       ALLOCATE(td%tdulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlotot,j),stat=err)
       ALLOCATE(td%tuulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlotot,j),stat=err)
       ALLOCATE(td%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,MAX(mlolotot,1),j), stat=err)
293
       ALLOCATE(td%ind(0:DIMENSION%lmd,0:DIMENSION%lmd,atoms%ntype,j),stat=err )
294 295 296 297 298
       IF (err.NE.0) THEN
          WRITE (*,*) 'eigen: an error occured during allocation of'
          WRITE (*,*) 'the tlmplm%tuu, tlmplm%tdd etc.: ',err,'  size: ',mlotot
          CALL juDFT_error("eigen: Error during allocation of tlmplm, tdd  etc.",calledby ="eigen")
       ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
299
       CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, v%mt(1,0,1,jsp),lh0,input, td,ud)
300
       IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,1,jsp,input%jspins)
301 302 303 304 305 306 307 308 309
       CALL timestop("tlmplm")

       !---> pk non-collinear
       !--->       call tlmplm again for the second spin direction in
       !--->       each MT, because the t-matrices are needed for both
       !--->       spins at once in hsmt
       IF (noco%l_noco) THEN
          isp = 2
          CALL timestart("tlmplm")
Daniel Wortmann's avatar
Daniel Wortmann committed
310
          CALL tlmplm(sphhar,atoms,DIMENSION,enpara,isp,isp,mpi, v%mt(1,0,1,isp),lh0,input, td,ud)
311
          IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,2,2,input%jspins)
312 313 314 315
          CALL timestop("tlmplm")
       ENDIF
       !

316
#ifdef CPP_MPI
317 318
       ! check that all sending operations are completed
       IF ( hybrid%l_calhf ) CALL MPI_WAITALL(sndreqd,sndreq,MPI_STATUSES_IGNORE,ierr)
319
#endif
320

Daniel Wortmann's avatar
Daniel Wortmann committed
321
       k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
322
#if defined(CPP_MPI)&&defined(CPP_NEVER)
323 324 325 326
          IF ( hybrid%l_calhf ) THEN
             ! jump to next k-point if this process is not present in communicator
             IF ( comm(nk) == MPI_COMM_NULL ) CYCLE
             ! allocate buffer for communication of the results
Daniel Wortmann's avatar
Daniel Wortmann committed
327
             IF ( irank2(nk) /= 0 ) CALL work_dist_reserve_buffer( hybdat%nbands(nk) )
328
          END IF
329
#endif
330 331

          nrec =  kpts%nkpt*(jsp-1) + nk
Daniel Wortmann's avatar
Daniel Wortmann committed
332
          nrec = mpi%n_size*(nrec-1) + mpi%n_rank + 1
333 334 335
          !
          !--->         set up lapw list
          !
336
          CALL timestart("Setup of LAPW")
337
          lapw%rk = 0 ; lapw%k1 = 0 ; lapw%k2 = 0 ; lapw%k3 = 0
338
          CALL apws(DIMENSION,input,noco, kpts,nk,cell,l_zref, mpi%n_size,jsp, bkpt,lapw,matind,nred)
339

340
          CALL timestop("Setup of LAPW")
341 342 343 344 345 346 347 348
          IF (noco%l_noco) THEN
             !--->         the file potmat contains the 2x2 matrix-potential in
             !--->         the interstitial region and the vacuum
             OPEN (25,FILE='potmat',FORM='unformatted', STATUS='old')
          ENDIF
          !
          !--->         set up interstitial hamiltonian and overlap matrices
          !
349
          CALL timestart("Interstitial Hamiltonian&Overlap")
Daniel Wortmann's avatar
Daniel Wortmann committed
350
          CALL hsint(input,noco,jij,stars, v%pw(:,jsp),lapw,jsp, mpi%n_size,mpi%n_rank,kpts%bk(:,nk),cell,atoms,l_real,hamOvlp)
351

352
          CALL timestop("Interstitial Hamiltonian&Overlap")
353 354 355
          !
          !--->         update with sphere terms
          !
356 357 358
          IF (.NOT.l_wu) THEN
             CALL timestart("MT Hamiltonian&Overlap")
             CALL hsmt(DIMENSION,atoms,sphhar,sym,enpara, mpi%SUB_COMM,mpi%n_size,mpi%n_rank,jsp,input,mpi,&
Daniel Wortmann's avatar
Daniel Wortmann committed
359
                  lmaxb, noco,cell, lapw, bkpt,v%mt, vs_mmp, oneD,ud, kveclo,td,l_real,hamOvlp)
360
             CALL timestop("MT Hamiltonian&Overlap")
361 362
          ENDIF
          !
363
          IF( hybrid%l_hybrid ) THEN
364

Daniel Wortmann's avatar
Daniel Wortmann committed
365 366 367
             CALL hsfock(nk,atoms,hybrid,lapw,DIMENSION,kpts,kpts%nkpt,jsp,input,hybdat,eig_irr,&
                  sym,cell,noco,results,it,maxval(hybdat%nobd),xcpot,&
                  mpi,irank2(nk),isize2(nk),comm(nk), hamovlp)
368 369 370 371

             IF ( irank2(nk) /= 0 ) CYCLE

             IF( hybrid%l_subvxc ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
372 373 374
                CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,vr0,atoms,ud,hybrid,enpara%el0,enpara%ello0,&
                     sym, atoms%nlotot,kveclo, cell,sphhar, stars, xcpot,mpi,&
                     oneD,  hamovlp)
375 376
             END IF

377
          END IF ! hybrid%l_hybrid
378 379 380
          !
          !--->         update with vacuum terms
          !
381
          CALL timestart("Vacuum Hamiltonian&Overlap")
382
          IF (input%film .AND. .NOT.oneD%odi%d1) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
383
             CALL hsvac(vacuum,stars,DIMENSION, atoms, jsp,input,v%vacxy(1,1,1,jsp),v%vacz,enpara%evac0,cell, &
Daniel Wortmann's avatar
Daniel Wortmann committed
384
                  bkpt,lapw,sym, noco,jij, mpi%n_size,mpi%n_rank,nv2,l_real,hamOvlp)
385
          ELSEIF (oneD%odi%d1) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
386
             CALL od_hsvac(vacuum,stars,DIMENSION, oneD,atoms, jsp,input,v%vacxy(1,1,1,jsp),v%vacz, &
387
                  enpara%evac0,cell, bkpt,lapw, oneD%odi%M,oneD%odi%mb,oneD%odi%m_cyl,oneD%odi%n2d, &
Daniel Wortmann's avatar
Daniel Wortmann committed
388
                  mpi%n_size,mpi%n_rank,sym,noco,jij,nv2,l_real,hamOvlp)
389
          END IF
390
          CALL timestop("Vacuum Hamiltonian&Overlap")
391 392 393 394

          IF (noco%l_noco) CLOSE (25)

          !write overlap matrix b to direct access file olap
395 396 397
          INQUIRE(file='olap',exist=l_file)
          IF (l_file) THEN
             IF (l_real) THEN
398
                OPEN(88,file='olap',form='unformatted',access='direct', recl=matsize*8)
399
                WRITE(88,rec=nrec) hamOvlp%b_r
400
                CLOSE(88)
401
             ELSE
402
                OPEN(88,file='olap',form='unformatted',access='direct', recl=matsize*16)
403
                WRITE(88,rec=nrec) hamOvlp%b_c
404
                CLOSE(88)
405 406
             ENDIF
          ENDIF
407

408
       
409
          CALL eigen_diag(jsp,eig_id,it,atoms,DIMENSION,matsize,mpi, mpi%n_rank,mpi%n_size,ne,nk,lapw,input,&
Daniel Wortmann's avatar
Daniel Wortmann committed
410
               nred,mpi%sub_comm, sym,l_zref,matind,kveclo, noco,cell,bkpt,enpara%el0,jij,l_wu,&
411
               oneD,td,ud, eig,ne_found,hamOvlp,zMat)
412
          
413 414 415 416
          !
          !--->         output results
          !
          CALL timestart("EV output")
417
          ne_all=ne_found
418 419
#if defined(CPP_MPI)
          !Collect number of all eigenvalues
Daniel Wortmann's avatar
Daniel Wortmann committed
420
          CALL MPI_ALLREDUCE(ne_found,ne_all,1,MPI_INTEGER,MPI_SUM, mpi%sub_comm,ierr)
421
          ne_all=MIN(DIMENSION%neigd,ne_all)
422 423
#endif
          !jij%eig_l = 0.0 ! need not be used, if hdf-file is present
424 425 426
          IF (.NOT.l_real) THEN
             IF (.NOT.jij%l_J) THEN
                zMat%z_c(:lapw%nmat,:ne_found) = CONJG(zMat%z_c(:lapw%nmat,:ne_found))
427
             ELSE
428
                zMat%z_c(:lapw%nmat,:ne_found) = CMPLX(0.0,0.0)
429
             ENDIF
430
          ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
431
	  zmat%nbands=ne_found
432
          CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,lapw%nv(jsp),lapw%nmat,&
433 434
                  lapw%k1(:lapw%nv(jsp),jsp),lapw%k2 (:lapw%nv(jsp),jsp),lapw%k3(:lapw%nv(jsp),jsp),&
                  bkpt, kpts%wtkpt(nk),eig(:ne_found),enpara%el0(0:,:,jsp), enpara%ello0(:,:,jsp),enpara%evac0(:,jsp),&
435
                  atoms%nlotot,kveclo,mpi%n_size,mpi%n_rank,zMat)
436
          IF (noco%l_noco) THEN
437
             CALL write_eig(eig_id, nk,2,ne_found,ne_all,lapw%nv(2),lapw%nmat,&
438
                  lapw%k1(:lapw%nv(2),2),lapw%k2 (:lapw%nv(2),2),lapw%k3(:lapw%nv(2),2),&
439
                  bkpt, kpts%wtkpt(nk),eig(:ne_found),enpara%el0(0:,:,2), enpara%ello0(:,:,2),enpara%evac0(:,2),&
440 441
                  atoms%nlotot,kveclo)
          ENDIF
442 443 444 445
#if defined(CPP_MPI)
          !RMA synchronization
          CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
446

447
#if defined(CPP_MPI)&&defined(CPP_NEVER)
448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
          IF ( hybrid%l_calhf ) THEN
             IF ( isize2(nk) == 1 ) THEN
                WRITE(*,'(a,i6,a,i6,a)') 'HF: kpt ', nk, ' was done by rank ', mpi%irank, '.'
             ELSE
                WRITE(*,'(a,i6,a,i6,a,i6,a)')&
                     'HF: kpt ', nk, ' was done by rank ', mpi%irank, ' and ', isize2(nk)-1, ' more.'
             END IF
             !                ELSE
             !                  WRITE(*,'(a,i6,a,i6,a)')        '    kpt ', nk, ' was done by rank ', irank, '.'
          END IF
          !#             else
          !                WRITE (*,*) 'pe: ',irank,' wrote ',nrec
#             endif
          CALL timestop("EV output")
          !#ifdef CPP_MPI
463
          IF (l_real) THEN
464
             DEALLOCATE ( zMat%z_r )
465
          ELSE
466
             DEALLOCATE ( zMat%z_c )
467
ENDIF
468 469 470 471 472 473 474 475 476 477 478 479 480
          !
       END DO  k_loop

       DEALLOCATE (td%tuu,td%tud,td%tdu,td%tdd)
       DEALLOCATE (td%ind,td%tuulo,td%tdulo)
       DEALLOCATE (td%tuloulo)
#ifdef CPP_NEVER
       IF ( hybrid%l_calhf ) THEN
          DEALLOCATE ( eig_irr,kveclo_eig )
       END IF
#endif
    END DO ! spin loop ends
    DEALLOCATE( vs_mmp )
481
    DEALLOCATE (matind)
482 483 484 485 486
    IF (l_real) THEN
       DEALLOCATE(hamOvlp%a_r,hamOvlp%b_r)
    ELSE
       DEALLOCATE(hamOvlp%a_c,hamOvlp%b_c)
    ENDIF
487 488 489 490 491 492
#ifdef CPP_NEVER
    IF( hybrid%l_calhf ) THEN
       DEALLOCATE( fac,sfac,gauntarr )
       DEALLOCATE( nindxc,core1,core2,nbasm,eig_c )
    END IF
#endif
493
#if defined(CPP_MPI)&&defined(CPP_NEVER)
494
    IF ( hybrid%l_calhf ) DEALLOCATE (nkpt_EIBZ)
495
#endif
496

Daniel Wortmann's avatar
Daniel Wortmann committed
497
  
498
    !     hf: write out radial potential vr0
499
    IF (hybrid%l_hybrid.OR.hybrid%l_calhf) THEN
500 501
       OPEN(unit=120,file='vr0',form='unformatted')
       DO isp=1,DIMENSION%jspd
Daniel Wortmann's avatar
Daniel Wortmann committed
502
          DO nn=1,atoms%ntype
503
             DO i=1,atoms%jmtd
Daniel Wortmann's avatar
Daniel Wortmann committed
504
                WRITE(120) vr0(i,nn,isp)
505 506 507 508 509 510 511
             END DO
          END DO
       END DO
       CLOSE(120)
    ENDIF

#ifdef CPP_MPI
512
    CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
513
#endif
514
    IF (hybrid%l_hybrid.OR.hybrid%l_calhf) CALL close_eig(eig_id_hf)
515
    atoms%n_u=n_u_in
516 517


518
    IF( input%jspins .EQ. 1 .AND. hybrid%l_hybrid ) THEN
519 520 521
       results%te_hfex%valence = 2*results%te_hfex%valence
       results%te_hfex%core    = 2*results%te_hfex%core
    END IF
522 523
    enpara_in%epara_min = MINVAL(enpara%el0)
    enpara_in%epara_min = MIN(MINVAL(enpara%ello0),enpara_in%epara_min)
524
!    enpara_in=enpara
525 526
  END SUBROUTINE eigen
END MODULE m_eigen