Line data Source code
1 : MODULE m_convol
2 : CONTAINS
3 5540 : SUBROUTINE convol(stars, fg3, ag3)
4 :
5 : !************************************************************
6 : !* *
7 : !* calculate f(G) = \sum_G' U(G - G') a(G') *
8 : !* *
9 : !* U is already given on the real space mesh as U(r) *
10 : !* *
11 : !* ag3(star) -- FFT --> gfft(r,1) *
12 : !* gfft(r,1)=gfft(r,1) * U (r) *
13 : !* fg3(star) <- FFT --- gfft(r,1) *
14 : !* *
15 : !* dimension of gfft is *
16 : !* (3*stars%mx1 x 3*stars%mx2 x 3*stars%mx3) *
17 : !* *
18 : !************************************************************
19 : USE m_types_fftGrid
20 : USE m_juDFT
21 : USE m_types_stars
22 :
23 : IMPLICIT NONE
24 :
25 : TYPE(t_stars), INTENT(IN) :: stars
26 :
27 : COMPLEX, INTENT(INOUT) :: fg3(:)
28 : COMPLEX, INTENT(IN), OPTIONAL :: ag3(:)
29 :
30 44320 : TYPE(t_fftgrid) :: fftgrid
31 :
32 22160 : CALL fftgrid%init((/3*stars%mx1,3*stars%mx2,3*stars%mx3/))
33 :
34 5540 : IF (SIZE(fftgrid%grid)/=SIZE(stars%ufft)) CALL judft_error("Bug in t_stars%convol")
35 5540 : IF (PRESENT(ag3)) THEN
36 4395 : CALL fftgrid%putFieldOnGrid(stars,ag3)
37 : ELSE
38 : !In place version
39 1145 : CALL fftgrid%putFieldOnGrid(stars,fg3)
40 : END IF
41 5540 : CALL fftgrid%perform_fft(forward=.false.)
42 :
43 235963297 : fftgrid%grid = fftgrid%grid*stars%ufft
44 :
45 5540 : CALL fftgrid%perform_fft(forward=.true.)
46 5540 : CALL fftgrid%takeFieldFromGrid(stars,fg3)
47 8448614 : fg3 = fg3*stars%nstr
48 :
49 5540 : END SUBROUTINE convol
50 :
51 0 : SUBROUTINE dfpt_convol(stars, starsq, pw, pwq, pww)
52 : USE m_types_fftGrid
53 : USE m_juDFT
54 : USE m_types_stars
55 :
56 : IMPLICIT NONE
57 :
58 : TYPE(t_stars), INTENT(IN) :: stars, starsq
59 :
60 : COMPLEX, INTENT(IN) :: pw(:), pwq(:)
61 : COMPLEX, INTENT(INOUT) :: pww(:)
62 :
63 0 : TYPE(t_fftgrid) :: fftgrid, fftgridq
64 :
65 0 : CALL fftgrid%init((/3*stars%mx1,3*stars%mx2,3*stars%mx3/))
66 0 : CALL fftgridq%init((/3*starsq%mx1,3*starsq%mx2,3*starsq%mx3/))
67 :
68 0 : IF (SIZE(fftgrid%grid)/=SIZE(stars%ufft)) CALL judft_error("Size mismatch in dfpt_convol (1)!")
69 0 : IF (SIZE(fftgridq%grid)/=SIZE(starsq%ufft1)) CALL judft_error("Size mismatch in dfpt_convol (2)!")
70 0 : IF (SIZE(fftgridq%grid)/=SIZE(fftgrid%grid)) CALL judft_error("Size mismatch in dfpt_convol (3)!")
71 :
72 0 : CALL fftgrid%putFieldOnGrid(stars,pw)
73 0 : CALL fftgridq%putFieldOnGrid(starsq,pwq)
74 0 : CALL fftgrid%perform_fft(forward=.false.)
75 0 : CALL fftgridq%perform_fft(forward=.false.)
76 :
77 0 : fftgrid%grid = fftgrid%grid*starsq%ufft1 + fftgridq%grid*stars%ufft
78 :
79 0 : CALL fftgrid%perform_fft(forward=.true.)
80 0 : CALL fftgrid%takeFieldFromGrid(stars,pww)
81 0 : pww = pww*stars%nstr
82 :
83 0 : END SUBROUTINE dfpt_convol
84 :
85 0 : SUBROUTINE dfpt_convol_direct(stars, starsq, pw, pwq, pwwq)
86 : ! TODO: Should probably be replaced by a "finer" function with full
87 : ! G-grid for ustep(1)
88 : USE m_types_fftGrid
89 : USE m_juDFT
90 : USE m_types_stars
91 :
92 : IMPLICIT NONE
93 :
94 : TYPE(t_stars), INTENT(IN) :: stars, starsq
95 :
96 : COMPLEX, INTENT(IN) :: pw(:), pwq(:)
97 : COMPLEX, INTENT(INOUT) :: pwwq(:)
98 :
99 0 : TYPE(t_fftgrid) :: fftgrid, fftgridq
100 :
101 0 : CALL fftgrid%init((/3*stars%mx1,3*stars%mx2,3*stars%mx3/))
102 0 : CALL fftgridq%init((/3*starsq%mx1,3*starsq%mx2,3*starsq%mx3/))
103 :
104 0 : IF (SIZE(fftgridq%grid)/=SIZE(fftgrid%grid)) CALL judft_error("Size mismatch in dfpt_convol (3)!")
105 :
106 0 : CALL fftgrid%putFieldOnGrid(stars,pw)
107 0 : CALL fftgridq%putFieldOnGrid(starsq,pwq)
108 0 : CALL fftgrid%perform_fft(forward=.false.)
109 0 : CALL fftgridq%perform_fft(forward=.false.)
110 :
111 0 : fftgrid%grid = fftgrid%grid*fftgridq%grid
112 :
113 0 : CALL fftgrid%perform_fft(forward=.true.)
114 0 : CALL fftgrid%takeFieldFromGrid(starsq,pwwq)
115 0 : pwwq = pwwq*starsq%nstr
116 :
117 0 : END SUBROUTINE dfpt_convol_direct
118 :
119 0 : SUBROUTINE dfpt_convol_big(resultstar, stars, starsfull, pw, pwfull, pww)
120 : USE m_types_fftGrid
121 : USE m_juDFT
122 : USE m_types_stars
123 :
124 : IMPLICIT NONE
125 :
126 : INTEGER, INTENT(IN) :: resultstar
127 : TYPE(t_stars), INTENT(IN) :: stars, starsfull
128 :
129 : COMPLEX, INTENT(IN) :: pw(:), pwfull(0:)
130 : COMPLEX, INTENT(INOUT) :: pww(:)
131 :
132 0 : TYPE(t_fftgrid) :: fftgrid, fftgridfin
133 :
134 0 : CALL fftgrid%init((/3*stars%mx1,3*stars%mx2,3*stars%mx3/))
135 :
136 0 : IF (SIZE(pwfull)/=SIZE(fftgrid%grid)) CALL judft_error("Size mismatch in dfpt_convol (4)!")
137 :
138 0 : CALL fftgrid%putFieldOnGrid(stars,pw)
139 0 : CALL fftgrid%perform_fft(forward=.false.)
140 :
141 0 : IF (resultstar==1) THEN
142 0 : fftgrid%grid = fftgrid%grid*pwfull
143 0 : CALL fftgrid%perform_fft(forward=.true.)
144 0 : CALL fftgrid%takeFieldFromGrid(stars,pww)
145 0 : pww = pww*stars%nstr
146 0 : ELSE IF (resultstar==2) THEN
147 0 : CALL fftgridfin%init((/3*starsfull%mx1,3*starsfull%mx2,3*starsfull%mx3/))
148 0 : fftgridfin%grid = fftgrid%grid*pwfull
149 0 : CALL fftgridfin%perform_fft(forward=.true.)
150 0 : CALL fftgridfin%takeFieldFromGrid(starsfull,pww)
151 0 : pww = pww*starsfull%nstr
152 : ELSE
153 0 : CALL judft_error("Impossible star index!")
154 : END IF
155 :
156 0 : END SUBROUTINE dfpt_convol_big
157 :
158 : END MODULE m_convol
|
