fleur.F90 19 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
6
MODULE m_fleur
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
  IMPLICIT NONE
CONTAINS
  SUBROUTINE fleur_execute(mpi_comm)

    !     ***************************************************************
    !
    !     based on flapw7 (c.l.fu, m.weinert, e.wimmer):
    !     full potential linearized augmented plane wave method for thin
    !     films and superlattices (version 7 ---- general symmetry)
    !     symmetry part       ---  e.wimmer
    !     potential generator ---  c.l.fu,r.podloucky
    !     matrix elements     ---  m.weinert
    !     charge density      ---  c.l.fu
    !                                c.l.fu        1987
    !     2nd variation diagon.  --- r.-q. wu      1992
    !     forces a la Yu et al   --- r.podloucky   1995
    !     full relativistic core --- a.shick       1996
    !     broyden mixing         --- r.pentcheva   1996
    !     gga (pw91, pbe)        --- t.asada       1997
    !     local orbitals         --- p.kurz        1997
    !     automatic symmetry     --- w.hofer       1997
    !     core tails & start     --- r.abt         1998
    !     spin orbit coupling    --- a.shick,x.nie 1998
    !     non-colinear magnet.   --- p.kurz        1999
    !     one-dimensional        --- y.mokrousov   2002
    !     exchange parameters    --- m.lezaic      2004
    !
    !                       g.bihlmayer, s.bluegel 1999
    !     ***************************************************************
    !----------------------------------------
    ! this routine is the main PROGRAM

    USE m_types
    USE m_constants
    USE m_fleur_init
    USE m_optional
43
    USE m_cdn_io
44
    USE m_mixing_history
45
    USE m_qfix
46 47 48 49 50 51 52 53 54 55 56 57 58
    USE m_vgen
    USE m_writexcstuff
    USE m_vmatgen
    USE m_eigen
    USE m_eigenso
    USE m_fermie
    USE m_cdngen
    USE m_totale
    USE m_potdis
    USE m_mix
    USE m_xmlOutput
    USE m_juDFT_time
    USE m_calc_hybrid
59
    USE m_rdmft
Gregor Michalicek's avatar
Gregor Michalicek committed
60
    USE m_io_hybrid
61 62 63 64 65
    USE m_wann_optional
    USE m_wannier
    USE m_bs_comfort
    USE m_dwigner
    USE m_ylm
Matthias Redies's avatar
Matthias Redies committed
66
    USE m_metagga
67
#ifdef CPP_MPI
68
    USE m_mpi_bc_potden
69
#endif
70
    USE m_eig66_io
71
    USE m_chase_diag
72
    USE m_writeBasis
73 74
    IMPLICIT NONE

75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
    INTEGER, INTENT(IN)             :: mpi_comm

    TYPE(t_input)                   :: input
    TYPE(t_field)                   :: field, field2
    TYPE(t_dimension)               :: DIMENSION
    TYPE(t_atoms)                   :: atoms
    TYPE(t_sphhar)                  :: sphhar
    TYPE(t_cell)                    :: cell
    TYPE(t_stars)                   :: stars
    TYPE(t_sym)                     :: sym
    TYPE(t_noco)                    :: noco
    TYPE(t_vacuum)                  :: vacuum
    TYPE(t_sliceplot)               :: sliceplot
    TYPE(t_banddos)                 :: banddos
    TYPE(t_enpara)                  :: enpara
    TYPE(t_results)                 :: results
    TYPE(t_kpts)                    :: kpts
    TYPE(t_hybrid)                  :: hybrid
    TYPE(t_oneD)                    :: oneD
    TYPE(t_mpi)                     :: mpi
    TYPE(t_coreSpecInput)           :: coreSpecInput
    TYPE(t_wann)                    :: wann
    TYPE(t_potden)                  :: vTot, vx, vCoul, vTemp
Matthias Redies's avatar
Matthias Redies committed
98
    TYPE(t_potden)                  :: inDen, outDen, EnergyDen
99 100 101 102 103
    CLASS(t_xcpot),     ALLOCATABLE :: xcpot
    CLASS(t_forcetheo), ALLOCATABLE :: forcetheo

    ! local scalars
    INTEGER :: eig_id,archiveType
104
    INTEGER :: n,iter,iterHF
Daniel Wortmann's avatar
Daniel Wortmann committed
105
    LOGICAL :: l_opti,l_cont,l_qfix,l_real
106
    REAL    :: fix
107
#ifdef CPP_MPI
108
    INCLUDE 'mpif.h'
109
    INTEGER :: ierr(2)
