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_hs_int
       8             : CONTAINS
       9             :    !Subroutine to construct the interstitial Hamiltonian and overlap matrix
      10        7342 :    SUBROUTINE hs_int(input, noco, nococonv, stars, lapw, fmpi, bbmat, isp, vpw, &
      11        7342 :                    & smat, hmat)
      12             :       ! Control subroutine for the calculation of Hamiltonian/overlap matrix
      13             :       ! elements in the interstitial. The spin logic and case selections are
      14             :       ! found here while the actual calculation loop is one layer deeper in
      15             :       ! hs_int_direct.
      16             :       !
      17             :       ! <\Phi'|H/S|\Phi>
      18             :       !
      19             :       ! All primed indices are to be understood as corresponding to the Bra
      20             :       ! basis function, e.g. iSpinPr is the left and iSpin the right hand spin.
      21             : 
      22             :       USE m_types
      23             :       USE m_hs_int_direct
      24             : 
      25             :       IMPLICIT NONE
      26             : 
      27             :       TYPE(t_input),    INTENT(IN)    :: input
      28             :       TYPE(t_noco),     INTENT(IN)    :: noco
      29             :       TYPE(t_nococonv), INTENT(IN)    :: nococonv
      30             :       TYPE(t_stars),    INTENT(IN)    :: stars
      31             :       REAL,             INTENT(IN)    :: bbmat(3, 3)
      32             :       TYPE(t_lapw),     INTENT(IN)    :: lapw
      33             :       TYPE(t_mpi),      INTENT(IN)    :: fmpi
      34             :       INTEGER,          INTENT(IN)    :: isp
      35             :       COMPLEX,          INTENT(IN)    :: vpw(:,:)
      36             :       CLASS(t_mat),     INTENT(INOUT) :: smat(:,:),hmat(:,:)
      37             : 
      38             :       INTEGER :: iSpinPr, iSpin, igSpin, igSpinPr
      39             :       INTEGER :: iTkin, fact, iQss
      40             :       LOGICAL :: l_smat
      41             : 
      42        7342 :       COMPLEX, ALLOCATABLE :: vpw_temp(:)
      43             : 
      44       22026 :       ALLOCATE(vpw_temp(SIZE(vpw,1)))
      45             : 
      46        7342 :       IF (noco%l_noco.AND.isp==2) RETURN !was done already
      47             : 
      48       15380 :       DO iSpinPr=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
      49        8038 :          igSpinPr=MIN(iSpinPr,SIZE(smat,1))
      50       24810 :          DO iSpin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
      51        9430 :             igSpin=MIN(iSpin,SIZE(smat,1))
      52        9430 :             IF (iSpinPr.EQ.1.AND.iSpin.EQ.2) THEN
      53     3704748 :                vpw_temp = conjg(vpw(:, 3))
      54         696 :                l_smat   = .FALSE. ! Offdiagonal part --> No step function part.
      55         696 :                iTkin    = 0       ! Offdiagonal part --> No T part.
      56         696 :                fact     = -1      ! (12)-element --> (-1) prefactor
      57         696 :                iQss     = 0       ! No spin-spiral considered (no T).
      58        8734 :             ELSE IF (iSpinPr.EQ.2.AND.iSpin.EQ.1) THEN
      59     3704748 :                vpw_temp = vpw(:, 3)
      60         696 :                l_smat   = .FALSE.
      61         696 :                iTkin    = 0
      62         696 :                fact     = 1
      63         696 :                iQss     = 0
      64             :             ELSE
      65    13194514 :                vpw_temp = vpw(:, iSpin)
      66        8038 :                l_smat   = .TRUE.
      67        8038 :                IF (input%l_useapw) THEN
      68           0 :                   iTkin = 1 ! Dirac form.
      69           0 :                   iQss  = 0 ! No q-vector in kinetic energy.
      70             :                ELSE
      71        8038 :                   iTkin = 2 ! Symmetrized Laplace form.
      72        8038 :                   iQss  = 1 ! Additional q-vectors in kinetic energy.
      73             :                END IF
      74        8038 :                fact     = 1
      75             :             END IF
      76             :             CALL hs_int_direct(fmpi, stars, bbmat, lapw%gvec(:,:,iSpinPr), lapw%gvec(:,:,iSpin), &
      77             :                              & lapw%bkpt+iQss*(2*iSpinPr - 3)/2.0*nococonv%qss+lapw%qphon, lapw%bkpt+iQss*(2*iSpin - 3)/2.0*nococonv%qss+lapw%qphon, &
      78       74048 :                              & lapw%nv(iSpinPr), lapw%nv(iSpin), iTkin, fact, l_smat, .FALSE., vpw_temp, hmat(igSpinPr,igSpin), smat(igSpinPr,igSpin))
      79             :             END DO
      80             :       END DO
      81        7342 :    END SUBROUTINE hs_int
      82             : END MODULE m_hs_int