test.f90 2.46 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
Luca's avatar
Luca committed
6 7
  use mpl_module
  use gpl_module
Luca's avatar
Luca committed
8
  implicit none
Luca's avatar
Luca committed
9 10

  complex(kind=prec) :: res 
Luca's avatar
Luca committed
11
  real, parameter :: tol = 1.0e-14
12
  logical :: tests_successful = .true.
Luca's avatar
Luca committed
13

14
  call do_MPL_tests() 
Luca Naterop's avatar
Luca Naterop committed
15
  call do_GPL_tests()
Luca's avatar
Luca committed
16

17 18 19 20 21 22
  if(tests_successful) then
    print*, 'All tests passed. '
  else 
    print*, 'Some tests failed. '
    stop 1
  end if
Luca Naterop's avatar
Luca Naterop committed
23

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

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

  subroutine test_one_MPL(m,x,ref, test_id)
    integer :: m(:)
    complex(kind=prec) :: x(:), ref
    character(len=*) :: test_id

    print*, '  ', 'testing MPL ', test_id, ' ...'
    res = MPL(m,x)
    call check(res,ref)
  end subroutine test_one_MPL

Luca's avatar
Luca committed
49
  subroutine do_MPL_tests()
Luca's avatar
Luca committed
50 51 52 53
    integer :: m2(2), m3(3)
    integer :: bla
    complex(kind=prec) :: x2(2), x3(3)
    complex(kind=prec) :: res, ref
Luca Naterop's avatar
Luca Naterop committed
54
    print*, 'doing MPL tests...'
Luca's avatar
Luca committed
55
    
Luca Naterop's avatar
Luca Naterop committed
56
    ref = dcmplx(0.022696600480693277651633)
57
    call test_one_MPL((/ 1,1 /),cmplx((/ 0.3156498673740053, 0.3431255827785649 /)),ref, '1.1')
Luca's avatar
Luca committed
58

Luca Naterop's avatar
Luca Naterop committed
59
    ref = dcmplx(0.00023134615630308335448329926098409)
60
    call test_one_MPL((/ 1,1 /),cmplx((/ 0.03, 0.5012562893380046 /)),ref, '1.2')
Luca's avatar
Luca committed
61
    
Luca Naterop's avatar
Luca Naterop committed
62
    ref = dcmplx(0.000023446106415452030937059124671151)
63 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

67 68 69 70
  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
71

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

  subroutine do_GPL_tests()
Luca's avatar
Luca committed
78 79
    integer :: m2(2), m1(1), k
    complex(kind=prec) :: z2(2), z1(1), y, res, ref
Luca Naterop's avatar
Luca Naterop committed
80 81 82
    print*, 'doing GPL tests...'

    ref = dcmplx(0.0819393734128676)
83
    call test_one_GPL((/ 1,1 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.1')
Luca Naterop's avatar
Luca Naterop committed
84 85

    ref = dcmplx(0.01592795952537145)
86
    call test_one_GPL((/ 3,2 /),cmplx((/ 1.3d0, 1.1d0 /)),cmplx(0.4),2,ref,'2.2')
Luca Naterop's avatar
Luca Naterop committed
87

Luca's avatar
Luca committed
88
    ref = dcmplx(0.0173042341866201179)
89
    call test_one_GPL((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
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