110
#endif
Gregor Michalicek's avatar
Gregor Michalicek committed
111

112
    mpi%mpi_comm = mpi_comm
113

114
    CALL timestart("Initialization")
115
    CALL fleur_init(mpi,input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,&
Daniel Wortmann's avatar
Daniel Wortmann committed
116
                    banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann,l_opti)
117
    CALL timestop("Initialization")
Daniel Wortmann's avatar
Daniel Wortmann committed
118

119 120
    IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN
      CALL juDFT_error('Currently no preconditioner for 1D calculations', calledby = 'fleur')
121
    END IF
122

123
    IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
Daniel Wortmann's avatar
Daniel Wortmann committed
124
                              stars,input,sym,cell,sliceplot,xcpot,noco,oneD)
125 126 127

    IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN
       IF(mpi%isize.NE.1) CALL juDFT_error('No Wannier+MPI at the moment',calledby = 'fleur')
128
       CALL wann_optional(input,kpts,atoms,sym,cell,oneD,noco,wann)
129
    END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
130
  
131 132 133
    iter     = 0
    iterHF   = 0
    l_cont = (iter < input%itmax)
134
    
135 136
    IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('scfLoop')

137
    ! Initialize and load inDen density (start)
138
    CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
139 140
    archiveType = CDN_ARCHIVE_TYPE_CDN1_const
    IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
141 142
    IF(mpi%irank.EQ.0) THEN
       CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
143
                        0,results%ef,l_qfix,inDen)
144
       CALL timestart("Qfix")
145
       CALL qfix(mpi,stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix)
146 147
       CALL timestop("Qfix")
       CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
148
                         0,-1.0,results%ef,.FALSE.,inDen)
149
    END IF
150
    ! Initialize and load inDen density (end)
151

152
    ! Initialize potentials (start)
153 154 155 156
    CALL vTot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
    CALL vCoul%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
    CALL vx%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
    CALL vTemp%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
157
    ! Initialize potentials (end)
158

159
    ! Open/allocate eigenvector storage (start)
160
    l_real=sym%invs.AND..NOT.noco%l_noco
161
    eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,input%jspins,&
162 163 164
                    noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size)

#ifdef CPP_CHASE
Daniel Wortmann's avatar
Daniel Wortmann committed
165
    CALL init_chase(mpi,dimension,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco)
166
#endif
167
    ! Open/allocate eigenvector storage (end)
168

169
    scfloop:DO WHILE (l_cont)
170

171
       iter = iter + 1
172
       IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber      '/),&
173
                                                       (/iter,inden%iter/), RESHAPE((/19,13,5,5/),(/2,2/)))
Gregor Michalicek's avatar
Gregor Michalicek committed
174

175 176 177
!!$       !+t3e
!!$       IF (input%alpha.LT.10.0) THEN
!!$
178
!!$          IF (iter.GT.1) THEN
179 180 181
!!$             input%alpha = input%alpha - NINT(input%alpha)
!!$          END IF

182
       !CALL resetIterationDependentTimers()
183 184
       CALL timestart("Iteration")
       IF (mpi%irank.EQ.0) THEN
185 186
          WRITE (6,FMT=8100) iter
8100      FORMAT (/,10x,'   iter=  ',i5)
187
       ENDIF !mpi%irank.eq.0
188
       input%total = .TRUE.
189

Matthias Redies's avatar
Matthias Redies committed
190
#ifdef CPP_CHASE
191
       CALL chase_distance(results%last_distance)
Matthias Redies's avatar
Matthias Redies committed
192
#endif
193

194
#ifdef CPP_MPI
195
       CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDen)
196 197
#endif

198 199
       dimension%neigd2 = dimension%neigd
       IF (noco%l_soc) dimension%neigd2 = dimension%neigd*2
200 201

       !HF
202 203 204
       IF (hybrid%l_hybrid) THEN
          SELECT TYPE(xcpot)
          TYPE IS(t_xcpot_inbuild)
205 206
             CALL calc_hybrid(eig_id,hybrid,kpts,atoms,input,DIMENSION,mpi,noco,&
                              cell,oneD,enpara,results,sym,xcpot,vTot,iter,iterHF)
207
          END SELECT
208
          IF(hybrid%l_calhf) THEN
209
             call mixing_history_reset(mpi)
210 211
             iter = 0
          END IF
212
       ENDIF
Gregor Michalicek's avatar
Gregor Michalicek committed
213 214 215 216
       !RDMFT
       IF(input%l_rdmft) THEN
          CALL open_hybrid_io1(DIMENSION,sym%invs)
       END IF
