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

reworked sweep signal

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: 3872
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent e9e40967
......@@ -32,13 +32,14 @@ c 28/08/2002 V1.4 added noise
c 01/07/2002 V1.5 added test triangle
c 12/09/2007 V1.6 provide GSL random numbers
c 05/04/2011 V1.7 provide logarithmic sweep
c 20/04/2011 V1.8 provide better control for sweep
c
c==============================================================================
c
program siggen
c
character*(*) version
parameter(version='SIGGEN V1.7 SIGnal GENerator')
parameter(version='SIGGEN V1.8 SIGnal GENerator')
character*(*) SIGGEN_CVS_ID
parameter(SIGGEN_CVS_ID=
& '$Id$')
......@@ -52,7 +53,7 @@ c functions
real tf_rand
c internal parameters
integer nsamples,i
double precision ti,tend,bx,tx,dx
double precision ti,tend,bx,tx,dx,h,g
double precision myexpo
real pi
parameter(pi= 3.1415926535897)
......@@ -61,8 +62,8 @@ c internal parameters
c data space
integer maxsamples
parameter(maxsamples=100000)
real data(maxsamples)
double precision ddata(maxsamples)
real series(maxsamples)
double precision dseries(maxsamples)
c commandline
integer maxopt, lastarg, iargc
character*80 argument
......@@ -310,7 +311,7 @@ c
print 52,'number of samples',nsamples,' '
endif
do i=1,nsamples
data(i)=a*sin(2*pi*(i-1)*d*f)
series(i)=a*sin(2*pi*(i-1)*d*f)
enddo
elseif (nsig.eq.2) then
if (verbose) then
......@@ -330,12 +331,12 @@ c
do i=1,nsamples
ti=d*(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.te) then
data(i)=a*(0.5-0.75*cos(pi*(ti-ta)/(te-ta))+
series(i)=a*(0.5-0.75*cos(pi*(ti-ta)/(te-ta))+
& 0.25*cos(pi*(ti-ta)/(te-ta))**3)
else
data(i)=a
series(i)=a
endif
enddo
elseif (nsig.eq.3) then
......@@ -356,11 +357,11 @@ c
do i=1,nsamples
ti=d*(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.te) then
data(i)=a*(3.*pi/(4.*(te-ta))*sin(pi*(ti-ta)/(te-ta))**3)
series(i)=a*(3.*pi/(4.*(te-ta))*sin(pi*(ti-ta)/(te-ta))**3)
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.4) then
......@@ -381,13 +382,13 @@ c
do i=1,nsamples
ti=d*(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.te) then
data(i)=a*(9*pi**2/(4.*(te-ta)**2)*
series(i)=a*(9*pi**2/(4.*(te-ta)**2)*
& sin(pi*(ti-ta)/(te-ta))**2*
& cos(pi*(ti-ta)/(te-ta)))
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.5) then
......@@ -418,12 +419,12 @@ c
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.tend) then
data(i)=a*(sin(2*pi*(f1+bx*(ti-ta))*(ti-ta))*
series(i)=a*(sin(2*pi*(f1+bx*(ti-ta))*(ti-ta))*
& exp(-(ti-Ta)/Td))
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.6) then
......@@ -453,12 +454,12 @@ c
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.te) then
data(i)=a*(sin(2*pi*(1.-myexpo(dble(1.-(ti-ta)/(te-ta)),bx)))*
series(i)=a*(sin(2*pi*(1.-myexpo(dble(1.-(ti-ta)/(te-ta)),bx)))*
& exp(-(ti-Ta)/Td))
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.7) then
......@@ -486,10 +487,10 @@ c
do i=1,nsamples
ti=d*float(i-1)
if(ti.le.te) then
data(i)=a*(cos(1.5*pi*(1.-myexpo(dble(1.-ti/te),bx)))*
series(i)=a*(cos(1.5*pi*(1.-myexpo(dble(1.-ti/te),bx)))*
& exp(-ti/Td))
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.8) then
......@@ -510,12 +511,12 @@ c
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif (ncyc.gt.0) then
data(i)=a
series(i)=a
ncyc=ncyc-1
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.9) then
......@@ -537,11 +538,11 @@ c
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif (ti.lt.tm) then
data(i)=-a
series(i)=-a
else
data(i)=2*a*(Tm-Ta)/(sqrt(pi)*(Te-Tm))*
series(i)=2*a*(Tm-Ta)/(sqrt(pi)*(Te-Tm))*
& sqrt((ti-Tm)/(Te-Tm))*
& exp(-(ti-Tm)/(Te-Tm))
endif
......@@ -565,14 +566,14 @@ c
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif (ti.lt.tm) then
data(i)=-a
series(i)=-a
elseif (ncyc.gt.0) then
ncyc=0
data(i)=a*(tm-ta)/d
series(i)=a*(tm-ta)/d
else
data(i)=0
series(i)=0
endif
enddo
elseif (nsig.eq.11) then
......@@ -593,11 +594,11 @@ c
do i=1,nsamples
ti=d*(i-1)
if (ti.lt.ta) then
data(i)=0.
series(i)=0.
elseif(ti.le.te) then
data(i)=a*sin(pi*(ti-ta)/(te-ta))
series(i)=a*sin(pi*(ti-ta)/(te-ta))
else
data(i)=0.
series(i)=0.
endif
enddo
elseif (nsig.eq.12) then
......@@ -621,7 +622,7 @@ c
endif
if (nsamples .gt. maxsamples) stop 'too many samples'
do i=1,nsamples
data(i)=a*(2.*tf_rand()-1.)
series(i)=a*(2.*tf_rand()-1.)
enddo
elseif (nsig.eq.13) then
if (verbose) then
......@@ -653,7 +654,7 @@ c slope
else
dx=-2.*a/bx
endif
data(i)=dx*(ti-tx)+b+c*ti
series(i)=dx*(ti-tx)+b+c*ti
enddo
elseif (nsig.eq.14) then
if (verbose) then
......@@ -669,9 +670,9 @@ c slope
print 52,'number of samples',nsamples,' '
endif
if (nsamples .gt. maxsamples) stop 'too many samples'
call tf_gsl_rng_ugaussian(ddata, nsamples)
call tf_gsl_rng_ugaussian(dseries, nsamples)
do i=1,nsamples
data(i)=a*ddata(i)
series(i)=a*dseries(i)
enddo
elseif (nsig.eq.15) then
if (verbose) then
......@@ -680,8 +681,9 @@ c slope
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'sampling interval','d',d,'s'
print 50,'time series lentgh','T',t,'s'
print 51,'number of cycle pre decade','n',ncyc,' '
print 50,'time series length','T',t,'s'
print 50,'initial frequency','f',f,'Hz'
print 51,'number of cycle per decade','n',ncyc,' '
endif
nsamples=int(t/d)
if (verbose) then
......@@ -689,8 +691,10 @@ c slope
print 52,'number of samples',nsamples,' '
endif
if (nsamples .gt. maxsamples) stop 'too many samples'
h=(ncyc*log10(exp(1.d0))/f)-d
g=-log10(d+h)
do i=1,nsamples
data(i)=a*sin(log10(d*i)*2*pi*ncyc)
series(i)=a*sin((g+log10(i*d+h))*2*pi*ncyc)
enddo
else
stop 'ERROR: unknown signal'
......@@ -701,7 +705,7 @@ c slope
if (i.ne.0) stop 'ERROR: deleting output file'
endif
call sffu_simpleopen(lu,filename)
call sffu_simplewrite(lu, .true., data, nsamples, sngl(d), 0.)
call sffu_simplewrite(lu, .true., series, nsamples, sngl(d), 0.)
stop
50 format(3x,a30,1x,a3,1x,f10.3,a4)
......@@ -712,14 +716,14 @@ c slope
c
c----------------------------------------------------------------------
double precision function myexpo(x,y)
double precision x,y,result
double precision x,y,r
if (x.lt.0.d0) stop 'ERROR: argument of myexpo'
if (x.lt.1.d-2) then
result=0.d0
r=0.d0
else
result=exp(y*log(x))
r=exp(y*log(x))
endif
myexpo=result
myexpo=r
return
end
......
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