LCOV - code coverage report
Current view: top level - hybrid - hsfock.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 71 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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             :    USE m_judft
      10             : ! 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
      11             : !     This module is the driver routine for the calculation of the Hartree    c
      12             : !     Fock exchange term by using the mixed basis set.                        c
      13             : !                                                                             c
      14             : !     hsfock                                                                  c
      15             : !         |                                                                   c
      16             : !         |- symm.F:                                                          c
      17             : !         |  calculates the irreducible representation                        c
      18             : !         |                                                                   c
      19             : !         |- wavefproducts.F:                 s      s*                       c
      20             : !         |  computes the repsentation of phi    phi       in the mixed basis c
      21             : !         |                                  n,k    n',k+q                    c
      22             : !         |                                                                   c
      23             : !         |- exchange.F:                                                      c
      24             : !         |  calculates valence-valence part of the exchange matrix (mat_ex), c
      25             : !         |                                                                   c
      26             : !         |- exchange_core.F                                                  c
      27             : !         |  calculate valence-core contribution                              c
      28             : !                                                                             c
      29             : !     variables:                                                              c
      30             : !         kpts%nkptf   :=   number of kpoints                                      c
      31             : !         kpts%nkpt   :=   number of irreducible kpoints                          c
      32             : !         nbands  :=   number of bands for which the exchange matrix (mat_ex) c
      33             : !                      in the space of the wavefunctions is calculated        c
      34             : !         te_hfex :=   hf exchange contribution to the total energy           c
      35             : !         mnobd   :=   maximum number of occupied bands                       c
      36             : !         parent  :=   parent(ikpt) points to the symmetry equivalent point   c
      37             : !                      under the little group of kpoint nk                    c
      38             : !         symop   :=   symop(ikpt) points to the symmetry operation, which    c
      39             : !                      maps parent(ikpt) on ikpt                              c
      40             : !                                                                             c
      41             : !                                                                             c
      42             : !                                               M.Betzinger (09/07)           c
      43             : ! 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
      44             : 
      45             : CONTAINS
      46             : 
      47           0 :    SUBROUTINE hsfock(nk, atoms, hybrid, lapw, dimension, kpts, jsp, input, hybdat, eig_irr, sym, cell, noco, &
      48             :                      results, it, mnobd, xcpot, mpi)
      49             : 
      50             :       USE m_types
      51             :       USE m_symm_hf
      52             :       USE m_util, ONLY: intgrf, intgrf_init
      53             :       USE m_exchange_valence_hf
      54             :       USE m_exchange_core
      55             :       USE m_symmetrizeh
      56             :       USE m_wrapper
      57             :       USE m_hsefunctional, ONLY: exchange_vccvHSE, exchange_ccccHSE
      58             :       USE m_io_hybrid
      59             : 
      60             :       IMPLICIT NONE
      61             : 
      62             :       TYPE(t_xcpot_inbuild), INTENT(IN)    :: xcpot
      63             :       TYPE(t_mpi), INTENT(IN)    :: mpi
      64             :       TYPE(t_dimension), INTENT(IN)    :: dimension
      65             :       TYPE(t_input), INTENT(IN)    :: input
      66             :       TYPE(t_noco), INTENT(IN)    :: noco
      67             :       TYPE(t_sym), INTENT(IN)    :: sym
      68             :       TYPE(t_cell), INTENT(IN)    :: cell
      69             :       TYPE(t_kpts), INTENT(IN)    :: kpts
      70             :       TYPE(t_atoms), INTENT(IN)    :: atoms
      71             :       TYPE(t_lapw), INTENT(IN)    :: lapw
      72             :       TYPE(t_hybrid), INTENT(INOUT) :: hybrid
      73             :       TYPE(t_hybdat), INTENT(INOUT) :: hybdat
      74             :       TYPE(t_results), INTENT(INOUT) :: results
      75             : 
      76             :       ! scalars
      77             :       INTEGER, INTENT(IN)    :: jsp
      78             :       INTEGER, INTENT(IN)    :: it
      79             :       INTEGER, INTENT(IN)    :: nk
      80             :       INTEGER, INTENT(IN)    :: mnobd
      81             : 
      82             :       ! arrays
      83             :       REAL, INTENT(IN)    :: eig_irr(dimension%neigd, kpts%nkpt)
      84             : 
      85             :       ! local scalars
      86             :       INTEGER                 ::  i, j, ic, ic1, l, itype, n, nn
      87             :       INTEGER                 ::  iband, iband1, iband2
      88             :       INTEGER                 ::  ikpt, ikpt0
      89             :       INTEGER                 ::  irec
      90             :       INTEGER                 ::  irecl_olap, irecl_z, irecl_vx
      91             :       INTEGER                 ::  nbasfcn
      92             :       INTEGER                 ::  nsymop
      93             :       INTEGER                 ::  nkpt_EIBZ
      94             :       INTEGER                 ::  ncstd
      95             :       INTEGER                 ::  ok
      96             :       REAL                    ::  a_ex
      97             : 
      98             :       ! local arrays
      99           0 :       INTEGER                 ::  nsest(hybrid%nbands(nk)), indx_sest(hybrid%nbands(nk), hybrid%nbands(nk))
     100           0 :       INTEGER                 ::  rrot(3, 3, sym%nsym)
     101           0 :       INTEGER                 ::  psym(sym%nsym) ! Note: psym is only filled up to index nsymop
     102             : 
     103           0 :       INTEGER, ALLOCATABLE     ::  parent(:)
     104           0 :       INTEGER, ALLOCATABLE     ::  pointer_EIBZ(:)
     105           0 :       INTEGER, ALLOCATABLE     ::  n_q(:)
     106             : 
     107           0 :       REAL                    ::  wl_iks(dimension%neigd, kpts%nkptf)
     108             : 
     109           0 :       TYPE(t_mat)             :: olap, trafo, invtrafo, ex, tmp, v_x, z
     110             :       COMPLEX                 ::  exch(dimension%neigd, dimension%neigd)
     111             :       COMPLEX, ALLOCATABLE     ::  carr(:)
     112             : 
     113           0 :       CALL timestart("total time hsfock")
     114             : 
     115             :       ! preparations
     116             : 
     117             :       ! initialize gridf for radial integration
     118             :       !CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
     119             : 
     120             :       ! initialize weighting factor for HF exchange part
     121           0 :       a_ex = xcpot%get_exchange_weight()
     122             : 
     123             :       ! read in lower triangle part of overlap matrix from direct acces file olap
     124           0 :       call timestart("read in olap")
     125           0 :       nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
     126           0 :       call olap%alloc(sym%invs, nbasfcn)
     127           0 :       call read_olap(olap, kpts%nkpt*(jsp - 1) + nk)
     128           0 :       IF (olap%l_real) THEN
     129           0 :          DO i = 1, nbasfcn
     130           0 :             DO j = 1, i
     131           0 :                olap%data_r(i, j) = olap%data_r(j, i)
     132             :             END DO
     133             :          END DO
     134             :       ELSE
     135           0 :          DO i = 1, nbasfcn
     136           0 :             DO j = 1, i
     137           0 :                olap%data_c(i, j) = CONJG(olap%data_c(j, i))
     138             :             END DO
     139             :          END DO
     140           0 :          olap%data_c = conjg(olap%data_c)
     141             :       END IF
     142           0 :       call timestop("read in olap")
     143             : 
     144           0 :       IF (hybrid%l_calhf) THEN
     145           0 :          ncstd = sum((/((hybdat%nindxc(l, itype)*(2*l + 1)*atoms%neq(itype), l=0, hybdat%lmaxc(itype)), itype=1, atoms%ntype)/))
     146           0 :          IF (nk == 1 .and. mpi%irank == 0) WRITE (*, *) 'calculate new HF matrix'
     147           0 :          IF (nk == 1 .and. jsp == 1 .and. input%imix > 10) CALL system('rm -f broyd*')
     148             :          ! calculate all symmetrie operations, which yield k invariant
     149             : 
     150           0 :          ALLOCATE (parent(kpts%nkptf), stat=ok)
     151           0 :          IF (ok /= 0) STOP 'mhsfock: failure allocation parent'
     152           0 :          parent = 0
     153             : 
     154           0 :          CALL timestart("symm_hf")
     155           0 :          CALL symm_hf_init(sym, kpts, nk, nsymop, rrot, psym)
     156             : 
     157             :          CALL symm_hf(kpts, nk, sym, dimension, hybdat, eig_irr, atoms, hybrid, cell, lapw, jsp, mpi, &
     158           0 :                       rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest)
     159           0 :          CALL timestop("symm_hf")
     160             : 
     161             :          ! remove weights(wtkpt) in w_iks
     162           0 :          DO ikpt = 1, kpts%nkptf
     163           0 :             DO iband = 1, dimension%neigd
     164           0 :                ikpt0 = kpts%bkp(ikpt)
     165           0 :                wl_iks(iband, ikpt) = results%w_iks(iband, ikpt0, jsp)/(kpts%wtkpt(ikpt0)*kpts%nkptf)
     166             :             END DO
     167             :          END DO
     168             : 
     169             :          ! calculate contribution from valence electrons to the
     170             :          ! HF exchange
     171           0 :          ex%l_real = sym%invs
     172             :          CALL exchange_valence_hf(nk, kpts, nkpt_EIBZ, sym, atoms, hybrid, cell, dimension, input, jsp, hybdat, mnobd, lapw, &
     173             :                                   eig_irr, results, parent, pointer_EIBZ, n_q, wl_iks, it, xcpot, noco, nsest, indx_sest, &
     174           0 :                                   mpi, ex)
     175             : 
     176           0 :          CALL timestart("core exchange calculation")
     177             : 
     178             :          ! calculate contribution from the core states to the HF exchange
     179           0 :          IF (xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
     180           0 :             STOP "HSE not implemented in hsfock"
     181             :          ELSE
     182           0 :             CALL exchange_vccv1(nk, atoms, hybrid, hybdat, dimension, jsp, lapw, nsymop, nsest, indx_sest, mpi, a_ex, results, ex)
     183           0 :             CALL exchange_cccc(nk, atoms, hybdat, ncstd, sym, kpts, a_ex, mpi, results)
     184             :          END IF
     185             : 
     186           0 :          DEALLOCATE (n_q)
     187           0 :          CALL timestop("core exchange calculation")
     188             : 
     189           0 :          CALL timestart("time for performing T^-1*mat_ex*T^-1*")
     190             :          !calculate trafo from wavefunctions to APW basis
     191           0 :          IF (dimension%neigd < hybrid%nbands(nk)) STOP " mhsfock: neigd  < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)"
     192             : 
     193           0 :          call z%init(olap%l_real, nbasfcn, dimension%neigd)
     194           0 :          call read_z(z, kpts%nkpt*(jsp - 1) + nk)
     195           0 :          z%matsize2 = hybrid%nbands(nk) ! reduce "visible matsize" for the following computations
     196             : 
     197           0 :          call olap%multiply(z, trafo)
     198             : 
     199           0 :          CALL invtrafo%alloc(olap%l_real, hybrid%nbands(nk), nbasfcn)
     200           0 :          CALL trafo%TRANSPOSE(invtrafo)
     201           0 :          IF (.NOT. invtrafo%l_real) invtrafo%data_c = CONJG(invtrafo%data_c)
     202             : 
     203           0 :          DO i = 1, hybrid%nbands(nk)
     204           0 :             DO j = 1, i - 1
     205           0 :                IF (ex%l_real) THEN
     206           0 :                   ex%data_r(i, j) = ex%data_r(j, i)
     207             :                ELSE
     208           0 :                   ex%data_c(i, j) = conjg(ex%data_c(j, i))
     209             :                END IF
     210             :             ENDDO
     211             :          ENDDO
     212             : 
     213           0 :          CALL ex%multiply(invtrafo, tmp)
     214           0 :          CALL trafo%multiply(tmp, v_x)
     215             : 
     216           0 :          CALL timestop("time for performing T^-1*mat_ex*T^-1*")
     217             : 
     218           0 :          call timestart("symmetrizeh")
     219           0 :          CALL symmetrizeh(atoms, kpts%bkf(:, nk), dimension, jsp, lapw, sym, hybdat%kveclo_eig, cell, nsymop, psym, v_x)
     220           0 :          call timestop("symmetrizeh")
     221             : 
     222           0 :          CALL write_v_x(v_x, kpts%nkpt*(jsp - 1) + nk)
     223             :       END IF ! hybrid%l_calhf
     224             : 
     225           0 :       CALL timestop("total time hsfock")
     226             : 
     227           0 :    END SUBROUTINE hsfock
     228             : 
     229             : END MODULE m_hsfock

Generated by: LCOV version 1.13