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

tested interface to libc random number generator

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.
this interface appears to be out of order currently
I found no way to fix the problem quickly


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 4721
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 326fcca4
......@@ -156,7 +156,7 @@ libtf.a: $(SUBS)
$(AR) rcv libtf.a $(SUBS)
$(RANLIB) libtf.a
testlibtf: testlibtf.o libtf.a
testlibtf: testlibtf.o install
$(FC) -o $@ $< -ltf -lm -lgsl -lgslcblas $(FFLAGS) $(LDFLAGS)
#======================================================================
......
......@@ -27,6 +27,7 @@ c 09/05/2007 V1.0 Thomas Forbriger
c 17/12/2007 V1.1 use keyword file in open statement
c 27/11/2009 V1.2 test magic numbers
c 04/02/2010 V1.3 test taper reading
c 03/06/2012 V1.4 added test for libc random number generator
c
c ============================================================================
c
......@@ -34,7 +35,7 @@ c
c
character*(*) version
parameter(version=
&'TESTLIBTF V1.3 program to test libtf functions')
&'TESTLIBTF V1.4 program to test libtf functions')
character*(*) TESTLIBTF_CVS_ID
parameter(TESTLIBTF_CVS_ID=
&'$Id$')
......@@ -43,22 +44,25 @@ c
parameter(m=10000)
double precision a(m)
character*4 cmagic
c
real tf_rand
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=7)
parameter(maxopt=8)
character*7 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c
logical testrng, fileoutput, testmagic, testrtaper
logical testrng, fileoutput, testmagic, testrtaper, testrand
character*80 taperfile
c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 4h-rng, 2h-f, 2h-n, '-magic', '-rtaper'/
data opthasarg/4*.FALSE.,.TRUE.,.FALSE.,.TRUE./
data optarg/4*1h-,3h150,2*'-'/
data optid/2h-d, 2h-v, 4h-rng, 2h-f, 2h-n, '-magic', '-rtaper',
& '-rand'/
data opthasarg/4*.FALSE.,.TRUE.,.FALSE.,.TRUE.,.FALSE./
data optarg/4*1h-,3h150,3*'-'/
c
c------------------------------------------------------------------------------
c basic information
......@@ -68,7 +72,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] [-n n]'
print *,'Usage: testlibtf [-v] [-f] [-n n] [-rand]'
print *,' [-rng] [-magic] [-rtaper f]'
print *,' or: testlibtf -help'
if (argument(1:5).ne.'-help')
......@@ -84,6 +88,7 @@ c
print *,' '
print *,'select tests:'
print *,'-rng test gsl random number generator'
print *,'-rand test libc random number generator'
print *,'-magic test magic numbers'
print *,'-rtaper f test reading a quad taper from file ''f'' '
stop
......@@ -102,6 +107,7 @@ c
testmagic=optset(6)
taperfile=optarg(7)
testrtaper=optset(7)
testrand=optset(8)
c
c------------------------------------------------------------------------------
c go
......@@ -122,6 +128,18 @@ c go
write(unit=10, fmt='(f7.4)', err=98) (a(i), i=1,n)
close(unit=10, err=97)
endif
c----------------------------------------------------------------------
if (testrand) then
print *,'test libc random number generator'
do i=1,n
print *,tf_rand()
a(i)=dble(tf_rand())
enddo
print '(8(2x,f7.4))', (a(i), i=1,n)
open(unit=10, file='test_rand.xxx', err=99)
write(unit=10, fmt='(f7.4)', err=98) (a(i), i=1,n)
close(unit=10, err=97)
endif
c----------------------------------------------------------------------
if (testmagic) then
print *,'test magic numbers'
......
......@@ -24,10 +24,12 @@
* REVISIONS and CHANGES
* 18/11/97 V1.0 Thomas Forbriger
* 11/11/99 V1.1 include stdlib.h and added function tsrand_()
* 03/06/12 V1.2 interface appears broken; issue warning
*
* ============================================================================
*/
#include <stdio.h>
#include <stdlib.h>
#ifndef RAND_MAX
#include <math.h>
......@@ -44,6 +46,7 @@
real tf_rand__()
{
real retval, randval, randmax;
fprintf(stderr, "WARNING: function tf_rand() is not maintained!\n");
randmax=(real)RAND_MAX;
randval=(real)rand();
retval=randval/randmax;
......@@ -58,6 +61,7 @@ int tf_srand__(seed)
integer *seed;
{
unsigned int cseed;
fprintf(stderr, "WARNING: function tf_srand() is not maintained!\n");
cseed=*seed;
srand(cseed);
return 0;
......@@ -70,6 +74,7 @@ int tf_tsrand__()
{
unsigned int cseed;
time_t mytime;
fprintf(stderr, "WARNING: function tf_tsrand() is not maintained!\n");
time(&mytime);
cseed=(unsigned int)mytime;
srand(cseed);
......
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