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