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

not yet finished...

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: 511
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 43840154
# ---------------------------------------
#
# $Id: Makefile,v 1.11 2001-08-08 07:37:36 forbrig Exp $
# $Id: Makefile,v 1.12 2001-10-24 16:03:24 forbrig Exp $
#
# Makefile fuer tools /src/ts/wf
#
# 22/01/2001 introduced smoos and did some "tidy up"
# 24/10/2001 introduced siggen
#
# ---------------------------------------
......@@ -39,7 +40,7 @@ susei evelo tesiff teswf: %: %.o
$(CC) $(CFLAGS) $< -o $@ -ltf -lsff $(F2CLIB) -L$(LOCLIBDIR)
newprog $@
smoos dise: %: %.o
siggen smoos dise: %: %.o
$(CC) $(CFLAGS) $< -o $@ -ltf -lsffu -ltime -lsff $(F2CLIB) \
-L$(LOCLIBDIR)
newprog $@
......
c this is <siggen.f>
c------------------------------------------------------------------------------
c ($Id: siggen.f,v 1.1 2001-10-24 16:03:24 forbrig Exp $)
c
c 24/10/2001 by Thomas Forbriger (IMGF Frankfurt)
c
c SIGnal GENerator
c
c REVISIONS and CHANGES
c 24/10/2001 V1.0 Thomas Forbriger
c
c==============================================================================
c
program siggen
c
character*(*) version
parameter(version='SIGGEN V1.0 SIGnal GENerator')
character*(*) SIGGEN_CVS_ID
parameter(SIGGEN_CVS_ID='$Id: siggen.f,v 1.1 2001-10-24 16:03:24 forbrig Exp $')
c
c parameters
integer nsig,ncyc
real f,t,a,d,ta,te,td,tm,f1,f2
logical overwrite
character*80 filename
c internal parameters
integer nsamples,i
double precision ti,freq,tend,b,fh1,fh2
real pi
parameter(pi= 3.1415926535897)
integer lu
parameter(lu=10)
c data space
integer maxsamples
parameter(maxsamples=50000)
real data(maxsamples)
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=14)
character*3 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-D, 2h-v, 2h-o, 2h-f, 2h-T, 2h-a, 2h-d,
& 3h-Ta,3h-Te,2h-n,3h-Td,3h-Tm,3h-f1,3h-f2/
data opthasarg/3*.FALSE.,11*.TRUE./
data optarg/3*1h-,3h20.,3*2h1.,2h0.,3h20.,1h5,5h1.e20,3h30.,2*3h20./
c
c------------------------------------------------------------------------------
c basic information
c
c
argument=' '
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().lt.2)) then
print *,version
print *,'Usage: siggen type file [-v] [-o] [-f f] [-T T] [-a a] [-d d]'
print *,' [-Ta Ta] [-Te Te] [-Td Td] [-Tm Tm]'
print *,' [-n n] [-f1 f1] [-f2 f2]'
print *,' or: siggen -help'
if (argument(1:5).ne.'-help') stop 'ERROR: wrong number of arguments'
print *,' '
print *,'SIGnal GENerator'
print *,' '
c
print *,'type select signal type ''type'' (see list below)'
print *,'file SFF output file'
print *,' '
print *,'-o overwrite existing output file'
print *,'-v be verbose'
print *,'-f f set frequency parameter to ''f''Hz'
print *,' this is the fundamental signal freqeuncy'
print *,' (default: ',optarg(4)(1:3),')'
print *,'-T T set time parameter to ''T''s'
print *,' this is the length of the signal'
print *,' (default: ',optarg(5)(1:3),')'
print *,'-d d set time parameter to ''d''ms'
print *,' this is the sampling interval'
print *,' (default: ',optarg(7)(1:3),')'
print *,'-a a set amplitude parameter to ''a'' '
print *,' this is the signal amplitude'
print *,' (default: ',optarg(6)(1:3),')'
print *,' '
print *,'-Ta Ta set time parameter Ta to ''Ta''ms'
print *,' (default: ',optarg(8)(1:3),')'
print *,'-Te Te set time parameter Te to ''Te''ms'
print *,' (default: ',optarg(9)(1:3),')'
print *,'-Td Td set time parameter Td to ''Td''ms'
print *,' (default: ',optarg(11)(1:3),')'
print *,'-Tm Tm set time parameter Tm to ''Tm''ms'
print *,' (default: ',optarg(12)(1:3),')'
print *,'-n n set cycle parameter n to ''n'' cycles'
print *,' (default: ',optarg(10)(1:3),')'
print *,'-f1 f1 set frequency parameter f1 to ''f1''Hz'
print *,' (default: ',optarg(13)(1:3),')'
print *,'-f2 f2 set frequency parameter f2 to ''f2''Hz'
print *,' (default: ',optarg(14)(1:3),')'
print *,' '
print *,'type signal'
print *,'-------------------------'
print *,' '
print *,'1 sine wave'
print *,' f(t)=a*sin(2*pi*f*t)'
print *,' '
print *,'2 Mueller-Bruestle function'
print *,' f(t)=0 t <= Ta'
print *,' f(t)=a*(-0.75*cos(pi*(t-Ta)/(Te-Ta))+'
print *,' 0.25*cos(pi*(t-Ta)/(Te-Ta))**3) Ta < t < Te'
print *,' f(t)=1 t >= Te'
print *,' '
print *,'3 first order derivative of Mueller-Bruestle function'
print *,' f(t)=0 t <= Ta'
print *,' f(t)=a*(0.75*pi/(Te-Ta)*'
print *,' dsin(pi*(t-Ta)/(Te-Ta))**3) Ta < t < Te'
print *,' f(t)=0 t >= Te'
print *,' '
print *,'4 second order derivative of Mueller-Bruestle function'
print *,' f(t)=0 t <= Ta'
print *,' f(t)=a*(9*pi**2/(4*(Te-Ta)**2)*'
print *,' sin(pi*(t-Ta)/(Te-Ta))**2*'
print *,' cos(pi*(t-Ta)/(Te-Ta))) Ta < t < Te'
print *,' f(t)=0 t >= Te'
print *,' '
print *,'5 damped modulated sine'
print *,' the frequency is modulated according to'
print *,' Fr(t)=f1+b*t'
print *,' with b=sqrt(((2*f2-f1)**2-f1**1)/(4*n))'
print *,' the end of the signal is at'
print *,' Tend=Ta+(f2-f1)/b'
print *,' the freqeuncy extrema are'
print *,' Fr(0)=f1 Fr(Tend-Ta)=f2'
print *,' the final value of the signal phase is'
print *,' 2*pi*Fr(Te-Ta)*(Te-Ta)=n*2*pi'
print *,' f(t)=0 t <= Ta'
print *,' f(t)=a*(sin(2*pi*Fr(t-Ta)*(t-Ta))*'
print *,' exp(-(t-Ta)/Td))) Ta < t < Tend'
print *,' f(t)=0 t <= Ta'
print *,' '
print *,SIGGEN_CVS_ID
stop
endif
c
c------------------------------------------------------------------------------
c read command line arguments
c
call getarg(1, argument)
read(argument, *) nsig
call getarg(2, filename)
call tf_cmdline(3, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
debug=optset(1)
verbose=optset(2)
overwrite=optset(3)
read(optarg(4), *) f
read(optarg(5), *) t
read(optarg(6), *) a
read(optarg(7), *) d
read(optarg(8), *) ta
read(optarg(9), *) te
read(optarg(10), *) ncyc
read(optarg(11), *) td
read(optarg(12), *) tm
read(optarg(13), *) f1
read(optarg(14), *) f2
c
c------------------------------------------------------------------------------
c go
c
if (nsig.eq.1) then
if (verbose) then
print *,'sine wave'
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'frequency','f',f,'Hz'
print 50,'sampling interval','d',d,'ms'
print 50,'time series lentgh','T',t,'s'
endif
nsamples=int(1.e3*t/d)
if (verbose) then
print *,'derived parameters:'
print 52,'number of samples',nsamples,' '
endif
do i=1,nsamples
data(i)=a*sin(2*pi*(i-1)*d*1.e-3*f)
enddo
elseif (nsig.eq.2) then
if (verbose) then
print *,'Mueller-Bruestle function'
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'sampling interval','d',d,'ms'
print 50,'time series lentgh','T',t,'s'
print 50,'onset of wavelet','Ta',ta,'ms'
print 50,'end of wavelet','Te',te,'ms'
endif
nsamples=int(1.e3*t/d)
if (verbose) then
print *,'derived parameters:'
print 52,'number of samples',nsamples,' '
endif
do i=1,nsamples
ti=d*1.e-3*(i-1)
if (ti.lt.(1.e-3*ta)) then
data(i)=0.
elseif(ti.le.(1.e-3*te)) then
data(i)=a*(-0.75*cos(pi*(ti-1.e-3*ta)/(1.e-3*(te-ta)))+
& 0.25*cos(pi*(ti-1.e-3*ta)/(1.e-3*(te-ta)))**3)
else
data(i)=a
endif
enddo
elseif (nsig.eq.3) then
if (verbose) then
print *,'first order derivative of Mueller-Bruestle function'
endif
elseif (nsig.eq.4) then
if (verbose) then
print *,'second order derivative of Mueller-Bruestle function'
endif
elseif (nsig.eq.5) then
if (verbose) then
print *,'modulated and damped sine wave'
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'sampling interval','d',d,'ms'
print 50,'time series lentgh','T',t,'s'
print 50,'onset of wavelet','Ta',ta,'ms'
print 50,'damping time constant','Td',td,'ms'
print 51,'number of cycles','n',ncyc,' '
print 50,'initial frequency','f1',f1,'Hz'
print 50,'final frequency','f2',f2,'Hz'
endif
nsamples=int(1.e3*t/d)
c b=((2*f2-f1)**2-f1**2)/(4*ncyc)
if (f1.gt.f2) then
b=-b
endif
tend=4.*float(ncyc)*(f2-f1)/((2.*f2-f1)**2-f1**2)
b=(f2-f1)/tend
tend=ta+1.e3*tend
c tend=1.e3*(1.e-3*ta-f1/(2.*b)+sqrt(f1**2+4.*b*float(ncyc))/(2.*b))
if (verbose) then
print *,'derived parameters:'
print 52,'number of samples',nsamples,' '
print 53,'end of signal',tend,'ms'
print 53,'frequency modulation slope',b,'Hz/s'
print 53,'initial frequency',f1,'Hz/s'
print 53,'final frequency',f1+b*1.e-3*(tend-ta),'Hz/s'
endif
do i=1,nsamples
ti=d*1.e-3*(i-1)
if (ti.lt.(1.e-3*ta)) then
data(i)=0.
elseif(ti.le.(1.e-3*tend)) then
freq=f1+b*ti
data(i)=a*(sin(2*pi*freq*(ti-1.e-3*Ta))*
& exp(-1.e3*(ti-1.e-3*Ta)/Td))
else
data(i)=0.
endif
enddo
else
stop 'ERROR: unknown signal'
endif
if (overwrite) then
call sff_New(lu,filename,i)
if (i.ne.0) stop 'ERROR: deleting output file'
endif
call sffu_simpleopen(lu,filename)
call sffu_simplewrite(lu, .true., data, nsamples, 1.e-3*d, 0.)
stop
50 format(3x,a30,1x,a3,1x,f10.3,a4)
51 format(3x,a30,1x,a3,1x,i10,a4)
52 format(3x,a30,1x,3x,1x,i10,a4)
53 format(3x,a30,1x,3x,1x,f10.3,a4)
end
c
c ----- END OF siggen.f -----
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