Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \par History
10 : !> none
11 : ! **************************************************************************************************
12 : MODULE structure_factors
13 :
14 : USE kinds, ONLY: dp
15 : USE mathconstants, ONLY: twopi
16 : USE structure_factor_types, ONLY: structure_factor_type
17 : #include "../base/base_uses.f90"
18 :
19 : IMPLICIT NONE
20 :
21 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'structure_factors'
22 :
23 : PRIVATE
24 : PUBLIC :: structure_factor_evaluate, structure_factor_allocate
25 : PUBLIC :: structure_factor_deallocate, structure_factor_init
26 :
27 : CONTAINS
28 :
29 : ! **************************************************************************************************
30 : !> \brief ...
31 : !> \param exp_igr ...
32 : ! **************************************************************************************************
33 1818 : SUBROUTINE structure_factor_init(exp_igr)
34 :
35 : TYPE(structure_factor_type), INTENT(INOUT) :: exp_igr
36 :
37 1818 : NULLIFY (exp_igr%ex, exp_igr%ey, exp_igr%ez)
38 1818 : NULLIFY (exp_igr%shell_ex, exp_igr%shell_ey, exp_igr%shell_ez)
39 1818 : NULLIFY (exp_igr%core_ex, exp_igr%core_ey, exp_igr%core_ez)
40 1818 : NULLIFY (exp_igr%centre, exp_igr%shell_centre, exp_igr%core_centre)
41 1818 : NULLIFY (exp_igr%delta, exp_igr%shell_delta, exp_igr%core_delta)
42 :
43 1818 : END SUBROUTINE structure_factor_init
44 :
45 : ! **************************************************************************************************
46 : !> \brief ...
47 : !> \param exp_igr ...
48 : ! **************************************************************************************************
49 34191 : SUBROUTINE structure_factor_deallocate(exp_igr)
50 :
51 : TYPE(structure_factor_type), INTENT(INOUT) :: exp_igr
52 :
53 34191 : DEALLOCATE (exp_igr%ex)
54 34191 : DEALLOCATE (exp_igr%ey)
55 34191 : DEALLOCATE (exp_igr%ez)
56 34191 : IF (ASSOCIATED(exp_igr%shell_ex)) THEN
57 0 : DEALLOCATE (exp_igr%shell_ex)
58 0 : DEALLOCATE (exp_igr%shell_ey)
59 0 : DEALLOCATE (exp_igr%shell_ez)
60 : END IF
61 34191 : IF (ASSOCIATED(exp_igr%core_ex)) THEN
62 0 : DEALLOCATE (exp_igr%core_ex)
63 0 : DEALLOCATE (exp_igr%core_ey)
64 0 : DEALLOCATE (exp_igr%core_ez)
65 : END IF
66 34191 : IF (ASSOCIATED(exp_igr%centre)) THEN
67 1818 : DEALLOCATE (exp_igr%centre, exp_igr%delta)
68 : END IF
69 34191 : IF (ASSOCIATED(exp_igr%shell_centre)) THEN
70 0 : DEALLOCATE (exp_igr%shell_centre, exp_igr%shell_delta)
71 : END IF
72 34191 : IF (ASSOCIATED(exp_igr%core_centre)) THEN
73 0 : DEALLOCATE (exp_igr%core_centre, exp_igr%core_delta)
74 : END IF
75 :
76 34191 : END SUBROUTINE structure_factor_deallocate
77 :
78 : ! **************************************************************************************************
79 : !> \brief ...
80 : !> \param bds ...
81 : !> \param nparts ...
82 : !> \param exp_igr ...
83 : !> \param allocate_centre ...
84 : !> \param allocate_shell_e ...
85 : !> \param allocate_shell_centre ...
86 : !> \param nshell ...
87 : ! **************************************************************************************************
88 136764 : SUBROUTINE structure_factor_allocate(bds, nparts, exp_igr, &
89 : allocate_centre, allocate_shell_e, &
90 : allocate_shell_centre, nshell)
91 :
92 : INTEGER, DIMENSION(:, :), INTENT(IN) :: bds
93 : INTEGER, INTENT(IN) :: nparts
94 : TYPE(structure_factor_type), INTENT(OUT) :: exp_igr
95 : LOGICAL, INTENT(IN), OPTIONAL :: allocate_centre, allocate_shell_e, &
96 : allocate_shell_centre
97 : INTEGER, INTENT(IN), OPTIONAL :: nshell
98 :
99 136134 : ALLOCATE (exp_igr%ex(bds(1, 1):bds(2, 1) + 1, nparts))
100 136134 : ALLOCATE (exp_igr%ey(bds(1, 2):bds(2, 2) + 1, nparts))
101 136134 : ALLOCATE (exp_igr%ez(bds(1, 3):bds(2, 3) + 1, nparts))
102 : NULLIFY (exp_igr%centre, exp_igr%delta)
103 :
104 34191 : exp_igr%lb(1) = LBOUND(exp_igr%ex, 1)
105 34191 : exp_igr%lb(2) = LBOUND(exp_igr%ey, 1)
106 34191 : exp_igr%lb(3) = LBOUND(exp_igr%ez, 1)
107 :
108 34191 : IF (PRESENT(allocate_centre)) THEN
109 1818 : IF (allocate_centre) THEN
110 9090 : ALLOCATE (exp_igr%centre(3, nparts), exp_igr%delta(3, nparts))
111 : END IF
112 : END IF
113 :
114 34191 : IF (PRESENT(allocate_shell_e)) THEN
115 0 : IF (allocate_shell_e) THEN
116 0 : ALLOCATE (exp_igr%shell_ex(bds(1, 1):bds(2, 1) + 1, nshell))
117 0 : ALLOCATE (exp_igr%shell_ey(bds(1, 2):bds(2, 2) + 1, nshell))
118 0 : ALLOCATE (exp_igr%shell_ez(bds(1, 3):bds(2, 3) + 1, nshell))
119 : NULLIFY (exp_igr%shell_centre, exp_igr%shell_delta)
120 :
121 0 : ALLOCATE (exp_igr%core_ex(bds(1, 1):bds(2, 1) + 1, nshell))
122 0 : ALLOCATE (exp_igr%core_ey(bds(1, 2):bds(2, 2) + 1, nshell))
123 0 : ALLOCATE (exp_igr%core_ez(bds(1, 3):bds(2, 3) + 1, nshell))
124 : NULLIFY (exp_igr%core_centre, exp_igr%core_delta)
125 :
126 0 : IF (PRESENT(allocate_shell_centre)) THEN
127 0 : IF (allocate_shell_centre) THEN
128 0 : ALLOCATE (exp_igr%shell_centre(3, nshell), exp_igr%shell_delta(3, nshell))
129 0 : ALLOCATE (exp_igr%core_centre(3, nshell), exp_igr%core_delta(3, nshell))
130 : END IF
131 : END IF
132 : END IF
133 : ELSE
134 : NULLIFY (exp_igr%shell_ex, exp_igr%shell_ey, exp_igr%shell_ez)
135 : NULLIFY (exp_igr%core_ex, exp_igr%core_ey, exp_igr%core_ez)
136 : NULLIFY (exp_igr%shell_centre, exp_igr%core_centre)
137 : NULLIFY (exp_igr%shell_delta, exp_igr%core_delta)
138 : END IF
139 :
140 34191 : END SUBROUTINE structure_factor_allocate
141 :
142 : ! **************************************************************************************************
143 : !> \brief ...
144 : !> \param delta ...
145 : !> \param lb ...
146 : !> \param ex ...
147 : !> \param ey ...
148 : !> \param ez ...
149 : ! **************************************************************************************************
150 537519 : SUBROUTINE structure_factor_evaluate(delta, lb, ex, ey, ez)
151 :
152 : REAL(KIND=dp), DIMENSION(:), INTENT(in) :: delta
153 : INTEGER, DIMENSION(3), INTENT(IN) :: lb
154 : COMPLEX(KIND=dp), DIMENSION(lb(1):), INTENT(out) :: ex
155 : COMPLEX(KIND=dp), DIMENSION(lb(2):), INTENT(out) :: ey
156 : COMPLEX(KIND=dp), DIMENSION(lb(3):), INTENT(out) :: ez
157 :
158 : COMPLEX(KIND=dp) :: fm, fp
159 : INTEGER :: j, l0, l1, m0, m1, n0, n1
160 : REAL(KIND=dp) :: vec(3)
161 :
162 537519 : l0 = LBOUND(ex, 1)
163 537519 : l1 = UBOUND(ex, 1)
164 537519 : m0 = LBOUND(ey, 1)
165 537519 : m1 = UBOUND(ey, 1)
166 537519 : n0 = LBOUND(ez, 1)
167 1075038 : n1 = UBOUND(ez, 1)
168 :
169 : ! delta is in scaled coordinates
170 2150076 : vec(:) = twopi*(delta(:) + 0.5_dp)
171 :
172 537519 : ex(l0) = 1.0_dp
173 537519 : ey(m0) = 1.0_dp
174 537519 : ez(n0) = 1.0_dp
175 537519 : ex(l1) = 1.0_dp
176 537519 : ey(m1) = 1.0_dp
177 537519 : ez(n1) = 1.0_dp
178 :
179 537519 : fp = CMPLX(COS(vec(1)), -SIN(vec(1)), KIND=dp)
180 537519 : fm = CONJG(fp)
181 5415543 : DO j = 1, -l0
182 4878024 : ex(j + l0) = ex(j + l0 - 1)*fp
183 5415543 : ex(-j + l1) = ex(-j + l1 + 1)*fm
184 : END DO
185 :
186 537519 : fp = CMPLX(COS(vec(2)), -SIN(vec(2)), KIND=dp)
187 537519 : fm = CONJG(fp)
188 5415543 : DO j = 1, -m0
189 4878024 : ey(j + m0) = ey(j + m0 - 1)*fp
190 5415543 : ey(-j + m1) = ey(-j + m1 + 1)*fm
191 : END DO
192 :
193 537519 : fp = CMPLX(COS(vec(3)), -SIN(vec(3)), KIND=dp)
194 537519 : fm = CONJG(fp)
195 5415543 : DO j = 1, -n0
196 4878024 : ez(j + n0) = ez(j + n0 - 1)*fp
197 5415543 : ez(-j + n1) = ez(-j + n1 + 1)*fm
198 : END DO
199 :
200 537519 : END SUBROUTINE structure_factor_evaluate
201 :
202 : END MODULE structure_factors
|
