test.f90 3.07 KB
Newer Older
Luca's avatar
Luca committed
1

Luca's avatar
Luca committed
2 3
! In terminal kann man den exit code bekommen via echo $?
! These tests assume that GPLInfinity = 30
Luca's avatar
Luca committed
4

Luca's avatar
Luca committed
5
PROGRAM TEST
6
  use globals
7
  use utils
8
  use shuffle
Luca's avatar
Luca committed
9 10
  use mpl_module
  use gpl_module
Luca's avatar
Luca committed
11
  implicit none
Luca's avatar
Luca committed
12
  
Luca's avatar
Luca committed
13
  complex(kind=prec) :: res 
Luca's avatar
Luca committed
14
  real, parameter :: tol = 1.0e-14
15
  logical :: tests_successful = .true.
16

17
  ! call do_MPL_tests() 
18 19
  ! call do_GPL_tests()
  call do_shuffle_tests() ! put this somewhere else
Luca's avatar
Luca committed
20
  
21 22 23 24 25 26
  if(tests_successful) then
    print*, 'All tests passed. '
  else 
    print*, 'Some tests failed. '
    stop 1
  end if
27

28
CONTAINS
29
   
Luca Naterop's avatar
Luca Naterop committed
30 31 32 33 34 35
  subroutine check(res, ref)
    complex(kind=prec) :: res, ref
    real(kind=prec) :: delta

    delta = abs((res-ref)/ref)
    if(delta < tol) then
36
      print*, '  ',' passed with delta = ', delta
Luca Naterop's avatar
Luca Naterop committed
37
    else 
38 39
      print*, '  ',' failed with delta = ', delta
      tests_successful = .false.
Luca Naterop's avatar
Luca Naterop committed
40 41
    end if
  end subroutine check
42 43 44 45 46

  subroutine test_one_MPL(m,x,ref, test_id)
    integer :: m(:)
    complex(kind=prec) :: x(:), ref
    character(len=*) :: test_id
Luca's avatar
Luca committed
47
    
48 49 50 51 52
    print*, '  ', 'testing MPL ', test_id, ' ...'
    res = MPL(m,x)
    call check(res,ref)
  end subroutine test_one_MPL

Luca's avatar
Luca committed
53
  subroutine do_MPL_tests()
Luca's avatar
Luca committed
54
    complex(kind=prec) :: ref
Luca Naterop's avatar
Luca Naterop committed
55
    print*, 'doing MPL tests...'
Luca's avatar
Luca committed
56
    
Luca Naterop's avatar
Luca Naterop committed
57
    ref = dcmplx(0.022696600480693277651633)
58
    call test_one_MPL((/ 1,1 /),cmplx((/ 0.3156498673740053, 0.3431255827785649 /)),ref, '1.1')
Luca's avatar
Luca committed
59
    
Luca Naterop's avatar
Luca Naterop committed
60
    ref = dcmplx(0.00023134615630308335448329926098409)
61
    call test_one_MPL((/ 1,1 /),cmplx((/ 0.03, 0.5012562893380046 /)),ref, '1.2')
Luca's avatar
Luca committed
62
    
Luca Naterop's avatar
Luca Naterop committed
63
    ref = dcmplx(0.000023446106415452030937059124671151)
Luca's avatar
Luca committed
64
    call test_one_MPL((/ 2,1,2 /),cmplx((/ 0.03, 0.5012562893380046, 55.3832 /)),ref, '1.3')  
Luca's avatar
Luca committed
65
  end subroutine do_MPL_tests
Luca's avatar
Luca committed
66

Luca's avatar
Luca committed
67
  subroutine test_one_condensed(m,z,y,k,ref,test_id)
68 69 70
    integer :: m(:), k
    complex(kind=prec) :: z(:), y, res, ref
    character(len=*) :: test_id
Luca Naterop's avatar
Luca Naterop committed
71

72
    print*, '  ', 'testing GPL ', test_id, ' ...'
73
    res = G_condensed(m,z,y,k)
Luca Naterop's avatar
Luca Naterop committed
74
    call check(res,ref)
Luca's avatar
Luca committed
75 76 77 78 79 80 81 82 83 84
  end subroutine test_one_condensed

  subroutine test_one_flat(z,y,ref,test_id)
    complex(kind=prec) :: z(:), y, res, ref
    character(len=*) :: test_id

    print*, '  ', 'testing GPL ', test_id, ' ...'
    res = G_flat(z,y)
    call check(res,ref)
  end subroutine test_one_flat
Luca Naterop's avatar
Luca Naterop committed
85 86

  subroutine do_GPL_tests()
Luca's avatar
Luca committed
87
    complex(kind=prec) :: ref
Luca's avatar
Luca committed
88
    complex(kind=prec), parameter :: epsilon = 1E-14
Luca Naterop's avatar
Luca Naterop committed
89
    print*, 'doing GPL tests...'
Luca's avatar
Luca committed
90
    
91 92
    ref = dcmplx(0.0819393734128676)
    call test_one_condensed((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1')
Luca's avatar
Luca committed
93
    
94 95
    ref = dcmplx(0.01592795952537145)
    call test_one_condensed((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2')
96
    
97 98
    ref = dcmplx(0.0020332632172573974)
    call test_one_condensed((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
Luca's avatar
Luca committed
99

Luca's avatar
Luca committed
100 101
    ref = dcmplx(0.0020332632172573974)
    call test_one_flat(cmplx((/0.0,1.7,0.5/)),cmplx(1.1),ref,'2.5')
Luca Naterop's avatar
Luca Naterop committed
102 103
  end subroutine do_GPL_tests

104
  subroutine do_shuffle_tests() 
Luca's avatar
minor  
Luca committed
105
    complex(kind=prec) :: v(2) = cmplx((/1,2/))
Luca's avatar
minor  
Luca committed
106
    complex(kind=prec) :: w(2) = cmplx((/3,4/))
107 108 109 110

    call print_matrix(shuffle_product(v,w))
  end subroutine do_shuffle_tests

Luca's avatar
Luca committed
111
END PROGRAM TEST
Luca's avatar
Luca committed
112