Commit 01c4b239 authored by ulrich_y's avatar ulrich_y

iprint in long test

parent eead04dc
......@@ -537,7 +537,6 @@ CONTAINS
integer(kind=8) cstart, cend, count_rate
real(kind=prec) :: time(2), ttime(2)
integer i,j, u
character,parameter :: cr = achar(13)
character(len=*) msg
character(len=90) msg2
do j=1,size(args,1)
......@@ -752,7 +751,7 @@ CONTAINS
real(kind=prec) :: v, maxd
complex(kind=prec) :: ans(2)
complex(kind=8) :: geval
character,parameter :: cr = achar(13)
character(len=80) :: msg
maxd=0._prec
seed = 112312
......@@ -778,7 +777,8 @@ CONTAINS
do w=1,size(perweight)
do i=1,perweight(w)
oldseed = seed
write( * , 900, advance='no' ) cr, i, perweight(w), w
write(msg, 900) i, perweight(w), w
call iprint(msg,-1)
args(1:w) = basis((/ (1+int(size(basis)*ran2(seed)),j=1,w) /))
#if KINDREAL==16
ans(1) = cmplx(geval(inum2inum([args(1:w),ione]), w+1),kind=prec)
......@@ -787,9 +787,9 @@ CONTAINS
#endif
ans(2) = G(args(1:w),ione)
if ((abs(ans(1)) .gt. 1.e10).or.(abs(ans(2)) .gt. 1.e10)) then
print*," can't deal with",args," (seed was",oldseed,')'
print*,"GiNaC : ",ans(1)
print*,"handyG: ",ans(2)
write(msg,903) oldseed
call iprint(msg,3)
print*,"Args are ",args(1:w)
cycle
endif
write(9) w,i,oldseed, abs(ans(1)-ans(2))
......@@ -797,21 +797,30 @@ CONTAINS
if(abs(ans(1)-ans(2)) > maxd) maxd = abs(ans(1)-ans(2))
if(abs(ans(1)-ans(2)) > tol) goto 123
enddo
print*,' done. largest=',maxd
write(msg,901) maxd
if (maxd < 1.e-3_prec) then
call iprint(msg,0)
else
call iprint(msg,1)
endif
maxd=0.
enddo
print*,maxd
close(9)
tests_successful = tests_successful .and. .true.
return
123 continue
print*,"Failed with delta",abs(ans(1)-ans(2))
write(msg,902) abs(ans(1)-ans(2)), oldseed
call iprint(msg,1)
print*,"Offending G was",args(1:w)
print*,ans
close(9)
tests_successful = tests_successful .and. .false.
900 FORMAT(a , 'Testing ',i5,'/',i5,' GPLs with w=',i1)
900 FORMAT('Testing ',i5,'/',i5,' GPLs with w=',i1)
901 FORMAT(' done. Largest delta = ',ES10.3)
902 FORMAT(' failed with delta = ',ES10.3, ' (seed=',I10,')')
903 FORMAT(' GiNaC problems with seed=',I10)
END SUBROUTINE
......
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