Dice Fortran Backend Documentation
testing.f90
Go to the documentation of this file.
1 ! ---------------------------------------------------------------------------------------
2 ! Dice Quantum Monte Carlo
3 ! ---------------------------------------------------------------------------------------
4 ! MODULE: testing
5 !
6 ! DESCRIPTION:
9 !
13 ! ---------------------------------------------------------------------------------------
14 
15 module testing
16 
17  use shared_data
18  use input_parser
19  use write_netcdf
20  use solvers
21  use vqmc
22 
23  implicit none
24 
25  real(real64), parameter :: tol = 1e-6_real64
26 
27 contains
28 
29 ! ---------------------------------------------------------------------------------------
30 ! SECTION: Individual unit test functions
31 !
32 ! MODULE SUBSECTION: solvers
33 ! ---------------------------------------------------------------------------------------
34 
35  ! -----------------------------------------------------------------------------------
36  ! ROUTINE: test_QHO_Prob
37  !
38  ! DESCRIPTION:
41  !
44  !
45  ! PARAMETERS:
47  ! -----------------------------------------------------------------------------------
48  function test_qho_prob() result(ierr)
49 
50  implicit none
51 
52  real(real64) :: alpha = 0.1_real64
53  real(real64) :: x_current = 0.2_real64
54  real(real64) :: x_next = 1.0_real64
55  real(real64) :: res_expected = 0.8253068685_real64
56 
57  real(real64) :: res_actual
58  integer :: ierr
59 
60  res_actual = qho_prob(alpha, x_current, x_next)
61 
62  if (abs(res_actual - res_expected) .ge. tol) then
63  ierr = 1
64  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
65  else
66  ierr = 0
67  end if
68 
69  end function test_qho_prob
70 
71  ! -----------------------------------------------------------------------------------
72  ! ROUTINE: test_QHO_Energy
73  !
74  ! DESCRIPTION:
78  !
81  !
82  ! PARAMETERS:
84  ! -----------------------------------------------------------------------------------
85  function test_qho_energy() result(ierr)
86 
87  implicit none
88 
89  real(real64) :: alpha = 0.15_real64
90  real(real64) :: x = 0.314_real64
91  real(real64) :: res_expected = 0.19486118_real64
92 
93  real(real64) :: res_actual
94  integer :: ierr
95 
96  res_actual = qho_energy(alpha, x)
97 
98  if (abs(res_actual - res_expected) .ge. tol) then
99  ierr = 1
100  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
101  else
102  ierr = 0
103  end if
104 
105  end function test_qho_energy
106 
107  ! -----------------------------------------------------------------------------------
108  ! ROUTINE: test_H1s_wfn
109  !
110  ! DESCRIPTION:
113  !
116  !
117  ! PARAMETERS:
119  ! -----------------------------------------------------------------------------------
120  function test_h1s_wfn() result(ierr)
121 
122  implicit none
123 
124  real(real64), dimension(3) :: r_elec = (/1.5_real64, 0.2_real64, -0.5_real64/)
125  real(real64), dimension(3) :: r_nuc = (/1.0_real64, 0.0_real64, 0.0_real64/)
126  real(real64) :: res_expected = 0.2705734006_real64
127 
128  real(real64) :: res_actual
129  integer :: ierr
130 
131  res_actual = h1s_wfn(r_elec, r_nuc)
132 
133  if (abs(res_actual - res_expected) .ge. tol) then
134  ierr = 1
135  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
136  else
137  ierr = 0
138  end if
139 
140  end function test_h1s_wfn
141 
142  ! -----------------------------------------------------------------------------------
143  ! ROUTINE: test_H2s_wfn
144  !
145  ! DESCRIPTION:
148  !
151  !
152  ! PARAMETERS:
154  ! -----------------------------------------------------------------------------------
155  function test_h2s_wfn() result(ierr)
156 
157  implicit none
158 
159  real(real64), dimension(3) :: r_elec = (/1.5_real64, 0.2_real64, -0.5_real64/)
160  real(real64), dimension(3) :: r_nuc = (/1.0_real64, 0.0_real64, 0.0_real64/)
161  real(real64) :: res_expected = 0.08738223907_real64
162 
163  real(real64) :: res_actual
164  integer :: ierr
165 
166  res_actual = h2s_wfn(r_elec, r_nuc)
167 
168  if (abs(res_actual - res_expected) .ge. tol) then
169  ierr = 1
170  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
171  else
172  ierr = 0
173  end if
174 
175  end function test_h2s_wfn
176 
177  ! -----------------------------------------------------------------------------------
178  ! ROUTINE: test_H_2_plus_wfn
179  !
180  ! DESCRIPTION:
184  !
187  !
188  ! PARAMETERS:
190  ! -----------------------------------------------------------------------------------
191  function test_h_2_plus_wfn() result(ierr)
192 
193  implicit none
194 
195  real(real64) :: c = 0.5_real64
196  real(real64), dimension(3) :: r = (/1.5_real64, 0.2_real64, -0.5_real64/)
197  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
198  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
199  real(real64) :: res_expected = 0.1731585063_real64
200 
201  real(real64) :: res_actual
202  integer :: ierr
203 
204  res_actual= h_2_plus_wfn(c, r, r_a, r_b)
205 
206  if (abs(res_actual - res_expected) .ge. tol) then
207  ierr = 1
208  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
209  else
210  ierr = 0
211  end if
212 
213  end function test_h_2_plus_wfn
214 
215  ! -----------------------------------------------------------------------------------
216  ! ROUTINE: test_H_2_plus_Prob
217  !
218  ! DESCRIPTION:
222  !
225  !
226  ! PARAMETERS:
228  ! -----------------------------------------------------------------------------------
229  function test_h_2_plus_prob() result(ierr)
230 
231  implicit none
232 
233  real(real64) :: c = 0.5_real64
234  real(real64), dimension(3) :: r_current = (/1.5_real64, 0.2_real64, -0.5_real64/)
235  real(real64), dimension(3) :: r_next = (/1.2_real64, -0.4_real64, -0.8_real64/)
236  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
237  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
238  real(real64) :: res_expected = 0.835383508_real64
239 
240  real(real64) :: res_actual
241  integer :: ierr
242 
243  res_actual = h_2_plus_prob(c, r_current, r_next, r_a, r_b)
244 
245  if (abs(res_actual - res_expected) .ge. tol) then
246  ierr = 1
247  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
248  else
249  ierr = 0
250  end if
251 
252  end function test_h_2_plus_prob
253 
254  ! -----------------------------------------------------------------------------------
255  ! ROUTINE: test_H_2_plus_Energy
256  !
257  ! DESCRIPTION:
261  !
264  !
265  ! PARAMETERS:
267  ! -----------------------------------------------------------------------------------
268  function test_h_2_plus_energy() result(ierr)
269 
270  implicit none
271 
272  real(real64) :: c = 0.5_real64
273  real(real64), dimension(3) :: r = (/1.5_real64, 0.2_real64, -0.5_real64/)
274  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
275  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
276  real(real64) :: energy_expected = -0.60313643_real64
277  real(real64) :: grad_expected = 0.24532551_real64
278 
279  real(real64) :: energy_actual, grad_actual
280  integer :: ierr
281 
282  h2plus%auto_params = .true.
283  call h_2_plus_energy(c, r, r_a, r_b, energy_actual, grad_actual)
284 
285  if (abs(energy_actual - energy_expected) .ge. tol) then
286  ierr = 1
287  write(*, "('Expected energy: ' F12.8, ', got energy ', F12.8, ' instead.')") energy_expected, energy_actual
288  else if (abs(grad_actual - grad_expected) .ge. tol) then
289  ierr = 1
290  write(*, "('Expected gradient: ' F12.8, ', got gradient ', F12.8, ' instead.')") grad_expected, grad_actual
291  else
292  ierr = 0
293  end if
294 
295  end function test_h_2_plus_energy
296 
297  ! -----------------------------------------------------------------------------------
298  ! ROUTINE: test_H_2_plus_update_c
299  !
300  ! DESCRIPTION:
304  !
307  !
308  ! PARAMETERS:
310  ! -----------------------------------------------------------------------------------
311  function test_h_2_plus_update_c() result(ierr)
312 
313  implicit none
314 
315  real(real64) :: c_old = 0.5_real64
316  real(real64) :: grad = 0.8_real64
317  real(real64) :: res_expected = -0.3_real64
318 
319  real(real64) :: res_actual
320  integer :: ierr
321 
322  call h_2_plus_update_c(c_old, grad, res_actual)
323 
324  if (abs(res_actual - res_expected) .ge. tol) then
325  ierr = 1
326  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
327  else
328  ierr = 0
329  end if
330 
331  end function test_h_2_plus_update_c
332 
333  ! -----------------------------------------------------------------------------------
334  ! ROUTINE: test_H_2_cusp
335  !
336  ! DESCRIPTION:
340  !
343  !
344  ! PARAMETERS:
346  ! -----------------------------------------------------------------------------------
347  function test_h_2_cusp() result(ierr)
348 
349  implicit none
350 
351  real(real64) :: s = 1.0_real64
352  real(real64) :: res_expected = 0.78218836_real64
353 
354  real(real64) :: res_actual
355  integer :: ierr
356 
357  res_actual = h_2_cusp(s)
358 
359  if (abs(res_actual - res_expected) .ge. tol) then
360  ierr = 1
361  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
362  else
363  ierr = 0
364  end if
365 
366  end function test_h_2_cusp
367 
368  ! -----------------------------------------------------------------------------------
369  ! ROUTINE: test_H_2_wfn
370  !
371  ! DESCRIPTION:
375  !
378  !
379  ! PARAMETERS:
381  ! -----------------------------------------------------------------------------------
382  function test_h_2_wfn() result(ierr)
383 
384  implicit none
385 
386  real(real64) :: a = 1.0_real64
387  real(real64) :: beta = 0.4_real64
388  real(real64), dimension(3) :: r_1 = (/1.5_real64, 0.2_real64, -0.5_real64/)
389  real(real64), dimension(3) :: r_2 = (/0.5_real64, -0.2_real64, 1.4_real64/)
390  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
391  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
392  real(real64) :: res_expected = 0.34961993_real64
393 
394  real(real64) :: res_actual
395  integer :: ierr
396 
397  res_actual = h_2_wfn(a, beta, r_1, r_2, r_a, r_b)
398 
399  if (abs(res_actual - res_expected) .ge. tol) then
400  ierr = 1
401  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
402  else
403  ierr = 0
404  end if
405 
406  end function test_h_2_wfn
407 
408  ! -----------------------------------------------------------------------------------
409  ! ROUTINE: test_H_2_Prob
410  !
411  ! DESCRIPTION:
415  !
418  !
419  ! PARAMETERS:
421  ! -----------------------------------------------------------------------------------
422  function test_h_2_prob() result(ierr)
423 
424  implicit none
425 
426  real(real64) :: a = 0.1, beta = 0.4
427  real(real64), dimension(3) :: r_1_current = (/1.5_real64, 0.2_real64, -0.5_real64/)
428  real(real64), dimension(3) :: r_2_current = (/1.1_real64, -0.5_real64, 2.1_real64/)
429  real(real64), dimension(3) :: r_1_next = (/1.2_real64, -0.4_real64, -0.8_real64/)
430  real(real64), dimension(3) :: r_2_next = (/-0.2_real64, -1.3_real64, 1.0_real64/)
431  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
432  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
433  real(real64) :: res_expected = 26.08521296_real64
434 
435  real(real64) :: res_actual
436  integer :: ierr
437 
438  res_actual = h_2_prob(a, beta, r_1_current, r_2_current, r_1_next, r_2_next, r_a, r_b)
439 
440  if (abs(res_actual - res_expected) .ge. tol) then
441  ierr = 1
442  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
443  else
444  ierr = 0
445  end if
446 
447  end function test_h_2_prob
448 
449  ! -----------------------------------------------------------------------------------
450  ! ROUTINE: test_H_2_Energy
451  !
452  ! DESCRIPTION:
456  !
459  !
460  ! PARAMETERS:
462  ! -----------------------------------------------------------------------------------
463  function test_h_2_energy() result(ierr)
464 
465  implicit none
466 
467  real(real64) :: a = 0.1, beta = 0.4
468  real(real64), dimension(3) :: r_1 = (/1.5_real64, 0.2_real64, -0.5_real64/)
469  real(real64), dimension(3) :: r_2 = (/1.1_real64, -0.5_real64, 2.1_real64/)
470  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
471  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
472  real(real64) :: energy_expected = -81.43386904_real64
473  real(real64) :: grad_expected = -0.84912693_real64
474 
475  real(real64) :: energy_actual
476  real(real64) :: grad_actual
477  integer :: ierr
478 
479  call h_2_energy(a, beta, r_1, r_2, r_a, r_b, energy_actual, grad_actual)
480 
481  if (abs(energy_actual - energy_expected) .ge. tol) then
482  ierr = 1
483  write(*, "('Expected energy: ' F12.8, ', got energy ', F12.8, ' instead.')") energy_expected, energy_actual
484  else if (abs(grad_actual - grad_expected) .ge. tol) then
485  ierr = 1
486  write(*, "('Expected gradient: ' F12.8, ', got gradient ', F12.8, ' instead.')") grad_expected, grad_actual
487  else
488  ierr = 0
489  end if
490 
491  end function test_h_2_energy
492 
493  ! -----------------------------------------------------------------------------------
494  ! ROUTINE: test_H_2_update_beta
495  !
496  ! DESCRIPTION:
500  !
503  !
504  ! PARAMETERS:
506  ! -----------------------------------------------------------------------------------
507  function test_h_2_update_beta() result(ierr)
508 
509  implicit none
510 
511  real(real64) :: beta_old = 0.5_real64
512  real(real64) :: grad = 0.8_real64
513  real(real64) :: res_expected = -0.3_real64
514 
515  real(real64) :: res_actual
516  integer :: ierr
517 
518  call h_2_update_beta(beta_old, grad, res_actual)
519 
520  if (abs(res_actual - res_expected) .ge. tol) then
521  ierr = 1
522  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
523  else
524  ierr = 0
525  end if
526 
527  end function test_h_2_update_beta
528 
529 ! ---------------------------------------------------------------------------------------
530 ! MODULE SUBSECTION: VQMC
531 ! ---------------------------------------------------------------------------------------
532 
533  ! -----------------------------------------------------------------------------------
534  ! ROUTINE: test_ran1
535  !
536  ! DESCRIPTION:
539  !
544  !
545  ! PARAMETERS:
547  ! -----------------------------------------------------------------------------------
548  function test_ran1() result(ierr)
549 
550  implicit none
551 
552  integer(int64) :: seed_set = -1
553  real(real64) :: res_expected = 0.41599935685098144_real64
554 
555  real(real64) :: res_actual
556  integer :: ierr
557 
558  seed = seed_set
559  call ran1(res_actual, seed)
560 
561  if (abs(res_actual - res_expected) .ge. tol) then
562  ierr = 1
563  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
564  else
565  ierr = 0
566  end if
567 
568  end function test_ran1
569 
570  ! -----------------------------------------------------------------------------------
571  ! ROUTINE: test_random_normal
572  !
573  ! DESCRIPTION:
577  !
582  !
583  ! PARAMETERS:
585  ! -----------------------------------------------------------------------------------
586  function test_random_normal() result(ierr)
587 
588  implicit none
589 
590  integer :: dim = 3
591  real(real64), dimension(3) :: res_expected = (/1.10941582390076, &
592  -0.734250042177316, &
593  -0.282471493382388/)
594 
595  real(real64), dimension(3) :: res_actual
596  integer :: ierr
597 
598  seed = -1
599  call random_normal(dim, res_actual)
600 
601  if (norm2(res_actual - res_expected) .ge. tol) then
602  ierr = 1
603  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
604  else
605  ierr = 0
606  end if
607 
608  end function test_random_normal
609 
610  ! -----------------------------------------------------------------------------------
611  ! ROUTINE: test_linspace
612  !
613  ! DESCRIPTION:
617  !
620  !
621  ! PARAMETERS:
623  ! -----------------------------------------------------------------------------------
624  function test_linspace() result(ierr)
625 
626  implicit none
627 
628  real(real64) :: start = 1.0_real64
629  real(real64) :: end = 3.0_real64
630  real(real64) :: num = 3.0_real64
631  real(real64), dimension(3) :: res_expected = (/1.0_real64, &
632  2.0_real64, &
633  3.0_real64/)
634 
635  real(real64), dimension(:), allocatable :: res_actual
636  integer :: ierr
637 
638  seed = -1
639  res_actual = linspace(start, end, num)
640 
641  if (norm2(res_actual - res_expected) .ge. tol) then
642  ierr = 1
643  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
644  else
645  ierr = 0
646  end if
647 
648  end function test_linspace
649 
650  ! -----------------------------------------------------------------------------------
651  ! ROUTINE: test_VQMC_QHO
652  !
653  ! DESCRIPTION:
657  !
660  !
661  ! PARAMETERS:
663  ! -----------------------------------------------------------------------------------
664  function test_vqmc_qho() result(ierr)
665 
666  implicit none
667 
668  real(real64), dimension(:), allocatable :: energy_chain
669  real(real64), dimension(:), allocatable :: pos_chain
670  real(real64) :: accept_rate
671  real(real64) :: energy_variance
672  real(real64) :: res_expected = 0.510854650956392_real64
673 
674  real(real64) :: res_actual
675  integer :: ierr
676 
677  seed = -1
678  call vqmc_qho(0.5_real64, 100, 10, 2, &
679  0.4_real64, pos_chain, accept_rate, energy_chain, res_actual, &
680  energy_variance)
681 
682  if (abs(res_actual - res_expected) .ge. tol) then
683  ierr = 1
684  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
685  else
686  ierr = 0
687  end if
688 
689  end function test_vqmc_qho
690 
691  ! -----------------------------------------------------------------------------------
692  ! ROUTINE: test_VQMC_H_2_plus
693  !
694  ! DESCRIPTION:
698  !
701  !
702  ! PARAMETERS:
704  ! -----------------------------------------------------------------------------------
705  function test_vqmc_h_2_plus() result(ierr)
706 
707  implicit none
708 
709  real(real64), dimension(:), allocatable :: energy_chain
710  real(real64), dimension(:,:), allocatable :: pos_chain
711  real(real64), dimension(:), allocatable :: dphidc_chain
712  real(real64) :: accept_rate
713  real(real64) :: energy_variance
714  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
715  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
716  real(real64) :: res_expected = -0.590080460643371_real64
717 
718  real(real64) :: res_actual
719  integer :: ierr
720 
721  seed = -1
722  call vqmc_h_2_plus(h2plus%sigma, 100, 10, 2, &
723  0.7_real64, r_a, r_b, pos_chain, accept_rate, energy_chain, res_actual, &
724  energy_variance, dphidc_chain)
725 
726  if (abs(res_actual - res_expected) .ge. tol) then
727  ierr = 1
728  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
729  else
730  ierr = 0
731  end if
732 
733  end function test_vqmc_h_2_plus
734 
735  ! -----------------------------------------------------------------------------------
736  ! ROUTINE: test_VQMC_H_2
737  !
738  ! DESCRIPTION:
742  !
745  !
746  ! PARAMETERS:
748  ! -----------------------------------------------------------------------------------
749  function test_vqmc_h_2() result(ierr)
750 
751  implicit none
752 
753  real(real64), dimension(:), allocatable :: energy_chain
754  real(real64), dimension(:,:), allocatable :: pos_chain_1, pos_chain_2
755  real(real64), dimension(:), allocatable :: dphidbeta_chain
756  real(real64) :: accept_rate
757  real(real64) :: energy_variance
758  real(real64), dimension(3) :: r_a = (/1.0_real64, 0.0_real64, 0.0_real64/)
759  real(real64), dimension(3) :: r_b = (/-1.0_real64, 0.0_real64, 0.0_real64/)
760  real(real64) :: res_expected = -2.36644573374483_real64
761 
762  real(real64) :: res_actual
763  integer :: ierr
764 
765  seed = -1
766  call vqmc_h_2(h2plus%sigma, 100, 10, 2, 0.5_real64, 0.5_real64, &
767  r_a, r_b, pos_chain_1, pos_chain_2, accept_rate, energy_chain, res_actual, &
768  energy_variance, dphidbeta_chain)
769 
770  if (abs(res_actual - res_expected) .ge. tol) then
771  ierr = 1
772  write(*, "('Expected result: ' F12.8, ', got result ', F12.8, ' instead.')") res_expected, res_actual
773  else
774  ierr = 0
775  end if
776 
777  end function test_vqmc_h_2
778 
779 ! ---------------------------------------------------------------------------------------
780 ! SECTION: Unit testing caller
781 ! ---------------------------------------------------------------------------------------
782 
783  ! -----------------------------------------------------------------------------------
784  ! ROUTINE: unit_tests
785  !
786  ! DESCRIPTION:
789  !
792  ! -----------------------------------------------------------------------------------
793  subroutine unit_tests()
794 
795  implicit none
796 
797  integer :: ierr
798  integer :: total_tests = 19
799  integer :: fail_counter, test_counter
800 
801  write(0, "('')")
802  write(0, "('--------------------------------------------------')")
803  write(0, "('[PROGRAM NAME] Unit Testing Suite')")
804  write(0, "('--------------------------------------------------')")
805  write(0, "('*** ', I2, ' function tests implemented, starting... ***')") total_tests
806  write(0, "('')")
807 
808  fail_counter = 0
809  test_counter = 0
810 
811  test_counter = test_counter + 1
812  write(0, "('[', I2, '/', I2, '] test_ran1')") test_counter, total_tests
813  ierr = test_ran1()
814  if (ierr .eq. 0) then
815  write(0, "(' Unit test successful.')")
816  else
817  write(0, "(' *** Unit test failed. ***')")
818  fail_counter = fail_counter + 1
819  end if
820 
821  test_counter = test_counter + 1
822  write(0, "('[', I2, '/', I2, '] test_QHO_Prob')") test_counter, total_tests
823  ierr = test_random_normal()
824  if (ierr .eq. 0) then
825  write(0, "(' Unit test successful.')")
826  else
827  write(0, "(' *** Unit test failed. ***')")
828  fail_counter = fail_counter + 1
829  end if
830 
831  test_counter = test_counter + 1
832  write(0, "('[', I2, '/', I2, '] test_QHO_Prob')") test_counter, total_tests
833  ierr = test_qho_prob()
834  if (ierr .eq. 0) then
835  write(0, "(' Unit test successful.')")
836  else
837  write(0, "(' *** Unit test failed. ***')")
838  fail_counter = fail_counter + 1
839  end if
840 
841  test_counter = test_counter + 1
842  write(0, "('[', I2, '/', I2, '] test_QHO_Energy')") test_counter, total_tests
843  ierr = test_qho_energy()
844  if (ierr .eq. 0) then
845  write(0, "(' Unit test successful.')")
846  else
847  write(0, "(' *** Unit test failed. ***')")
848  fail_counter = fail_counter + 1
849  end if
850 
851  test_counter = test_counter + 1
852  write(0, "('[', I2, '/', I2, '] test_H1s_wfn')") test_counter, total_tests
853  ierr = test_h1s_wfn()
854  if (ierr .eq. 0) then
855  write(0, "(' Unit test successful.')")
856  else
857  write(0, "(' *** Unit test failed. ***')")
858  fail_counter = fail_counter + 1
859  end if
860 
861  test_counter = test_counter + 1
862  write(0, "('[', I2, '/', I2, '] test_H2s_wfn')") test_counter, total_tests
863  ierr = test_h2s_wfn()
864  if (ierr .eq. 0) then
865  write(0, "(' Unit test successful.')")
866  else
867  write(0, "(' *** Unit test failed. ***')")
868  fail_counter = fail_counter + 1
869  end if
870 
871  test_counter = test_counter + 1
872  write(0, "('[', I2, '/', I2, '] test_H_2_plus_wfn')") test_counter, total_tests
873  ierr = test_h_2_plus_wfn()
874  if (ierr .eq. 0) then
875  write(0, "(' Unit test successful.')")
876  else
877  write(0, "(' *** Unit test failed. ***')")
878  fail_counter = fail_counter + 1
879  end if
880 
881  test_counter = test_counter + 1
882  write(0, "('[', I2, '/', I2, '] test_H_2_plus_Prob')") test_counter, total_tests
883  ierr = test_h_2_plus_prob()
884  if (ierr .eq. 0) then
885  write(0, "(' Unit test successful.')")
886  else
887  write(0, "(' *** Unit test failed. ***')")
888  fail_counter = fail_counter + 1
889  end if
890 
891  test_counter = test_counter + 1
892  write(0, "('[', I2, '/', I2, '] test_H_2_plus_Energy')") test_counter, total_tests
893  ierr = test_h_2_plus_energy()
894  if (ierr .eq. 0) then
895  write(0, "(' Unit test successful.')")
896  else
897  write(0, "(' *** Unit test failed. ***')")
898  fail_counter = fail_counter + 1
899  end if
900 
901  test_counter = test_counter + 1
902  write(0, "('[', I2, '/', I2, '] test_H_2_plus_update_c')") test_counter, total_tests
903  ierr = test_h_2_plus_update_c()
904  if (ierr .eq. 0) then
905  write(0, "(' Unit test successful.')")
906  else
907  write(0, "(' *** Unit test failed. ***')")
908  fail_counter = fail_counter + 1
909  end if
910 
911  test_counter = test_counter + 1
912  write(0, "('[', I2, '/', I2, '] test_H_2_cusp')") test_counter, total_tests
913  ierr = test_h_2_cusp()
914  if (ierr .eq. 0) then
915  write(0, "(' Unit test successful.')")
916  else
917  write(0, "(' *** Unit test failed. ***')")
918  fail_counter = fail_counter + 1
919  end if
920 
921  test_counter = test_counter + 1
922  write(0, "('[', I2, '/', I2, '] test_H_2_wfn')") test_counter, total_tests
923  ierr = test_h_2_wfn()
924  if (ierr .eq. 0) then
925  write(0, "(' Unit test successful.')")
926  else
927  write(0, "(' *** Unit test failed. ***')")
928  fail_counter = fail_counter + 1
929  end if
930 
931  test_counter = test_counter + 1
932  write(0, "('[', I2, '/', I2, '] test_H_2_Prob')") test_counter, total_tests
933  ierr = test_h_2_prob()
934  if (ierr .eq. 0) then
935  write(0, "(' Unit test successful.')")
936  else
937  write(0, "(' *** Unit test failed. ***')")
938  fail_counter = fail_counter + 1
939  end if
940 
941  test_counter = test_counter + 1
942  write(0, "('[', I2, '/', I2, '] test_H_2_Energy')") test_counter, total_tests
943  ierr = test_h_2_energy()
944  if (ierr .eq. 0) then
945  write(0, "(' Unit test successful.')")
946  else
947  write(0, "(' *** Unit test failed. ***')")
948  fail_counter = fail_counter + 1
949  end if
950 
951  test_counter = test_counter + 1
952  write(0, "('[', I2, '/', I2, '] test_H_2_update_beta')") test_counter, total_tests
953  ierr = test_h_2_update_beta()
954  if (ierr .eq. 0) then
955  write(0, "(' Unit test successful.')")
956  else
957  write(0, "(' *** Unit test failed. ***')")
958  fail_counter = fail_counter + 1
959  end if
960 
961  test_counter = test_counter + 1
962  write(0, "('[', I2, '/', I2, '] test_linspace')") test_counter, total_tests
963  ierr = test_linspace()
964  if (ierr .eq. 0) then
965  write(0, "(' Unit test successful.')")
966  else
967  write(0, "(' *** Unit test failed. ***')")
968  fail_counter = fail_counter + 1
969  end if
970 
971  test_counter = test_counter + 1
972  write(0, "('[', I2, '/', I2, '] test_VQMC_QHO')") test_counter, total_tests
973  ierr = test_vqmc_qho()
974  if (ierr .eq. 0) then
975  write(0, "(' Unit test successful.')")
976  else
977  write(0, "(' *** Unit test failed. ***')")
978  fail_counter = fail_counter + 1
979  end if
980 
981  test_counter = test_counter + 1
982  write(0, "('[', I2, '/', I2, '] test_VQMC_H_2_plus')") test_counter, total_tests
983  ierr = test_vqmc_h_2_plus()
984  if (ierr .eq. 0) then
985  write(0, "(' Unit test successful.')")
986  else
987  write(0, "(' *** Unit test failed. ***')")
988  fail_counter = fail_counter + 1
989  end if
990 
991  test_counter = test_counter + 1
992  write(0, "('[', I2, '/', I2, '] test_VQMC_H_2')") test_counter, total_tests
993  ierr = test_vqmc_h_2()
994  if (ierr .eq. 0) then
995  write(0, "(' Unit test successful.')")
996  else
997  write(0, "(' *** Unit test failed. ***')")
998  fail_counter = fail_counter + 1
999  end if
1000 
1001  write(0, "('')")
1002  write(0, "('--------------------------------------------------')")
1003  write(0, "('Unit testing results:')")
1004  if (fail_counter .eq. 0) then
1005  write(0, "(I2, '/', I2, ' unit tests passed!')") test_counter, total_tests
1006  else
1007  write(0, "(I2, '/', I2, ' unit tests failed!')") fail_counter, total_tests
1008  end if
1009  write(0, "('--------------------------------------------------')")
1010 
1011  write(0, "('')")
1012  write(0, "('Unit testing complete, exiting program...')")
1013 
1014  end subroutine unit_tests
1015 
1016 end module testing
input_parser
Contains routines that read the input file params.txt.
Definition: input_parser.f90:16
shared_data
Contains derived types, and global variables to store input values of simulation parameters.
Definition: shared_data.f90:49
shared_data::seed
integer(int64) seed
Seed for the random number generator.
Definition: shared_data.f90:152
shared_data::h2plus
type(h2plus_type) h2plus
To store inputs for H2 ion system.
Definition: shared_data.f90:139
solvers
Contains local energy and transition probability solvers for available problems.
Definition: quantum_solvers.f90:16
solvers::h_2_cusp
real(real64) function h_2_cusp(s)
Calculates a value for a given the bond length s by Newton-Raphson iteration.
Definition: quantum_solvers.f90:395
solvers::h_2_update_beta
subroutine h_2_update_beta(beta_old, gradient, beta_new)
Updates the parameter in the problem by dampened steepest descent.
Definition: quantum_solvers.f90:665
solvers::qho_energy
real(real64) function qho_energy(alpha, x)
Calculates local energy for quantum harmonic oscillator problem.
Definition: quantum_solvers.f90:77
solvers::h_2_plus_prob
real(real64) function h_2_plus_prob(c, r_current, r_next, R_a, R_b)
Calculates transition probability for the problem.
Definition: quantum_solvers.f90:226
solvers::h_2_plus_wfn
real(real64) function h_2_plus_wfn(c, r, R_a, R_b)
Calculates trial wavefunction for the problem.
Definition: quantum_solvers.f90:191
solvers::qho_prob
real(real64) function qho_prob(alpha, x_current, x_next)
Calculates transition probability for quantum harmonic oscillator problem.
Definition: quantum_solvers.f90:48
solvers::h1s_wfn
real(real64) function h1s_wfn(r_elec, R_nuc)
Calculates value of the wavefunction of a hydrogen 1s orbital.
Definition: quantum_solvers.f90:112
solvers::h2s_wfn
real(real64) function h2s_wfn(r_elec, R_nuc)
[DEPRECATED] Calculates value of the wavefunction of a hydrogen 2s orbital.
Definition: quantum_solvers.f90:150
solvers::h_2_energy
subroutine h_2_energy(a, beta, r_1, r_2, R_a, R_b, E_loc, DphiDbeta)
{UPDATE ME} Calculates local energy for the problem.
Definition: quantum_solvers.f90:592
solvers::h_2_plus_energy
subroutine h_2_plus_energy(c, r, R_a, R_b, E_loc, gradient)
Calculates local energy for the problem.
Definition: quantum_solvers.f90:278
solvers::h_2_prob
real(real64) function h_2_prob(a, beta, r_1_current, r_2_current, r_1_next, r_2_next, R_a, R_b)
Calculates transition probability for the problem.
Definition: quantum_solvers.f90:541
solvers::h_2_wfn
real(real64) function h_2_wfn(a, beta, r_1, r_2, R_a, R_b)
Calculates trial wavefunction for the problem.
Definition: quantum_solvers.f90:489
solvers::h_2_plus_update_c
subroutine h_2_plus_update_c(c_old, gradient, c_new)
Updates the parameter in the problem by dampened steepest descent.
Definition: quantum_solvers.f90:355
testing
Contains unit tests for all major functions in the program.
Definition: testing.f90:15
testing::test_h_2_update_beta
integer function test_h_2_update_beta()
Tests the H_2_update_beta function in the solvers module.
Definition: testing.f90:508
testing::test_h1s_wfn
integer function test_h1s_wfn()
Tests the H1s_wfn function in the solvers module.
Definition: testing.f90:121
testing::test_h_2_plus_prob
integer function test_h_2_plus_prob()
Tests the H_2_plus_Prob function in the solvers module.
Definition: testing.f90:230
testing::test_vqmc_h_2
integer function test_vqmc_h_2()
Tests the VQMC_H_2 function in the vqmc module.
Definition: testing.f90:750
testing::test_h_2_energy
integer function test_h_2_energy()
Tests the H_2_Energy function in the solvers module.
Definition: testing.f90:464
testing::test_qho_prob
integer function test_qho_prob()
Tests the QHO_Prob function in the solvers module.
Definition: testing.f90:49
testing::unit_tests
subroutine unit_tests()
Runs all of the unit tests, reporting successes and failures.
Definition: testing.f90:794
testing::test_qho_energy
integer function test_qho_energy()
Tests the QHO_Energy function in the solvers module.
Definition: testing.f90:86
testing::test_linspace
integer function test_linspace()
Tests the linspace function in the vqmc module.
Definition: testing.f90:625
testing::test_h_2_wfn
integer function test_h_2_wfn()
Tests the H_2_wfn function in the solvers module.
Definition: testing.f90:383
testing::test_h_2_plus_update_c
integer function test_h_2_plus_update_c()
Tests the H_2_plus_update_c function in the solvers module.
Definition: testing.f90:312
testing::test_h_2_plus_energy
integer function test_h_2_plus_energy()
Tests the H_2_plus_Energy function in the solvers module.
Definition: testing.f90:269
testing::tol
real(real64), parameter tol
Error tolerance in floating point evaluations.
Definition: testing.f90:25
testing::test_h2s_wfn
integer function test_h2s_wfn()
Tests the H2s_wfn function in the solvers module.
Definition: testing.f90:156
testing::test_random_normal
integer function test_random_normal()
Tests the random_normal function in the vqmc module.
Definition: testing.f90:587
testing::test_vqmc_h_2_plus
integer function test_vqmc_h_2_plus()
Tests the VQMC_H_2_plus function in the vqmc module.
Definition: testing.f90:706
testing::test_h_2_prob
integer function test_h_2_prob()
Tests the H_2_Prob function in the solvers module.
Definition: testing.f90:423
testing::test_h_2_plus_wfn
integer function test_h_2_plus_wfn()
Tests the H_2_plus_wfn function in the solvers module.
Definition: testing.f90:192
testing::test_ran1
integer function test_ran1()
Tests the ran1 function in the vqmc module.
Definition: testing.f90:549
testing::test_vqmc_qho
integer function test_vqmc_qho()
Tests the VQMC_QHO function in the vqmc module.
Definition: testing.f90:665
testing::test_h_2_cusp
integer function test_h_2_cusp()
Tests the H_2_cusp function in the solvers module.
Definition: testing.f90:348
vqmc
Contains routines for handline random number generation, the main VQMC algorithms and routines for de...
Definition: vqmc.f90:30
vqmc::ran1
subroutine ran1(sample, dseed)
Implementation of Press et al's random number generator.
Definition: vqmc.f90:119
vqmc::random_normal
subroutine random_normal(dim, x)
Draws a sample from a normal distribution using the Box-Muller transform.
Definition: vqmc.f90:229
vqmc::linspace
real(real64) function, dimension(:), allocatable linspace(start, end, num)
Adaptation of numpy's linspace function.
Definition: vqmc.f90:183
write_netcdf
Contains NetCDF output functions for different problem main & equilibration runs.
Definition: netcdf_out.f90:16