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

does not work

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: 1613
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent c4338f9c
# --------------------------------------- # ---------------------------------------
# #
# $Id: Makefile,v 1.20 2004-11-09 13:15:09 tforb Exp $ # $Id: Makefile,v 1.21 2005-01-11 15:11:57 tforb Exp $
# #
# Makefile fuer tools /src/ts/wf # Makefile fuer tools /src/ts/wf
# #
...@@ -63,3 +63,13 @@ tidofi fredofi sigfit: %: %.o ...@@ -63,3 +63,13 @@ tidofi fredofi sigfit: %: %.o
-L$(LOCLIBDIR) $(CXXFLAGS) $(FLAGS) -L$(LOCLIBDIR) $(CXXFLAGS) $(FLAGS)
newprog $@ newprog $@
phasetest%.sff: phasedsignals
phasedsignals $@ -o -p $(patsubst phasetest%.sff,%,$@) -n 16 \
-t 10. -b 20.
P%.sff: %.sff; evelo $< $@ -P
%.s.ps: %.sff; splot $< 0. $@/ps 1.e-2
RVAL=0.
%.ps: %.sff; stuplo -d $@/ps -R $(RVAL) $<
%.psp: %.ps; gv $<; /bin/rm -fv $<
c this is <phasedsignals.f> c this is <phasedsignals.f>
c ---------------------------------------------------------------------------- c ----------------------------------------------------------------------------
c ($Id: phasedsignals.f,v 1.2 2004-11-09 13:15:09 tforb Exp $) c ($Id: phasedsignals.f,v 1.3 2005-01-11 15:11:57 tforb Exp $)
c c
c Copyright (c) 2004 by Thomas Forbriger (BFO Schiltach) c Copyright (c) 2004 by Thomas Forbriger (BFO Schiltach)
c c
...@@ -19,7 +19,7 @@ c ...@@ -19,7 +19,7 @@ c
& //'compute synthetic signals with given phase') & //'compute synthetic signals with given phase')
character*(*) PHASEDSIGNALS_CVS_ID character*(*) PHASEDSIGNALS_CVS_ID
parameter(PHASEDSIGNALS_CVS_ID= parameter(PHASEDSIGNALS_CVS_ID=
& '$Id: phasedsignals.f,v 1.2 2004-11-09 13:15:09 tforb Exp $') & '$Id: phasedsignals.f,v 1.3 2005-01-11 15:11:57 tforb Exp $')
c c
c c
logical overwrite logical overwrite
...@@ -29,13 +29,15 @@ c ...@@ -29,13 +29,15 @@ c
c c
integer nsamples, maxsamples, maxfreq, nfreq integer nsamples, maxsamples, maxfreq, nfreq
parameter(maxsamples=100000,maxfreq=((maxsamples/2)+1)) parameter(maxsamples=100000,maxfreq=((maxsamples/2)+1))
double precision dt, t0, df, pi, pi2, f ,t, bw, fac double precision dt, t0, df, pi, pi2, f ,t, bw, fac, v
parameter(pi=3.141592653589793d0,pi2=2.d0*pi) parameter(pi=3.141592653589793d0,pi2=2.d0*pi)
double precision amp(maxfreq), phase(maxfreq) double precision amp(maxfreq), phase(maxfreq)
double precision sigtospec, sigtotime
parameter (sigtospec=-1.d0, sigtotime=1.d0)
real fdata(maxsamples), tf_rand real fdata(maxsamples), tf_rand
integer idata(maxsamples) integer idata(maxsamples)
equivalence (fdata,idata) equivalence (fdata,idata)
double complex spectrum(maxsamples), ime double complex spectrum(maxsamples), ime, pfac
parameter(ime=(0.d0,1.d0)) parameter(ime=(0.d0,1.d0))
integer lu, i integer lu, i
parameter(lu=12) parameter(lu=12)
...@@ -112,7 +114,7 @@ c go ...@@ -112,7 +114,7 @@ c go
c c
do i=1,nfreq do i=1,nfreq
f=(i-1)*df f=(i-1)*df
amp(i)=exp(-(f/bw)**2) amp(i)=max(1.e8*exp(-(f/bw)**2),1.)
enddo enddo
c c
if (arg_model.eq.'0') then if (arg_model.eq.'0') then
...@@ -126,24 +128,23 @@ c ...@@ -126,24 +128,23 @@ c
enddo enddo
elseif (arg_model.eq.'m') then elseif (arg_model.eq.'m') then
do i=1,nfreq do i=1,nfreq
spectrum(i)=cmplx(log(abs(amp(i))),0.) spectrum(i)=log(abs(amp(i)))
enddo enddo
print *,'d1'
call ccspectrum(spectrum,nsamples)
call tf_dfork(nsamples,spectrum,-1.d0)
print *,'d2'
do i=2,nfreq-1 do i=2,nfreq-1
spectrum(i)=-ime*spectrum(i)/pi spectrum(nsamples+2-i)=log(abs(amp(i)))
enddo
call tf_dfork(nsamples,spectrum,sigtospec)
do i=2,nfreq-1
spectrum(i)=ime*spectrum(i)
enddo enddo
print *,'d3'
spectrum(nfreq)=(0.d0,0.d0) spectrum(nfreq)=(0.d0,0.d0)
call ccspectrum(spectrum,nsamples) do i=nfreq+1,nsamples
call tf_dfork(nsamples,spectrum,-1.d0) spectrum(i)=-ime*spectrum(i)
print *,'d4' enddo
call tf_dfork(nsamples,spectrum,sigtotime)
do i=1,nfreq do i=1,nfreq
phase(i)=real(spectrum(i)) phase(i)=real(spectrum(i))
enddo enddo
print *,'d5'
else else
stop 'ERROR: illegal model selection!' stop 'ERROR: illegal model selection!'
endif endif
...@@ -151,22 +152,22 @@ c ...@@ -151,22 +152,22 @@ c
do i=1,nfreq do i=1,nfreq
f=(i-1)*df f=(i-1)*df
phase(i)=phase(i)-f*pi2*t0 phase(i)=phase(i)-f*pi2*t0
spectrum(i)=amp(i)*exp(ime*phase(i)) pfac=exp(ime*phase(i))
spectrum(i)=amp(i)*pfac
if (abs(abs(pfac)-1.d0).gt.1.e-8) then
print *,i,amp(i),phase(i),pfac,ime
endif
enddo enddo
call ccspectrum(spectrum,nsamples) call ccspectrum(spectrum,nsamples)
call tf_dfork(nsamples,spectrum,1.d0) call tf_dfork(nsamples,spectrum,sigtotime)
fac=sqrt(float(nsamples))*df*pi2 fac=sqrt(float(nsamples))*df*pi2
do i=1,nsamples do i=1,nsamples
fdata(i)=real(spectrum(i))*fac fdata(i)=real(spectrum(i))*fac
enddo enddo
print *,'d6',nsamples
if (overwrite) call sff_New(lu,filename,i) if (overwrite) call sff_New(lu,filename,i)
print *,'d7',nsamples
call sffu_simpleopen(lu,filename) call sffu_simpleopen(lu,filename)
print *,'d8',nsamples
call sffu_simplewrite(lu, .true., fdata, nsamples, call sffu_simplewrite(lu, .true., fdata, nsamples,
& sngl(dt), sngl(t0)) & sngl(dt), sngl(t0))
print *,'d9',nsamples
c c
stop stop
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