Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2021 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief utils to manipulate splines on the regular grid of a pw
10 : !> \par History
11 : !> 01.2014 move routines related to input_section_types to separate file.
12 : !> \author Ole Schuett
13 : ! **************************************************************************************************
14 : MODULE cp_spline_utils
15 : USE input_section_types, ONLY: section_vals_type,&
16 : section_vals_val_get
17 : USE kinds, ONLY: dp
18 : USE pw_methods, ONLY: pw_axpy,&
19 : pw_zero
20 : USE pw_pool_types, ONLY: pw_pool_create_pw,&
21 : pw_pool_give_back_pw,&
22 : pw_pool_type
23 : USE pw_spline_utils, ONLY: &
24 : add_coarse2fine, add_fine2coarse, find_coeffs, pw_spline_do_precond, &
25 : pw_spline_precond_create, pw_spline_precond_release, pw_spline_precond_set_kind, &
26 : pw_spline_precond_type, spl3_1d_transf_border1, spl3_1d_transf_coeffs, spl3_nopbc, &
27 : spl3_nopbct, spl3_pbc
28 : USE pw_types, ONLY: REALDATA3D,&
29 : REALSPACE,&
30 : pw_type
31 : #include "../base/base_uses.f90"
32 :
33 : IMPLICIT NONE
34 : PRIVATE
35 :
36 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_spline_utils'
37 :
38 : PUBLIC :: pw_prolongate_s3, pw_restrict_s3
39 :
40 : ! input constants
41 : INTEGER, PARAMETER, PUBLIC :: pw_interp = 1, &
42 : spline3_nopbc_interp = 2, &
43 : spline3_pbc_interp = 3
44 :
45 : CONTAINS
46 :
47 : ! **************************************************************************************************
48 : !> \brief restricts the function from a fine grid to a coarse one
49 : !> \param pw_fine_in the fine grid
50 : !> \param pw_coarse_out the coarse grid
51 : !> \param coarse_pool ...
52 : !> \param param_section ...
53 : !> \author fawzi
54 : !> \note
55 : !> extremely slow (but correct) version
56 : ! **************************************************************************************************
57 8352 : SUBROUTINE pw_restrict_s3(pw_fine_in, pw_coarse_out, coarse_pool, param_section)
58 : TYPE(pw_type), POINTER :: pw_fine_in, pw_coarse_out
59 : TYPE(pw_pool_type), POINTER :: coarse_pool
60 : TYPE(section_vals_type), POINTER :: param_section
61 :
62 : CHARACTER(len=*), PARAMETER :: routineN = 'pw_restrict_s3'
63 :
64 : INTEGER :: aint_precond, handle, interp_kind, &
65 : max_iter, precond_kind
66 : INTEGER, DIMENSION(2, 3) :: bo
67 : INTEGER, SAVE :: ifile = 0
68 : LOGICAL :: pbc, safe_computation, success
69 : REAL(kind=dp) :: eps_r, eps_x
70 : TYPE(pw_spline_precond_type), POINTER :: precond
71 : TYPE(pw_type), POINTER :: coeffs, values
72 :
73 1044 : ifile = ifile + 1
74 1044 : CALL timeset(routineN, handle)
75 : CALL section_vals_val_get(param_section, "safe_computation", &
76 1044 : l_val=safe_computation)
77 : CALL section_vals_val_get(param_section, "aint_precond", &
78 1044 : i_val=aint_precond)
79 : CALL section_vals_val_get(param_section, "precond", &
80 1044 : i_val=precond_kind)
81 : CALL section_vals_val_get(param_section, "max_iter", &
82 1044 : i_val=max_iter)
83 : CALL section_vals_val_get(param_section, "eps_r", &
84 1044 : r_val=eps_r)
85 : CALL section_vals_val_get(param_section, "eps_x", &
86 1044 : r_val=eps_x)
87 : CALL section_vals_val_get(param_section, "kind", &
88 1044 : i_val=interp_kind)
89 :
90 1044 : pbc = (interp_kind == spline3_pbc_interp)
91 1044 : CPASSERT(pbc .OR. interp_kind == spline3_nopbc_interp)
92 10440 : bo = pw_coarse_out%pw_grid%bounds_local
93 1044 : NULLIFY (values, coeffs)
94 : CALL pw_pool_create_pw(coarse_pool, values, use_data=REALDATA3D, &
95 1044 : in_space=REALSPACE)
96 1044 : CALL pw_zero(values)
97 :
98 : !FM nullify(tst_pw)
99 : !FM CALL pw_pool_create_pw(coarse_pool,tst_pw, use_data=REALDATA3D,&
100 : !FM in_space=REALSPACE)
101 : !FM call pw_copy(values,tst_pw)
102 : !FM call add_fine2coarse(fine_values_pw=pw_fine_in,&
103 : !FM coarse_coeffs_pw=tst_pw,&
104 : !FM weights_1d=spl3_1d_transf_coeffs/2._dp, w_border0=0.5_dp,&
105 : !FM w_border1=spl3_1d_transf_border1/2._dp,pbc=pbc,&
106 : !FM safe_computation=.false.)
107 :
108 : CALL add_fine2coarse(fine_values_pw=pw_fine_in, &
109 : coarse_coeffs_pw=values, &
110 : weights_1d=spl3_1d_transf_coeffs/2._dp, w_border0=0.5_dp, &
111 : w_border1=spl3_1d_transf_border1/2._dp, pbc=pbc, &
112 1044 : safe_computation=safe_computation)
113 :
114 : !FM CALL pw_compare_debug(tst_pw,values,max_diff)
115 : !FM WRITE(cp_logger_get_default_unit_nr(logger,.TRUE.),*)"f2cmax_diff=",max_diff
116 : !FM CALL pw_pool_give_back_pw(coarse_pool,tst_pw)
117 :
118 : CALL pw_pool_create_pw(coarse_pool, coeffs, use_data=REALDATA3D, &
119 1044 : in_space=REALSPACE)
120 1044 : NULLIFY (precond)
121 : CALL pw_spline_precond_create(precond, precond_kind=aint_precond, &
122 1044 : pool=coarse_pool, pbc=pbc, transpose=.TRUE.)
123 1044 : CALL pw_spline_do_precond(precond, values, coeffs)
124 1044 : CALL pw_spline_precond_set_kind(precond, precond_kind)
125 1044 : IF (pbc) THEN
126 : success = find_coeffs(values=values, coeffs=coeffs, &
127 : linOp=spl3_pbc, preconditioner=precond, pool=coarse_pool, &
128 0 : eps_r=eps_r, eps_x=eps_x, max_iter=max_iter)
129 : ELSE
130 : success = find_coeffs(values=values, coeffs=coeffs, &
131 : linOp=spl3_nopbct, preconditioner=precond, pool=coarse_pool, &
132 1044 : eps_r=eps_r, eps_x=eps_x, max_iter=max_iter)
133 : END IF
134 1044 : CALL pw_spline_precond_release(precond)
135 :
136 1044 : CALL pw_zero(pw_coarse_out)
137 1044 : CALL pw_axpy(coeffs, pw_coarse_out)
138 :
139 1044 : CALL pw_pool_give_back_pw(coarse_pool, values)
140 1044 : CALL pw_pool_give_back_pw(coarse_pool, coeffs)
141 1044 : CALL timestop(handle)
142 1044 : END SUBROUTINE pw_restrict_s3
143 :
144 : ! **************************************************************************************************
145 : !> \brief prolongates a function from a coarse grid into a fine one
146 : !> \param pw_coarse_in the coarse grid
147 : !> \param pw_fine_out the fine grid
148 : !> \param coarse_pool ...
149 : !> \param param_section ...
150 : !> \author fawzi
151 : !> \note
152 : !> extremely slow (but correct) version
153 : ! **************************************************************************************************
154 17936 : SUBROUTINE pw_prolongate_s3(pw_coarse_in, pw_fine_out, coarse_pool, &
155 : param_section)
156 : TYPE(pw_type), POINTER :: pw_coarse_in, pw_fine_out
157 : TYPE(pw_pool_type), POINTER :: coarse_pool
158 : TYPE(section_vals_type), POINTER :: param_section
159 :
160 : CHARACTER(len=*), PARAMETER :: routineN = 'pw_prolongate_s3'
161 :
162 : INTEGER :: aint_precond, handle, interp_kind, &
163 : max_iter, precond_kind
164 : INTEGER, DIMENSION(2, 3) :: bo
165 : INTEGER, SAVE :: ifile = 0
166 : LOGICAL :: pbc, safe_computation, success
167 : REAL(kind=dp) :: eps_r, eps_x
168 : TYPE(pw_spline_precond_type), POINTER :: precond
169 : TYPE(pw_type), POINTER :: coeffs
170 :
171 2242 : ifile = ifile + 1
172 2242 : CALL timeset(routineN, handle)
173 2242 : NULLIFY (coeffs)
174 : CALL pw_pool_create_pw(coarse_pool, coeffs, use_data=REALDATA3D, &
175 2242 : in_space=REALSPACE)
176 22420 : bo = pw_coarse_in%pw_grid%bounds_local
177 : CALL section_vals_val_get(param_section, "safe_computation", &
178 2242 : l_val=safe_computation)
179 : CALL section_vals_val_get(param_section, "aint_precond", &
180 2242 : i_val=aint_precond)
181 : CALL section_vals_val_get(param_section, "precond", &
182 2242 : i_val=precond_kind)
183 : CALL section_vals_val_get(param_section, "max_iter", &
184 2242 : i_val=max_iter)
185 : CALL section_vals_val_get(param_section, "eps_r", &
186 2242 : r_val=eps_r)
187 : CALL section_vals_val_get(param_section, "eps_x", &
188 2242 : r_val=eps_x)
189 : CALL section_vals_val_get(param_section, "kind", &
190 2242 : i_val=interp_kind)
191 :
192 2242 : pbc = (interp_kind == spline3_pbc_interp)
193 2242 : CPASSERT(pbc .OR. interp_kind == spline3_nopbc_interp)
194 2242 : NULLIFY (precond)
195 : CALL pw_spline_precond_create(precond, precond_kind=aint_precond, &
196 2242 : pool=coarse_pool, pbc=pbc, transpose=.FALSE.)
197 2242 : CALL pw_spline_do_precond(precond, pw_coarse_in, coeffs)
198 2242 : CALL pw_spline_precond_set_kind(precond, precond_kind)
199 2242 : IF (pbc) THEN
200 : success = find_coeffs(values=pw_coarse_in, coeffs=coeffs, &
201 : linOp=spl3_pbc, preconditioner=precond, pool=coarse_pool, &
202 : eps_r=eps_r, eps_x=eps_x, &
203 0 : max_iter=max_iter)
204 : ELSE
205 : success = find_coeffs(values=pw_coarse_in, coeffs=coeffs, &
206 : linOp=spl3_nopbc, preconditioner=precond, pool=coarse_pool, &
207 : eps_r=eps_r, eps_x=eps_x, &
208 2242 : max_iter=max_iter)
209 : END IF
210 2242 : CPASSERT(success)
211 2242 : CALL pw_spline_precond_release(precond)
212 :
213 : !FM nullify(tst_pw)
214 : !FM call pw_create(tst_pw, pw_fine_out%pw_grid, use_data=REALDATA3D,&
215 : !FM in_space=REALSPACE)
216 : !FM call pw_copy(pw_fine_out,tst_pw)
217 : !FM CALL add_coarse2fine(coarse_coeffs_pw=coeffs,&
218 : !FM fine_values_pw=tst_pw,&
219 : !FM weights_1d=spl3_1d_transf_coeffs,&
220 : !FM w_border0=1._dp,&
221 : !FM w_border1=spl3_1d_transf_border1,&
222 : !FM pbc=pbc,safe_computation=.false.,&
223 : !FM
224 :
225 : CALL add_coarse2fine(coarse_coeffs_pw=coeffs, &
226 : fine_values_pw=pw_fine_out, &
227 : weights_1d=spl3_1d_transf_coeffs, &
228 : w_border0=1._dp, &
229 : w_border1=spl3_1d_transf_border1, &
230 2242 : pbc=pbc, safe_computation=safe_computation)
231 :
232 : !FM CALL pw_compare_debug(tst_pw,pw_fine_out,max_diff)
233 : !FM WRITE(cp_logger_get_default_unit_nr(logger,.TRUE.),*)"c2fmax_diff=",max_diff
234 : !FM CALL pw_release(tst_pw)
235 :
236 2242 : CALL pw_pool_give_back_pw(coarse_pool, coeffs)
237 :
238 2242 : CALL timestop(handle)
239 2242 : END SUBROUTINE pw_prolongate_s3
240 :
241 : END MODULE cp_spline_utils
|