217 218 219

       CALL reset_eig(eig_id,noco%l_soc) ! This has to be placed after the calc_hybrid call but before eigen

220 221 222 223 224 225 226 227 228 229 230 231 232 233
       !#endif

!!$             DO pc = 1, wann%nparampts
!!$                !---> gwf
!!$                IF (wann%l_sgwf.OR.wann%l_ms) THEN
!!$                   noco%qss(:) = wann%param_vec(:,pc)
!!$                   noco%alph(:) = wann%param_alpha(:,pc)
!!$                ELSE IF (wann%l_socgwf) THEN
!!$                   IF(wann%l_dim(2)) noco%phi   = tpi_const * wann%param_vec(2,pc)
!!$                   IF(wann%l_dim(3)) noco%theta = tpi_const * wann%param_vec(3,pc)
!!$                END IF
       !---< gwf

       CALL timestart("generation of potential")
234
       CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
Daniel Wortmann's avatar
Daniel Wortmann committed
235
                 cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul)
236 237
       CALL timestop("generation of potential")

238
#ifdef CPP_MPI
239
       CALL MPI_BARRIER(mpi%mpi_comm,ierr)
240 241
#endif

242
       CALL forcetheo%start(vtot,mpi%irank==0)
Daniel Wortmann's avatar
Daniel Wortmann committed
243
       forcetheoloop:DO WHILE(forcetheo%next_job(iter==input%itmax,atoms,noco))
244

Matthias Redies's avatar
Matthias Redies committed
245
          CALL timestart("gen. of hamil. and diag. (total)")
246 247
          CALL timestart("eigen")
          vTemp = vTot
248
          CALL timestart("Updating energy parameters")
249
          CALL enpara%update(mpi,atoms,vacuum,input,vToT)
250
          CALL timestop("Updating energy parameters")
Daniel Wortmann's avatar
Daniel Wortmann committed
251
          CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,DIMENSION,vacuum,input,&
252
                     cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inDen,vTemp,vx)
253 254 255
          vTot%mmpMat = vTemp%mmpMat
!!$          eig_idList(pc) = eig_id
          CALL timestop("eigen")
256 257

          ! add all contributions to total energy
258
#ifdef CPP_MPI
259
          ! send all result of local total energies to the r
260 261 262 263 264 265 266 267 268 269 270
          IF (hybrid%l_hybrid.AND.hybrid%l_calhf) THEN
             IF (mpi%irank==0) THEN
                CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%core,1,MPI_REAL8,MPI_SUM,0,mpi%mpi_comm,ierr(1))
             ELSE
                CALL MPI_Reduce(results%te_hfex%core,MPI_IN_PLACE,1,MPI_REAL8,MPI_SUM,0, mpi%mpi_comm,ierr(1))
             END IF
             IF (mpi%irank==0) THEN
                CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%valence,1,MPI_REAL8,MPI_SUM,0,mpi%mpi_comm,ierr(1))
             ELSE
                CALL MPI_Reduce(results%te_hfex%valence,MPI_IN_PLACE,1,MPI_REAL8,MPI_SUM,0, mpi%mpi_comm,ierr(1))
             END IF
271
          END IF
272 273
#endif

274 275
          ! WRITE(6,fmt='(A)') 'Starting 2nd variation ...'
          IF (noco%l_soc.AND..NOT.noco%l_noco) &
276
             CALL eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
Daniel Wortmann's avatar
Daniel Wortmann committed
277
                          sym,cell,noco,input,kpts, oneD,vTot,enpara,results)
Matthias Redies's avatar
Matthias Redies committed
278
          CALL timestop("gen. of hamil. and diag. (total)")
279 280

#ifdef CPP_MPI
281
          CALL MPI_BARRIER(mpi%mpi_comm,ierr)
282 283
#endif

284 285 286
          ! fermi level and occupancies
          IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd = 2*DIMENSION%neigd
          IF ((mpi%irank.EQ.0)) THEN
287 288
             CALL timestart("determination of fermi energy")

289
             IF (noco%l_soc.AND.(.NOT.noco%l_noco)) THEN
290
                input%zelec = input%zelec*2
Daniel Wortmann's avatar
Daniel Wortmann committed
291
                CALL fermie(eig_id,mpi,kpts,input,noco,enpara%epara_min,cell,results)
292 293 294 295
                results%seigscv = results%seigscv/2
                results%ts = results%ts/2
                input%zelec = input%zelec/2
             ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
296
                CALL fermie(eig_id,mpi,kpts,input,noco,enpara%epara_min,cell,results)
