Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2022 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_direct
       8             : CONTAINS
       9        9430 :    SUBROUTINE hs_int_direct(fmpi, stars, bbmat, gvecPr, gvec, kvecPr, kvec, nvPr, nv, &
      10        9430 :                           & iTkin, fact, l_smat, l_fullj, vpw, hmat, smat, theta_alt)
      11             :       ! Calculates matrix elements of the form
      12             :       ! <\phi_{k'G'}|M|\phi_{kG}>
      13             :       ! for different use cases in the DFT/DFPT scf loop and operators M.
      14             :       !
      15             :       ! The spin loop and distinction is found on a higher level and translates
      16             :       ! into new switches.
      17             :       !
      18             :       ! DFT:
      19             :       ! M = \Theta_{IR} * (T + V) goes into hmat, M = \Theta_{IR} into smat.
      20             :       ! [vpw = \Theta_{IR} * V]
      21             :       ! [stars%ustep = \Theta_{IR}]
      22             :       ! [l_smat = F for offdiags, l_fullj = F]
      23             :       ! [iTkin = 0 for offdiags, 1 for l_useapw, 2 else]
      24             :       !
      25             :       ! DFPT:
      26             :       ! M = \Theta_{IR}^{(1)} * (T + V) + \Theta_{IR} * V^{(1)} goes into hmat,
      27             :       ! M = \Theta_{IR}^{(1)} into smat.
      28             :       ! [vpw = \Theta_{IR}^{(1)} * V + \Theta_{IR} * V^{(1)}]
      29             :       ! [stars%ustep = \Theta_{IR}^{(1)}]
      30             :       ! [l_smat = F for offdiags, l_fullj = T]
      31             :       ! [iTkin = 0 for offdiags, 1 else]
      32             : 
      33             :       USE m_types
      34             : 
      35             :       IMPLICIT NONE
      36             : 
      37             :       TYPE(t_mpi),   INTENT(IN)    :: fmpi
      38             :       TYPE(t_stars), INTENT(IN)    :: stars
      39             :       REAL,          INTENT(IN)    :: bbmat(3, 3)
      40             :       INTEGER,       INTENT(IN)    :: gvecPr(:, :), gvec(:, :)
      41             :       REAL,          INTENT(IN)    :: kvecPr(3), kvec(3)
      42             :       INTEGER,       INTENT(IN)    :: nvPr, nv, iTkin, fact
      43             :       LOGICAL,       INTENT(IN)    :: l_smat, l_fullj
      44             :       COMPLEX,       INTENT(IN)    :: vpw(:)
      45             : 
      46             :       CLASS(t_mat),  INTENT(INOUT) :: hmat, smat
      47             : 
      48             :       COMPLEX, OPTIONAL, INTENT(IN) :: theta_alt(:)
      49             : 
      50             :       INTEGER :: ikGPr, ikG, ikG0, gPrG(3), gInd
      51             :       COMPLEX :: th, ts, phase
      52             :       REAL    :: bvecPr(3), bvec(3), r2
      53             : 
      54             :       !$OMP PARALLEL DO SCHEDULE(dynamic) DEFAULT(none) &
      55             :       !$OMP SHARED(fmpi, stars, bbmat, gvecPr, gvec, kvecPr, kvec) &
      56             :       !$OMP SHARED(nvPr, nv, iTkin, fact, l_smat, l_fullj, vpw, hmat, smat, theta_alt) &
      57        9430 :       !$OMP PRIVATE(ikGPr, ikG, ikG0, gPrG, gInd, th, ts, phase, bvecPr, bvec, r2)
      58             :       DO ikG = fmpi%n_rank + 1, nv, fmpi%n_size
      59             :          ikG0 = (ikG-1) / fmpi%n_size + 1
      60             :          DO  ikGPr = 1, MERGE(nvPr, MIN(ikG, nvPr), l_fullj)
      61             :             gPrG = fact * (gvecPr(:, ikGPr) - gvec(:, ikG))
      62             : 
      63             :             gInd = stars%ig(gPrG(1), gPrG(2), gPrG(3))
      64             : 
      65             :             IF (gInd.EQ.0) CYCLE
      66             : 
      67             :             phase = stars%rgphs(gPrG(1), gPrG(2), gPrG(3))
      68             : 
      69             :             th = phase * vpw(gInd)
      70             : 
      71             :             IF (iTkin.GT.0) THEN
      72             :                bvecPr = kvecPr + gvecPr(:, ikGPr)
      73             :                bvec = kvec + gvec(:, ikG)
      74             : 
      75             :                IF (iTkin.EQ.1) THEN ! Symmetric Dirac form
      76             :                   r2 = 0.5 * DOT_PRODUCT(MATMUL(bvecPr, bbmat), bvec)
      77             :                ELSE IF (iTkin.EQ.2) THEN ! Symmetrized Laplace form
      78             :                   r2 =      0.25 * DOT_PRODUCT(MATMUL(bvecPr, bbmat), bvecPr)
      79             :                   r2 = r2 + 0.25 * DOT_PRODUCT(MATMUL(bvec, bbmat), bvec)
      80             :                   ! Old form:
      81             :                   ! 0.25* (rk(i)**2+rkPr(j)**2); rk(Pr)=lapw(Pr)%rk
      82             :                ELSE ! Pure Laplace form
      83             :                   r2 = 0.5 * DOT_PRODUCT(MATMUL(bvec, bbmat), bvec)
      84             :                END IF
      85             : 
      86             :                IF (PRESENT(theta_alt)) THEN
      87             :                   th = th + phase * r2 * theta_alt(gInd)
      88             :                ELSE
      89             :                   th = th + phase * r2 * stars%ustep(gInd)
      90             :                END IF
      91             :             END IF
      92             : 
      93             :             IF (l_smat) THEN
      94             :                IF (PRESENT(theta_alt)) THEN
      95             :                   ts = phase * theta_alt(gInd)
      96             :                ELSE
      97             :                   ts = phase * stars%ustep(gInd)
      98             :                END IF
      99             :             ELSE
     100             :                ts = 0.0
     101             :             END IF
     102             : 
     103             :             IF (hmat%l_real) THEN
     104             :                hmat%data_r(ikGPr, ikG0) = REAL(th)
     105             :                smat%data_r(ikGPr, ikG0) = REAL(ts)
     106             :             ELSE
     107             :                hmat%data_c(ikGPr, ikG0) = th
     108             :                smat%data_c(ikGPr, ikG0) = ts
     109             :             END IF
     110             :          END DO
     111             :       END DO
     112             :       !$OMP END PARALLEL DO
     113        9430 :    END SUBROUTINE hs_int_direct
     114             : END MODULE m_hs_int_direct