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_dfpt_eigen_hssetup
       8             : CONTAINS
       9           0 :    SUBROUTINE dfpt_eigen_hssetup(isp, fmpi, fi, enpara, nococonv, starsq, &
      10             :                             ud, td, tdV1, vTot, vTot1, lapw, lapwq, iDir, iDtype, hmat_final, smat_final, nk, killcont)
      11             :       USE m_types
      12             :       USE m_types_mpimat
      13             :       USE m_dfpt_hs_int
      14             :       USE m_dfpt_hsmt
      15             :       USE m_dfpt_hsvac
      16             :       USE m_dfpt_eigen_redist_matrix
      17             : 
      18             :       IMPLICIT NONE
      19             : 
      20             :       INTEGER,            INTENT(IN)     :: isp
      21             :       TYPE(t_mpi),        INTENT(IN)     :: fmpi
      22             :       type(t_fleurinput), INTENT(IN)     :: fi
      23             :       TYPE(t_stars),      INTENT(IN)     :: starsq
      24             :       TYPE(t_enpara),     INTENT(IN)     :: enpara
      25             :       TYPE(t_nococonv),   INTENT(IN)     :: nococonv
      26             :       TYPE(t_usdus),      INTENT(IN)     :: ud
      27             :       TYPE(t_tlmplm),     INTENT(IN)     :: td, tdV1
      28             :       TYPE(t_lapw),       INTENT(IN)     :: lapw, lapwq
      29             :       TYPE(t_potden),     INTENT(IN)     :: vTot, vTot1
      30             :       INTEGER,            INTENT(IN)     :: iDir, iDtype
      31             :       CLASS(t_mat), ALLOCATABLE, INTENT(INOUT)   :: smat_final, hmat_final
      32             :       INTEGER,      INTENT(IN)     :: nk, killcont(6)
      33             : 
      34           0 :       CLASS(t_mat), ALLOCATABLE :: smat(:, :), hmat(:, :)
      35             : 
      36             :       INTEGER :: i, j, nspins
      37             : 
      38           0 :       nspins = MERGE(2, 1, fi%noco%l_noco)
      39           0 :       IF (fmpi%n_size == 1) THEN
      40           0 :          ALLOCATE (t_mat::smat(nspins, nspins), hmat(nspins, nspins))
      41             :       ELSE
      42           0 :          ALLOCATE (t_mpimat::smat(nspins, nspins), hmat(nspins, nspins))
      43             :       END IF
      44             : 
      45           0 :       DO i = 1, nspins
      46           0 :          DO j = 1, nspins
      47           0 :             CALL smat(i, j)%init(.FALSE., lapwq%nv(i) + fi%atoms%nlotot, lapw%nv(j) + fi%atoms%nlotot, fmpi%sub_comm, .false.)
      48           0 :             CALL hmat(i, j)%init(smat(i, j))
      49             :          END DO
      50             :       END DO
      51             : 
      52             :       ! Interstitial part:
      53             :       ! h1 gets V1Theta(k+q,k), VTheta1(k+q,k) and TTheta1(k+q,k)
      54             :       ! s1 gets Theta1(k+q,k)
      55           0 :       CALL timestart("Interstitial part")
      56           0 :       CALL dfpt_hs_int(fi%noco, fi%juphon, starsq, lapwq, lapw, fmpi, fi%cell%bbmat, isp, vTot1%pw_w, hmat, smat, killcont(1:3))
      57           0 :       CALL timestop("Interstitial part")
      58             : 
      59             :       ! Interstitial part:
      60             :       ! h1 gets V1MT(k+q,k) and pref_H0(k+q,k)
      61             :       ! s1 gets pref_S0(k+q,k)
      62             :       ! The prefactor parts only apply in the displaced MT
      63           0 :       CALL timestart("MT part")
      64           0 :       DO i = 1, nspins; DO j = 1, nspins
      65             :             !$acc enter data copyin(hmat(i,j),smat(i,j))
      66             :             !$acc enter data copyin(hmat(i,j)%data_r,smat(i,j)%data_r,hmat(i,j)%data_c,smat(i,j)%data_c)
      67             :       END DO; END DO
      68           0 :       CALL dfpt_hsmt(fi%atoms, fi%sym, fi%juphon, enpara, isp, iDir, iDtype, fi%input, fmpi, fi%noco, nococonv, fi%cell, lapw, lapwq, ud, td, tdV1, hmat, smat, nk, killcont(4:6))
      69           0 :       DO i = 1, nspins; DO j = 1, nspins; if (hmat(1, 1)%l_real) THEN
      70             :             !$acc exit data copyout(hmat(i,j)%data_r,smat(i,j)%data_r) delete(hmat(i,j)%data_c,smat(i,j)%data_c)
      71             :             !$acc exist data delete(hmat(i,j),smat(i,j))
      72             :          ELSE
      73             :             !$acc exit data copyout(hmat(i,j)%data_c,smat(i,j)%data_c) delete(hmat(i,j)%data_r,smat(i,j)%data_r)
      74             :             !$acc exist data delete(hmat(i,j),smat(i,j))
      75             :          END IF; END DO; END DO
      76           0 :       CALL timestop("MT part")
      77             : 
      78             :       ! Vacuum part:
      79             :       ! h1 gets V1Vac(k+q,k)
      80           0 :       IF (fi%input%film) THEN
      81           0 :          CALL timestart("Vacuum part")
      82             :          CALL dfpt_hsvac(fi%vacuum, starsq, fmpi, isp, fi%input, vTot, vTot1, enpara%evac, fi%cell, &
      83           0 :                     lapwq, lapw,  fi%noco, nococonv, hmat)
      84           0 :          CALL timestop("Vacuum part")
      85             :       END IF
      86             : 
      87             :       ! NOCO_DFPT: Build a big matrix with both spins on both axes from
      88             :       ! the 2x2 array of matrices that each have one spin combination.
      89             :       ! Now copy the data into final matrix
      90             :       ! Collect the four fi%noco parts into a single matrix
      91             :       ! In collinear case only a copy is done
      92             :       ! In the parallel case also a redistribution happens
      93           0 :       ALLOCATE (smat_final, mold=smat(1, 1))
      94           0 :       ALLOCATE (hmat_final, mold=smat(1, 1))
      95             : 
      96           0 :       CALL timestart("Matrix redistribution")
      97           0 :       CALL dfpt_eigen_redist_matrix(fmpi, lapwq, lapw, fi%atoms, smat, smat_final)
      98           0 :       CALL dfpt_eigen_redist_matrix(fmpi, lapwq, lapw, fi%atoms, hmat, hmat_final, smat_final)
      99           0 :       CALL timestop("Matrix redistribution")
     100             : 
     101           0 :    END SUBROUTINE dfpt_eigen_hssetup
     102             : END MODULE m_dfpt_eigen_hssetup