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

proceeding

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: 1587
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 2a26973a
# ---------------------------------------
#
# $Id: Makefile,v 1.19 2004-11-09 12:09:58 tforb Exp $
# $Id: Makefile,v 1.20 2004-11-09 13:15:09 tforb Exp $
#
# Makefile fuer tools /src/ts/wf
#
......@@ -48,11 +48,11 @@ rotate coro xyz2uvw detect: %: %.o
$(CC) $(CFLAGS) $< -o $@ -lsff $(F2CLIB) -L$(LOCLIBDIR) -ltf
newprog $@
phasedsignals susei evelo tesiff teswf: %: %.o
susei evelo tesiff teswf: %: %.o
$(CC) $(CFLAGS) $< -o $@ -ltf -lsff $(F2CLIB) -L$(LOCLIBDIR)
newprog $@
hamres siggen smoos dise: %: %.o
phasedsignals hamres siggen smoos dise: %: %.o
$(CC) $(CFLAGS) $< -o $@ -ltf -lsffu -ltime -lsff $(F2CLIB) \
-L$(LOCLIBDIR)
newprog $@
......
c this is <phasedsignals.f>
c ----------------------------------------------------------------------------
c ($Id: phasedsignals.f,v 1.1 2004-11-09 12:09:58 tforb Exp $)
c ($Id: phasedsignals.f,v 1.2 2004-11-09 13:15:09 tforb Exp $)
c
c Copyright (c) 2004 by Thomas Forbriger (BFO Schiltach)
c
......@@ -19,26 +19,36 @@ c
& //'compute synthetic signals with given phase')
character*(*) PHASEDSIGNALS_CVS_ID
parameter(PHASEDSIGNALS_CVS_ID=
& '$Id: phasedsignals.f,v 1.1 2004-11-09 12:09:58 tforb Exp $')
& '$Id: phasedsignals.f,v 1.2 2004-11-09 13:15:09 tforb Exp $')
c
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=7)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c
logical overwrite
character arg_model
double precision arg_duration, arg_delay, arg_bandwidth
integer arg_npower
c
integer nsamples, maxsamples
parameter(maxsamples=100000)
double precision dt, t0
integer nsamples, maxsamples, maxfreq, nfreq
parameter(maxsamples=100000,maxfreq=((maxsamples/2)+1))
double precision dt, t0, df, pi, pi2, f ,t, bw, fac
parameter(pi=3.141592653589793d0,pi2=2.d0*pi)
double precision amp(maxfreq), phase(maxfreq)
real fdata(maxsamples), tf_rand
integer idata(maxsamples)
equivalence (fdata,idata)
double complex spectrum(maxsamples), ime
parameter(ime=(0.d0,1.d0))
integer lu, i
parameter(lu=12)
character*80 filename
c debugging
logical debug, verbose
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=8)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 2h-o, 2h-p, 2h-t, 2h-n, 2h-s, 2h-b/
data opthasarg/3*.FALSE.,5*.TRUE./
......@@ -77,6 +87,7 @@ c
c------------------------------------------------------------------------------
c read command line arguments
c
call getarg(1, filename)
call tf_cmdline(2, lastarg, maxopt, optid,
& optarg, optset, opthasarg)
debug=optset(1)
......@@ -95,11 +106,84 @@ c go
& stop 'ERROR: you request too many samples!'
t0=arg_delay
dt=arg_duration/nsamples
df=1./arg_duration
nfreq=(nsamples/2)+1
bw=arg_bandwidth
c
do i=1,nfreq
f=(i-1)*df
amp(i)=exp(-(f/bw)**2)
enddo
c
if (arg_model.eq.'0') then
do i=1,nfreq
phase(i)=0.d0
enddo
elseif (arg_model.eq.'r') then
call tf_tsrand()
do i=1,nfreq
phase(i)=pi2*tf_rand()
enddo
elseif (arg_model.eq.'m') then
do i=1,nfreq
spectrum(i)=cmplx(log(abs(amp(i))),0.)
enddo
print *,'d1'
call ccspectrum(spectrum,nsamples)
call tf_dfork(nsamples,spectrum,-1.d0)
print *,'d2'
do i=2,nfreq-1
spectrum(i)=-ime*spectrum(i)/pi
enddo
print *,'d3'
spectrum(nfreq)=(0.d0,0.d0)
call ccspectrum(spectrum,nsamples)
call tf_dfork(nsamples,spectrum,-1.d0)
print *,'d4'
do i=1,nfreq
phase(i)=real(spectrum(i))
enddo
print *,'d5'
else
stop 'ERROR: illegal model selection!'
endif
c
do i=1,nfreq
f=(i-1)*df
phase(i)=phase(i)-f*pi2*t0
spectrum(i)=amp(i)*exp(ime*phase(i))
enddo
call ccspectrum(spectrum,nsamples)
call tf_dfork(nsamples,spectrum,1.d0)
fac=sqrt(float(nsamples))*df*pi2
do i=1,nsamples
fdata(i)=real(spectrum(i))*fac
enddo
print *,'d6',nsamples
if (overwrite) call sff_New(lu,filename,i)
print *,'d7',nsamples
call sffu_simpleopen(lu,filename)
print *,'d8',nsamples
call sffu_simplewrite(lu, .true., fdata, nsamples,
& sngl(dt), sngl(t0))
print *,'d9',nsamples
c
stop
end
c======================================================================
c
subroutine ccspectrum(spectrum, n)
c
c complement the spectrum
c
double complex spectrum(n)
integer n,i
integer n2
n2=n/2
do i=2,n2
spectrum(n-i+2)=conjg(spectrum(i))
enddo
return
end
c
c ----- END OF phasedsignals.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