(git:0de0cc2)
structure_factors.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 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 ! **************************************************************************************************
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
26 
27 CONTAINS
28 
29 ! **************************************************************************************************
30 !> \brief ...
31 !> \param exp_igr ...
32 ! **************************************************************************************************
33  SUBROUTINE structure_factor_init(exp_igr)
34 
35  TYPE(structure_factor_type), INTENT(INOUT) :: exp_igr
36 
37  NULLIFY (exp_igr%ex, exp_igr%ey, exp_igr%ez)
38  NULLIFY (exp_igr%shell_ex, exp_igr%shell_ey, exp_igr%shell_ez)
39  NULLIFY (exp_igr%core_ex, exp_igr%core_ey, exp_igr%core_ez)
40  NULLIFY (exp_igr%centre, exp_igr%shell_centre, exp_igr%core_centre)
41  NULLIFY (exp_igr%delta, exp_igr%shell_delta, exp_igr%core_delta)
42 
43  END SUBROUTINE structure_factor_init
44 
45 ! **************************************************************************************************
46 !> \brief ...
47 !> \param exp_igr ...
48 ! **************************************************************************************************
49  SUBROUTINE structure_factor_deallocate(exp_igr)
50 
51  TYPE(structure_factor_type), INTENT(INOUT) :: exp_igr
52 
53  DEALLOCATE (exp_igr%ex)
54  DEALLOCATE (exp_igr%ey)
55  DEALLOCATE (exp_igr%ez)
56  IF (ASSOCIATED(exp_igr%shell_ex)) THEN
57  DEALLOCATE (exp_igr%shell_ex)
58  DEALLOCATE (exp_igr%shell_ey)
59  DEALLOCATE (exp_igr%shell_ez)
60  END IF
61  IF (ASSOCIATED(exp_igr%core_ex)) THEN
62  DEALLOCATE (exp_igr%core_ex)
63  DEALLOCATE (exp_igr%core_ey)
64  DEALLOCATE (exp_igr%core_ez)
65  END IF
66  IF (ASSOCIATED(exp_igr%centre)) THEN
67  DEALLOCATE (exp_igr%centre, exp_igr%delta)
68  END IF
69  IF (ASSOCIATED(exp_igr%shell_centre)) THEN
70  DEALLOCATE (exp_igr%shell_centre, exp_igr%shell_delta)
71  END IF
72  IF (ASSOCIATED(exp_igr%core_centre)) THEN
73  DEALLOCATE (exp_igr%core_centre, exp_igr%core_delta)
74  END IF
75 
76  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  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  ALLOCATE (exp_igr%ex(bds(1, 1):bds(2, 1) + 1, nparts))
100  ALLOCATE (exp_igr%ey(bds(1, 2):bds(2, 2) + 1, nparts))
101  ALLOCATE (exp_igr%ez(bds(1, 3):bds(2, 3) + 1, nparts))
102  NULLIFY (exp_igr%centre, exp_igr%delta)
103 
104  exp_igr%lb(1) = lbound(exp_igr%ex, 1)
105  exp_igr%lb(2) = lbound(exp_igr%ey, 1)
106  exp_igr%lb(3) = lbound(exp_igr%ez, 1)
107 
108  IF (PRESENT(allocate_centre)) THEN
109  IF (allocate_centre) THEN
110  ALLOCATE (exp_igr%centre(3, nparts), exp_igr%delta(3, nparts))
111  END IF
112  END IF
113 
114  IF (PRESENT(allocate_shell_e)) THEN
115  IF (allocate_shell_e) THEN
116  ALLOCATE (exp_igr%shell_ex(bds(1, 1):bds(2, 1) + 1, nshell))
117  ALLOCATE (exp_igr%shell_ey(bds(1, 2):bds(2, 2) + 1, nshell))
118  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  ALLOCATE (exp_igr%core_ex(bds(1, 1):bds(2, 1) + 1, nshell))
122  ALLOCATE (exp_igr%core_ey(bds(1, 2):bds(2, 2) + 1, nshell))
123  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  IF (PRESENT(allocate_shell_centre)) THEN
127  IF (allocate_shell_centre) THEN
128  ALLOCATE (exp_igr%shell_centre(3, nshell), exp_igr%shell_delta(3, nshell))
129  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  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  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  l0 = lbound(ex, 1)
163  l1 = ubound(ex, 1)
164  m0 = lbound(ey, 1)
165  m1 = ubound(ey, 1)
166  n0 = lbound(ez, 1)
167  n1 = ubound(ez, 1)
168 
169  ! delta is in scaled coordinates
170  vec(:) = twopi*(delta(:) + 0.5_dp)
171 
172  ex(l0) = 1.0_dp
173  ey(m0) = 1.0_dp
174  ez(n0) = 1.0_dp
175  ex(l1) = 1.0_dp
176  ey(m1) = 1.0_dp
177  ez(n1) = 1.0_dp
178 
179  fp = cmplx(cos(vec(1)), -sin(vec(1)), kind=dp)
180  fm = conjg(fp)
181  DO j = 1, -l0
182  ex(j + l0) = ex(j + l0 - 1)*fp
183  ex(-j + l1) = ex(-j + l1 + 1)*fm
184  END DO
185 
186  fp = cmplx(cos(vec(2)), -sin(vec(2)), kind=dp)
187  fm = conjg(fp)
188  DO j = 1, -m0
189  ey(j + m0) = ey(j + m0 - 1)*fp
190  ey(-j + m1) = ey(-j + m1 + 1)*fm
191  END DO
192 
193  fp = cmplx(cos(vec(3)), -sin(vec(3)), kind=dp)
194  fm = conjg(fp)
195  DO j = 1, -n0
196  ez(j + n0) = ez(j + n0 - 1)*fp
197  ez(-j + n1) = ez(-j + n1 + 1)*fm
198  END DO
199 
200  END SUBROUTINE structure_factor_evaluate
201 
202 END MODULE structure_factors
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Definition of mathematical constants and functions.
Definition: mathconstants.F:16
real(kind=dp), parameter, public twopi
subroutine, public structure_factor_deallocate(exp_igr)
...
subroutine, public structure_factor_allocate(bds, nparts, exp_igr, allocate_centre, allocate_shell_e, allocate_shell_centre, nshell)
...
subroutine, public structure_factor_evaluate(delta, lb, ex, ey, ez)
...
subroutine, public structure_factor_init(exp_igr)
...