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)
213 real(real64),
parameter :: nearly_zero = 1e-14_real64
223 pp =
cos(omega * time)
224 xx_origin(2:sys_grid%box%dim) =
m_zero
225 xx_origin(1) = 3.11_real64
227 do ip = 1, sys_grid%np_part
228 call mesh_r(sys_grid, ip, rr, coords = xx, origin = xx_origin)
229 if (rr >= sys_grid%spacing(1))
then
232 this%long_field(ip, :) = (
m_three * dot_product(pp, xx) * xx - pp) *
cos(omega*time)/(rr**3)
235 this%trans_field(ip, :) = (kk**2) * cross_p * (
cos(kk*rr - omega*time)/rr -
sin(kk*rr - omega*time)/(kk * rr**2))
237 this%vector_potential(ip, :) = kk * (pp - dot_product(pp, xx)*xx) *
sin(kk*rr - omega*time)/rr
238 this%vector_potential(ip, :) = this%vector_potential(ip, :) * (pp -
m_three*dot_product(pp, xx)*xx) * &
239 (
cos(kk*rr - omega*time)/(rr**2) - (
sin(kk*rr - omega*time) -
sin(omega*time))/(kk * rr**3))
241 this%scalar_potential(ip) = dot_product(pp, xx) *
cos(omega*time) / (rr**2)
243 this%total_field = this%trans_field + this%long_field
247 norm =
dmf_nrm2(sys_grid, sys_grid%box%dim, this%total_field - this%trans_field - this%long_field)
248 assert(norm < nearly_zero)
253 subroutine gaussian_test(helmholtz, sys_grid, namespace, space)
255 type(
grid_t),
intent(in) :: sys_grid
257 class(
space_t),
intent(in) :: space
266 character(len=20) :: test_case
269 assert(space%dim == 3)
272 call helm_analytical%init(sys_grid%np_part, sys_grid%box%dim)
273 call helm_comp_test_1%init(sys_grid%np_part, sys_grid%box%dim)
274 call helm_comp_vec_pot_from_trans_field%init(sys_grid%np_part, sys_grid%box%dim)
279 call io_mkdir(
"gaussian_field_test", namespace=namespace)
281 call io_mkdir(
"gaussian_field_test/exact_fields", namespace=namespace)
282 call output_fields(sys_grid, helm_analytical, space, namespace,
"gaussian_field_test/exact_fields")
286 call helmholtz%get_trans_field(namespace, helm_comp_test_1%trans_field, total_field=helm_analytical%total_field, &
287 apply_boundary=.false.)
288 call helmholtz%get_long_field(namespace, helm_comp_test_1%long_field, total_field=helm_analytical%total_field, &
289 apply_boundary=.false.)
291 call helmholtz%get_vector_potential(namespace, helm_comp_test_1%vector_potential, total_field=helm_analytical%total_field, &
292 apply_boundary=.false.)
293 call helmholtz%get_scalar_potential(namespace, helm_comp_test_1%scalar_potential, helm_analytical%total_field, &
294 apply_boundary=.false.)
296 test_case =
"no_surf_corr"
297 if (helmholtz%compute_surface_correction) test_case =
"with_surf_corr"
298 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
299 call output_fields(sys_grid, helm_comp_test_1, space, namespace,
"gaussian_field_test/" // trim(test_case))
300 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_test_1, namespace,
"gaussian_field_test/"//trim(test_case))
303 call helmholtz%get_vector_potential(namespace, helm_comp_vec_pot_from_trans_field%vector_potential, &
304 trans_field=helm_analytical%trans_field, apply_boundary=.
true.)
306 test_case =
"vec_pot_from_b_field"
307 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
308 call output_fields(sys_grid, helm_comp_vec_pot_from_trans_field, space, namespace,
"gaussian_field_test/" // trim(test_case))
309 call compute_norms(helmholtz, sys_grid, helm_analytical, helm_comp_vec_pot_from_trans_field, namespace, &
310 "gaussian_field_test/"//trim(test_case), apply_stencil_for_vec_pot=.
true.)
315 if (helmholtz%compute_surface_correction)
then
316 helmholtz%compute_surface_correction = .false.
317 call helm_comp_test_2%init(sys_grid%np_part, sys_grid%box%dim)
319 call helmholtz%get_trans_field(namespace, helm_comp_test_2%trans_field, total_field=helm_analytical%total_field, &
320 apply_boundary=.false.)
321 call helmholtz%get_long_field(namespace, helm_comp_test_2%long_field, total_field=helm_analytical%total_field, &
322 apply_boundary=.false.)
324 call helmholtz%get_vector_potential(namespace, helm_comp_test_2%vector_potential, helm_analytical%total_field, &
325 apply_boundary=.false.)
326 call helmholtz%get_scalar_potential(namespace, helm_comp_test_2%scalar_potential, helm_analytical%total_field, &
327 apply_boundary=.false.)
329 test_case =
"no_surf_corr"
330 call io_mkdir(
"gaussian_field_test/" // trim(test_case), namespace=namespace)
331 call output_fields(sys_grid, helm_comp_test_2, space, namespace,
"gaussian_field_test/" // trim(test_case))
332 call compute_norms(helmholtz,sys_grid, helm_analytical, helm_comp_test_2, namespace,
"gaussian_field_test/"//trim(test_case))
334 helmholtz%compute_surface_correction = .
true.
337 call compare_norms(helm_comp_test_1, helm_comp_test_2, namespace,
"gaussian_field_test/")
345 type(
grid_t),
intent(in) :: sys_grid
347 real(real64) :: alpha, beta, a_prefactor, b_prefactor, ra, rb, norm
348 real(real64) :: aa(sys_grid%box%dim), a_origin(sys_grid%box%dim), bb(sys_grid%box%dim), b_origin(sys_grid%box%dim)
355 a_prefactor = 1.5_real64
356 a_origin =
m_one / 10
358 b_prefactor = 1.7_real64
359 b_origin = -
m_one / 10
362 do ip = 1, sys_grid%np_part
363 call mesh_r(sys_grid, ip, ra, coords = aa, origin = a_origin)
365 this%long_field(ip, :) = (2 * a_prefactor / (alpha**2)) * aa(:) *
exp(-(ra / alpha)**2)
367 this%scalar_potential(ip) = a_prefactor *
exp(-(ra / alpha)**2)
369 call mesh_r(sys_grid, ip, rb, coords = bb, origin = b_origin)
371 this%trans_field(ip, 1) = - (2 * b_prefactor / (beta**2)) * bb(1) * bb(3) *
exp(-(rb / beta)**2)
372 this%trans_field(ip, 2) = - (2 * b_prefactor / (beta**2)) * bb(2) * bb(3) *
exp(-(rb / beta)**2)
373 this%trans_field(ip, 3) = (2 * b_prefactor / (beta**2)) * (bb(1)**2 + bb(2)**2 - beta**2) *
exp(-(rb / beta)**2)
375 this%vector_potential(ip, 1) = b_prefactor * bb(2) *
exp(-(rb / beta)**2)
376 this%vector_potential(ip, 2) = - b_prefactor * bb(1) *
exp(-(rb / beta)**2)
379 this%total_field(ip, :) = this%long_field(ip, :) + this%trans_field(ip, :)
383 norm =
dmf_nrm2(sys_grid, sys_grid%box%dim, this%total_field - this%trans_field - this%long_field)
389 subroutine output_fields(sys_grid, test, space, namespace, path)
390 type(
grid_t),
intent(in) :: sys_grid
392 class(
space_t),
intent(in) :: space
394 character(len=*),
intent(in) :: path
402 sys_grid, test%total_field,
unit_one, ierr)
404 sys_grid, test%trans_field,
unit_one, ierr)
406 sys_grid, test%long_field,
unit_one, ierr)
408 sys_grid, test%vector_potential,
unit_one, ierr)
410 sys_grid, test%scalar_potential,
unit_one, ierr)
415 subroutine compute_norms(helmholtz, sys_grid, analytical, test, namespace, path, apply_stencil_for_vec_pot)
417 type(
grid_t),
intent(in) :: sys_grid
421 character(len=*),
intent(in) :: path
422 logical,
optional,
intent(in) :: apply_stencil_for_vec_pot
424 integer :: iunit, dim, np
425 real(real64),
allocatable :: local_field(:,:)
428 safe_allocate(local_field(1:sys_grid%np, 1:sys_grid%box%dim))
430 dim = sys_grid%box%dim
435 local_field = analytical%trans_field(1:np,:)
436 call helmholtz%apply_inner_stencil_mask(local_field)
437 test%abs_norm_trans_field =
dmf_nrm2(sys_grid, dim, test%trans_field(1:np,:) - local_field(1:np,:))
438 test%rel_norm_trans_field = test%abs_norm_trans_field /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
440 local_field = analytical%long_field(1:np,:)
441 call helmholtz%apply_inner_stencil_mask(local_field)
442 test%abs_norm_long_field =
dmf_nrm2(sys_grid, dim, test%long_field(1:np, :) - local_field(1:np, :))
443 test%rel_norm_long_field = test%abs_norm_long_field /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
445 local_field = analytical%vector_potential(1:np,:)
447 call helmholtz%apply_inner_stencil_mask(local_field)
449 test%abs_norm_vec_pot =
dmf_nrm2(sys_grid, dim, test%vector_potential(1:np,:) - local_field(1:np,:))
450 test%rel_norm_vec_pot = test%abs_norm_vec_pot /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
452 test%abs_norm_scal_pot =
dmf_nrm2(sys_grid, test%scalar_potential(1:np) - analytical%scalar_potential(1:np))
453 test%rel_norm_scal_pot = test%abs_norm_scal_pot /
dmf_nrm2(sys_grid, analytical%scalar_potential(1:np))
455 local_field = analytical%total_field(1:np,:)
456 call helmholtz%apply_inner_stencil_mask(local_field)
457 test%abs_norm_self_consistency =
dmf_nrm2(sys_grid,dim,local_field(1:np,:)-test%trans_field(1:np,:)-test%long_field(1:np,:))
458 test%rel_norm_self_consistency = test%abs_norm_self_consistency /
dmf_nrm2(sys_grid, dim, local_field(1:np, :))
460 safe_deallocate_a(local_field)
463 iunit =
io_open(path //
"/norms", namespace, action=
'write')
464 write(iunit,
'(a,f19.13)')
'Transverse field test (abs.). = ', test%abs_norm_trans_field
465 write(iunit,
'(a,f19.13)')
'Transverse field test (rel.). = ', test%rel_norm_trans_field
466 write(iunit,
'(a,f19.13)')
'Longitudinal field test (abs.). = ', test%abs_norm_long_field
467 write(iunit,
'(a,f19.13)')
'Longitudinal field test (rel.). = ', test%rel_norm_long_field
468 write(iunit,
'(a,f19.13)')
'Vector potential test (abs.). = ', test%abs_norm_vec_pot
469 write(iunit,
'(a,f19.13)')
'Vector potential test (rel.). = ', test%rel_norm_vec_pot
470 write(iunit,
'(a,f19.13)')
'Scalar potential test (abs.). = ', test%abs_norm_scal_pot
471 write(iunit,
'(a,f19.13)')
'Scalar potential test (rel.). = ', test%rel_norm_scal_pot
472 write(iunit,
'(a,f19.13)')
'Self consistency test (abs.). = ', test%abs_norm_self_consistency
473 write(iunit,
'(a,f19.13)')
'Self consistency test (rel.). = ', test%rel_norm_self_consistency
480 subroutine compare_norms(test_with_sc, test_no_sc, namespace, path)
484 character(len=*),
intent(in) :: path
487 character(len=24),
parameter :: form =
'(a,f19.13,a,f19.13)'
492 iunit =
io_open(path //
"norm_comparison", namespace, action=
'write')
494 write(iunit, form)
'Transverse field test (abs.). No surf correction = ', test_no_sc%abs_norm_trans_field, &
495 " ;With surf correction = ", test_with_sc%abs_norm_trans_field
496 write(iunit, form)
'Transverse field test (rel.). No surf correction = ', test_no_sc%rel_norm_trans_field, &
497 " ;With surf correction = ", test_with_sc%rel_norm_trans_field
499 write(iunit, form)
'Longitudinal field test (abs.). No surf correction = ', test_no_sc%abs_norm_long_field, &
500 " ;With surf correction = ", test_with_sc%abs_norm_long_field
501 write(iunit, form)
'Longitudinal field test (rel.). No surf correction = ', test_no_sc%rel_norm_long_field, &
502 " ;With surf correction = ", test_with_sc%rel_norm_long_field
504 write(iunit, form)
'Vector potential test (abs.). No surf correction = ', test_no_sc%abs_norm_vec_pot, &
505 " ;With surf correction = ", test_with_sc%abs_norm_vec_pot
506 write(iunit, form)
'Vector potential test (rel.). No surf correction = ', test_no_sc%rel_norm_vec_pot, &
507 " ;With surf correction = ", test_with_sc%rel_norm_vec_pot
509 write(iunit, form)
'Scalar potential test (abs.). No surf correction = ', test_no_sc%abs_norm_scal_pot, &
510 " ;With surf correction = ", test_with_sc%abs_norm_scal_pot
511 write(iunit, form)
'Scalar potential test (rel.). No surf correction = ', test_no_sc%rel_norm_scal_pot, &
512 " ;With surf correction = ", test_with_sc%rel_norm_scal_pot
514 write(iunit, form)
'Self consistency test (abs.). No surf correction = ', test_no_sc%abs_norm_self_consistency, &
515 " ;With surf correction = ", test_with_sc%abs_norm_self_consistency
516 write(iunit, form)
'Self consistency test (rel.). No surf correction = ', test_no_sc%rel_norm_self_consistency, &
517 " ;With surf correction = ", test_with_sc%rel_norm_self_consistency
521 assert(test_with_sc%abs_norm_trans_field < test_no_sc%abs_norm_trans_field)
522 assert(test_with_sc%rel_norm_trans_field < test_no_sc%rel_norm_trans_field)
524 assert(test_with_sc%abs_norm_long_field < test_no_sc%abs_norm_long_field)
525 assert(test_with_sc%rel_norm_long_field < test_no_sc%rel_norm_long_field)
527 assert(test_with_sc%abs_norm_vec_pot < test_no_sc%abs_norm_vec_pot)
528 assert(test_with_sc%rel_norm_vec_pot < test_no_sc%rel_norm_vec_pot)
530 assert(test_with_sc%abs_norm_scal_pot < test_no_sc%abs_norm_scal_pot)
531 assert(test_with_sc%rel_norm_scal_pot < test_no_sc%rel_norm_scal_pot)
533 assert(test_with_sc%abs_norm_self_consistency < test_no_sc%abs_norm_self_consistency)
534 assert(test_with_sc%rel_norm_self_consistency < test_no_sc%rel_norm_self_consistency)
540#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.