Line data Source code
1 : module m_wavefproducts_inv
2 : USE m_types_hybdat
3 : use m_wavefproducts_noinv
4 : USE m_constants
5 : USE m_judft
6 : USE m_types
7 : USE m_types_hybinp
8 : USE m_util
9 : USE m_io_hybrid
10 : USE m_wrapper
11 : USE m_constants
12 : USE m_wavefproducts_aux
13 :
14 : CONTAINS
15 66 : SUBROUTINE wavefproducts_inv(fi, ik, z_k, iq, jsp, bandoi, bandof, lapw, hybdat, mpdata, nococonv, stars, ikqpt, cmt_nk, cprod)
16 : IMPLICIT NONE
17 : type(t_fleurinput), intent(in):: fi
18 : TYPE(t_mpdata), intent(in) :: mpdata
19 : type(t_nococonv), intent(in) :: nococonv
20 : type(t_stars), intent(in) :: stars
21 : type(t_mat), intent(in) :: z_k ! = z_k_p since ik < nkpt
22 : TYPE(t_lapw), INTENT(IN) :: lapw
23 : TYPE(t_hybdat), INTENT(INOUT) :: hybdat
24 : type(t_mat), intent(inout) :: cprod
25 :
26 : ! - scalars -
27 : INTEGER, INTENT(IN) :: jsp, ik, iq, bandoi, bandof
28 : INTEGER, INTENT(INOUT) :: ikqpt
29 : complex, intent(in) :: cmt_nk(:,:,:)
30 :
31 :
32 : ! - local scalars -
33 : INTEGER :: g_t(3), i, j
34 : REAL :: kqpt(3), kqpthlp(3)
35 :
36 66 : type(t_mat) :: z_kqpt_p
37 66 : complex, allocatable :: c_phase_kqpt(:), tmp(:,:)
38 :
39 66 : CALL timestart("wavefproducts_inv")
40 66 : ikqpt = -1
41 264 : kqpthlp = fi%kpts%bkf(:, ik) + fi%kpts%bkf(:, iq)
42 : ! kqpt can lie outside the first BZ, transfer it back
43 66 : kqpt = fi%kpts%to_first_bz(kqpthlp)
44 264 : g_t = nint(kqpt - kqpthlp)
45 :
46 : ! determine number of kqpt
47 66 : ikqpt = fi%kpts%get_nk(kqpt)
48 198 : allocate (c_phase_kqpt(hybdat%nbands(fi%kpts%bkp(ikqpt),jsp)))
49 66 : IF (.not. fi%kpts%is_kpt(kqpt)) call juDFT_error('wavefproducts_inv5: k-point not found')
50 :
51 : !$acc data copyin(hybdat, hybdat%nbasp)
52 : !$acc data copyin(cprod) create(cprod%data_c) copyout(cprod%data_r)
53 : !$acc kernels present(cprod, cprod%data_r)
54 8548200 : cprod%data_r(:,:) = 0.0
55 : !$acc end kernels
56 : call wavefproducts_IS_FFT(fi, ik, iq, g_t, jsp, bandoi, bandof, mpdata, hybdat, lapw, stars, nococonv, &
57 66 : ikqpt, z_k, z_kqpt_p, c_phase_kqpt, cprod)
58 : !$acc end data ! cprod
59 :
60 :
61 264 : allocate(tmp(hybdat%nbasp, cprod%matsize2))
62 : !$acc data copyout(tmp)
63 : !$acc kernels present(tmp)
64 6143694 : tmp = cmplx_0
65 : !$acc end kernels
66 : call wavefproducts_noinv_MT(fi, ik, iq, bandoi, bandof, nococonv, mpdata, hybdat, &
67 66 : jsp, ikqpt, z_kqpt_p, c_phase_kqpt, cmt_nk, tmp)
68 66 : call transform_to_realsph(fi, mpdata, tmp)
69 : !$acc end data
70 :
71 66 : call timestart("cpu cmplx2real copy")
72 66 : !$omp parallel do default(none) collapse(2) private(i,j) shared(cprod, hybdat, tmp)
73 : do i = 1,cprod%matsize2
74 : do j = 1,hybdat%nbasp
75 : cprod%data_r(j,i) = real(tmp(j,i))
76 : enddo
77 : enddo
78 : !$omp end parallel do
79 66 : call timestop("cpu cmplx2real copy")
80 66 : deallocate(tmp)
81 : !$acc end data ! hybdat
82 :
83 66 : CALL timestop("wavefproducts_inv")
84 66 : END SUBROUTINE wavefproducts_inv
85 :
86 66 : subroutine transform_to_realsph(fi, mpdata, cprod)
87 : use m_constants
88 : implicit none
89 : type(t_fleurinput), intent(in):: fi
90 : TYPE(t_mpdata), intent(in) :: mpdata
91 : complex, intent(inout) :: cprod(:,:)
92 :
93 : integer :: lm_0, lm, iatm, iatm2, itype, l, m, partner, ioffset, ishift
94 :
95 : !$acc data copyin(mpdata, mpdata%num_radbasfn)
96 66 : lm_0 = 0
97 154 : do iatm = 1,fi%atoms%nat
98 88 : itype = fi%atoms%itype(iatm)
99 :
100 88 : iatm2 = fi%sym%invsatnr(iatm)
101 88 : IF(iatm2.EQ.0) iatm2 = iatm
102 :
103 528 : ioffset = sum((/((2*l + 1)*mpdata%num_radbasfn(l, itype), l=0, fi%hybinp%lcutm1(itype))/))
104 :
105 154 : IF(iatm2.LT.iatm) THEN ! iatm is the second of two atoms that are mapped onto each other by inversion symmetry
106 0 : DO l = 0, fi%hybinp%lcutm1(itype)
107 0 : lm_0 = lm_0 + mpdata%num_radbasfn(l, itype)*(2*l + 1) ! go to the lm start index of the next l-quantum number
108 : END DO
109 : CYCLE
110 88 : ELSE IF (iatm2.GT.iatm) THEN
111 : ! In this case we already make everything correct in wavefproducts_noinv_MT
112 0 : DO l = 0, fi%hybinp%lcutm1(itype)
113 0 : lm = lm_0
114 0 : DO m = -l, l
115 :
116 : ishift = -2 * m * mpdata%num_radbasfn(l, itype)
117 : ! lm1 = lm + (iatm - fi%atoms%firstAtom(itype))*ioffset
118 : ! lm2 = lm + (iatm2 - fi%atoms%firstAtom(itype))*ioffset + ishift
119 :
120 : ! DO i = 1, mpdata%num_radbasfn(l, itype)
121 : ! cprod(i + lm1, (j-bandoi+1) + (k-1)*psize) = REAL(cprod(i + lm1, (j-bandoi+1) + (k-1)*psize))
122 : ! END DO
123 :
124 : lm = lm + mpdata%num_radbasfn(l, itype)
125 : END DO
126 0 : lm_0 = lm_0 + mpdata%num_radbasfn(l, itype)*(2*l + 1) ! go to the lm start index of the next l-quantum number
127 : END DO
128 : ELSE
129 : ! The default(shared) in the OMP part of the following loop is needed to avoid compilation issues on gfortran 7.5.
130 528 : DO l = 0, fi%hybinp%lcutm1(itype)
131 2640 : DO m = -l, l
132 2200 : lm = lm_0 + (m + l)*mpdata%num_radbasfn(l, itype)
133 2640 : if(m == 0) then
134 440 : if(mod(l,2) == 1) then
135 : !$acc kernels present(cprod, mpdata, mpdata%num_radbasfn)
136 : cprod(lm+1:lm+mpdata%num_radbasfn(l, itype), :) &
137 596492 : = -ImagUnit * cprod(lm+1:lm+mpdata%num_radbasfn(l, itype), :)
138 : !$acc end kernels
139 : endif
140 : else
141 1760 : if(m < 0) then
142 880 : partner = lm + 2*abs(m)*mpdata%num_radbasfn(l,itype)
143 : !$acc kernels present(cprod, mpdata, mpdata%num_radbasfn)
144 : cprod(lm+1:lm+mpdata%num_radbasfn(l, itype), :) &
145 5464488 : = (-1.0)**l * sqrt_2 * (-1.0)**m * real(cprod(partner+1:partner+mpdata%num_radbasfn(l, itype), :))
146 : !$acc end kernels
147 : else
148 : !$acc kernels present(cprod, mpdata, mpdata%num_radbasfn)
149 : cprod(lm+1:lm+mpdata%num_radbasfn(l, itype), :) &
150 2732684 : = -(-1.0)**l * sqrt_2 * (-1.0)**m * aimag(cprod(lm+1:lm+mpdata%num_radbasfn(l, itype), :))
151 : !$acc end kernels
152 : endif
153 : endif
154 : enddo
155 528 : lm_0 = lm_0 + mpdata%num_radbasfn(l, itype)*(2*l + 1) ! go to the lm start index of the next l-quantum number
156 : enddo
157 : END IF
158 : enddo
159 : !$acc end data
160 66 : end subroutine transform_to_realsph
161 : end module m_wavefproducts_inv
|
