55 use,
intrinsic :: iso_fortran_env
109 real(real64),
target :: shift_aux
110 type(preconditioner_t) :: prec_aux
120 type(namespace_t),
intent(in) :: namespace
121 type(mpi_grp_t),
intent(in) :: grp
123 type(test_parameters_t) :: param
130 call param%init_from_file(namespace)
217 call parse_variable(namespace,
'TestMode', option__testmode__hartree, test_mode)
227 select case (test_mode)
228 case (option__testmode__hartree)
230 case (option__testmode__derivatives)
232 case (option__testmode__orthogonalization)
234 case (option__testmode__interpolation)
236 case (option__testmode__ion_interaction)
238 case (option__testmode__projector)
240 case (option__testmode__dft_u)
242 case (option__testmode__hamiltonian_apply)
244 case (option__testmode__density_calc)
246 case (option__testmode__exp_apply)
248 case (option__testmode__boundaries)
250 case (option__testmode__subspace_diag)
252 case (option__testmode__batch_ops)
254 case (option__testmode__clock)
256 case (option__testmode__linear_solver)
258 case (option__testmode__cgal)
260 case (option__testmode__dense_eigensolver)
262 case (option__testmode__grid_interpolation)
264 case (option__testmode__iihash)
266 case (option__testmode__sihash)
268 case (option__testmode__sphash)
270 case (option__testmode__mpiwrappers)
272 case (option__testmode__regridding)
274 case (option__testmode__helmholtz_decomposition)
276 case (option__testmode__vecpot_analytical)
278 case (option__testmode__current_density)
280 case (option__testmode__mixing_tests)
282 case (option__testmode__optimizers)
284 case (option__testmode__weighted_kmeans)
286 case (option__testmode__csv_input)
288 case (option__testmode__composition_chebyshev)
290 case (option__testmode__lalg_adv)
292 case (option__testmode__isdf_serial)
294 case (option__testmode__isdf)
296 case (option__testmode__mesh_generation)
298 case (option__testmode__poisson_fft_batch)
317 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
318 call poisson_test(sys%hm%psolver, sys%space, sys%gr, sys%ions%latt, namespace, param%repetitions)
319 safe_deallocate_p(sys)
337 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
339 call helmholtz%init(namespace, sys%gr, sys%mc, sys%space)
342 write(
message(1),
'(a)')
"Helmholtz decomposition: beginning Hertzian dipole test"
346 write(
message(1),
'(a)')
"Helmholtz decomposition: beginning Gaussian test"
348 call gaussian_test(helmholtz, sys%gr, sys%namespace, sys%space)
350 safe_deallocate_p(sys)
357 use,
intrinsic :: iso_c_binding, only: c_ptr
362 real(real64),
allocatable :: rho(:), x(:),
center(:)
363 real(real64) :: rr, alpha, beta, res
365 integer,
target :: prefactor = -1
367 real(real64),
parameter :: threshold = 1.e-7_real64
373 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
378 shift_aux = 0.25_real64
384 alpha =
m_four * sys%gr%spacing(1)
385 beta =
m_one / (alpha**sys%space%dim *
sqrt(
m_pi)**sys%space%dim)
387 safe_allocate(
center(1:sys%space%dim))
390 safe_allocate(rho(1:sys%gr%np))
394 rho(ip) = beta*
exp(-(rr/alpha)**2)
397 safe_allocate(x(1:sys%gr%np))
404 threshold, userdata=[c_loc(sys%gr%der),c_loc(shift_aux),c_loc(prefactor)])
405 write(
message(1),
'(a,i6,a)')
"Info: CG converged with ", iter,
" iterations."
406 write(
message(2),
'(a,e14.6)')
"Info: The residue is ", res
407 write(
message(3),
'(a,e14.6)')
"Info: Norm solution CG ",
dmf_nrm2(sys%gr, x)
412 safe_deallocate_a(rho)
413 safe_deallocate_p(sys)
427 complex(real64),
allocatable :: psi(:, :)
433 call messages_write(
'Info: Testing the nonlocal part of the pseudopotential with SOC')
438 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
446 call sys%st%group%psib(1, 1)%copy_to(epsib)
450 do itime = 1, param%repetitions
452 sys%hm%ep%natoms, 2, sys%st%group%psib(1, 1), epsib)
455 safe_allocate(psi(1:sys%gr%np, 1:sys%st%d%dim))
456 do itime = 1, epsib%nst
458 write(
message(1),
'(a,i1,3x, f12.6)')
"Norm state ", itime,
zmf_nrm2(sys%gr, 2, psi)
461 safe_deallocate_a(psi)
465 safe_deallocate_p(sys)
478 integer :: itime, ist
480 real(real64),
allocatable :: ddot(:,:,:), dweight(:,:)
481 complex(real64),
allocatable :: zdot(:,:,:), zweight(:,:)
482 logical :: skipSOrbitals, useAllOrbitals
495 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
499 if (sys%st%pack_states)
call sys%st%pack()
501 call sys%st%group%psib(1, 1)%copy_to(epsib2, copy_data = .
true.)
504 if (.not. sys%hm%phase%is_allocated())
then
505 call sys%st%group%psib(1, 1)%copy_to(epsib, copy_data = .
true.)
507 call sys%st%group%psib(1, 1)%copy_to(epsib)
508 call sys%hm%phase%apply_to(sys%gr, sys%gr%np, &
509 .false., epsib, src=sys%st%group%psib(1, 1))
510 epsib2%has_phase = .
true.
517 call parse_variable(namespace,
'UseAllAtomicOrbitals', .false., useallorbitals)
521 call dorbitalbasis_build(basis, sys%namespace, sys%ions, sys%gr, sys%st%d%kpt, sys%st%d%dim, &
522 skipsorbitals, useallorbitals, verbose=.false.)
523 safe_allocate(dweight(1:basis%orbsets(1)%norbs, 1:epsib%nst_linear))
524 safe_allocate(ddot(1:sys%st%d%dim, 1:basis%orbsets(1)%norbs, 1:epsib%nst))
526 call zorbitalbasis_build(basis, sys%namespace, sys%ions, sys%gr, sys%st%d%kpt, sys%st%d%dim, &
527 skipsorbitals, useallorbitals, verbose=.false.)
529 safe_allocate(zweight(1:basis%orbsets(1)%norbs, 1:epsib%nst_linear))
530 safe_allocate(zdot(1:sys%st%d%dim, 1:basis%orbsets(1)%norbs, 1:epsib%nst))
533 if (sys%hm%phase%is_allocated())
then
539 do itime = 1, param%repetitions
554 if (epsib%is_packed())
then
555 call epsib%do_unpack(force = .
true.)
558 do ist = 1, epsib%nst
560 write(
message(1),
'(a,i2,3x,e13.6)')
"Dotp state ", ist, ddot(1,1,ist)
562 write(
message(1),
'(a,i2,2(3x,e13.6))')
"Dotp state ", ist, zdot(1,1,ist)
570 safe_deallocate_a(dweight)
571 safe_deallocate_a(zweight)
572 safe_deallocate_a(ddot)
573 safe_deallocate_a(zdot)
579 safe_deallocate_p(sys)
592 type(
wfs_elec_t) :: hpsib, hpsib_copy, hpsib_diff
593 integer :: itime, terms
595 logical :: copy_before_apply
596 real(real64),
allocatable :: norm_hpsib(:), norm_diff(:)
597 real(real64) :: max_rel_diff
598 real(real64),
parameter :: hamiltonian_copy_rel_tol = 1.0e-12_real64
617 call parse_variable(namespace,
'TestHamiltonianApply', option__testhamiltonianapply__term_all, terms)
618 if (terms == 0) terms = huge(1)
628 call parse_variable(namespace,
'TestHamiltonianCopyBeforeApply', .false., copy_before_apply)
634 call messages_write(
'Info: Testing the application of the Hamiltonian')
639 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
645 if (sys%st%pack_states .and. sys%hm%apply_packed())
call sys%st%pack()
648 call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners)
650 if (copy_before_apply)
then
654 call boundaries_set(sys%gr%der%boundaries, sys%gr, sys%st%group%psib(1, 1))
656 call sys%st%group%psib(1, 1)%copy_to(hpsib)
657 if (copy_before_apply)
call sys%st%group%psib(1, 1)%copy_to(hpsib_copy)
659 if (sys%hm%apply_packed())
then
660 call sys%st%group%psib(1, 1)%do_pack()
661 call hpsib%do_pack(copy = .false.)
662 if (copy_before_apply)
call hpsib_copy%do_pack(copy = .false.)
665 do itime = 1, param%repetitions
668 terms = terms, set_bc = .false.)
669 if (copy_before_apply)
then
671 terms = terms, set_bc = .false.)
675 terms = terms, set_bc = .false.)
676 if (copy_before_apply)
then
678 terms = terms, set_bc = .false.)
683 if (hpsib%is_packed())
then
684 call hpsib%do_unpack(force = .
true.)
686 if (copy_before_apply .and. hpsib_copy%is_packed())
then
687 call hpsib_copy%do_unpack(force = .
true.)
690 if (copy_before_apply)
then
691 call hpsib_copy%copy_to(hpsib_diff, copy_data = .
true.)
692 call batch_axpy(sys%gr%np, -1.0_real64, hpsib, hpsib_diff)
694 safe_allocate(norm_hpsib(1:hpsib%nst))
695 safe_allocate(norm_diff(1:hpsib_diff%nst))
699 max_rel_diff = maxval(norm_diff / max(norm_hpsib, tiny(1.0_real64)))
700 write(
message(1),
'(a,e23.16)')
'Hamiltonian copy max relative difference ', max_rel_diff
703 do ist = 1, hpsib%nst
704 if (norm_diff(ist) > hamiltonian_copy_rel_tol*max(norm_hpsib(ist), tiny(1.0_real64)))
then
705 write(
message(1),
'(a,i6)')
'Hamiltonian copy mismatch for state ', ist
710 safe_deallocate_a(norm_hpsib)
711 safe_deallocate_a(norm_diff)
712 call hpsib_diff%end(copy = .false.)
717 if (copy_before_apply)
then
719 call hpsib_copy%end(copy = .false.)
721 if (sys%hm%apply_packed())
then
722 call hpsib%do_pack(copy = .false.)
726 terms = terms, set_bc = .false.)
729 terms = terms, set_bc = .false.)
732 call hpsib%end(copy = .false.)
734 safe_deallocate_p(sys)
758 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
762 if (sys%st%pack_states)
call sys%st%pack()
764 do itime = 1, param%repetitions
768 write(
message(1),
'(a,3x, f12.6)')
"Norm density ",
dmf_nrm2(sys%gr, sys%st%rho(:,1))
772 safe_deallocate_p(sys)
796 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
800 if (sys%st%pack_states)
call sys%st%pack()
802 do itime = 1, param%repetitions
803 call boundaries_set(sys%gr%der%boundaries, sys%gr, sys%st%group%psib(1, 1))
809 safe_deallocate_p(sys)
824 integer,
allocatable :: degree(:)
832 call messages_write(
'Info: Testing Chebyshev filtering and its composition rule')
837 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
841 if (sys%st%pack_states .and. sys%hm%apply_packed())
call sys%st%pack()
844 call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners)
847 safe_allocate(degree(1:sys%st%group%nblocks))
857 call parse_variable(namespace,
'TestCompositionOrder', 2, degree_n)
869 call dchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
871 call zchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
875 call messages_write(
'Info: Result after calling 2n-th order filtering')
881 call sys%st%group%psib(1, 1)%copy_to(psib, copy_data=.
true.)
884 call dchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
885 call dchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
887 call zchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
888 call zchebyshev_filter(namespace, sys%gr, sys%st, sys%hm, degree, bounds, 1, normalize=.false.)
899 safe_deallocate_a(degree)
900 safe_deallocate_p(bounds)
904 safe_deallocate_p(sys)
930 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
936 if (sys%st%pack_states .and. sys%hm%apply_packed())
call sys%st%pack()
939 call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners)
943 if (sys%hm%apply_packed())
then
944 call sys%st%group%psib(1, 1)%do_pack()
947 do itime = 1, param%repetitions
948 call te%apply_batch(sys%namespace, sys%gr, sys%hm, sys%st%group%psib(1, 1), 1e-3_real64)
954 safe_deallocate_p(sys)
969 real(real64),
allocatable :: diff(:)
980 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
985 if (sys%st%pack_states .and. sys%hm%apply_packed())
call sys%st%pack()
988 call v_ks_calc(sys%ks, sys%namespace, sys%space, sys%hm, sys%st, sys%ions, sys%ext_partners)
990 call sdiag%init(sys%namespace, sys%st)
992 safe_allocate(diff(1:sys%st%nst))
994 do itime = 1, param%repetitions
996 call dsubspace_diag(sdiag, sys%namespace, sys%gr, sys%st, sys%hm, 1, sys%st%eigenval(:, 1), diff)
998 call zsubspace_diag(sdiag, sys%namespace, sys%gr, sys%st, sys%hm, 1, sys%st%eigenval(:, 1), diff)
1002 safe_deallocate_a(diff)
1007 safe_deallocate_p(sys)
1020 integer :: itime, ops, ops_default, ist, jst, nst, ip
1022 real(real64),
allocatable :: tmp(:)
1023 real(real64),
allocatable :: ddotv(:)
1024 complex(real64),
allocatable :: zdotv(:)
1025 real(real64),
allocatable :: ddot(:,:), df(:,:), dweight(:), dpoints(:,:,:)
1026 complex(real64),
allocatable :: zdot(:,:), zf(:,:), zweight(:), zpoints(:,:,:)
1027 real(real64),
allocatable :: dff_mf(:)
1028 complex(real64),
allocatable :: zff_mf(:)
1029 integer :: sp, block_size, size
1058 option__testbatchops__ops_axpy + &
1059 option__testbatchops__ops_scal + &
1060 option__testbatchops__ops_nrm2 + &
1061 option__testbatchops__ops_dotp_matrix + &
1062 option__testbatchops__ops_dotp_self + &
1063 option__testbatchops__ops_dotp_vector + &
1064 option__testbatchops__ops_ax_function_py + &
1065 option__testbatchops__ops_get_points
1076 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
1080 if (sys%st%pack_states)
call sys%st%pack()
1082 if (
bitand(ops, option__testbatchops__ops_axpy) /= 0)
then
1083 message(1) =
'Info: Testing axpy'
1086 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1087 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1089 do itime = 1, param%repetitions
1090 call batch_axpy(sys%gr%np, 0.1_real64, xx, yy)
1097 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1098 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1099 do itime = 1, param%repetitions
1100 call batch_axpby(sys%gr%np, 0.1_real64, xx, 0.2_real64, yy)
1108 if (
bitand(ops, option__testbatchops__ops_scal) /= 0)
then
1112 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1114 do itime = 1, param%repetitions
1120 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1121 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .false.)
1122 do itime = 1, param%repetitions
1129 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1130 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1131 call sys%st%group%psib(1, 1)%copy_to(zz, copy_data = .false.)
1133 do itime = 1, param%repetitions
1141 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1142 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .false.)
1144 safe_allocate(dff_mf(1:sys%gr%np))
1145 do ip = 1, sys%gr%np
1146 dff_mf(ip) = 0.01_real64 + 0.001_real64*real(sys%gr%x(1, ip), real64)
1149 do itime = 1, param%repetitions
1153 safe_allocate(zff_mf(1:sys%gr%np))
1154 do ip = 1, sys%gr%np
1155 zff_mf(ip) = cmplx(0.01_real64 + 0.001_real64*real(sys%gr%x(1, ip), real64), 0.02_real64, real64)
1158 do itime = 1, param%repetitions
1166 safe_deallocate_a(dff_mf)
1167 safe_deallocate_a(zff_mf)
1173 if (
bitand(ops, option__testbatchops__ops_nrm2) /= 0)
then
1174 message(1) =
'Info: Testing nrm2'
1177 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1178 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1180 safe_allocate(tmp(1:xx%nst))
1182 do itime = 1, param%repetitions
1185 do itime = 1, xx%nst
1186 write(
message(1),
'(a,i1,3x,e23.16)')
"Nrm2 norm state ", itime, tmp(itime)
1190 safe_deallocate_a(tmp)
1196 if (
bitand(ops, option__testbatchops__ops_dotp_matrix) /= 0)
then
1198 message(1) =
'Info: Testing dotp_matrix'
1201 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1202 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1204 nst = sys%st%group%psib(1, 1)%nst
1207 safe_allocate(ddot(1:nst, 1:nst))
1208 do itime = 1, param%repetitions
1214 write(
message(jst),
'(a,2i3,3x,e23.16)')
'Dotp_matrix states', ist, jst, ddot(ist,jst)
1218 safe_deallocate_a(ddot)
1220 safe_allocate(zdot(1:nst, 1:nst))
1221 do itime = 1, param%repetitions
1227 write(
message(jst),
'(a,2i3,3x,2(e23.16,1x))')
'Dotp_matrix states', ist, jst, zdot(ist,jst)
1231 safe_deallocate_a(zdot)
1237 message(1) =
'Info: Testing dotp_matrix with distinct batches'
1240 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1241 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .false.)
1243 nst = sys%st%group%psib(1, 1)%nst
1246 safe_allocate(dff_mf(1:sys%gr%np))
1247 do ip = 1, sys%gr%np
1248 dff_mf(ip) = 0.5_real64 + 0.1_real64*real(sys%gr%x(1, ip), real64)
1251 safe_deallocate_a(dff_mf)
1253 safe_allocate(ddot(1:nst, 1:nst))
1257 write(
message(jst),
'(a,2i3,3x,e23.16)')
'Dotp_matrix_ab states', ist, jst, ddot(ist,jst)
1261 safe_deallocate_a(ddot)
1263 safe_allocate(zff_mf(1:sys%gr%np))
1264 do ip = 1, sys%gr%np
1265 zff_mf(ip) = cmplx(0.5_real64 + 0.1_real64*real(sys%gr%x(1, ip), real64), &
1266 0.3_real64*real(sys%gr%x(1, ip), real64), real64)
1269 safe_deallocate_a(zff_mf)
1271 safe_allocate(zdot(1:nst, 1:nst))
1275 write(
message(jst),
'(a,2i3,3x,2(e23.16,1x))')
'Dotp_matrix_ab states', ist, jst, zdot(ist,jst)
1279 safe_deallocate_a(zdot)
1286 if (
bitand(ops, option__testbatchops__ops_dotp_vector) /= 0)
then
1288 message(1) =
'Info: Testing dotp_vector'
1291 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1292 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1294 nst = sys%st%group%psib(1, 1)%nst
1297 safe_allocate(ddotv(1:nst))
1298 do itime = 1, param%repetitions
1303 write(
message(ist),
'(a,i3,3x,e23.16)')
'Dotp_vector state', ist, ddotv(ist)
1306 safe_deallocate_a(ddotv)
1308 safe_allocate(zdotv(1:nst))
1309 do itime = 1, param%repetitions
1314 write(
message(ist),
'(a,i3,3x,2(e23.16,1x))')
'Dotp_vector state', ist, zdotv(ist)
1317 safe_deallocate_a(zdotv)
1324 if (
bitand(ops, option__testbatchops__ops_dotp_self) /= 0)
then
1326 message(1) =
'Info: Testing dotp_self'
1329 call sys%st%group%psib(1, 1)%copy_to(xx, copy_data = .
true.)
1331 nst = sys%st%group%psib(1, 1)%nst
1334 safe_allocate(ddot(1:nst, 1:nst))
1335 do itime = 1, param%repetitions
1341 write(
message(jst),
'(a,2i3,3x,e23.16)')
'Dotp_self states', ist, jst, ddot(ist,jst)
1345 safe_deallocate_a(ddot)
1347 safe_allocate(zdot(1:nst, 1:nst))
1348 do itime = 1, param%repetitions
1354 write(
message(jst),
'(a,2i3,3x,2(e23.16,1x))')
'Dotp_self states', ist, jst, zdot(ist,jst)
1358 safe_deallocate_a(zdot)
1364 if (
bitand(ops, option__testbatchops__ops_ax_function_py) /= 0)
then
1365 message(1) =
'Info: Testing ax_function_py'
1368 call sys%st%group%psib(1, 1)%copy_to(yy, copy_data = .
true.)
1371 safe_allocate(df(sys%gr%np, sys%st%d%dim))
1372 safe_allocate(dweight(1:sys%st%group%psib(1, 1)%nst_linear))
1373 dweight = 0.1_real64
1376 do itime = 1, param%repetitions
1379 safe_deallocate_a(df)
1380 safe_deallocate_a(dweight)
1382 safe_allocate(zf(sys%gr%np, sys%st%d%dim))
1383 safe_allocate(zweight(1:sys%st%group%psib(1, 1)%nst_linear))
1384 zweight = cmplx(0.1_real64,
m_zero, real64)
1387 do itime = 1, param%repetitions
1390 safe_deallocate_a(zf)
1391 safe_deallocate_a(zweight)
1398 if (
bitand(ops, option__testbatchops__ops_get_points) /= 0)
then
1403 call sys%st%group%psib(1, 1)%copy_to(yy)
1409 safe_allocate(dpoints(1:sys%st%nst, 1:sys%st%d%dim, 1:block_size))
1411 do itime = 1, param%repetitions
1412 do sp = 1, sys%gr%np, block_size
1413 size = min(block_size, sys%gr%np - sp + 1)
1418 safe_deallocate_a(dpoints)
1424 safe_allocate(zpoints(1:sys%st%nst, 1:sys%st%d%dim, 1:block_size))
1426 do itime = 1, param%repetitions
1427 do sp = 1, sys%gr%np, block_size
1428 size = min(block_size, sys%gr%np - sp + 1)
1433 safe_deallocate_a(zpoints)
1444 safe_deallocate_p(sys)
1459 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
1461 message(1) =
'Info: Testing the finite-differences derivatives.'
1465 if (param%type == option__testtype__all .or. param%type == option__testtype__real)
then
1466 call dderivatives_test(sys%gr%der, sys%namespace, param%repetitions, param%min_blocksize, param%max_blocksize)
1469 if (param%type == option__testtype__all .or. param%type == option__testtype__complex)
then
1470 call zderivatives_test(sys%gr%der, sys%namespace, param%repetitions, param%min_blocksize, param%max_blocksize)
1473 if (sys%space%dim > 1)
then
1477 safe_deallocate_p(sys)
1497 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
1499 message(1) =
'Info: Testing orthogonalization.'
1503 if (param%type == option__testtype__all .or. param%type == option__testtype__real)
then
1504 message(1) =
'Info: Real wave-functions.'
1506 do itime = 1, param%repetitions
1511 if (param%type == option__testtype__all .or. param%type == option__testtype__complex)
then
1512 message(1) =
'Info: Complex wave-functions.'
1514 do itime = 1, param%repetitions
1519 safe_deallocate_p(sys)
1535 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
1537 if (param%type == option__testtype__all .or. param%type == option__testtype__real)
then
1546 if (param%type == option__testtype__all .or. param%type == option__testtype__complex)
then
1548 call messages_write(
'Info: Testing complex interpolation routines')
1556 safe_deallocate_p(sys)
1572 sys =>
electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
1574 call ion_interaction_test(sys%space, sys%ions%latt, sys%ions%atom, sys%ions%natoms, sys%ions%pos, &
1575 sys%gr%box%bounding_box_l, namespace, sys%mc)
1577 safe_deallocate_p(sys)
1586 type(
grid_t),
intent(in) :: gr
1587 class(
batch_t),
intent(inout) :: psib
1588 character(*),
optional,
intent(in) :: string
1591 complex(real64),
allocatable :: zpsi(:, :)
1592 real(real64),
allocatable :: dpsi(:, :)
1594 character(80) :: string_
1601 safe_allocate(dpsi(1:gr%np, 1:st%d%dim))
1603 safe_allocate(zpsi(1:gr%np, 1:st%d%dim))
1606 do itime = 1, psib%nst
1609 write(
message(1),
'(a,i2,3x,e23.16)')
"Norm state "//trim(string_)//
" ", itime,
dmf_nrm2(gr, st%d%dim, dpsi)
1612 write(
message(1),
'(a,i2,3x,e23.16)')
"Norm state "//trim(string_)//
" ", itime,
zmf_nrm2(gr, st%d%dim, zpsi)
1618 safe_deallocate_a(dpsi)
1620 safe_deallocate_a(zpsi)
1636 write(
message(1),
'(a)')
" Operation Counter Time Global step"
1651 call clock%set(
clock_t(time_step=
m_four, initial_iteration=1))
1655 write(
message(1),
'(a)')
" Clock comparisons:"
1658 other_clock =
clock_t(time_step=
m_one, initial_iteration=5)
1670 character(len=*),
intent(in) :: operation
1672 write(
message(1),
'(a17,1x,i6,1x,f10.1,1x,i16)') operation, clock%counter(), clock%value(), clock%global_step()
1677 character(len=*),
intent(in) :: condition
1678 logical,
intent(in) :: result
1680 write(
message(1),
'(a10," = ",i1," (",l1,")")') condition, abs(transfer(result, 0)), result
1697 message(1) =
"cgal_polyhedron_point_inside"
1709 integer :: N, ii, jj, N_list(4), i_N
1710 real(real64),
allocatable :: matrix(:, :), eigenvectors(:, :), eigenvalues(:), test(:)
1711 real(real64),
allocatable :: differences(:)
1715 n_list = [15, 32, 100, 500]
1719 safe_allocate(matrix(1:n, 1:n))
1720 safe_allocate(eigenvectors(1:n, 1:n))
1721 safe_allocate(eigenvalues(1:n))
1722 safe_allocate(test(1:n))
1723 safe_allocate(differences(1:n))
1729 matrix(ii, jj) = ii * jj
1734 eigenvectors(1:n, 1:n) = matrix(1:n, 1:n)
1738 test(:) = matmul(matrix, eigenvectors(:, ii)) - eigenvalues(ii) * eigenvectors(:, ii)
1739 differences(ii) = sum(abs(test)) / sum(abs(eigenvectors(:, ii)))
1741 write(
message(1),
"(A, I3, A, E13.6)")
"Parallel solver - N: ", n, &
1742 ", average difference: ", sum(differences)/n
1746 eigenvectors(1:n, 1:n) = matrix(1:n, 1:n)
1750 test(:) = matmul(matrix, eigenvectors(:, ii)) - eigenvalues(ii) * eigenvectors(:, ii)
1751 differences(ii) = sum(abs(test)) / sum(abs(eigenvectors(:, ii)))
1753 write(
message(1),
"(A, I3, A, E13.6)")
"Serial solver - N: ", n, &
1754 ", average difference: ", sum(differences)/n
1757 safe_deallocate_a(matrix)
1758 safe_deallocate_a(eigenvectors)
1759 safe_deallocate_a(eigenvalues)
1760 safe_deallocate_a(test)
1761 safe_deallocate_a(differences)
1768 class(
batch_t),
intent(inout) :: psib
1769 class(
mesh_t),
intent(in) :: mesh
1771 real(real64),
allocatable :: dff(:)
1772 complex(real64),
allocatable :: zff(:)
1774 real(real64) :: da, db, dc
1775 complex(real64) :: za, zb, zc
1780 da =
m_one/mesh%box%bounding_box_l(1)
1786 za = da +
m_zi*0.01_real64
1787 zb = db*
exp(
m_zi*0.345_real64)
1788 zc = dc -
m_zi*50.0_real64
1790 safe_allocate(zff(1:mesh%np))
1791 do ist = 1, psib%nst_linear
1795 zff(ip) = zb*
exp(-za*sum(mesh%x(:, ip)**2)) + zc
1800 safe_deallocate_a(zff)
1802 safe_allocate(dff(1:mesh%np))
1803 do ist = 1, psib%nst_linear
1807 dff(ip) = db*
exp(-da*sum(mesh%x(:, ip)**2)) + dc
1812 safe_deallocate_a(dff)
1829 sys%gr%stencil, sys%mc, nlevels=3)
1835 safe_deallocate_p(sys)
1851 write(
message(1),*)
'hash[1] :', found,
value
1855 write(
message(1),*)
'hash[2] :', found,
value
1859 write(
message(1),*)
'hash[3] :', found,
value
1871 integer ::
value, sum
1880 write(
message(1),*)
'hash["one"]: ', found,
value
1884 write(
message(1),*)
'hash["two"]: ', found,
value
1888 write(
message(1),*)
'hash["three"]: ', found,
value
1895 do while (it%has_next())
1896 value = it%get_next()
1898 write(
message(1),
'(I3,A,I5)') counter,
': hash[...] = ',
value
1900 counter = counter + 1
1902 write(
message(1),*)
'counter = ', counter
1903 write(
message(2),*)
'sum = ', sum
1925 class(*),
pointer :: value
1927 integer :: count_clock, count_space
1929 safe_allocate(clock_2)
1943 write(
message(1),*)
'hash["one"]: ', found,
value%counter()
1946 write(
message(1),*)
'hash["one"]: ', found,
value%short_info()
1949 write(
message(1),*)
'wrong type. found = ', found
1956 write(
message(1),*)
'hash["two"]: ', found,
value%counter()
1959 write(
message(1),*)
'hash["two"]: ', found,
value%short_info()
1962 write(
message(1),*)
'wrong type. found = ',found
1966 safe_deallocate_a(clock_2)
1971 write(
message(1),*)
'hash["three"]: ', found,
value%counter()
1974 write(
message(1),*)
'hash["three"]: ', found,
value%short_info()
1977 write(
message(1),*)
'wrong type. found = ',found
1986 do while (it%has_next())
1987 value => it%get_next()
1990 count_clock = count_clock + 1
1992 count_space = count_space + 1
1996 write(
message(1), *)
'Count_clock = ', count_clock
1997 write(
message(2), *)
'Count_space = ', count_space
2011 real(real64),
allocatable :: ff_A(:), ff_A_reference(:), ff_B(:), ff_B_reference(:), diff_A(:), diff_B(:)
2012 real(real64) :: norm_ff, norm_diff
2022 safe_allocate(ff_a(1:sysa%gr%np))
2023 safe_allocate(ff_a_reference(1:sysa%gr%np))
2024 safe_allocate(diff_a(1:sysa%gr%np))
2025 safe_allocate(ff_b(1:sysb%gr%np))
2026 safe_allocate(ff_b_reference(1:sysb%gr%np))
2027 safe_allocate(diff_b(1:sysb%gr%np))
2029 do ip = 1, sysa%gr%np
2030 ff_a_reference(ip) =
values(sysa%gr%x(:, ip))
2032 do ip = 1, sysb%gr%np
2033 ff_b_reference(ip) =
values(sysb%gr%x(:, ip))
2037 regridding =>
regridding_t(sysb%gr, sysa%gr, sysa%space, sysa%namespace)
2038 call regridding%do_transfer(ff_b, ff_a_reference)
2039 safe_deallocate_p(regridding)
2042 do ip = 1, sysb%gr%np
2044 ff_b_reference(ip) =
m_zero
2047 diff_b(ip) = abs(ff_b_reference(ip) - ff_b(ip))
2050 norm_ff =
dmf_nrm2(sysb%gr, ff_b_reference)
2051 norm_diff =
dmf_nrm2(sysb%gr, diff_b)
2053 write(
message(1),
'(a, E14.6)')
"Forward: difference of reference to mapped function (rel.): ", &
2058 sysb%gr, ff_b_reference,
unit_one, ierr)
2062 sysa%gr, ff_a_reference,
unit_one, ierr)
2065 regridding =>
regridding_t(sysa%gr, sysb%gr, sysb%space, sysb%namespace)
2066 call regridding%do_transfer(ff_a, ff_b_reference)
2067 safe_deallocate_p(regridding)
2069 do ip = 1, sysa%gr%np
2071 ff_a_reference(ip) =
m_zero
2074 diff_a(ip) = abs(ff_a_reference(ip) - ff_a(ip))
2077 norm_ff =
dmf_nrm2(sysa%gr, ff_a_reference)
2078 norm_diff =
dmf_nrm2(sysa%gr, diff_a)
2080 write(
message(1),
'(a, E14.6)')
"Backward: difference of reference to mapped function (rel.): ", &
2085 sysa%gr, ff_a_reference,
unit_one, ierr)
2089 sysb%gr, ff_b_reference,
unit_one, ierr)
2091 safe_deallocate_a(ff_a)
2092 safe_deallocate_a(ff_a_reference)
2093 safe_deallocate_a(ff_b)
2094 safe_deallocate_a(ff_b_reference)
2095 safe_deallocate_a(diff_a)
2096 safe_deallocate_a(diff_b)
2097 safe_deallocate_p(sysa)
2098 safe_deallocate_p(sysb)
2104 real(real64) function values(xx)
2105 real(real64),
intent(in) :: xx(:)
2106 real(real64) :: xx0(1:size(xx, dim=1))
2107 real(real64),
parameter :: aa =
m_half
2108 real(real64),
parameter :: bb =
m_four
2112 values = bb *
exp(-aa*sum((xx-xx0)**2))
2118 type(namespace_t),
intent(in) :: namespace
2119 type(mpi_grp_t),
intent(in) :: grp
2121 type(namespace_t) :: namespace_a, namespace_b
2122 type(electrons_t),
pointer :: sysA, sysB
2123 type(regridding_t),
pointer :: regridding
2124 real(real64),
allocatable :: ff_a(:), ff_b(:), lapl_a(:), lapl_b(:), lapl_b_on_a(:), diff_lapl(:)
2125 real(real64) :: abs_diff, rel_diff, norm_lapl
2127 real(real64),
parameter :: alpha = 0.5_real64
2131 call calc_mode_par%set_parallelization(p_strategy_states, default=.false.)
2133 namespace_a = namespace_t(
"A", namespace)
2134 namespace_b = namespace_t(
"B", namespace)
2136 sysa => electrons_t(namespace_a, grp, int(option__calculationmode__dummy, int32))
2137 sysb => electrons_t(namespace_b, grp, int(option__calculationmode__dummy, int32))
2139 assert(sysa%gr%np_global == sysb%gr%np_global)
2140 assert(sysa%st%nst == sysb%st%nst)
2141 assert(sysa%ions%natoms == sysb%ions%natoms)
2143 dim = sysa%gr%box%dim
2144 safe_allocate(ff_a(1:sysa%gr%np_part))
2145 safe_allocate(ff_b(1:sysb%gr%np_part))
2146 safe_allocate(lapl_a(1:sysa%gr%np))
2147 safe_allocate(lapl_b(1:sysb%gr%np))
2148 safe_allocate(lapl_b_on_a(1:sysa%gr%np))
2149 safe_allocate(diff_lapl(1:sysa%gr%np))
2151 do ip = 1, sysa%gr%np_part
2152 ff_a(ip) =
gaussian(sysa%gr%x(1:dim, ip), alpha)
2154 do ip = 1, sysb%gr%np_part
2155 ff_b(ip) =
gaussian(sysb%gr%x(1:dim, ip), alpha)
2158 call dderivatives_lapl(sysa%gr%der, ff_a, lapl_a, set_bc=.false.)
2159 call dderivatives_lapl(sysb%gr%der, ff_b, lapl_b, set_bc=.false.)
2161 regridding => regridding_t(sysa%gr, sysb%gr, sysb%space, sysb%namespace)
2162 call regridding%do_transfer(lapl_b_on_a, lapl_b)
2163 safe_deallocate_p(regridding)
2165 diff_lapl = lapl_a - lapl_b_on_a
2166 abs_diff = dmf_nrm2(sysa%gr, diff_lapl)
2167 norm_lapl = dmf_nrm2(sysa%gr, lapl_a)
2168 rel_diff = abs_diff/max(norm_lapl, m_epsilon)
2170 assert(rel_diff <= 1.0e-12_real64)
2172 write(message(1),
'(a)')
"System A initialized"
2173 call messages_info(1, namespace=namespace_a)
2174 write(message(1),
'(a)')
"System B initialized"
2175 call messages_info(1, namespace=namespace_b)
2176 write(message(1),
'(a,es17.10)')
"Gaussian Laplacian absolute difference = ", abs_diff
2177 write(message(2),
'(a,es17.10)')
"Gaussian Laplacian relative difference = ", rel_diff
2178 write(message(3),
'(a,es17.10)')
"Gaussian Laplacian reference norm = ", norm_lapl
2179 call messages_info(3, namespace=namespace)
2181 safe_deallocate_a(ff_a)
2182 safe_deallocate_a(ff_b)
2183 safe_deallocate_a(lapl_a)
2184 safe_deallocate_a(lapl_b)
2185 safe_deallocate_a(lapl_b_on_a)
2186 safe_deallocate_a(diff_lapl)
2187 safe_deallocate_p(sysa)
2188 safe_deallocate_p(sysb)
2192 real(real64) function gaussian(x, a) result(val)
2193 real(real64),
intent(in) :: x(:)
2194 real(real64),
intent(in) :: a
2196 val =
exp(-a*sum(x**2))
2207 type(namespace_t),
intent(in) :: namespace
2208 type(mpi_grp_t),
intent(in) :: grp
2210 class(maxwell_t),
pointer :: maxwell_system
2212 real(real64),
allocatable :: magnetic_field(:,:)
2213 real(real64),
allocatable :: vector_potential_mag(:,:)
2214 real(real64),
allocatable :: vector_potential_analytical(:,:)
2215 real(real64),
allocatable :: delta(:,:)
2216 real(real64) :: exp_factor
2220 real(real64) :: sigma
2221 integer :: ip, j, ierr, nn
2222 integer(int64) :: out_how
2223 character(len=MAX_PATH_LEN) :: fname, fname2, fname3
2226 maxwell_system => maxwell_t(namespace, grp)
2227 sigma = maxwell_system%gr%box%bounding_box_l(1)/10_real64
2229 safe_allocate(magnetic_field(1:maxwell_system%gr%np_part, 1:3))
2230 safe_allocate(vector_potential_mag(1:maxwell_system%gr%np_part, 1:3))
2231 safe_allocate(vector_potential_analytical(1:maxwell_system%gr%np_part, 1:3))
2232 safe_allocate(delta(1:maxwell_system%gr%np, 1:3))
2245 call parse_variable(namespace,
'TestVectorPotentialType', option__testvectorpotentialtype__bounded, nn)
2248 case (option__testvectorpotentialtype__bounded)
2249 do ip = 1, maxwell_system%gr%np_part
2250 xx = maxwell_system%gr%x(1, ip)
2251 yy = maxwell_system%gr%x(2, ip)
2252 zz = maxwell_system%gr%x(3, ip)
2253 exp_factor =
exp((-xx**2 - yy**2 - zz**2)*1/(2*sigma**2))
2254 magnetic_field(ip, 1) = exp_factor*yy*(1 - (-xx**2 + yy**2)/(3*sigma**2) - zz**2/(3*sigma**2))
2255 magnetic_field(ip, 2) = exp_factor * xx * (1 + (-xx**2 + yy**2)/(3*sigma**2) - zz**2/(3*sigma**2))
2256 magnetic_field(ip, 3) = exp_factor * 2 * xx * yy * zz * 1/(3*sigma**2)
2258 vector_potential_analytical(ip, 1) = m_third * xx * zz * exp_factor
2259 vector_potential_analytical(ip, 2) = - m_third * yy * zz * exp_factor
2260 vector_potential_analytical(ip, 3) = m_third * (-xx**2 + yy**2) * exp_factor
2262 case (option__testvectorpotentialtype__unbounded)
2264 do ip = 1, maxwell_system%gr%np_part
2265 magnetic_field(ip, 1) = maxwell_system%gr%x(2, ip)
2266 magnetic_field(ip, 2) = maxwell_system%gr%x(1, ip)
2267 magnetic_field(ip, 3) = m_zero
2269 vector_potential_analytical(ip, 1) = m_third * maxwell_system%gr%x(1, ip) * maxwell_system%gr%x(3, ip)
2270 vector_potential_analytical(ip, 2) = - m_third * maxwell_system%gr%x(2, ip) * maxwell_system%gr%x(3, ip)
2271 vector_potential_analytical(ip, 3) = - m_third * (maxwell_system%gr%x(1, ip)**2 - maxwell_system%gr%x(2, ip)**2)
2274 call maxwell_system%helmholtz%get_vector_potential(namespace, vector_potential_mag, magnetic_field)
2278 do ip = 1, maxwell_system%gr%np
2279 delta(ip,j) = vector_potential_analytical(ip, j) - vector_potential_mag(ip, j)
2284 write(message(j),*)
'j, norm2(delta)', j, norm2(delta(:,j))
2286 call messages_info(3)
2288 write(fname,
'(a)')
'deviation_from_analytical_formulation'
2289 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, maxwell_system%space, maxwell_system%gr, &
2290 delta, unit_one, ierr)
2291 write(fname2,
'(a)')
'vector_potential_analytical'
2292 call io_function_output_vector(out_how ,
'./' , trim(fname2), namespace, maxwell_system%space, maxwell_system%gr, &
2293 vector_potential_analytical, unit_one, ierr)
2294 write(fname3,
'(a)')
'vector_potential_mag'
2295 call io_function_output_vector(out_how ,
'./' , trim(fname3), namespace, maxwell_system%space, maxwell_system%gr, &
2296 vector_potential_mag, unit_one, ierr)
2298 safe_deallocate_a(magnetic_field)
2299 safe_deallocate_a(vector_potential_mag)
2300 safe_deallocate_a(vector_potential_analytical)
2301 safe_deallocate_a(delta)
2302 safe_deallocate_p(maxwell_system)
2308 type(multigrid_t),
intent(in) :: mgrid
2309 class(space_t),
intent(in) :: space
2311 real(real64),
allocatable :: guess0(:), res0(:), guess1(:)
2312 type(mesh_t),
pointer :: mesh0, mesh1
2313 real(real64) :: delta, xx(3,2), alpha, beta, rr
2314 integer :: nn, ip, ierr
2318 message(1) =
'Info: Testing the grid interpolation.'
2320 call messages_info(2)
2322 mesh0 => mgrid%level(0)%mesh
2323 mesh1 => mgrid%level(1)%mesh
2325 safe_allocate(guess0(1:mesh0%np_part))
2326 safe_allocate(res0(1:mesh0%np_part))
2327 safe_allocate(guess1(1:mesh1%np_part))
2329 alpha = m_four*mesh0%spacing(1)
2330 beta = m_one / (alpha**space%dim *
sqrt(m_pi)**space%dim)
2345 call mesh_r(mesh0, ip, rr, origin = xx(:, nn))
2346 guess0(ip) = guess0(ip) + (-1)**nn * beta*
exp(-(rr/alpha)**2)
2350 call dio_function_output (io_function_fill_how(
'AxisX'),
".",
"interpolation_target", global_namespace, &
2351 space, mesh0, guess0, unit_one, ierr)
2352 call dio_function_output (io_function_fill_how(
'AxisZ'),
".",
"interpolation_target", global_namespace, &
2353 space, mesh0, guess0, unit_one, ierr)
2354 call dio_function_output (io_function_fill_how(
'PlaneZ'),
".",
"interpolation_target", global_namespace, &
2355 space, mesh0, guess0, unit_one, ierr)
2362 call dmultigrid_fine2coarse(mgrid%level(1)%tt, mgrid%level(0)%der, mesh1, guess0, guess1, injection)
2364 call dmultigrid_coarse2fine(mgrid%level(1)%tt, mgrid%level(1)%der, mesh0, guess1, res0)
2366 call dio_function_output (io_function_fill_how(
'AxisX'),
".",
"interpolation_result", global_namespace, &
2367 space, mesh0, res0, unit_one, ierr)
2368 call dio_function_output (io_function_fill_how(
'AxisZ'),
".",
"interpolation_result", global_namespace, &
2369 space, mesh0, res0, unit_one, ierr)
2370 call dio_function_output (io_function_fill_how(
'PlaneZ'),
".",
"interpolation_result", global_namespace, &
2371 space, mesh0, res0, unit_one, ierr)
2373 delta = dmf_nrm2(mesh0, guess0(1:mesh0%np)-res0(1:mesh0%np))
2374 write(message(1),
'(a,e13.6)')
'Interpolation test (abs.) = ', delta
2380 call dmultigrid_fine2coarse(mgrid%level(1)%tt, mgrid%level(0)%der, mesh1, guess0, guess1, fullweight)
2382 call dmultigrid_coarse2fine(mgrid%level(1)%tt, mgrid%level(1)%der, mesh0, guess1, res0)
2384 call dio_function_output (io_function_fill_how(
'AxisX'),
".",
"restriction_result", global_namespace, &
2385 space, mesh0, res0, unit_one, ierr)
2386 call dio_function_output (io_function_fill_how(
'AxisZ'),
".",
"restriction_result", global_namespace, &
2387 space, mesh0, res0, unit_one, ierr)
2388 call dio_function_output (io_function_fill_how(
'PlaneZ'),
".",
"restriction_result", global_namespace, &
2389 space, mesh0, res0, unit_one, ierr)
2391 delta = dmf_nrm2(mesh0, guess0(1:mesh0%np)-res0(1:mesh0%np))
2392 write(message(2),
'(a,e13.6)')
'Restriction test (abs.) = ', delta
2393 call messages_info(2)
2395 safe_deallocate_a(guess0)
2396 safe_deallocate_a(res0)
2397 safe_deallocate_a(guess1)
2405 type(namespace_t),
intent(in) :: namespace
2406 type(mpi_grp_t),
intent(in) :: grp
2407 type(electrons_t),
pointer :: sys
2409 type(current_t) :: current
2410 character(len=MAX_PATH_LEN) :: fname
2411 integer :: ierr, ip, idir
2412 integer(int64) :: out_how
2413 real(real64),
allocatable :: current_para_ref(:,:), current_dia_ref(:,:), current_mag_ref(:,:), delta(:)
2414 real(real64) :: xx(3), rr, a0, mag_curr, sin_thet, sin_phi, cos_phi, vec_pot_slope
2415 complex(real64) :: alpha
2417 sys => electrons_t(namespace, grp, int(option__calculationmode__dummy, int32))
2419 alpha = (0.0_real64, 0.5_real64)
2421 vec_pot_slope = 0.4_real64
2423 call states_elec_allocate_wfns(sys%st, sys%gr, wfs_type = type_cmplx)
2426 call current_init(current, namespace)
2428 call hamiltonian_elec_epot_generate(sys%hm, sys%namespace, sys%space, sys%gr, sys%ions, sys%ext_partners, sys%st)
2430 safe_allocate(sys%hm%hm_base%vector_potential(1:3, 1:sys%gr%np))
2432 sys%hm%hm_base%vector_potential = m_zero
2433 do ip = 1, sys%gr%np
2434 xx = sys%gr%x(1:3, ip)
2435 sys%hm%hm_base%vector_potential(2, ip) = vec_pot_slope * xx(1) / p_c
2438 call states_elec_allocate_current(sys%st, sys%space, sys%gr)
2439 call density_calc(sys%st, sys%gr, sys%st%rho)
2441 call current_calculate(current, namespace, sys%gr, sys%hm, sys%space, sys%st)
2443 safe_allocate(current_para_ref(1:sys%gr%np,1:3))
2444 safe_allocate(current_dia_ref(1:sys%gr%np,1:3))
2445 safe_allocate(current_mag_ref(1:sys%gr%np,1:3))
2446 safe_allocate(delta(1:sys%gr%np))
2449 current_para_ref(:,:) = m_zero
2450 do ip = 1, sys%gr%np
2451 call mesh_r(sys%gr, ip, rr)
2452 xx = sys%gr%x(1:3, ip)
2453 if (rr > r_small)
then
2455 psi_1s(rr, a0) *
dr_psi_2s(rr, a0) ) * aimag(alpha) / (1 + abs(alpha)**2) * xx(1:3) / rr
2459 write(fname,
'(a)')
'current_para'
2460 out_how = io_function_fill_how(
"PlaneZ")
2461 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2462 sys%st%current_para(:,:,1), unit_one, ierr)
2464 write(fname,
'(a)')
'current_para-ref'
2465 out_how = io_function_fill_how(
"PlaneZ")
2466 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2467 current_para_ref(:,:), unit_one, ierr)
2471 delta(:) = current_para_ref(1:sys%gr%np, idir) - sys%st%current_para(1:sys%gr%np, idir, 1)
2472 write(message(idir),*)
'idir =',idir,
', norm2(delta paramagnetic)',norm2(delta)
2474 call messages_info(3)
2477 current_dia_ref(:,:) = m_zero
2478 do ip = 1, sys%gr%np
2479 call mesh_r(sys%gr, ip, rr)
2480 current_dia_ref(ip,1:3) = - sys%hm%hm_base%vector_potential(1:3,ip) *&
2484 write(fname,
'(a)')
'current_dia'
2485 out_how = io_function_fill_how(
"PlaneZ")
2486 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2487 sys%st%current_dia(:,:,1), unit_one, ierr)
2489 write(fname,
'(a)')
'current_dia-ref'
2490 out_how = io_function_fill_how(
"PlaneZ")
2491 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2492 current_dia_ref(:,:), unit_one, ierr)
2496 delta(:) = current_dia_ref(1:sys%gr%np, idir) - sys%st%current_dia(1:sys%gr%np, idir, 1)
2497 write(message(idir),*)
'idir =',idir,
', norm2(delta diamagnetic)',norm2(delta)
2499 call messages_info(3)
2502 call current_calculate_mag(sys%gr%der, sys%st)
2505 current_mag_ref(:,:) = m_zero
2506 do ip = 1, sys%gr%np
2507 call mesh_r(sys%gr, ip, rr)
2508 xx = sys%gr%x(1:3, ip)
2509 if (norm2(xx(1:2)) > r_small .and. rr > r_small)
then
2510 sin_thet = norm2(xx(1:2)) / rr
2511 sin_phi = xx(2) / norm2(xx(1:2))
2512 cos_phi = xx(1) / norm2(xx(1:2))
2516 current_mag_ref(ip,1) = m_half * mag_curr * sin_thet * sin_phi / (1+abs(alpha)**2)
2517 current_mag_ref(ip,2) = -m_half * mag_curr * sin_thet * cos_phi / (1+abs(alpha)**2)
2521 write(fname,
'(a)')
'current_mag'
2522 out_how = io_function_fill_how(
"PlaneZ")
2523 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2524 sys%st%current_mag(:,:,1), unit_one, ierr)
2526 write(fname,
'(a)')
'current_mag-ref'
2527 out_how = io_function_fill_how(
"PlaneZ")
2528 call io_function_output_vector(out_how ,
'./' , trim(fname), namespace, sys%space, sys%gr, &
2529 current_mag_ref(:,:), unit_one, ierr)
2533 delta(:) = current_mag_ref(1:sys%gr%np, idir) - sys%st%current_mag(1:sys%gr%np, idir, 1)
2534 write(message(idir),*)
'idir =',idir,
', norm2(delta magnetization)',norm2(delta)
2536 call messages_info(3)
2538 safe_deallocate_a(current_para_ref)
2539 safe_deallocate_a(current_dia_ref)
2540 safe_deallocate_a(current_mag_ref)
2541 safe_deallocate_a(delta)
2542 safe_deallocate_p(sys)
2548 class(batch_t),
intent(inout) :: psib
2549 class(mesh_t),
intent(in) :: mesh
2550 type(namespace_t),
intent(in) :: namespace
2551 complex(real64),
intent(in) :: alpha
2552 real(real64),
intent(in) :: a0
2554 complex(real64),
allocatable :: zff(:)
2561 safe_allocate(zff(1:mesh%np))
2562 if (type_is_complex(psib%type()))
then
2564 call mesh_r(mesh, ip, rr)
2567 call batch_set_state(psib, 1, mesh%np, zff)
2569 write(message(1),*)
"States should be complex for the linear combination of hydrogenic states to work"
2570 call messages_info(1, namespace=namespace)
2572 safe_deallocate_a(zff)
2578 real(real64),
intent(in) :: a0, rr
2579 complex(real64),
intent(in) :: alpha
2585 real(real64) function psi_1s(rr, a0)
2586 real(real64),
intent(in) :: a0, rr
2592 real(real64) function psi_2s(rr, a0)
2593 real(real64),
intent(in) :: a0, rr
2595 psi_2s =
sqrt(m_two) * a0**(-m_three/m_two) * (m_one - rr/(m_two * a0)) *
exp(-rr/(m_two * a0)) &
2596 / (m_two *
sqrt(m_pi))
2599 real(real64) function dr_psi_1s(rr, a0)
2600 real(real64),
intent(in) :: a0, rr
2605 real(real64) function dr_psi_2s(rr, a0)
2606 real(real64),
intent(in) :: a0, rr
2609 a0**(-m_five/m_two) *
exp(-rr/(m_two * a0)) / (
sqrt(m_two) * m_two *
sqrt(m_pi))
2614 type(namespace_t),
intent(in) :: namespace
2617 integer(int64) :: i, j, k
2618 integer(int64) :: dims(3)
2619 character(len=MAX_PATH_LEN) :: fname
2621 real(real64),
allocatable :: ff(:)
2631 call parse_variable(namespace,
'TestCSVFileName',
"", fname)
2633 message(1) =
"Attempting to probe "//trim(fname)
2634 call messages_info(1, namespace=namespace)
2636 call io_csv_get_info(fname, dims, ierr)
2638 message(1) =
"Probing successful."
2639 write(message(2),
'("found dimensions: ",3I20)') dims
2640 call messages_info(2, namespace=namespace)
2642 write(message(1),
'("Probing failed. ierr = ",I5)') ierr
2643 call messages_fatal(1, namespace=namespace)
2646 safe_allocate(ff(1:dims(1)*dims(2)*dims(3)))
2648 message(1) =
"Attempting to read "//trim(fname)
2649 call messages_info(1, namespace=namespace)
2651 call dread_csv(fname, dims(1)*dims(2)*dims(3), ff, ierr)
2653 message(1) =
"Reading successful."
2654 call messages_info(1, namespace=namespace)
2656 do k=1, min(4_int64, dims(3))
2657 do j=1, min(4_int64, dims(2))
2658 write(message(j),
'("data ",2I5, 1X, 4F8.2)') k, j, &
2659 (ff(i + dims(1)*(j-1) + dims(1)* dims(2)*(k-1)), i=1, min(4_int64, dims(1)))
2661 write(message(int(j, int32)),
'("")')
2662 call messages_info(int(j, int32), namespace=namespace)
2666 message(1) =
"Reading failed."
2667 call messages_fatal(1, namespace=namespace)
2670 safe_deallocate_a(ff)
batchified version of the BLAS axpy routine:
batchified multiplication by mesh function with optional conjugation:
batchified scale with optional conjugation:
scale a batch by a constant or vector
There are several ways how to call batch_set_state and batch_get_state:
Prints out to iunit a message in the form: ["InputVariable" = value] where "InputVariable" is given b...
double exp(double __x) __attribute__((__nothrow__
double sqrt(double __x) __attribute__((__nothrow__
pure logical function, public accel_is_enabled()
This module implements batches of mesh functions.
This module implements common operations on batches of mesh functions.
subroutine, public dbatch_ax_function_py(np, aa, psi, yy)
This routine performs a set of axpy operations adding the same function psi to all functions of a bat...
subroutine, public batch_set_zero(this, np, async)
fill all mesh functions of the batch with zero
subroutine, public zbatch_ax_function_py(np, aa, psi, yy)
This routine performs a set of axpy operations adding the same function psi to all functions of a bat...
Module implementing boundary conditions in Octopus.
Module, implementing a factory for boxes.
This module handles the calculation mode.
integer, parameter, public p_strategy_kpoints
parallelization in k-points
integer, parameter, public p_strategy_domains
parallelization in domains
type(calc_mode_par_t), public calc_mode_par
Singleton instance of parallel calculation mode.
integer, parameter, public p_strategy_states
parallelization in states
subroutine, public cgal_polyhedron_init(cgal_poly, fname, verbose)
logical function, public cgal_polyhedron_point_inside(cgal_poly, xq, yq, zq)
subroutine, public cgal_polyhedron_end(cgal_poly)
pure real(real64) function center(this)
Center of the filter interval.
This module implements a calculator for the density and defines related functions.
subroutine, public density_calc(st, gr, density, istin)
Computes the density from the orbitals in st.
This module calculates the derivatives (gradients, Laplacians, etc.) of a function.
This module provides unit tests for the derivatives.
subroutine, public zderivatives_test(this, namespace, repetitions, min_blocksize, max_blocksize)
unit test for derivatives
subroutine, public dderivatives_test(this, namespace, repetitions, min_blocksize, max_blocksize)
unit test for derivatives
subroutine, public derivatives_advanced_benchmark(this, namespace)
Further unit tests design to challenge numerical stability of the finite differences.
subroutine, public zchebyshev_filter(namespace, mesh, st, hm, degree, bounds, ik, normalize)
Chebyshev Filter.
subroutine, public dchebyshev_filter(namespace, mesh, st, hm, degree, bounds, ik, normalize)
Chebyshev Filter.
integer, parameter, public spin_polarized
subroutine, public exponential_init(te, namespace, full_batch)
real(real64), parameter, public m_two
real(real64), parameter, public m_zero
real(real64), parameter, public m_four
real(real64), parameter, public m_pi
some mathematical constants
complex(real64), parameter, public m_zi
real(real64), parameter, public m_epsilon
real(real64), parameter, public m_half
real(real64), parameter, public m_one
This module implements the underlying real-space grid.
subroutine, public zhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc)
subroutine, public hamiltonian_elec_end(hm)
subroutine, public hamiltonian_elec_epot_generate(this, namespace, space, gr, ions, ext_partners, st, time)
subroutine, public hamiltonian_elec_copy(hm_out, hm_in)
Deep-copy a hamiltonian_elec_t snapshot.
subroutine, public dhamiltonian_elec_apply_batch(hm, namespace, mesh, psib, hpsib, terms, set_bc)
type(hardware_t), public cpu_hardware
Global instance of CPU hardware specification.
integer, parameter, public sizeof_real64
Number of bytes to store a variable of type real(real64)
integer, parameter, public sizeof_complex64
Number of bytes to store a variable of type complex(real64)
The Helmholtz decomposition is intended to contain "only mathematical" functions and procedures to co...
Test suit for the Helmholtz decomposition module.
subroutine, public gaussian_test(helmholtz, sys_grid, namespace, space)
subroutine, public hertzian_dipole_test(helmholtz, sys_grid, namespace, space)
This module implements a simple hash table for non-negative integer keys and integer values.
subroutine, public iihash_end(h)
Free a hash table.
subroutine, public iihash_insert(h, key, val)
Insert a (key, val) pair into the hash table h.
integer function, public iihash_lookup(h, key, found)
Look up a value in the hash table h. If found is present, it indicates if key could be found in the t...
subroutine, public iihash_init(h)
Initialize a hash table h.
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 ion_interaction_test(space, latt, atom, natoms, pos, lsize, namespace, mc)
This modules takes care of testing some linear algebra routines.
subroutine, public test_exponential_matrix(namespace)
Unit tests for the exponential of a matrix.
Computes and , suitable as an operator callback for iterative solvers (CG, QMR, etc....
subroutine, public dshifted_laplacian_op(x, lx, userdata)
Computes the shifted Laplacian operator: .
This module defines functions over batches of mesh functions.
subroutine, public dmesh_batch_dotp_matrix(mesh, aa, bb, dot, reduce)
Calculate the overlap matrix of two batches.
subroutine, public dmesh_batch_dotp_self(mesh, aa, dot, reduce)
calculate the overlap matrix of a batch with itself
subroutine, public mesh_batch_nrm2(mesh, aa, nrm2, reduce)
Calculate the norms (norm2, not the square!) of a batch of mesh functions.
subroutine, public zmesh_batch_dotp_vector(mesh, aa, bb, dot, reduce, cproduct)
A simple switch between specialized kernels and generic kernels.
subroutine, public zmesh_batch_dotp_matrix(mesh, aa, bb, dot, reduce)
Calculate the overlap matrix of two batches.
subroutine, public zmesh_batch_normalize(mesh, psib, norm)
Normalize a batch.
subroutine, public zmesh_batch_dotp_self(mesh, aa, dot, reduce)
calculate the overlap matrix of a batch with itself
subroutine, public dmesh_batch_normalize(mesh, psib, norm)
Normalize a batch.
subroutine, public dmesh_batch_dotp_vector(mesh, aa, bb, dot, reduce, cproduct)
A simple switch between specialized kernels and generic kernels.
This module defines various routines, operating on mesh functions.
real(real64) function, public dmf_dotp_aux(f1, f2)
dot product between two vectors (mesh functions)
subroutine, public mesh_init_mesh_aux(mesh)
Initialise a pointer to the grid/mesh, that is globally exposed, such that low level mesh operations ...
subroutine, public zmesh_interpolation_test(mesh)
subroutine, public dmesh_interpolation_test(mesh)
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
subroutine, public messages_print_with_emphasis(msg, iunit, namespace)
character(len=512), private msg
subroutine, public messages_obsolete_variable(namespace, name, rep)
subroutine, public messages_new_line()
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
subroutine, public messages_info(no_lines, iunit, debug_only, stress, all_nodes, namespace)
This modules takes care of testing optimizers using standard test functions.
subroutine, public test_optimizers(namespace)
Unit tests for different optimizers.
This module implements unit tests for the mixing methods.
subroutine, public mix_tests_run()
subroutine, public test_mpiwrappers
This module handles the communicators for the various parallelization strategies.
subroutine, public multigrid_end(mgrid)
subroutine, public multigrid_init(mgrid, namespace, space, mesh, der, stencil, mc, nlevels)
type(namespace_t), public global_namespace
subroutine, public orbitalbasis_end(this)
subroutine, public zorbitalbasis_build(this, namespace, ions, mesh, kpt, ndim, skip_s_orb, use_all_orb, verbose)
This routine is an interface for constructing the orbital basis.
subroutine, public dorbitalbasis_build(this, namespace, ions, mesh, kpt, ndim, skip_s_orb, use_all_orb, verbose)
This routine is an interface for constructing the orbital basis.
subroutine, public orbitalbasis_init(this, namespace, periodic_dim)
subroutine, public dorbitalset_add_to_batch(os, ndim, psib, weight)
subroutine, public zorbitalset_add_to_batch(os, ndim, psib, weight)
subroutine, public orbitalset_update_phase(os, dim, kpt, kpoints, spin_polarized, vec_pot, vec_pot_var, kpt_max)
Build the phase correction to the global phase in case the orbital crosses the border of the simulato...
subroutine, public dorbitalset_get_coeff_batch(os, ndim, psib, dot, reduce)
subroutine, public zorbitalset_get_coeff_batch(os, ndim, psib, dot, reduce)
subroutine, public poisson_test(this, space, mesh, latt, namespace, repetitions)
This routine checks the Hartree solver selected in the input file by calculating numerically and anal...
subroutine, public preconditioner_end(this)
subroutine, public preconditioner_init(this, namespace, gr, mc, space)
subroutine, public zproject_psi_batch(mesh, bnd, pj, npj, dim, psib, ppsib)
To optimize the application of the non-local operator in parallel, the projectors are applied in step...
Implementation details for regridding.
This module implements a simple hash table for string valued keys and integer values using the C++ ST...
subroutine, public sihash_insert(h, key, val)
Insert a (key, val) pair into the hash table h.
subroutine, public sihash_init(h)
Initialize a hash table h with size entries. Since we use separate chaining, the number of entries in...
integer function, public sihash_lookup(h, key, found)
Look up a value in the hash table h. If found is present, it indicates if key could be found in the t...
subroutine, public sihash_end(h)
Free a hash table.
This module is intended to contain "only mathematical" functions and procedures.
This module implements a simple hash table for string valued keys and integer values using the C++ ST...
subroutine, public sphash_init(h)
Initialize a hash table h with size entries. Since we use separate chaining, the number of entries in...
subroutine, public sphash_insert(h, key, val, clone)
Insert a (key, val) pair into the hash table h. If clone=.true., the object will be copied.
subroutine, public sphash_end(h)
Free a hash table.
class(*) function, pointer, public sphash_lookup(h, key, found)
Look up a value in the hash table h. If found is present, it indicates if key could be found in the t...
pure logical function, public states_are_real(st)
subroutine, public zstates_elec_calc_orth_test(st, namespace, mesh, kpoints)
subroutine, public dstates_elec_calc_orth_test(st, namespace, mesh, kpoints)
This module handles spin dimensions of the states and the k-point distribution.
subroutine, public states_elec_deallocate_wfns(st)
Deallocates the KS wavefunctions defined within a states_elec_t structure.
subroutine, public states_elec_allocate_wfns(st, mesh, wfs_type, skip, packed)
Allocates the KS wavefunctions defined within a states_elec_t structure.
subroutine, public dsubspace_diag(this, namespace, mesh, st, hm, ik, eigenval, diff, nonortho)
Diagonalises the Hamiltonian in the subspace defined by the states.
subroutine, public zsubspace_diag(this, namespace, mesh, st, hm, ik, eigenval, diff, nonortho)
Diagonalises the Hamiltonian in the subspace defined by the states.
Integration tests for ISDF.
subroutine, public test_isdf(namespace, serial)
Set up an electron system, compute some optimal centroid positions, and use these to build a set of I...
subroutine, public test_weighted_kmeans(namespace)
Test weighted kmeans algorithm for a finite system.
This module implements a unit-test like runmode for Octopus.
real(real64) function psi_2s(rr, a0)
subroutine test_ion_interaction(namespace, grp)
subroutine test_hartree(param, namespace, grp)
subroutine test_interpolation(param, namespace, grp)
subroutine test_helmholtz_decomposition(namespace, grp)
subroutine test_current_density(namespace, grp)
Here we test the different contributions to the total electronic current density.
subroutine test_derivatives(param, namespace, grp)
real(real64) function psi_1s(rr, a0)
subroutine test_batch_set_gaussian(psib, mesh)
subroutine test_boundaries(param, namespace, grp)
subroutine test_sphash(namespace)
subroutine test_hamiltonian(param, namespace, grp)
subroutine test_dense_eigensolver()
subroutine multigrid_test_interpolation(mgrid, space)
subroutine test_projector(param, namespace, grp)
real(real64) function dr_psi_2s(rr, a0)
subroutine test_composition_chebyshev(namespace, grp)
Test the composition rule for Chebyshev polynomials.
complex(real64) function lc_hydrogen_state(rr, alpha, a0)
subroutine test_subspace_diagonalization(param, namespace, grp)
subroutine, public test_run(namespace, grp)
Components and integration test runner.
subroutine test_density_calc(param, namespace, grp)
subroutine test_linear_solver(namespace, grp)
subroutine test_prints_info_batch(st, gr, psib, string)
subroutine test_orthogonalization(param, namespace, grp)
real(real64) function dr_psi_1s(rr, a0)
subroutine test_regridding(namespace, grp)
subroutine test_batch_ops(param, namespace, grp)
subroutine test_vecpot_analytical(namespace, grp)
Here, analytical formulation for vector potential and B field are used. Ref: Sangita Sen and Erik I....
subroutine test_exponential(param, namespace, grp)
subroutine test_mesh_generation(namespace, grp)
subroutine set_hydrogen_states(psib, mesh, namespace, alpha, a0)
subroutine test_dft_u(param, namespace, grp)
subroutine test_grid_interpolation(grp)
subroutine test_csv_input(namespace)
subroutine, public test_poisson_fft_batch(namespace)
type(type_t), parameter, public type_cmplx
logical pure function, public type_is_complex(this)
This module defines the unit system, used for input and output.
type(unit_t), public unit_one
some special units required for particular quantities
subroutine, public v_ks_calc(ks, namespace, space, hm, st, ions, ext_partners, calc_eigenval, time, calc_energy, calc_current, force_semilocal)
Class defining batches of mesh functions.
Overload default constructor.
Class describing the electron system.
Description of the grid, containing information on derivatives, stencil, and symmetries.
This class implements the iteration counter used by the multisystem algorithms. As any iteration coun...
Describes mesh distribution to nodes.
This is defined even when running serial.
contains the information of the meshes and provides the transfer functions
The states_elec_t class contains all electronic wave functions.
batches of electronic states
subroutine write_clock(operation)
real(real64) function gaussian(x, a)
subroutine write_condition_result(condition, result)
real(real64) function values(xx)