LCOV - code coverage report
Current view: top level - hybrid - hsfock.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 45 53 84.9 %
Date: 2024-03-28 04:22:06 Functions: 1 1 100.0 %

          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             : 
       7             : MODULE m_hsfock
       8             : 
       9             : ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
      10             : !     This module is the driver routine for the calculation of the Hartree    c
      11             : !     Fock exchange term by using the mixed basis set.                        c
      12             : !                                                                             c
      13             : !     hsfock                                                                  c
      14             : !         |                                                                   c
      15             : !         |- symm.F:                                                          c
      16             : !         |  calculates the irreducible representation                        c
      17             : !         |                                                                   c
      18             : !         |- wavefproducts.F:                 s      s*                       c
      19             : !         |  computes the repsentation of phi    phi       in the mixed basis c
      20             : !         |                                  n,k    n',k+q                    c
      21             : !         |                                                                   c
      22             : !         |- exchange.F:                                                      c
      23             : !         |  calculates valence-valence part of the exchange matrix (mat_ex), c
      24             : !         |                                                                   c
      25             : !         |- exchange_core.F                                                  c
      26             : !         |  calculate valence-core contribution                              c
      27             : !                                                                             c
      28             : !     variables:                                                              c
      29             : !         fi%kpts%nkptf   :=   number of kpoints                                      c
      30             : !         fi%kpts%nkpt   :=   number of irreducible kpoints                          c
      31             : !         nbands  :=   number of bands for which the exchange matrix (mat_ex) c
      32             : !                      in the space of the wavefunctions is calculated        c
      33             : !         te_hfex :=   hf exchange contribution to the total energy           c
      34             : !         parent  :=   parent(ikpt) points to the symmetry equivalent point   c
      35             : !                      under the little group of kpoint nk                    c
      36             : !         symop   :=   symop(ikpt) points to the symmetry operation, which    c
      37             : !                      maps parent(ikpt) on ikpt                              c
      38             : !                                                                             c
      39             : !                                                                             c
      40             : !                                               M.Betzinger (09/07)           c
      41             : ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
      42             : 
      43             : CONTAINS
      44             : 
      45          24 :    SUBROUTINE hsfock(fi, k_pack, mpdata, lapw, jsp, hybdat, &
      46          24 :                      eig_irr, nococonv, stars, &
      47             :                      results, xcpot, fmpi, vx_tmp)
      48             : 
      49             :       use m_ex_to_vx
      50             :       USE m_judft
      51             :       USE m_types
      52             :       USE m_intgrf
      53             :       USE m_wrapper
      54             :       USE m_io_hybrid
      55             :       USE m_hsefunctional
      56             :       USE m_symm_hf
      57             :       USE m_exchange_valence_hf
      58             :       USE m_exchange_core
      59             :       USE m_symmetrizeh
      60             :       use m_work_package
      61             :       USE m_eig66_data
      62             :       use m_eig66_mpi
      63             :       use m_calc_cmt
      64             :       IMPLICIT NONE
      65             : 
      66             :       type(t_fleurinput), intent(in)    :: fi
      67             :       type(t_k_package), intent(in)     :: k_pack
      68             :       TYPE(t_xcpot_inbuild), INTENT(IN) :: xcpot
      69             :       TYPE(t_mpi), INTENT(IN)           :: fmpi
      70             :       TYPE(t_nococonv), INTENT(IN)      :: nococonv
      71             :       TYPE(t_lapw), INTENT(IN)          :: lapw
      72             :       type(t_stars), intent(in)         :: stars
      73             :       TYPE(t_mpdata), intent(inout)     :: mpdata
      74             :       TYPE(t_hybdat), INTENT(INOUT)     :: hybdat
      75             :       TYPE(t_results), INTENT(INOUT)    :: results
      76             :       type(t_mat), intent(inout)        :: vx_tmp
      77             : 
      78             :       ! scalars
      79             :       INTEGER, INTENT(IN)    :: jsp
      80             : 
      81             :       ! arrays
      82             :       REAL, INTENT(IN)    :: eig_irr(:, :)
      83             : 
      84             :       ! local scalars
      85             :       INTEGER                 ::  l, itype
      86             :       INTEGER                 ::  iband, nk
      87             :       INTEGER                 ::  ikpt, ikpt0
      88             :       INTEGER                 ::  nsymop
      89             :       INTEGER                 ::  ncstd
      90             :       INTEGER                 ::  ok
      91             :       REAL                    ::  a_ex
      92             : 
      93             :       ! local arrays
      94          24 :       INTEGER                 ::  nsest(hybdat%nbands(k_pack%nk ,jsp)), indx_sest(hybdat%nbands(k_pack%nk ,jsp), hybdat%nbands(k_pack%nk ,jsp))
      95          24 :       INTEGER                 ::  rrot(3, 3, fi%sym%nsym), ierr
      96          24 :       INTEGER                 ::  psym(fi%sym%nsym) ! Note: psym is only filled up to index nsymop
      97             :       INTEGER                 ::  tempI, tempJ
      98             : 
      99          24 :       INTEGER, ALLOCATABLE    :: parent(:)
     100          24 :       INTEGER, ALLOCATABLE    :: n_q(:)
     101          24 :       complex, allocatable    :: cmt_nk(:,:,:) 
     102             : 
     103          24 :       complex                  :: c_phase_k(hybdat%nbands(k_pack%nk ,jsp))
     104          24 :       REAL                     :: wl_iks(fi%input%neig, fi%kpts%nkptf)
     105          24 :       TYPE(t_mat)              :: mat_ex
     106             : 
     107          24 :       CALL timestart("total time hsfock")
     108          24 :       nk = k_pack%nk 
     109             :       ! initialize weighting factor for HF exchange part
     110          24 :       a_ex = xcpot%get_exchange_weight()
     111         204 :       ncstd = sum([((hybdat%nindxc(l, itype)*(2*l + 1)*fi%atoms%neq(itype), l=0, hybdat%lmaxc(itype)), itype=1, fi%atoms%ntype)])
     112          24 :       IF(nk == 1 .and. fmpi%irank == 0) WRITE(*, *) 'calculate new HF matrix'
     113          24 :       IF(nk == 1 .and. jsp == 1 .and. fi%input%imix > 10) CALL system('rm -f broyd*')
     114             :       ! calculate all symmetrie operations, which yield k invariant
     115             : 
     116          72 :       allocate(parent(fi%kpts%nkptf), stat=ok)
     117          24 :       IF(ok /= 0) call judft_error('mhsfock: failure allocation parent')
     118         216 :       parent = 0
     119             : 
     120         120 :       allocate(cmt_nk(hybdat%nbands(nk,jsp), hybdat%maxlmindx, fi%atoms%nat), stat=ierr)
     121          24 :       if(ierr  /= 0) call judft_error("can't allocate cmt_nk")
     122             :       call calc_cmt(fi%atoms, fi%cell, fi%input, fi%noco, nococonv, fi%hybinp, hybdat, mpdata, fi%kpts, &
     123          24 :                    fi%sym,  hybdat%zmat(nk,jsp)%mat, jsp, nk, c_phase_k, cmt_nk, k_pack%submpi)
     124             : 
     125             : 
     126          24 :       CALL symm_hf_init(fi, nk, nsymop, rrot, psym)
     127             : 
     128             :       CALL symm_hf(fi, nk, hybdat, results, k_pack%submpi, eig_irr, mpdata, cmt_nk,&
     129          24 :                    rrot, nsymop, psym, n_q, parent, nsest, indx_sest, jsp)
     130             : 
     131             :       ! remove weights(wtkpt) in w_iks
     132         216 :       DO ikpt = 1, fi%kpts%nkptf
     133       13176 :          DO iband = 1, fi%input%neig
     134       12960 :             ikpt0 = fi%kpts%bkp(ikpt)
     135       13152 :             wl_iks(iband, ikpt) = results%w_iks(iband, ikpt0, jsp)/(fi%kpts%wtkpt(ikpt0)*fi%kpts%nkptf)
     136             :          END DO
     137             :       END DO
     138             : 
     139             :       ! calculate contribution from valence electrons to the
     140             :       ! HF exchange
     141          24 :       mat_ex%l_real = fi%sym%invs
     142          24 :       PRINT*, "exchange_valence_hf"
     143             :    
     144             :       CALL exchange_valence_hf(k_pack, fi, fmpi, hybdat%zmat(nk,jsp)%mat, mpdata, jsp, hybdat, lapw, eig_irr, results, &
     145          24 :                                n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, cmt_nk, mat_ex)
     146             :       
     147             :       
     148             :       ! calculate contribution from the core states to the HF exchange
     149          24 :       PRINT*, "core exchange calculation"
     150          24 :       CALL timestart("core exchange calculation")
     151             :       
     152          24 :       IF(xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
     153           0 :          CALL timestart("hse: exchange vccv")
     154             :          CALL exchange_vccvHSE(nk, fi, mpdata, hybdat, jsp, lapw, nsymop, nsest, indx_sest, &
     155           0 :                                fmpi%irank, a_ex, results, cmt_nk, mat_ex)
     156           0 :          CALL timestop("hse: exchange vccv")
     157             : 
     158           0 :          CALL timestart("hse: exchange cccc")
     159           0 :          CALL exchange_ccccHSE(nk, fi, hybdat, ncstd, a_ex, results)
     160             : 
     161           0 :          CALL timestop("hse: exchange cccc")
     162             :       
     163             :       ELSE
     164             :          CALL exchange_vccv1(nk, fi, mpdata, hybdat, jsp, &
     165          24 :                            lapw, k_pack%submpi, nsymop, nsest, indx_sest, a_ex, results, cmt_nk, mat_ex)
     166             : 
     167          24 :          if(k_pack%submpi%root()) then
     168          24 :             CALL exchange_cccc(nk, fi%atoms, hybdat, ncstd, fi%sym, fi%kpts, a_ex, results)
     169             :          endif
     170             :       END IF
     171             : 
     172          24 :       CALL timestop("core exchange calculation")
     173          24 :       if(k_pack%submpi%root()) then
     174          24 :          call ex_to_vx(fi, nk, jsp, nsymop, psym, hybdat, lapw, hybdat%zmat(nk,jsp)%mat, mat_ex, vx_tmp)
     175          24 :          call vx_tmp%u2l()
     176             :       ELSE  
     177             : #ifdef CPP_MPI
     178             :          ! balance post read_z barrier
     179           0 :          call MPI_Barrier(MPI_COMM_WORLD, ierr)
     180           0 :          hybdat%max_q = hybdat%max_q - 1
     181             : #endif
     182             :       endif
     183             : 
     184          24 :       hybdat%l_addhf = .True.
     185          24 :       CALL timestop("total time hsfock")
     186          24 :    END SUBROUTINE hsfock
     187             : END MODULE m_hsfock

Generated by: LCOV version 1.14