test.f90 2.52 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 utils
Luca's avatar
Luca committed
7 8
  use mpl_module
  use gpl_module
Luca's avatar
Luca committed
9
  implicit none
Luca's avatar
Luca committed
10
  
Luca's avatar
Luca committed
11
  complex(kind=prec) :: res 
Luca's avatar
Luca committed
12
  real, parameter :: tol = 1.0e-14
13
  logical :: tests_successful = .true.
Luca's avatar
Luca committed
14
  
15
  ! call do_MPL_tests() 
Luca Naterop's avatar
Luca Naterop committed
16
  call do_GPL_tests()
Luca's avatar
Luca committed
17
  
18 19 20 21 22 23
  if(tests_successful) then
    print*, 'All tests passed. '
  else 
    print*, 'Some tests failed. '
    stop 1
  end if
24

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

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

  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
44
    
45 46 47 48 49
    print*, '  ', 'testing MPL ', test_id, ' ...'
    res = MPL(m,x)
    call check(res,ref)
  end subroutine test_one_MPL

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

64 65 66 67
  subroutine test_one_GPL(m,z,y,k,ref,test_id)
    integer :: m(:), k
    complex(kind=prec) :: z(:), y, res, ref
    character(len=*) :: test_id
Luca Naterop's avatar
Luca Naterop committed
68

69 70
    print*, '  ', 'testing GPL ', test_id, ' ...'
    res = GPL(m,z,y,k)
Luca Naterop's avatar
Luca Naterop committed
71
    call check(res,ref)
72
  end subroutine test_one_GPL
Luca Naterop's avatar
Luca Naterop committed
73 74

  subroutine do_GPL_tests()
Luca's avatar
Luca committed
75
    complex(kind=prec) :: ref
Luca's avatar
Luca committed
76
    complex(kind=prec), parameter :: epsilon = 1E-14
Luca Naterop's avatar
Luca Naterop committed
77
    print*, 'doing GPL tests...'
Luca's avatar
Luca committed
78
    
Luca Naterop's avatar
Luca Naterop committed
79
    ref = dcmplx(0.0819393734128676)
80
    call test_one_GPL((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1')
Luca's avatar
Luca committed
81
    
Luca Naterop's avatar
Luca Naterop committed
82
    ref = dcmplx(0.01592795952537145)
83
    call test_one_GPL((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2')
Luca's avatar
Luca committed
84 85
    
    ref = dcmplx(0.0020332632172573974)
86
    call test_one_GPL((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
87
    
88 89
    ref = dcmplx(0.0020332632172573974)
    call test_one_GPL((/ 1,1 /),cmplx((/ 1.7,0.0 /)),cmplx(1.1),2,ref,'2.4')
Luca's avatar
Luca committed
90

Luca Naterop's avatar
Luca Naterop committed
91 92
  end subroutine do_GPL_tests

Luca's avatar
Luca committed
93
END PROGRAM TEST
Luca's avatar
Luca committed
94