297 298
             ENDIF
             CALL timestop("determination of fermi energy")
299

300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318
!!$          !+Wannier
!!$          IF(wann%l_bs_comf)THEN
!!$             IF(pc.EQ.1) THEN
!!$                OPEN(777,file='out_eig.1')
!!$                OPEN(778,file='out_eig.2')
!!$                OPEN(779,file='out_eig.1_diag')
!!$                OPEN(780,file='out_eig.2_diag')
!!$             END IF
!!$
!!$             CALL bs_comfort(eig_id,DIMENSION,input,noco,kpts%nkpt,pc)
!!$
!!$             IF(pc.EQ.wann%nparampts)THEN
!!$                CLOSE(777)
!!$                CLOSE(778)
!!$                CLOSE(779)
!!$                CLOSE(780)
!!$             END IF
!!$          END IF
!!$          !-Wannier
319

320
          ENDIF
321
#ifdef CPP_MPI
322 323
          CALL MPI_BCAST(results%ef,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(results%w_iks,SIZE(results%w_iks),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
324 325
#endif

326
          IF (forcetheo%eval(eig_id,DIMENSION,atoms,kpts,sym,cell,noco,input,mpi,oneD,enpara,vToT,results)) THEN
327
             IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2
328 329
             CYCLE forcetheoloop
          ENDIF
330 331

          
Daniel Wortmann's avatar
Daniel Wortmann committed
332 333 334 335 336 337 338
          !+Wannier functions
          IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN
             CALL wannier(DIMENSION,mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,&
                  wann,noco,cell,enpara,banddos,sliceplot,vTot,results,&
                  (/eig_id/),(sym%invs).AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco),kpts%nkpt)
          END IF
          !-Wannier
339

340
          ! charge density generation
341
          CALL timestart("generation of new charge density (total)")
342
          CALL outDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
343
          outDen%iter = inDen%iter
344 345 346 347
          CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum, &
                      dimension,kpts,atoms,sphhar,stars,sym,&
                      enpara,cell,noco,vTot,results,oneD,coreSpecInput,&
                      archiveType,xcpot,outDen,EnergyDen)
348

Gregor Michalicek's avatar
Gregor Michalicek committed
349 350 351 352
          IF (input%l_rdmft) THEN
             SELECT TYPE(xcpot)
                TYPE IS(t_xcpot_inbuild)
                   CALL rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,dimension,&
Gregor Michalicek's avatar
Gregor Michalicek committed
353
                              sphhar,sym,field,vTot,vCoul,oneD,noco,xcpot,hybrid,results,coreSpecInput,archiveType,outDen)
Gregor Michalicek's avatar
Gregor Michalicek committed
354 355
             END SELECT
          END IF
356

357 358
          IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2

