LCOV - code coverage report
Current view: top level - main - fleur.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 142 187 75.9 %
Date: 2019-09-08 04:53:50 Functions: 2 3 66.7 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_fleur
       7             :   IMPLICIT NONE
       8             : CONTAINS
       9          76 :   SUBROUTINE fleur_execute(mpi_comm)
      10             : 
      11             :     !     ***************************************************************
      12             :     !
      13             :     !     based on flapw7 (c.l.fu, m.weinert, e.wimmer):
      14             :     !     full potential linearized augmented plane wave method for thin
      15             :     !     films and superlattices (version 7 ---- general symmetry)
      16             :     !     symmetry part       ---  e.wimmer
      17             :     !     potential generator ---  c.l.fu,r.podloucky
      18             :     !     matrix elements     ---  m.weinert
      19             :     !     charge density      ---  c.l.fu
      20             :     !                                c.l.fu        1987
      21             :     !     2nd variation diagon.  --- r.-q. wu      1992
      22             :     !     forces a la Yu et al   --- r.podloucky   1995
      23             :     !     full relativistic core --- a.shick       1996
      24             :     !     broyden mixing         --- r.pentcheva   1996
      25             :     !     gga (pw91, pbe)        --- t.asada       1997
      26             :     !     local orbitals         --- p.kurz        1997
      27             :     !     automatic symmetry     --- w.hofer       1997
      28             :     !     core tails & start     --- r.abt         1998
      29             :     !     spin orbit coupling    --- a.shick,x.nie 1998
      30             :     !     non-colinear magnet.   --- p.kurz        1999
      31             :     !     one-dimensional        --- y.mokrousov   2002
      32             :     !     exchange parameters    --- m.lezaic      2004
      33             :     !
      34             :     !                       g.bihlmayer, s.bluegel 1999
      35             :     !     ***************************************************************
      36             :     !----------------------------------------
      37             :     ! this routine is the main PROGRAM
      38             : 
      39             :     USE m_types
      40             :     USE m_constants
      41             :     USE m_fleur_init
      42             :     USE m_optional
      43             :     USE m_cdn_io
      44             :     USE m_mixing_history
      45             :     USE m_qfix
      46             :     USE m_vgen
      47             :     USE m_writexcstuff
      48             :     USE m_vmatgen
      49             :     USE m_eigen
      50             :     USE m_eigenso
      51             :     USE m_fermie
      52             :     USE m_cdngen
      53             :     USE m_totale
      54             :     USE m_potdis
      55             :     USE m_mix
      56             :     USE m_xmlOutput
      57             :     USE m_juDFT_time
      58             :     USE m_calc_hybrid
      59             :     USE m_rdmft
      60             :     USE m_io_hybrid
      61             :     USE m_wann_optional
      62             :     USE m_wannier
      63             :     USE m_bs_comfort
      64             :     USE m_dwigner
      65             :     USE m_ylm
      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             :     !$ USE omp_lib
      74             :     IMPLICIT NONE
      75             : 
      76             :     INTEGER, INTENT(IN)             :: mpi_comm
      77             : 
      78             :     TYPE(t_input)                   :: input
      79         228 :     TYPE(t_field)                   :: field, field2
      80             :     TYPE(t_dimension)               :: DIMENSION
      81          76 :     TYPE(t_atoms)                   :: atoms
      82          76 :     TYPE(t_sphhar)                  :: sphhar
      83             :     TYPE(t_cell)                    :: cell
      84          76 :     TYPE(t_stars)                   :: stars
      85          76 :     TYPE(t_sym)                     :: sym
      86          76 :     TYPE(t_noco)                    :: noco
      87          76 :     TYPE(t_vacuum)                  :: vacuum
      88             :     TYPE(t_sliceplot)               :: sliceplot
      89             :     TYPE(t_banddos)                 :: banddos
      90             :     TYPE(t_obsolete)                :: obsolete
      91          76 :     TYPE(t_enpara)                  :: enpara
      92          76 :     TYPE(t_results)                 :: results
      93          76 :     TYPE(t_kpts)                    :: kpts
      94          76 :     TYPE(t_hybrid)                  :: hybrid
      95             :     TYPE(t_oneD)                    :: oneD
      96          76 :     TYPE(t_mpi)                     :: mpi
      97             :     TYPE(t_coreSpecInput)           :: coreSpecInput
      98          76 :     TYPE(t_wann)                    :: wann
      99          76 :     TYPE(t_potden)                  :: vTot, vx, vCoul, vTemp
     100         228 :     TYPE(t_potden)                  :: inDen, outDen, EnergyDen
     101          76 :     CLASS(t_xcpot),     ALLOCATABLE :: xcpot
     102          76 :     CLASS(t_forcetheo), ALLOCATABLE :: forcetheo
     103             : 
     104             :     ! local scalars
     105             :     INTEGER :: eig_id,archiveType, num_threads
     106             :     INTEGER :: iter,iterHF
     107             :     LOGICAL :: l_opti,l_cont,l_qfix,l_real
     108             :     REAL    :: fix
     109             : #ifdef CPP_MPI
     110             :     INCLUDE 'mpif.h'
     111             :     INTEGER :: ierr(2),n
     112             : #endif
     113             : 
     114          76 :     mpi%mpi_comm = mpi_comm
     115             : 
     116          76 :     CALL timestart("Initialization")
     117             :     CALL fleur_init(mpi,input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,&
     118             :                     banddos,obsolete,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann,l_opti)
     119          76 :     CALL timestop("Initialization")
     120             : 
     121          76 :     IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN
     122           0 :       CALL juDFT_error('Currently no preconditioner for 1D calculations', calledby = 'fleur')
     123             :     END IF
     124             : 
     125          76 :     IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
     126          76 :                               stars,input,sym,cell,sliceplot,obsolete,xcpot,noco,oneD)
     127             : 
     128          66 :     IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN
     129           0 :        IF(mpi%isize.NE.1) CALL juDFT_error('No Wannier+MPI at the moment',calledby = 'fleur')
     130           0 :        CALL wann_optional(input,kpts,atoms,sym,cell,oneD,noco,wann)
     131             :     END IF
     132             :   
     133          66 :     iter     = 0
     134          66 :     iterHF   = 0
     135          66 :     l_cont = (iter < input%itmax)
     136             :     
     137          66 :     IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('scfLoop')
     138             : 
     139             :     ! Initialize and load inDen density (start)
     140          66 :     CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
     141          66 :     archiveType = CDN_ARCHIVE_TYPE_CDN1_const
     142          66 :     IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
     143          66 :     IF(mpi%irank.EQ.0) THEN
     144             :        CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
     145          33 :                         0,results%ef,l_qfix,inDen)
     146          33 :        CALL timestart("Qfix")
     147          33 :        CALL qfix(mpi,stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix)
     148          33 :        CALL timestop("Qfix")
     149             :        CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
     150          33 :                          0,-1.0,results%ef,.FALSE.,inDen)
     151             :     END IF
     152             :     ! Initialize and load inDen density (end)
     153             : 
     154             :     ! Initialize potentials (start)
     155          66 :     CALL vTot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
     156          66 :     CALL vCoul%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
     157          66 :     CALL vx%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
     158          66 :     CALL vTemp%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
     159             :     ! Initialize potentials (end)
     160             : 
     161             :     ! Open/allocate eigenvector storage (start)
     162          66 :     l_real=sym%invs.AND..NOT.noco%l_noco
     163             :     eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,input%jspins,&
     164          66 :                     noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size)
     165             : 
     166             : #ifdef CPP_CHASE
     167             :     CALL init_chase(mpi,dimension,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco)
     168             : #endif
     169             :     ! Open/allocate eigenvector storage (end)
     170             : 
     171         388 :     scfloop:DO WHILE (l_cont)
     172             : 
     173         340 :        iter = iter + 1
     174         340 :        IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber      '/),&
     175         170 :                                                        (/iter,inden%iter/), RESHAPE((/19,13,5,5/),(/2,2/)))
     176             : 
     177             : !!$       !+t3e
     178             : !!$       IF (input%alpha.LT.10.0) THEN
     179             : !!$
     180             : !!$          IF (iter.GT.1) THEN
     181             : !!$             input%alpha = input%alpha - NINT(input%alpha)
     182             : !!$          END IF
     183             : 
     184             :        !CALL resetIterationDependentTimers()
     185         340 :        CALL timestart("Iteration")
     186         340 :        IF (mpi%irank.EQ.0) THEN
     187         170 :           WRITE (6,FMT=8100) iter
     188             : 8100      FORMAT (/,10x,'   iter=  ',i5)
     189             :        ENDIF !mpi%irank.eq.0
     190         340 :        input%total = .TRUE.
     191             : 
     192             : #ifdef CPP_CHASE
     193             :        CALL chase_distance(results%last_distance)
     194             : #endif
     195             : 
     196             : #ifdef CPP_MPI
     197         340 :        CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDen)
     198             : #endif
     199             : 
     200         340 :        dimension%neigd2 = dimension%neigd
     201         340 :        IF (noco%l_soc) dimension%neigd2 = dimension%neigd*2
     202             : 
     203             :        !HF
     204         340 :        !$ num_threads = omp_get_max_threads()
     205         340 :        !$ call omp_set_num_threads(1)
     206         340 :        IF (hybrid%l_hybrid) THEN
     207             :           SELECT TYPE(xcpot)
     208             :           TYPE IS(t_xcpot_inbuild)
     209             :              CALL calc_hybrid(eig_id,hybrid,kpts,atoms,input,DIMENSION,mpi,noco,&
     210           0 :                               cell,oneD,enpara,results,sym,xcpot,vTot,iter,iterHF)
     211             :           END SELECT
     212           0 :           IF(hybrid%l_calhf) THEN
     213           0 :              call mixing_history_reset(mpi)
     214           0 :              iter = 0
     215             :           END IF
     216             :        ENDIF
     217             :        !RDMFT
     218         340 :        IF(input%l_rdmft) THEN
     219           0 :           CALL open_hybrid_io1(DIMENSION,sym%invs)
     220             :        END IF
     221             : 
     222         340 :        CALL reset_eig(eig_id,noco%l_soc) ! This has to be placed after the calc_hybrid call but before eigen
     223         340 :        !$ call omp_set_num_threads(num_threads)
     224             : 
     225             :        !#endif
     226             : 
     227             : !!$             DO pc = 1, wann%nparampts
     228             : !!$                !---> gwf
     229             : !!$                IF (wann%l_sgwf.OR.wann%l_ms) THEN
     230             : !!$                   noco%qss(:) = wann%param_vec(:,pc)
     231             : !!$                   noco%alph(:) = wann%param_alpha(:,pc)
     232             : !!$                ELSE IF (wann%l_socgwf) THEN
     233             : !!$                   IF(wann%l_dim(2)) noco%phi   = tpi_const * wann%param_vec(2,pc)
     234             : !!$                   IF(wann%l_dim(3)) noco%theta = tpi_const * wann%param_vec(3,pc)
     235             : !!$                END IF
     236             :        !---< gwf
     237             : 
     238         340 :        CALL timestart("generation of potential")
     239             :        CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
     240         340 :                  obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul)
     241         340 :        CALL timestop("generation of potential")
     242             : 
     243             : #ifdef CPP_MPI
     244         340 :        CALL MPI_BARRIER(mpi%mpi_comm,ierr)
     245             : #endif
     246             : 
     247         340 :        CALL forcetheo%start(vtot,mpi%irank==0)
     248         662 :        forcetheoloop:DO WHILE(forcetheo%next_job(iter==input%itmax,atoms,noco))
     249             : 
     250         340 :           CALL timestart("gen. of hamil. and diag. (total)")
     251         340 :           CALL timestart("eigen")
     252         680 :           vTemp = vTot
     253         340 :           CALL timestart("Updating energy parameters")
     254         340 :           CALL enpara%update(mpi,atoms,vacuum,input,vToT)
     255         340 :           CALL timestop("Updating energy parameters")
     256             :           CALL eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,DIMENSION,vacuum,input,&
     257         340 :                      cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inDen,vTemp,vx)
     258         340 :           vTot%mmpMat = vTemp%mmpMat
     259             : !!$          eig_idList(pc) = eig_id
     260         340 :           CALL timestop("eigen")
     261             : 
     262             :           ! add all contributions to total energy
     263             : #ifdef CPP_MPI
     264             :           ! send all result of local total energies to the r
     265         340 :           IF (hybrid%l_hybrid.AND.hybrid%l_calhf) THEN
     266           0 :              IF (mpi%irank==0) THEN
     267           0 :                 CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%core,1,MPI_REAL8,MPI_SUM,0,mpi%mpi_comm,ierr(1))
     268             :              ELSE
     269           0 :                 CALL MPI_Reduce(results%te_hfex%core,MPI_IN_PLACE,1,MPI_REAL8,MPI_SUM,0, mpi%mpi_comm,ierr(1))
     270             :              END IF
     271           0 :              IF (mpi%irank==0) THEN
     272           0 :                 CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%valence,1,MPI_REAL8,MPI_SUM,0,mpi%mpi_comm,ierr(1))
     273             :              ELSE
     274           0 :                 CALL MPI_Reduce(results%te_hfex%valence,MPI_IN_PLACE,1,MPI_REAL8,MPI_SUM,0, mpi%mpi_comm,ierr(1))
     275             :              END IF
     276             :           END IF
     277             : #endif
     278             : 
     279             :           ! WRITE(6,fmt='(A)') 'Starting 2nd variation ...'
     280         340 :           IF (noco%l_soc.AND..NOT.noco%l_noco) &
     281             :              CALL eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
     282          14 :                           obsolete,sym,cell,noco,input,kpts, oneD,vTot,enpara,results)
     283         340 :           CALL timestop("gen. of hamil. and diag. (total)")
     284             : 
     285             : #ifdef CPP_MPI
     286         340 :           CALL MPI_BARRIER(mpi%mpi_comm,ierr)
     287             : #endif
     288             : 
     289             :           ! fermi level and occupancies
     290         340 :           IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd = 2*DIMENSION%neigd
     291             : 
     292         340 :           IF (input%gw.GT.0) THEN
     293           0 :             IF (mpi%irank.EQ.0) THEN
     294             :                CALL writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DIMENSION,&
     295           0 :                              results,eig_id,oneD,sphhar,stars,vacuum)
     296             :             END IF
     297           0 :             IF (input%gw.EQ.2) THEN
     298           0 :                CALL juDFT_end("GW data written. Fleur ends.",mpi%irank)
     299             :             END IF
     300             :           END IF
     301             : 
     302             :           !IF ((mpi%irank.EQ.0)) THEN
     303         340 :              CALL timestart("determination of fermi energy")
     304             : 
     305         340 :              IF (noco%l_soc.AND.(.NOT.noco%l_noco)) THEN
     306          14 :                 input%zelec = input%zelec*2
     307          14 :                 CALL fermie(eig_id,mpi,kpts,input,noco,enpara%epara_min,cell,results)
     308          14 :                 results%seigscv = results%seigscv/2
     309          14 :                 results%ts = results%ts/2
     310          14 :                 input%zelec = input%zelec/2
     311             :              ELSE
     312         326 :                 CALL fermie(eig_id,mpi,kpts,input,noco,enpara%epara_min,cell,results)
     313             :              ENDIF
     314         340 :              CALL timestop("determination of fermi energy")
     315             : 
     316             : !!$          !+Wannier
     317             : !!$          IF(wann%l_bs_comf)THEN
     318             : !!$             IF(pc.EQ.1) THEN
     319             : !!$                OPEN(777,file='out_eig.1')
     320             : !!$                OPEN(778,file='out_eig.2')
     321             : !!$                OPEN(779,file='out_eig.1_diag')
     322             : !!$                OPEN(780,file='out_eig.2_diag')
     323             : !!$             END IF
     324             : !!$
     325             : !!$             CALL bs_comfort(eig_id,DIMENSION,input,noco,kpts%nkpt,pc)
     326             : !!$
     327             : !!$             IF(pc.EQ.wann%nparampts)THEN
     328             : !!$                CLOSE(777)
     329             : !!$                CLOSE(778)
     330             : !!$                CLOSE(779)
     331             : !!$                CLOSE(780)
     332             : !!$             END IF
     333             : !!$          END IF
     334             : !!$          !-Wannier
     335             : 
     336             :           !ENDIF
     337             : #ifdef CPP_MPI
     338         340 :           CALL MPI_BCAST(results%ef,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     339         340 :           CALL MPI_BCAST(results%w_iks,SIZE(results%w_iks),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     340             : #endif
     341             : 
     342         340 :           IF (forcetheo%eval(eig_id,DIMENSION,atoms,kpts,sym,cell,noco,input,mpi,oneD,enpara,vToT,results)) THEN
     343           0 :              IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2
     344           0 :              CYCLE forcetheoloop
     345             :           ENDIF
     346             : 
     347             :           
     348             :           !+Wannier functions
     349         340 :           IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN
     350             :              CALL wannier(DIMENSION,mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,&
     351             :                   wann,noco,cell,enpara,banddos,sliceplot,vTot,results,&
     352           0 :                   (/eig_id/),(sym%invs).AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco),kpts%nkpt)
     353             :           END IF
     354             :           !-Wannier
     355             : 
     356             :           ! charge density generation
     357         340 :           CALL timestart("generation of new charge density (total)")
     358         340 :           CALL outDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
     359         340 :           outDen%iter = inDen%iter
     360             :           CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum, &
     361             :                       dimension,kpts,atoms,sphhar,stars,sym,&
     362             :                       enpara,cell,noco,vTot,results,oneD,coreSpecInput,&
     363         340 :                       archiveType,xcpot,outDen,EnergyDen)
     364             : 
     365         324 :           IF (input%l_rdmft) THEN
     366             :              SELECT TYPE(xcpot)
     367             :                 TYPE IS(t_xcpot_inbuild)
     368             :                    CALL rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars,vacuum,dimension,&
     369           0 :                               sphhar,sym,field,vTot,vCoul,oneD,noco,xcpot,hybrid,results,coreSpecInput,archiveType,outDen)
     370             :              END SELECT
     371             :           END IF
     372             : 
     373         324 :           IF (noco%l_soc.AND.(.NOT.noco%l_noco)) DIMENSION%neigd=DIMENSION%neigd/2
     374             : 
     375             : #ifdef CPP_MPI
     376         324 :           CALL MPI_BCAST(enpara%evac,SIZE(enpara%evac),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     377         324 :           CALL MPI_BCAST(enpara%evac0,SIZE(enpara%evac0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     378         324 :           CALL MPI_BCAST(enpara%el0,SIZE(enpara%el0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     379         324 :           CALL MPI_BCAST(enpara%ello0,SIZE(enpara%ello0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     380             : 
     381         324 :           IF (noco%l_noco) THEN
     382         704 :              DO n= 1,atoms%ntype
     383         704 :                 IF (noco%l_relax(n)) THEN
     384           0 :                    CALL MPI_BCAST(noco%alph(n),1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     385           0 :                    CALL MPI_BCAST(noco%beta(n),1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     386             :                 ENDIF
     387             :              ENDDO
     388         248 :              IF (noco%l_constr) THEN
     389           0 :                 CALL MPI_BCAST(noco%b_con,SIZE(noco%b_con),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     390             :              ENDIF
     391             :           ENDIF
     392             : #endif
     393         324 :           CALL timestop("generation of new charge density (total)")
     394             : 
     395             :              
     396             : !!$             !----> output potential and potential difference
     397             : !!$             IF (obsolete%disp) THEN
     398             : !!$                reap = .FALSE.
     399             : !!$                input%total = .FALSE.
     400             : !!$                CALL timestart("generation of potential (total)")
     401             : !!$                CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,&
     402             : !!$                     obsolete,cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul)
     403             : !!$                CALL timestop("generation of potential (total)")
     404             : !!$
     405             : !!$                CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym)
     406             : !!$             END IF
     407             :              
     408             :              ! total energy
     409         324 :              CALL timestart('determination of total energy')
     410             :              CALL totale(mpi,atoms,sphhar,stars,vacuum,DIMENSION,sym,input,noco,cell,oneD,&
     411         324 :                          xcpot,hybrid,vTot,vCoul,iter,inDen,results)
     412         322 :              CALL timestop('determination of total energy')
     413         322 :           IF (hybrid%l_hybrid) CALL close_eig(eig_id)
     414             : 
     415             :        END DO forcetheoloop
     416             : 
     417         322 :        CALL forcetheo%postprocess()
     418             : 
     419         322 :        CALL enpara%mix(mpi,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
     420         322 :        field2 = field
     421             : 
     422             :        ! mix input and output densities
     423             :        CALL mix_charge(field2,DIMENSION,mpi,(iter==input%itmax.OR.judft_was_argument("-mix_io")),&
     424             :             stars,atoms,sphhar,vacuum,input,&
     425         322 :             sym,cell,noco,oneD,archiveType,xcpot,iter,inDen,outDen,results)
     426             :        
     427         322 :        IF(mpi%irank == 0) THEN
     428         161 :          WRITE (6,FMT=8130) iter
     429             : 8130     FORMAT (/,5x,'******* it=',i3,'  is completed********',/,/)
     430         161 :          WRITE(*,*) "Iteration:",iter," Distance:",results%last_distance
     431         161 :          CALL timestop("Iteration")
     432             :        END IF ! mpi%irank.EQ.0
     433             :           
     434             : #ifdef CPP_MPI
     435         322 :        CALL MPI_BCAST(results%last_distance,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
     436         322 :        CALL MPI_BARRIER(mpi%mpi_comm,ierr)
     437             : #endif
     438         322 :        CALL priv_geo_end(mpi)
     439             : 
     440         322 :        l_cont = .TRUE.
     441         322 :        IF (hybrid%l_hybrid) THEN
     442           0 :           IF(hybrid%l_calhf) THEN
     443           0 :              l_cont = l_cont.AND.(iterHF < input%itmax)
     444           0 :              l_cont = l_cont.AND.(input%mindistance<=results%last_distance)
     445           0 :              CALL check_time_for_next_iteration(iterHF,l_cont)
     446             :           ELSE
     447           0 :              l_cont = l_cont.AND.(iter < 50) ! Security stop for non-converging nested PBE calculations
     448             :           END IF
     449           0 :           IF (hybrid%l_subvxc) THEN
     450           0 :              results%te_hfex%valence = 0
     451             :           END IF
     452             :        ELSE
     453         322 :           l_cont = l_cont.AND.(iter < input%itmax)
     454             :           ! MetaGGAs need a at least 2 iterations
     455             :           l_cont = l_cont.AND.((input%mindistance<=results%last_distance).OR.input%l_f & 
     456         322 :                                .OR. (xcpot%exc_is_MetaGGA() .and. iter == 1))
     457         322 :           CALL check_time_for_next_iteration(iter,l_cont)
     458             :        END IF
     459             : 
     460             :        !CALL writeTimesXML()
     461             : 
     462         370 :        IF (mpi%irank.EQ.0) THEN
     463         161 :           IF (isCurrentXMLElement("iteration")) CALL closeXMLElement('iteration')
     464             :        END IF
     465             : 
     466             :     END DO scfloop ! DO WHILE (l_cont)
     467             :    
     468          48 :     CALL add_usage_data("Iterations",iter)
     469             : 
     470          48 :     IF (mpi%irank.EQ.0) CALL closeXMLElement('scfLoop')
     471             : 
     472          48 :     CALL close_eig(eig_id)
     473             : 
     474         124 :     CALL juDFT_end("all done",mpi%irank)
     475             :     
     476             :   CONTAINS
     477         322 :     SUBROUTINE priv_geo_end(mpi)
     478             :       TYPE(t_mpi),INTENT(IN)::mpi
     479             :       LOGICAL :: l_exist
     480             :       !Check if a new input was generated
     481         322 :       INQUIRE (file='inp_new',exist=l_exist)
     482         322 :       IF (l_exist) THEN
     483           0 :          CALL juDFT_end(" GEO new inp created ! ",mpi%irank)
     484             :       END IF
     485             :       !check for inp.xml
     486         322 :       INQUIRE (file='inp_new.xml',exist=l_exist)
     487         644 :       IF (.NOT.l_exist) RETURN
     488           0 :       IF (mpi%irank==0) THEN
     489           0 :          CALL system('mv inp.xml inp_old.xml')
     490           0 :          CALL system('mv inp_new.xml inp.xml')
     491           0 :          INQUIRE (file='qfix',exist=l_exist)
     492           0 :          IF (l_exist) THEN
     493           0 :             OPEN(2,file='qfix')
     494           0 :             WRITE(2,*)"F"
     495           0 :             CLOSE(2)
     496           0 :             PRINT *,"qfix set to F"
     497             :          ENDIF
     498           0 :          call mixing_history_reset(mpi)
     499             :       ENDIF
     500           0 :       CALL juDFT_end(" GEO new inp.xml created ! ",mpi%irank)
     501             :     END SUBROUTINE priv_geo_end
     502             :     
     503             :   END SUBROUTINE fleur_execute
     504           0 : END MODULE m_fleur

Generated by: LCOV version 1.13