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

Gerhards source function

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: 540
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 08ff356d
c this is <siggen.f>
c------------------------------------------------------------------------------
c ($Id: siggen.f,v 1.7 2001-11-02 15:14:05 forbrig Exp $)
c ($Id: siggen.f,v 1.8 2001-11-20 12:44:18 forbrig Exp $)
c
c 24/10/2001 by Thomas Forbriger (IMGF Frankfurt)
c
......@@ -9,15 +9,16 @@ c
c REVISIONS and CHANGES
c 24/10/2001 V1.0 Thomas Forbriger
c 02/11/2001 V1.1 boxcar
c 20/11/2001 V1.2 Gerhards weight-drop source signal
c
c==============================================================================
c
program siggen
c
character*(*) version
parameter(version='SIGGEN V1.1 SIGnal GENerator')
parameter(version='SIGGEN V1.2 SIGnal GENerator')
character*(*) SIGGEN_CVS_ID
parameter(SIGGEN_CVS_ID='$Id: siggen.f,v 1.7 2001-11-02 15:14:05 forbrig Exp $')
parameter(SIGGEN_CVS_ID='$Id: siggen.f,v 1.8 2001-11-20 12:44:18 forbrig Exp $')
c
c parameters
integer nsig,ncyc
......@@ -183,6 +184,21 @@ c
print *,' All samples are zero. Only ''n'' samples after'
print *,' ''Ta'' seconds will be ''a''.'
print *,' '
print *,'9 Gerhards weight drop'
print *,' '
print *,' f(t)=0 t < Ta'
print *,' f(t)=-a Ta <= t <= Tm'
print *,' f(t)=2*a*(Tm-Ta)/(sqrt(pi)*(Te-Tm))*'
print *,' sqrt((t-Tm)/(Te-Tm))*'
print *,' exp(-(t-Tm)/(Te-Tm)) Tm < t'
print *,' '
print *,'10 Gerhards weight drop (spike version)'
print *,' '
print *,' f(t)=0 t < Ta'
print *,' f(t)=-a Ta <= t < Tm'
print *,' f(t)=a*(Tm-Ta)/d t = Tm'
print *,' f(t)=0 t > Tm'
print *,' '
print *,SIGGEN_CVS_ID
stop
endif
......@@ -439,6 +455,63 @@ c
data(i)=0.
endif
enddo
elseif (nsig.eq.9) then
if (verbose) then
print *,'Gerhards weight drop'
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'sampling interval','d',d,'s'
print 50,'time series lentgh','T',t,'s'
print 50,'weight release','Ta',ta,'s'
print 50,'weight impact','Tm',tm,'s'
print 50,'impulse transfer e-time','Te',te,'s'
endif
nsamples=int(t/d)
if (verbose) then
print *,'derived parameters:'
print 52,'number of samples',nsamples,' '
endif
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
elseif (ti.lt.tm) then
data(i)=-a
else
data(i)=2*a*(Tm-Ta)/(sqrt(pi)*(Te-Tm))*
& sqrt((ti-Tm)/(Te-Tm))*
& exp(-(ti-Tm)/(Te-Tm))
endif
enddo
elseif (nsig.eq.10) then
if (verbose) then
print *,'Gerhards weight drop (spike version)'
print *,'parameters:'
print 50,'amplitude','a',a,' '
print 50,'sampling interval','d',d,'s'
print 50,'time series lentgh','T',t,'s'
print 50,'weight release','Ta',ta,'s'
print 50,'weight impact','Tm',tm,'s'
endif
nsamples=int(t/d)
if (verbose) then
print *,'derived parameters:'
print 52,'number of samples',nsamples,' '
endif
ncyc=1
do i=1,nsamples
ti=d*float(i-1)
if (ti.lt.ta) then
data(i)=0.
elseif (ti.lt.tm) then
data(i)=-a
elseif (ncyc.gt.0) then
ncyc=0
data(i)=a*(tm-ta)/d
else
data(i)=0
endif
enddo
else
stop 'ERROR: unknown signal'
endif
......
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