359
#ifdef CPP_MPI
360
          CALL MPI_BCAST(enpara%evac,SIZE(enpara%evac),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
361 362 363
          CALL MPI_BCAST(enpara%evac0,SIZE(enpara%evac0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(enpara%el0,SIZE(enpara%el0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
          CALL MPI_BCAST(enpara%ello0,SIZE(enpara%ello0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
364

365 366 367 368 369
          IF (noco%l_noco) THEN
             DO n= 1,atoms%ntype
                IF (noco%l_relax(n)) THEN
                   CALL MPI_BCAST(noco%alph(n),1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
                   CALL MPI_BCAST(noco%beta(n),1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
370
                ENDIF
371 372 373
             ENDDO
             IF (noco%l_constr) THEN
                CALL MPI_BCAST(noco%b_con,SIZE(noco%b_con),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
374
             ENDIF
375
          ENDIF
376
#endif
377
          CALL timestop("generation of new charge density (total)")
378

379 380
             
!!$             !----> output potential and potential difference
Daniel Wortmann's avatar
Daniel Wortmann committed
381
!!$             IF (disp) THEN
382 383 384 385
!!$                reap = .FALSE.
!!$                input%total = .FALSE.
!!$                CALL timestart("generation of potential (total)")
!!$                CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,&
Daniel Wortmann's avatar
Daniel Wortmann committed
386
!!$                     cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul)
387 388 389 390 391
!!$                CALL timestop("generation of potential (total)")
!!$
!!$                CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym)
!!$             END IF
             
392
             ! total energy
393
             CALL timestart('determination of total energy')
Daniel Wortmann's avatar
Daniel Wortmann committed
394
             CALL totale(mpi,atoms,sphhar,stars,vacuum,DIMENSION,sym,input,noco,cell,oneD,&
395
                         xcpot,hybrid,vTot,vCoul,iter,inDen,results)
396
             CALL timestop('determination of total energy')
397
          IF (hybrid%l_hybrid) CALL close_eig(eig_id)
398 399 400 401

       END DO forcetheoloop

       CALL forcetheo%postprocess()
402

403 404 405 406 407 408
       IF (input%gw.GT.0) THEN
          IF (mpi%irank.EQ.0) THEN
             CALL writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DIMENSION,&
                             results,eig_id,oneD,sphhar,stars,vacuum)
          END IF
          CALL juDFT_end("GW data written. Fleur ends.",mpi%irank)
409 410
       END IF

411
       CALL enpara%mix(mpi,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
412
       field2 = field
413 414

       ! mix input and output densities
415 416 417
       CALL mix_charge(field2,DIMENSION,mpi,(iter==input%itmax.OR.judft_was_argument("-mix_io")),&
            stars,atoms,sphhar,vacuum,input,&
            sym,cell,noco,oneD,archiveType,inDen,outDen,results)
418
       
419
       IF(mpi%irank == 0) THEN
420
         WRITE (6,FMT=8130) iter
421
8130     FORMAT (/,5x,'******* it=',i3,'  is completed********',/,/)
422
         WRITE(*,*) "Iteration:",iter," Distance:",results%last_distance
423
         CALL timestop("Iteration")
424
       END IF ! mpi%irank.EQ.0
425
          
426
#ifdef CPP_MPI
427 428
       CALL MPI_BCAST(results%last_distance,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
       CALL MPI_BARRIER(mpi%mpi_comm,ierr)
429
#endif
430 431
       CALL priv_geo_end(mpi)

432
       l_cont = .TRUE.
Gregor Michalicek's avatar
Gregor Michalicek committed
433 434 435 436 437 438 439 440
       IF (hybrid%l_hybrid) THEN
          IF(hybrid%l_calhf) THEN
             l_cont = l_cont.AND.(iterHF < input%itmax)
             l_cont = l_cont.AND.(input%mindistance<=results%last_distance)
             CALL check_time_for_next_iteration(iterHF,l_cont)
          ELSE
             l_cont = l_cont.AND.(iter < 50) ! Security stop for non-converging nested PBE calculations
          END IF
441 442 443
          IF (hybrid%l_subvxc) THEN
             results%te_hfex%valence = 0
          END IF
444 445
       ELSE
          l_cont = l_cont.AND.(iter < input%itmax)
446 447 448
          ! MetaGGAs need a at least 2 iterations
          l_cont = l_cont.AND.((input%mindistance<=results%last_distance).OR.input%l_f & 
                               .OR. (xcpot%exc_is_MetaGGA() .and. iter == 1))
449
          CALL check_time_for_next_iteration(iter,l_cont)
450
       END IF
451

452
       !CALL writeTimesXML()
453

454 455 456 457
       IF ((mpi%irank.EQ.0).AND.(isCurrentXMLElement("iteration"))) THEN
          CALL closeXMLElement('iteration')
       END IF

458
    END DO scfloop ! DO WHILE (l_cont)
459 460
   
    CALL add_usage_data("Iterations",iter)
461 462

    IF (mpi%irank.EQ.0) CALL closeXMLElement('scfLoop')
463 464 465

    CALL close_eig(eig_id)

466
    CALL juDFT_end("all done",mpi%irank)
467
    
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
  CONTAINS
    SUBROUTINE priv_geo_end(mpi)
      TYPE(t_mpi),INTENT(IN)::mpi
      LOGICAL :: l_exist
      !Check if a new input was generated
      INQUIRE (file='inp_new',exist=l_exist)
      IF (l_exist) THEN
         CALL juDFT_end(" GEO new inp created ! ",mpi%irank)
      END IF
      !check for inp.xml
      INQUIRE (file='inp_new.xml',exist=l_exist)
      IF (.NOT.l_exist) RETURN
      IF (mpi%irank==0) THEN
         CALL system('mv inp.xml inp_old.xml')
         CALL system('mv inp_new.xml inp.xml')
         INQUIRE (file='qfix',exist=l_exist)
         IF (l_exist) THEN
            OPEN(2,file='qfix')
            WRITE(2,*)"F"
            CLOSE(2)
            PRINT *,"qfix set to F"
         ENDIF
490
         call mixing_history_reset(mpi)
491 492 493
      ENDIF
      CALL juDFT_end(" GEO new inp.xml created ! ",mpi%irank)
    END SUBROUTINE priv_geo_end
494
    
495 496
  END SUBROUTINE fleur_execute
END MODULE m_fleur