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_hs_int
8 : CONTAINS
9 : ! Constructs the interstitial perturbed Hamiltonian and overlap matrix
10 0 : SUBROUTINE dfpt_hs_int(noco, juphon, starsq, lapwq, lapw, fmpi, bbmat, isp, vpw, hmat, smat, killcont)
11 :
12 : USE m_types
13 : USE m_hs_int_direct
14 :
15 : IMPLICIT NONE
16 :
17 : TYPE(t_noco),INTENT(IN) :: noco
18 : TYPE(t_juphon),INTENT(IN) :: juphon
19 : TYPE(t_stars),INTENT(IN) :: starsq
20 : REAL, INTENT(IN) :: bbmat(3, 3)
21 : TYPE(t_lapw),INTENT(IN) :: lapwq, lapw
22 : TYPE(t_mpi),INTENT(IN) :: fmpi
23 : INTEGER,INTENT(IN) :: isp, killcont(3)
24 : COMPLEX,INTENT(IN) :: vpw(:, :)
25 : CLASS(t_mat),INTENT(INOUT) :: smat(:,:),hmat(:,:)
26 :
27 : INTEGER :: iSpinPr,iSpin, iMatPr, iMat, iTkin
28 : LOGICAL :: l_smat
29 0 : COMPLEX, ALLOCATABLE :: vpw_temp(:)
30 :
31 0 : IF (noco%l_noco.AND.isp.EQ.2) RETURN !was done already
32 :
33 0 : ALLOCATE(vpw_temp(SIZE(vpw, 1)))
34 :
35 0 : DO iSpinPr = MERGE(1, isp, noco%l_noco), MERGE(2, isp, noco%l_noco)
36 : ! co:
37 : ! iSpinPr = isp, SIZE(smat, 1) = 1 (?)
38 : ! noco:
39 : ! iSpinPr = 1...2, SIZE(smat, 1) = 2 (?)
40 : ! iispin = MIN(iSpinPr, SIZE(smat, 1))
41 : ! co:
42 : ! iispin = 1
43 : ! noco:
44 : ! iispin = 1...2
45 : ! --> alternative: iispin = MERGE(iSpinPr, 1, noco%l_noco) ?
46 0 : iMatPr = MERGE(iSpinPr, 1, noco%l_noco)
47 0 : DO iSpin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
48 0 : iMat = MERGE(iSpin, 1, noco%l_noco)
49 0 : iTkin = 0
50 : ! 1, 2, 3, 4 == 11, 22, 21, 12:
51 0 : IF ((iSpinPr.EQ.1).AND.(iSpin.EQ.1)) vpw_temp = vpw(:, 1) * killcont(1)
52 0 : IF ((iSpinPr.EQ.2).AND.(iSpin.EQ.2)) vpw_temp = vpw(:, 2) * killcont(1)
53 0 : IF ((iSpinPr.EQ.2).AND.(iSpin.EQ.1)) vpw_temp = vpw(:, 3) * killcont(1)
54 0 : IF ((iSpinPr.EQ.1).AND.(iSpin.EQ.2)) vpw_temp = vpw(:, 4) * killcont(1)
55 :
56 0 : l_smat = iSpinPr.EQ.iSpin
57 0 : IF (killcont(3)==0) l_smat = .FALSE.
58 :
59 0 : IF (iSpinPr.EQ.iSpin) iTkin = 2 * killcont(2)
60 :
61 0 : IF (.NOT.juphon%l_phonon) THEN
62 0 : l_smat = .FALSE.
63 0 : iTkin = 0
64 : END IF
65 :
66 : CALL hs_int_direct(fmpi, starsq, bbmat, lapwq%gvec(:, :, iSpinPr), lapw%gvec(:,:,iSpin), &
67 : & lapwq%bkpt + lapwq%qphon, lapw%bkpt, lapwq%nv(iSpinPr), lapw%nv(iSpin), iTkin, 1, &
68 0 : & l_smat, .TRUE., vpw_temp, hmat(iMatPr, iMat), smat(iMatPr, iMat))
69 : END DO
70 : END DO
71 0 : END SUBROUTINE dfpt_hs_int
72 :
73 0 : SUBROUTINE dfpt_dynmat_hs_int(noco, starsq, stars, lapwq, lapw, fmpi, bbmat, isp, theta1_pw0, theta1_pw, smat1, hmat1, smat1q, hmat1q, killcont)
74 :
75 : USE m_types
76 : USE m_hs_int_direct
77 :
78 : IMPLICIT NONE
79 :
80 : TYPE(t_noco),INTENT(IN) :: noco
81 : TYPE(t_stars),INTENT(IN) :: starsq, stars
82 : REAL, INTENT(IN) :: bbmat(3, 3)
83 : TYPE(t_lapw),INTENT(IN) :: lapwq, lapw
84 : TYPE(t_mpi),INTENT(IN) :: fmpi
85 : INTEGER, INTENT(IN) :: isp, killcont(4)
86 : COMPLEX, INTENT(IN) :: theta1_pw0(:), theta1_pw(:)
87 : CLASS(t_mat),INTENT(INOUT) :: smat1(:,:),hmat1(:,:),smat1q(:,:),hmat1q(:,:)!,smat2(:,:),hmat2(:,:)
88 :
89 : INTEGER :: iSpinPr,iSpin, iMatPr, iMat, iTkin
90 : LOGICAL :: l_smat
91 0 : COMPLEX, ALLOCATABLE :: vpw_temp(:), vpwq_temp(:)
92 :
93 0 : IF (noco%l_noco.AND.isp.EQ.2) RETURN !was done already
94 :
95 0 : ALLOCATE(vpw_temp(SIZE(stars%ustep, 1)))
96 0 : ALLOCATE(vpwq_temp(SIZE(starsq%ustep, 1)))
97 :
98 0 : DO iSpinPr = MERGE(1, isp, noco%l_noco), MERGE(2, isp, noco%l_noco)
99 0 : iMatPr = MERGE(iSpinPr, 1, noco%l_noco)
100 0 : DO iSpin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
101 0 : iMat = MERGE(iSpin, 1, noco%l_noco)
102 0 : iTkin = 0
103 :
104 0 : vpw_temp = CMPLX(0.0,0.0)
105 0 : vpwq_temp = CMPLX(0.0,0.0)
106 :
107 0 : l_smat = iSpinPr.EQ.iSpin
108 0 : IF (killcont(2)==0) l_smat = .FALSE.
109 :
110 0 : IF (iSpinPr.EQ.iSpin) iTkin = 2*killcont(1)
111 :
112 : CALL hs_int_direct(fmpi, stars, bbmat, lapw%gvec(:, :, iSpinPr), lapw%gvec(:,:,iSpin), &
113 : & lapw%bkpt, lapw%bkpt, lapw%nv(iSpinPr), lapw%nv(iSpin), iTkin, 1, &
114 0 : & l_smat, .TRUE., vpw_temp, hmat1(iMatPr, iMat), smat1(iMatPr, iMat), theta1_pw0)
115 :
116 0 : iTkin = 0
117 0 : l_smat = iSpinPr.EQ.iSpin
118 0 : IF (killcont(4)==0) l_smat = .FALSE.
119 :
120 0 : IF (iSpinPr.EQ.iSpin) iTkin = 2*killcont(3)
121 : CALL hs_int_direct(fmpi, starsq, bbmat, lapwq%gvec(:, :, iSpinPr), lapw%gvec(:,:,iSpin), &
122 : & lapwq%bkpt + lapwq%qphon, lapw%bkpt, lapwq%nv(iSpinPr), lapw%nv(iSpin), iTkin, 1, &
123 0 : & l_smat, .TRUE., vpwq_temp, hmat1q(iMatPr, iMat), smat1q(iMatPr, iMat), theta1_pw)
124 : ! Alternate form of the dynmat contribution:
125 : ! Calculate Theta2 as well
126 : !CALL hs_int_direct(fmpi, stars, bbmat, lapw%gvec(:, :, iSpinPr), lapw%gvec(:,:,iSpin), &
127 : ! & lapw%bkpt, lapw%bkpt, lapw%nv(iSpinPr), lapw%nv(iSpin), iTkin, 1, &
128 : ! & l_smat, .TRUE., vpw_temp, hmat2(iMatPr, iMat), smat2(iMatPr, iMat), theta1_pw0)
129 : END DO
130 : END DO
131 0 : END SUBROUTINE dfpt_dynmat_hs_int
132 : END MODULE m_dfpt_hs_int
|
