35 use,
intrinsic :: iso_fortran_env
61 real(real64),
allocatable :: total_field(:,:)
62 real(real64),
allocatable :: trans_field(:,:)
63 real(real64),
allocatable :: long_field(:,:)
64 real(real64),
allocatable :: vector_potential(:,:)
65 real(real64),
allocatable :: scalar_potential(:)
66 real(real64) :: abs_norm_self_consistency, abs_norm_long_field, abs_norm_trans_field, abs_norm_scal_pot, abs_norm_vec_pot
67 real(real64) :: rel_norm_self_consistency, rel_norm_long_field, rel_norm_trans_field, rel_norm_scal_pot, rel_norm_vec_pot
76 class(helmholtz_test_t),
intent(inout) :: this
77 integer,
intent(in) :: np_part
78 integer,
intent(in) :: dim
83 safe_allocate(this%scalar_potential(1:np_part))
84 this%scalar_potential =
m_zero
86 safe_allocate(this%vector_potential(1:np_part, 1:dim))
87 this%vector_potential =
m_zero
89 safe_allocate(this%total_field(1:np_part, 1:dim))
92 safe_allocate(this%trans_field(1:np_part, 1:dim))
95 safe_allocate(this%long_field(1:np_part, 1:dim))
102 type(helmholtz_test_t),
intent(inout) :: this
106 safe_deallocate_a(this%total_field)
107 safe_deallocate_a(this%trans_field)
108 safe_deallocate_a(this%long_field)
109 safe_deallocate_a(this%vector_potential)
110 safe_deallocate_a(this%scalar_potential)
116 class(helmholtz_decomposition_t),
intent(inout) :: helmholtz
117 type(grid_t),
intent(in) :: sys_grid
118 type(namespace_t),
intent(in) :: namespace
119 class(space_t),
intent(in) :: space
122 type(helmholtz_test_t) :: helm_analytical
123 type(helmholtz_test_t) :: helm_comp_test_1
124 type(helmholtz_test_t) :: helm_comp_test_2
126 type(helmholtz_test_t) :: helm_comp_vec_pot_from_trans_field
128 character(len=20) :: test_case
131 assert(space%dim == 3)
134 call helm_analytical%init(sys_grid%np_part, sys_grid%box%dim)
135 call helm_comp_test_1%init(sys_grid%np_part, sys_grid%box%dim)
136 call helm_comp_vec_pot_from_trans_field%init(sys_grid%np_part, sys_grid%box%dim)
141 call io_mkdir(
"hertzian_dipole_test", namespace=namespace)
143 call io_mkdir(
"hertzian_dipole_test/exact_fields", namespace=namespace)
144 call output_fields(sys_grid, helm_analytical, space, namespace,
"hertzian_dipole_test/exact_fields")
148 call helmholtz%get_trans_field(namespace, helm_comp_test_1%trans_field, total_field=helm_analytical%total_field, &
149 apply_boundary=.false.)
150 call helmholtz%get_long_field(namespace, helm_comp_test_1%long_field, total_field=helm_analytical%total_field, &
151 apply_boundary=.false.)
153 call helmholtz%get_vector_potential(namespace, helm_comp_test_1%vector_potential, total_field=helm_analytical%total_field, &
154 apply_boundary=.false.)
155 call helmholtz%get_scalar_potential(namespace, helm_comp_test_1%scalar_potential, helm_analytical%total_field, &
156 apply_boundary=.false.)
158 test_case =
"no_surf_corr"
159 if (helmholtz%compute_surface_correction) test_case =
"with_surf_corr"
160 call io_mkdir(
"hertzian_dipole_test/" // trim(test_case), namespace=namespace)
161 call output_fields(sys_grid, helm_comp_test_1, space, namespace,
"hertzian_dipole_test/" // trim(test_case))
162 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_test_1, namespace,
"hertzian_dipole_test/"//trim(test_case))
165 call helmholtz%get_vector_potential(namespace, helm_comp_vec_pot_from_trans_field%vector_potential, &
166 trans_field=helm_analytical%trans_field, apply_boundary=.
true.)
168 test_case =
"vec_pot_from_b_field"
169 call io_mkdir(
"hertzian_dipole_test/" // trim(test_case), namespace=namespace)
170 call output_fields(sys_grid, helm_comp_vec_pot_from_trans_field, space, namespace,
"hertzian_dipole_test/" // trim(test_case))
171 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_vec_pot_from_trans_field, namespace, &
172 "hertzian_dipole_test/"//trim(test_case), apply_stencil_for_vec_pot=.
true.)
177 if (helmholtz%compute_surface_correction)
then
178 helmholtz%compute_surface_correction = .false.
179 call helm_comp_test_2%init(sys_grid%np_part, sys_grid%box%dim)
181 call helmholtz%get_trans_field(namespace, helm_comp_test_2%trans_field, total_field=helm_analytical%total_field, &
182 apply_boundary=.false.)
183 call helmholtz%get_long_field(namespace, helm_comp_test_2%long_field, total_field=helm_analytical%total_field, &
184 apply_boundary=.false.)
186 call helmholtz%get_vector_potential(namespace, helm_comp_test_2%vector_potential, trans_field=helm_analytical%trans_field, &
187 apply_boundary=.false.)
188 call helmholtz%get_scalar_potential(namespace, helm_comp_test_2%scalar_potential, helm_analytical%total_field, &
189 apply_boundary=.false.)
191 test_case =
"no_surf_corr"
192 call io_mkdir(
"hertzian_dipole_test/" // trim(test_case), namespace=namespace)
193 call output_fields(sys_grid, helm_comp_test_2, space, namespace,
"hertzian_dipole_test/" // trim(test_case))
194 call compute_norms(helmholtz,sys_grid,helm_analytical, helm_comp_test_2, namespace,
"hertzian_dipole_test/"//trim(test_case))
196 helmholtz%compute_surface_correction = .
true.
199 call compare_norms(helm_comp_test_1, helm_comp_test_2, namespace,
"hertzian_dipole_test/")
207 type(
grid_t),
intent(in) :: sys_grid
209 real(real64) :: lambda, omega, kk, rr, time, norm
210 real(real64) :: xx(sys_grid%box%dim), xx_origin(sys_grid%box%dim), pp(sys_grid%box%dim), cross_p(sys_grid%box%dim)
212 real(real64),
parameter :: nearly_zero = 1e-14_real64
221 pp =
cos(omega * time)
222 xx_origin(2:sys_grid%box%dim) =
m_zero
223 xx_origin(1) = 3.11_real64
225 do ip = 1, sys_grid%np_part
226 call mesh_r(sys_grid, ip, rr, coords = xx, origin = xx_origin)
227 if (rr >= sys_grid%spacing(1))
then
230 this%long_field(ip, :) = (
m_three * dot_product(pp, xx) * xx - pp) *
cos(omega*time)/(rr**3)
233 this%trans_field(ip, :) = (kk**2) * cross_p * (
cos(kk*rr - omega*time)/rr -
sin(kk*rr - omega*time)/(kk * rr**2))
235 this%vector_potential(ip, :) = kk * (pp - dot_product(pp, xx)*xx) *
sin(kk*rr - omega*time)/rr
236 this%vector_potential(ip, :) = this%vector_potential(ip, :) * (pp -
m_three*dot_product(pp, xx)*xx) * &
237 (
cos(kk*rr - omega*time)/(rr**2) - (
sin(kk*rr - omega*time) -
sin(omega*time))/(kk * rr**3))
239 this%scalar_potential(ip) = dot_product(pp, xx) *
cos(omega*time) / (rr**2)
241 this%total_field = this%trans_field + this%long_field
245 norm =
dmf_nrm2(sys_grid, sys_grid%box%dim, this%total_field - this%trans_field - this%long_field)
246 assert(norm < nearly_zero)
251 subroutine gaussian_test(helmholtz, sys_grid, namespace, space)
253 type(
grid_t),
intent(in) :: sys_grid
255 class(
space_t),
intent(in) :: space
264 character(len=20) :: test_case
267 assert(space%dim == 3)
270 call helm_analytical%init(sys_grid%np_part, sys_grid%box%dim)
271 call helm_comp_test_1%init(sys_grid%np_part, sys_grid%box%dim)
272 call helm_comp_vec_pot_from_trans_field%init(sys_grid%np_part, sys_grid%box%dim)
277 call io_mkdir(
"gaussian_field_test", namespace=namespace)
279 call io_mkdir(
"gaussian_field_test/exact_fields", namespace=namespace)
280 call output_fields(sys_grid, helm_analytical, space, namespace,
"gaussian_field_test/exact_fields")
284 call helmholtz%get_trans_field(namespace, helm_comp_test_1%trans_field, total_field=helm_analytical%total_field, &
285 apply_boundary=.false.)
286 call helmholtz%get_long_field(namespace, helm_comp_test_1%long_field, total_field=helm_analytical%total_field, &
287 apply_boundary=.false.)
289 call helmholtz%get_vector_potential(namespace, helm_comp_test_1%vector_potential, total_field=helm_analytical%total_field, &
290 apply_boundary=.false.)
291 call helmholtz%get_scalar_potential(namespace, helm_comp_test_1%scalar_potential, helm_analytical%total_field, &
292 apply_boundary=.false.)
294 test_case =
"no_surf_corr"
295 if (helmholtz%compute_surface_correction) test_case =
"with_surf_corr"
296 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
297 call output_fields(sys_grid, helm_comp_test_1, space, namespace,
"gaussian_field_test/" // trim(test_case))
298 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_test_1, namespace,
"gaussian_field_test/"//trim(test_case))
301 call helmholtz%get_vector_potential(namespace, helm_comp_vec_pot_from_trans_field%vector_potential, &
302 trans_field=helm_analytical%trans_field, apply_boundary=.
true.)
304 test_case =
"vec_pot_from_b_field"
305 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
306 call output_fields(sys_grid, helm_comp_vec_pot_from_trans_field, space, namespace,
"gaussian_field_test/" // trim(test_case))
307 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_vec_pot_from_trans_field, namespace, &
308 "gaussian_field_test/"//trim(test_case), apply_stencil_for_vec_pot=.
true.)
313 if (helmholtz%compute_surface_correction)
then
314 helmholtz%compute_surface_correction = .false.
315 call helm_comp_test_2%init(sys_grid%np_part, sys_grid%box%dim)
317 call helmholtz%get_trans_field(namespace, helm_comp_test_2%trans_field, total_field=helm_analytical%total_field, &
318 apply_boundary=.false.)
319 call helmholtz%get_long_field(namespace, helm_comp_test_2%long_field, total_field=helm_analytical%total_field, &
320 apply_boundary=.false.)
322 call helmholtz%get_vector_potential(namespace, helm_comp_test_2%vector_potential, helm_analytical%total_field, &
323 apply_boundary=.false.)
324 call helmholtz%get_scalar_potential(namespace, helm_comp_test_2%scalar_potential, helm_analytical%total_field, &
325 apply_boundary=.false.)
327 test_case =
"no_surf_corr"
328 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
329 call output_fields(sys_grid, helm_comp_test_2, space, namespace,
"gaussian_field_test/" // trim(test_case))
330 call compute_norms(helmholtz,sys_grid, helm_analytical, helm_comp_test_2, namespace,
"gaussian_field_test/"//trim(test_case))
332 helmholtz%compute_surface_correction = .
true.
335 call compare_norms(helm_comp_test_1, helm_comp_test_2, namespace,
"gaussian_field_test/")
343 type(
grid_t),
intent(in) :: sys_grid
345 real(real64) :: alpha, beta, a_prefactor, b_prefactor, ra, rb, norm
346 real(real64) :: aa(sys_grid%box%dim), a_origin(sys_grid%box%dim), bb(sys_grid%box%dim), b_origin(sys_grid%box%dim)
353 a_prefactor = 1.5_real64
354 a_origin =
m_one / 10
356 b_prefactor = 1.7_real64
357 b_origin = -
m_one / 10
360 do ip = 1, sys_grid%np_part
361 call mesh_r(sys_grid, ip, ra, coords = aa, origin = a_origin)
363 this%long_field(ip, :) = (2 * a_prefactor / (alpha**2)) * aa(:) *
exp(-(ra / alpha)**2)
365 this%scalar_potential(ip) = a_prefactor *
exp(-(ra / alpha)**2)
367 call mesh_r(sys_grid, ip, rb, coords = bb, origin = b_origin)
369 this%trans_field(ip, 1) = - (2 * b_prefactor / (beta**2)) * bb(1) * bb(3) *
exp(-(rb / beta)**2)
370 this%trans_field(ip, 2) = - (2 * b_prefactor / (beta**2)) * bb(2) * bb(3) *
exp(-(rb / beta)**2)
371 this%trans_field(ip, 3) = (2 * b_prefactor / (beta**2)) * (bb(1)**2 + bb(2)**2 - beta**2) *
exp(-(rb / beta)**2)
373 this%vector_potential(ip, 1) = b_prefactor * bb(2) *
exp(-(rb / beta)**2)
374 this%vector_potential(ip, 2) = - b_prefactor * bb(1) *
exp(-(rb / beta)**2)
377 this%total_field(ip, :) = this%long_field(ip, :) + this%trans_field(ip, :)
381 norm =
dmf_nrm2(sys_grid, sys_grid%box%dim, this%total_field - this%trans_field - this%long_field)
387 subroutine output_fields(sys_grid, test, space, namespace, path)
388 type(
grid_t),
intent(in) :: sys_grid
390 class(
space_t),
intent(in) :: space
392 character(len=*),
intent(in) :: path
400 sys_grid, test%total_field,
unit_one, ierr)
402 sys_grid, test%trans_field,
unit_one, ierr)
404 sys_grid, test%long_field,
unit_one, ierr)
406 sys_grid, test%vector_potential,
unit_one, ierr)
408 sys_grid, test%scalar_potential,
unit_one, ierr)
413 subroutine compute_norms(helmholtz, sys_grid, analytical, test, namespace, path, apply_stencil_for_vec_pot)
415 type(
grid_t),
intent(in) :: sys_grid
419 character(len=*),
intent(in) :: path
420 logical,
optional,
intent(in) :: apply_stencil_for_vec_pot
422 integer :: iunit, dim, np
423 real(real64),
allocatable :: local_field(:,:)
426 safe_allocate(local_field(1:sys_grid%np, 1:sys_grid%box%dim))
428 dim = sys_grid%box%dim
433 local_field = analytical%trans_field(1:np,:)
434 call helmholtz%apply_inner_stencil_mask(local_field)
435 test%abs_norm_trans_field =
dmf_nrm2(sys_grid, dim, test%trans_field(1:np,:) - local_field(1:np,:))
436 test%rel_norm_trans_field = test%abs_norm_trans_field /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
438 local_field = analytical%long_field(1:np,:)
439 call helmholtz%apply_inner_stencil_mask(local_field)
440 test%abs_norm_long_field =
dmf_nrm2(sys_grid, dim, test%long_field(1:np, :) - local_field(1:np, :))
441 test%rel_norm_long_field = test%abs_norm_long_field /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
443 local_field = analytical%vector_potential(1:np,:)
445 call helmholtz%apply_inner_stencil_mask(local_field)
447 test%abs_norm_vec_pot =
dmf_nrm2(sys_grid, dim, test%vector_potential(1:np,:) - local_field(1:np,:))
448 test%rel_norm_vec_pot = test%abs_norm_vec_pot /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
450 test%abs_norm_scal_pot =
dmf_nrm2(sys_grid, test%scalar_potential(1:np) - analytical%scalar_potential(1:np))
451 test%rel_norm_scal_pot = test%abs_norm_scal_pot /
dmf_nrm2(sys_grid, analytical%scalar_potential(1:np))
453 local_field = analytical%total_field(1:np,:)
454 call helmholtz%apply_inner_stencil_mask(local_field)
455 test%abs_norm_self_consistency =
dmf_nrm2(sys_grid,dim,local_field(1:np,:)-test%trans_field(1:np,:)-test%long_field(1:np,:))
456 test%rel_norm_self_consistency = test%abs_norm_self_consistency /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
458 safe_deallocate_a(local_field)
461 iunit =
io_open(path //
"/norms", namespace, action=
'write')
462 write(iunit,
'(a,f19.13)')
'Transverse field test (abs.). = ', test%abs_norm_trans_field
463 write(iunit,
'(a,f19.13)')
'Transverse field test (rel.). = ', test%rel_norm_trans_field
464 write(iunit,
'(a,f19.13)')
'Longitudinal field test (abs.). = ', test%abs_norm_long_field
465 write(iunit,
'(a,f19.13)')
'Longitudinal field test (rel.). = ', test%rel_norm_long_field
466 write(iunit,
'(a,f19.13)')
'Vector potential test (abs.). = ', test%abs_norm_vec_pot
467 write(iunit,
'(a,f19.13)')
'Vector potential test (rel.). = ', test%rel_norm_vec_pot
468 write(iunit,
'(a,f19.13)')
'Scalar potential test (abs.). = ', test%abs_norm_scal_pot
469 write(iunit,
'(a,f19.13)')
'Scalar potential test (rel.). = ', test%rel_norm_scal_pot
470 write(iunit,
'(a,f19.13)')
'Self consistency test (abs.). = ', test%abs_norm_self_consistency
471 write(iunit,
'(a,f19.13)')
'Self consistency test (rel.). = ', test%rel_norm_self_consistency
478 subroutine compare_norms(test_with_sc, test_no_sc, namespace, path)
482 character(len=*),
intent(in) :: path
485 character(len=24),
parameter :: form =
'(a,f19.13,a,f19.13)'
490 iunit =
io_open(path //
"norm_comparison", namespace, action=
'write')
492 write(iunit, form)
'Transverse field test (abs.). No surf correction = ', test_no_sc%abs_norm_trans_field, &
493 " ;With surf correction = ", test_with_sc%abs_norm_trans_field
494 write(iunit, form)
'Transverse field test (rel.). No surf correction = ', test_no_sc%rel_norm_trans_field, &
495 " ;With surf correction = ", test_with_sc%rel_norm_trans_field
497 write(iunit, form)
'Longitudinal field test (abs.). No surf correction = ', test_no_sc%abs_norm_long_field, &
498 " ;With surf correction = ", test_with_sc%abs_norm_long_field
499 write(iunit, form)
'Longitudinal field test (rel.). No surf correction = ', test_no_sc%rel_norm_long_field, &
500 " ;With surf correction = ", test_with_sc%rel_norm_long_field
502 write(iunit, form)
'Vector potential test (abs.). No surf correction = ', test_no_sc%abs_norm_vec_pot, &
503 " ;With surf correction = ", test_with_sc%abs_norm_vec_pot
504 write(iunit, form)
'Vector potential test (rel.). No surf correction = ', test_no_sc%rel_norm_vec_pot, &
505 " ;With surf correction = ", test_with_sc%rel_norm_vec_pot
507 write(iunit, form)
'Scalar potential test (abs.). No surf correction = ', test_no_sc%abs_norm_scal_pot, &
508 " ;With surf correction = ", test_with_sc%abs_norm_scal_pot
509 write(iunit, form)
'Scalar potential test (rel.). No surf correction = ', test_no_sc%rel_norm_scal_pot, &
510 " ;With surf correction = ", test_with_sc%rel_norm_scal_pot
512 write(iunit, form)
'Self consistency test (abs.). No surf correction = ', test_no_sc%abs_norm_self_consistency, &
513 " ;With surf correction = ", test_with_sc%abs_norm_self_consistency
514 write(iunit, form)
'Self consistency test (rel.). No surf correction = ', test_no_sc%rel_norm_self_consistency, &
515 " ;With surf correction = ", test_with_sc%rel_norm_self_consistency
519 assert(test_with_sc%abs_norm_trans_field < test_no_sc%abs_norm_trans_field)
520 assert(test_with_sc%rel_norm_trans_field < test_no_sc%rel_norm_trans_field)
522 assert(test_with_sc%abs_norm_long_field < test_no_sc%abs_norm_long_field)
523 assert(test_with_sc%rel_norm_long_field < test_no_sc%rel_norm_long_field)
525 assert(test_with_sc%abs_norm_vec_pot < test_no_sc%abs_norm_vec_pot)
526 assert(test_with_sc%rel_norm_vec_pot < test_no_sc%rel_norm_vec_pot)
528 assert(test_with_sc%abs_norm_scal_pot < test_no_sc%abs_norm_scal_pot)
529 assert(test_with_sc%rel_norm_scal_pot < test_no_sc%rel_norm_scal_pot)
531 assert(test_with_sc%abs_norm_self_consistency < test_no_sc%abs_norm_self_consistency)
532 assert(test_with_sc%rel_norm_self_consistency < test_no_sc%rel_norm_self_consistency)
538#include "complex.F90"
double exp(double __x) __attribute__((__nothrow__
double sin(double __x) __attribute__((__nothrow__
double cos(double __x) __attribute__((__nothrow__
This module contains interfaces for BLAS routines You should not use these routines directly....
Module, implementing a factory for boxes.
This module calculates the derivatives (gradients, Laplacians, etc.) of a function.
real(real64), parameter, public m_two
real(real64), parameter, public m_zero
real(real64), parameter, public m_pi
some mathematical constants
real(real64), parameter, public m_epsilon
real(real64), parameter, public p_c
Electron gyromagnetic ratio, see Phys. Rev. Lett. 130, 071801 (2023)
real(real64), parameter, public m_one
real(real64), parameter, public m_three
This module implements the underlying real-space grid.
The Helmholtz decomposition is intended to contain "only mathematical" functions and procedures to co...
Test suit for the Helmholtz decomposition module.
subroutine compare_norms(test_with_sc, test_no_sc, namespace, path)
subroutine helmholtz_test_init(this, np_part, dim)
subroutine init_gaussian_field(this, sys_grid)
subroutine, public gaussian_test(helmholtz, sys_grid, namespace, space)
subroutine helmholtz_test_finalize(this)
subroutine init_hertzian_dipole_field(this, sys_grid)
subroutine compute_norms(helmholtz, sys_grid, analytical, test, namespace, path, apply_stencil_for_vec_pot)
subroutine, public hertzian_dipole_test(helmholtz, sys_grid, namespace, space)
subroutine output_fields(sys_grid, test, space, namespace, path)
subroutine, public dio_function_output(how, dir, fname, namespace, space, mesh, ff, unit, ierr, pos, atoms, grp, root)
Top-level IO routine for functions defined on the mesh.
integer(int64) function, public io_function_fill_how(where)
Use this function to quickly plot functions for debugging purposes: call dio_function_output(io_funct...
subroutine, public io_close(iunit, grp)
subroutine, public io_mkdir(fname, namespace, parents)
integer function, public io_open(file, namespace, action, status, form, position, die, recl, grp)
This module is intended to contain "only mathematical" functions and procedures.
pure real(real64) function, dimension(1:3), public dcross_product(a, b)
This module defines various routines, operating on mesh functions.
This module defines the meshes, which are used in Octopus.
pure subroutine, public mesh_r(mesh, ip, rr, origin, coords)
return the distance to the origin for a given grid point
This module handles the communicators for the various parallelization strategies.
brief This module defines the class unit_t which is used by the unit_systems_oct_m module.
This module defines the unit system, used for input and output.
type(unit_t), public unit_one
some special units required for particular quantities
Description of the grid, containing information on derivatives, stencil, and symmetries.