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_matrix_pref
8 : CONTAINS
9 0 : SUBROUTINE matrix_pref(fmpi, atoms, bmat, gvecPr, gvec, lapwPr, lapw, nk, nvPr, nv, &
10 : & iDtype, iDir, hmat_tmp, smat_tmp, hmat, smat, killcont)
11 : !> Decoratetes matrix elements of the form
12 : !! <\phi_{kG'q}|M|\phi_{kG}>
13 : !! with a prefactor i(G-G'-q).
14 :
15 : USE m_types
16 :
17 : IMPLICIT NONE
18 :
19 : TYPE(t_mpi), INTENT(IN) :: fmpi
20 : TYPE(t_atoms), INTENT(IN) :: atoms
21 : TYPE(t_lapw), INTENT(IN) :: lapwPr, lapw
22 : REAL, INTENT(IN) :: bmat(3, 3)
23 : INTEGER, INTENT(IN) :: gvecPr(:, :), gvec(:, :)
24 : INTEGER, INTENT(IN) :: nk, nvPr, nv, iDtype, iDir, killcont(2)
25 :
26 : CLASS(t_mat), INTENT(IN) :: hmat_tmp, smat_tmp
27 : CLASS(t_mat), INTENT(INOUT) :: hmat, smat
28 :
29 : INTEGER :: ikGPr, ikG, ikG0
30 : INTEGER :: iLo, l, imLo, ikLo, ikGLo, ikGLo0 ! LO stuff
31 : INTEGER :: iLoPr, lPr, imLoPr, ikLoPr, ikGLoPr ! LO stuff
32 : COMPLEX :: pref(3)
33 :
34 : !$OMP PARALLEL DO SCHEDULE(dynamic) DEFAULT(none) &
35 : !$OMP SHARED(fmpi, atoms, bmat, gvecPr, gvec, lapwPr, lapw, killcont) &
36 : !$OMP SHARED(nk, nvPr, nv, iDir, hmat_tmp, smat_tmp, hmat, smat, iDtype) &
37 : !$OMP PRIVATE(ikGPr, ikG, ikG0, pref) &
38 : !$OMP PRIVATE(iLo, l, imLo, ikLo, ikGLo, ikGLo0) &
39 0 : !$OMP PRIVATE(iLoPr, lPr, imLoPr, ikLoPr, ikGLoPr)
40 : DO ikG = fmpi%n_rank + 1, nv + atoms%nlo(iDtype), fmpi%n_size
41 : ikG0 = (ikG-1) / fmpi%n_size + 1
42 : DO ikGPr = 1, nvPr + atoms%nlo(iDtype)
43 : IF (ikGPr<=nvPr.AND.ikG<=nv) THEN
44 : pref = gvec(:, ikG) + lapw%bkpt
45 : pref = pref - gvecPr(:, ikGPr) - lapwPr%bkpt - lapwPr%qphon
46 : pref = ImagUnit * MATMUL(pref, bmat)
47 : !IF (nk==40) THEN
48 : ! write(9456,*) "---------------"
49 : ! write(9456,*) iDir, ikGPr, ikG
50 : ! write(9456,*) gvecPr(:, ikGPr)
51 : ! write(9456,*) lapwPr%bkpt
52 : ! write(9456,*) gvec(:, ikG)
53 : ! write(9456,*) lapw%bkpt
54 : ! write(9456,*) bmat
55 : ! write(9456,*) pref
56 : ! write(9456,*) smat_tmp%data_c(ikGPr, ikG0)
57 : !END IF
58 : hmat%data_c(ikGPr, ikG0) = hmat%data_c(ikGPr, ikG0) &
59 : & + killcont(1) * pref(iDir) * hmat_tmp%data_c(ikGPr, ikG0)
60 : smat%data_c(ikGPr, ikG0) = smat%data_c(ikGPr, ikG0) &
61 : & + killcont(2) * pref(iDir) * smat_tmp%data_c(ikGPr, ikG0)
62 : ELSE IF (ikGPr<=nvPr.AND.ikG==nv+1) THEN
63 :
64 : DO iLo = 1, atoms%nlo(iDtype)
65 : DO imLo = 1, lapw%nkvec(iLo,iDtype)
66 : ikLo = lapw%kvec(imLo,iLo,iDtype)
67 : ikGLo = nv + lapw%index_lo(iLo,iDtype) + imLo
68 :
69 : pref = 0*gvec(:,ikLo) + 0*lapw%bkpt
70 : pref = pref - gvecPr(:, ikGPr) - lapwPr%bkpt - lapwPr%qphon
71 : pref = ImagUnit * MATMUL(pref, bmat)
72 :
73 : hmat%data_c(ikGPr, ikGLo) = hmat%data_c(ikGPr, ikGLo) &
74 : & + killcont(1) * pref(iDir) * hmat_tmp%data_c(ikGPr, ikGLo)
75 : smat%data_c(ikGPr, ikGLo) = smat%data_c(ikGPr, ikGLo) &
76 : & + killcont(2) * pref(iDir) * smat_tmp%data_c(ikGPr, ikGLo)
77 : END DO
78 : END DO ! loop over LOs
79 :
80 : !iLo = ikG-nv
81 : !l = atoms%llo(iLo, iDtype)
82 : !DO imLo = 1, 2*l+1
83 : ! ikLo = lapw%kvec(imLo,iLo,iDtype)
84 : ! ikGLo = nv + lapw%index_lo(iLo,iDtype) + imLo
85 : ! IF (MOD(ikGLo-1,fmpi%n_size) == fmpi%n_rank) THEN
86 : ! ikGLo0 = (ikGLo-1)/fmpi%n_size+1
87 :
88 : ! pref = gvec(:,ikLo) + lapw%bkpt
89 : ! pref = pref - gvecPr(:, ikGPr) - lapwPr%bkpt - lapwPr%qphon
90 : ! pref = ImagUnit * MATMUL(pref, bmat)
91 :
92 : ! hmat%data_c(ikGPr, ikGLo0) = hmat%data_c(ikGPr, ikGLo0) &
93 : ! & + killcont(1) * pref(iDir) * hmat_tmp%data_c(ikGPr, ikGLo0)
94 : ! smat%data_c(ikGPr, ikGLo0) = smat%data_c(ikGPr, ikGLo0) &
95 : ! & + killcont(2) * pref(iDir) * smat_tmp%data_c(ikGPr, ikGLo0)
96 : ! END IF
97 : !END DO
98 : ELSE IF (ikGPr>nvPr.AND.ikG<=nv) THEN
99 : iLoPr = ikGPr-nvPr
100 : lPr = atoms%llo(iLoPr, iDtype)
101 : DO imLoPr = 1, 2*lPr+1
102 : ikLoPr = lapwPr%kvec(imLoPr,iLoPr,iDtype)
103 : ikGLoPr = nvPr + lapwPr%index_lo(iLoPr,iDtype) + imLoPr
104 :
105 : pref = gvec(:, ikG) + lapw%bkpt
106 : pref = pref - 0*gvecPr(:,ikLoPr) - 0*lapwPr%bkpt - 0*lapwPr%qphon
107 : pref = ImagUnit * MATMUL(pref, bmat)
108 :
109 : hmat%data_c(ikGLoPr, ikG0) = hmat%data_c(ikGLoPr, ikG0) &
110 : & + killcont(1) * pref(iDir) * hmat_tmp%data_c(ikGLoPr, ikG0)
111 : smat%data_c(ikGLoPr, ikG0) = smat%data_c(ikGLoPr, ikG0) &
112 : & + killcont(2) * pref(iDir) * smat_tmp%data_c(ikGLoPr, ikG0)
113 : END DO
114 : ELSE IF (ikGPr>nvPr.AND.ikG>nv) THEN
115 : iLoPr = ikGPr-nvPr
116 : lPr = atoms%llo(iLoPr, iDtype)
117 : iLo = ikG-nv
118 : l = atoms%llo(iLo, iDtype)
119 : DO imLo = 1, 2*l+1
120 : ikLo = lapw%kvec(imLo,iLo,iDtype)
121 : ikGLo = nv + lapw%index_lo(iLo,iDtype) + imLo
122 : IF (MOD(ikGLo-1,fmpi%n_size) == fmpi%n_rank) THEN
123 : ikGLo0 = (ikGLo-1)/fmpi%n_size+1
124 :
125 : DO imLoPr = 1, 2*lPr+1
126 : ikLoPr = lapwPr%kvec(imLoPr,iLoPr,iDtype)
127 : ikGLoPr = nvPr + lapwPr%index_lo(iLoPr,iDtype) + imLoPr
128 :
129 : pref = 0*gvec(:,ikLo) + 0*lapw%bkpt
130 : pref = pref - 0*gvecPr(:,ikLoPr) - 0*lapwPr%bkpt - 0*lapwPr%qphon
131 : pref = ImagUnit * MATMUL(pref, bmat)
132 :
133 : hmat%data_c(ikGLoPr, ikGLo0) = hmat%data_c(ikGLoPr, ikGLo0) &
134 : & + killcont(1) * pref(iDir) * hmat_tmp%data_c(ikGLoPr, ikGLo0)
135 : smat%data_c(ikGLoPr, ikGLo0) = smat%data_c(ikGLoPr, ikGLo0) &
136 : & + killcont(2) * pref(iDir) * smat_tmp%data_c(ikGLoPr, ikGLo0)
137 : END DO
138 : END IF
139 : END DO
140 : END IF
141 : END DO
142 : END DO
143 : !$OMP END PARALLEL DO
144 0 : END SUBROUTINE matrix_pref
145 : END MODULE m_matrix_pref
|
