Commit e4b55e11 authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

tests are ok

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 2271
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent dda3d96a
#
# $Id: Makefile,v 1.10 2007-05-09 11:24:31 tforb Exp $
# $Id: Makefile,v 1.11 2007-05-09 11:25:18 tforb Exp $
#
# Makefile for prog/lib
#
......@@ -114,4 +114,6 @@ testlibtf77: testlibtf.o77 libtf77.a
rngtest:
testlibtf -rng -f -n 9900
$(MAKE) test_gaussian.sort.plot test_uniform.sort.plot
testlibtf77 -rng -f -n 9900
$(MAKE) test_gaussian.sort.plot test_uniform.sort.plot
c this is <testlibtf.f>
c ----------------------------------------------------------------------------
c ($Id: testlibtf.f,v 1.1 2007-05-09 11:07:38 tforb Exp $)
c ($Id: testlibtf.f,v 1.2 2007-05-09 11:24:31 tforb Exp $)
c
c Copyright (c) 2007 by Thomas Forbriger (BFO Schiltach)
c
......@@ -17,15 +17,16 @@ c
parameter(version=
&'TESTLIBTF V1.0 program to test libtf functions')
character*(*) TESTLIBTF_CVS_ID
parameter(TESTLIBTF_CVS_ID='$Id: testlibtf.f,v 1.1 2007-05-09 11:07:38 tforb Exp $')
parameter(TESTLIBTF_CVS_ID=
&'$Id: testlibtf.f,v 1.2 2007-05-09 11:24:31 tforb Exp $')
c
integer m,i
parameter(m=150)
integer m,i,n
parameter(m=10000)
double precision a(m)
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=4)
parameter(maxopt=5)
character*5 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -34,9 +35,9 @@ c
c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 4h-rng, 2h-f/
data opthasarg/4*.FALSE./
data optarg/4*1h-/
data optid/2h-d, 2h-v, 4h-rng, 2h-f, 2h-n/
data opthasarg/4*.FALSE.,.TRUE./
data optarg/4*1h-,3h150/
c
c------------------------------------------------------------------------------
c basic information
......@@ -46,7 +47,7 @@ c
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().lt.1)) then
print *,version
print *,'Usage: testlibtf [-v] [-f]'
print *,'Usage: testlibtf [-v] [-f] [-n n]'
print *,' [-rng]'
print *,' or: testlibtf -help'
if (argument(1:5).ne.'-help')
......@@ -57,6 +58,7 @@ c
print *,TESTLIBTF_CVS_ID
print *,' '
print *,'-v be verbose'
print *,'-n n test n samples'
print *,'-f write results to files'
print *,' '
print *,'select tests:'
......@@ -73,23 +75,25 @@ c
verbose=optset(2)
testrng=optset(3)
fileoutput=optset(4)
read(optarg(5), *, err=96) n
c
c------------------------------------------------------------------------------
c go
if (testrng) then
print *,'test gsl random number generators'
if (n.gt.m) stop 'ERROR: too many samples requested'
print *,' '
print *,'gaussian distribution:'
call tf_gsl_rng_ugaussian(a, m)
print '(8(2x,f7.4))', (a(i), i=1,m)
call tf_gsl_rng_ugaussian(a, n)
print '(8(2x,f7.4))', (a(i), i=1,n)
open(10, name='test_gaussian.xxx', err=99)
write(10, '(f7.4)', err=98) (a(i), i=1,m)
write(10, '(f7.4)', err=98) (a(i), i=1,n)
close(10, err=97)
print *,'uniform distribution:'
call tf_gsl_rng_uniform(a, m)
print '(8(2x,f7.4))', (a(i), i=1,m)
call tf_gsl_rng_uniform(a, n)
print '(8(2x,f7.4))', (a(i), i=1,n)
open(10, name='test_uniform.xxx', err=99)
write(10, '(f7.4)', err=98) (a(i), i=1,m)
write(10, '(f7.4)', err=98) (a(i), i=1,n)
close(10, err=97)
endif
c
......@@ -97,6 +101,7 @@ c
99 stop 'ERROR: opening file'
98 stop 'ERROR: writing file'
97 stop 'ERROR: closing file'
96 stop 'ERROR: reading command line'
end
c
c
......
Supports Markdown
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