Commit 2c313036 authored by ulrich_y's avatar ulrich_y

Used iprint for chenref

parent 6d2e2459
...@@ -2,24 +2,13 @@ module chenreftest ...@@ -2,24 +2,13 @@ module chenreftest
contains contains
function test(z,ref,test_id) function test(z,ref,test_id)
use globals, only: prec use globals, only: prec
use gpl_module use ttools
implicit none implicit none
complex(kind=prec) :: z(:), res, ref complex(kind=prec) :: z(:), ref
character(len=*) :: test_id character(len=*) :: test_id
real(kind=prec) :: delta
logical test logical test
call test_one_flat(z,ref,test_id, test)
print*, ' ', 'testing GPL ', test_id, ' ...'
res = G(z)
delta = abs(res-ref)
if(delta < 8e-7) then
print*, ' ',' passed with delta = ', delta
test = .true.
else
print*, ' ',' FAILED with delta = ', delta
test = .false.
endif
end function end function
function do_chen_test() result(success) function do_chen_test() result(success)
use globals, only: prec use globals, only: prec
......
...@@ -504,10 +504,12 @@ CONTAINS ...@@ -504,10 +504,12 @@ CONTAINS
use maths_functions, only:clearcache use maths_functions, only:clearcache
complex(kind=prec) :: args(:,:) complex(kind=prec) :: args(:,:)
integer i,n integer i,n
character(len=40) :: msg
call clearcache call clearcache
do i=1,size(args,1) do i=1,size(args,1)
write(*,900) n,i write(msg,900) n,i
call iprint(msg, -1)
call check(evalt(args(i,:),0),evalt(args(i,:),1)) call check(evalt(args(i,:),0),evalt(args(i,:),1))
enddo enddo
......
...@@ -8,7 +8,7 @@ contains ...@@ -8,7 +8,7 @@ contains
subroutine iprint(imsg, typ) subroutine iprint(imsg, typ)
character(len=*) imsg character(len=*) imsg
character(len=100) msg character(len=200) msg
integer :: typ integer :: typ
character(len=5),parameter :: red = char(27)//'[31m' character(len=5),parameter :: red = char(27)//'[31m'
character(len=5),parameter :: green = char(27)//'[32m' character(len=5),parameter :: green = char(27)//'[32m'
...@@ -16,12 +16,12 @@ contains ...@@ -16,12 +16,12 @@ contains
character(len=4),parameter :: norm = char(27)//'[0m' character(len=4),parameter :: norm = char(27)//'[0m'
character ,parameter :: cr = achar(13) character ,parameter :: cr = achar(13)
integer, save :: prevlen, prevtype integer, save :: prevlen, prevtype
character(len=100), save :: prevmsg character(len=200), save :: prevmsg
if (prevtype == -1) then if ( (prevtype == -1).and.(typ .ne. -1) ) then
msg = prevmsg(1:prevlen) // imsg msg = prevmsg(1:prevlen) // trim(imsg)
else else
msg = imsg msg = trim(imsg)
endif endif
select case(typ) select case(typ)
...@@ -56,19 +56,22 @@ contains ...@@ -56,19 +56,22 @@ contains
end function end function
subroutine check(res, ref) subroutine check(res, ref, ans)
complex(kind=prec) :: res, ref complex(kind=prec) :: res, ref
real(kind=prec) :: delta real(kind=prec) :: delta
character(len=40) :: msg character(len=40) :: msg
logical, optional :: ans
delta = abs(res-ref) delta = abs(res-ref)
if(delta < tol) then if(delta < tol) then
write(msg, 900) delta write(msg, 900) delta
call iprint(trim(msg), 0) call iprint(trim(msg), 0)
if (present(ans)) ans = .true.
else else
write(msg, 900) delta write(msg, 900) delta
call iprint(trim(msg), 1) call iprint(trim(msg), 1)
tests_successful = .false. tests_successful = .false.
if (present(ans)) ans = .false.
end if end if
900 format(" with delta = ",ES10.3) 900 format(" with delta = ",ES10.3)
...@@ -95,13 +98,18 @@ contains ...@@ -95,13 +98,18 @@ contains
call check(res,ref) call check(res,ref)
end subroutine test_one_condensed end subroutine test_one_condensed
subroutine test_one_flat(z,ref,test_id) subroutine test_one_flat(z,ref,test_id, ans)
complex(kind=prec) :: z(:), res, ref complex(kind=prec) :: z(:), res, ref
character(len=*) :: test_id character(len=*) :: test_id
logical, optional :: ans
call iprint(' testing GPL '//test_id//' ...',-1) call iprint(' testing GPL '//test_id//' ...',-1)
res = G(z) res = G(z)
call check(res,ref) if (present(ans)) then
call check(res,ref,ans)
else
call check(res,ref)
endif
end subroutine test_one_flat end subroutine test_one_flat
END MODULE TTOOLS END MODULE TTOOLS
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment