Commit 6497766b authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

first version of phasor plot

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: 926
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent e9522391
......@@ -13,7 +13,7 @@ CFLAGS=-O2
GREBOBS=grepg.o grepg_message.o grepg_dopicks.o grepg_selstyle.o \
grepg_phase.o grepg_phasewedg.o grepg_poly.o grepg_remavg.o \
grepg_contr.o grepg_prepcol.o grepg_readfourier.o
grepg_contr.o grepg_prepcol.o grepg_readfourier.o grepg_phasor.o
make.incdep: *.f
incdep > make.incdep
......
c this is file <grepg.f>
c======================================================================
c $Id: grepg.f,v 1.26 2002-09-13 21:05:02 forbrig Exp $
c $Id: grepg.f,v 1.27 2002-09-13 22:02:01 forbrig Exp $
c
c GREPG.F
c
......@@ -88,6 +88,7 @@ c V2.33a 02/04/02 give more specific error messages
c V2.34 19/05/02 allow plots matching different Fourier transform sign
c conventions
c V2.35 13/09/02 phasor walkout from Fourier data
c V2.35a no provide phasor walkout pick
c
c======================================================================
program grepg
......@@ -101,11 +102,11 @@ c
character titleformat*130
c program version:
character*79 version
parameter(version='GREPG V2.35 plot green amplitudes')
parameter(version='GREPG V2.35a plot green amplitudes')
character*120 CVS_VERSION
parameter(CVS_VERSION=
& '$Id: grepg.f,v 1.26 2002-09-13 21:05:02 forbrig Exp $')
& '$Id: grepg.f,v 1.27 2002-09-13 22:02:01 forbrig Exp $')
c declare variables for io
character*80 filename
......@@ -422,6 +423,7 @@ c give basic information
print *,' <SPACE>, <r>: replot'
print *,' <right button>, <X>, <x>: exit'
print *,' <c>: plot a cross-section'
print *,' <w>: plot a phasor walkout'
print *,' <l>: read dispersion curves'
print *,' <s>: save dispersion curves'
print *,' <1>, <2>, <3>, <4>, <5>,'
......@@ -590,7 +592,8 @@ c
call grepg_pickinit
if (readpickfile) call grepg_readpicks(pickfile)
c
hints='active keys: <p,P,x,X,r,d,D,c,1,2,3,4,5,6,7,8,9,0,h,l,s,b>'
hints=
& 'active keys: <p,P,x,X,r,d,D,c,w,1,2,3,4,5,6,7,8,9,0,h,l,s,b>'
write (pickhint, 51) active_pick
c
c----------------------------------------------------------------------
......@@ -1258,6 +1261,14 @@ c print *,'startfreq is ',startfreq
call pgsci(1)
call pgslw(1)
call pgupdt
c plot phasor walkout
elseif (cub.eq.'w') then
extdev=pgp_open(outdevice)
if (extdev.gt.0) then
call grepg_phasor(cux,cuy)
call pgclos
endif
call pgslct(maindev)
c plot cross section
elseif (cub.eq.'c') then
ifreq=max(1,min(nfreq,int((nfreq-1)*(cux-minf)/(maxf-minf))))
......
c this is <grepg_phasor.f>
c ----------------------------------------------------------------------------
c ($Id: grepg_phasor.f,v 1.1 2002-09-13 21:08:43 forbrig Exp $)
c ($Id: grepg_phasor.f,v 1.2 2002-09-13 22:02:02 forbrig Exp $)
c
c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
c
......@@ -11,5 +11,60 @@ c 13/09/2002 V1.0 Thomas Forbriger
c
c ============================================================================
c
subroutine grepg_phasor(freq,slow)
c
real freq,slow
c
include 'grepg_fourier.inc'
c
complex phasor(0:fmaxtr)
real x(0:fmaxtr),y(0:fmaxtr)
real maxx,minx,maxy,miny
integer i, ifreq
real freqdist
complex ime
parameter (ime=(0.,1.))
c
real pi2
parameter (pi2=2.*3.141592653589793)
c
print *,'phasor walkout test at ',freq,' Hz and ',slow,' s/km'
c
freqdist=fom(fnom)
ifreq=fnom
do i=1,fnom
if (freqdist.gt.abs(freq-fom(i)/pi2)) then
ifreq=i
freqdist=abs(freq-fom(i)/pi2)
endif
enddo
print *,' true frequency: ',fom(ifreq)/pi2,' Hz'
c
phasor(0)=(0.,0.)
x(0)=0.
y(0)=0.
minx=0.
maxx=0.
miny=0.
maxy=0.
do i=1,fntr
phasor(i)=phasor(i-1)+
& fourier(i,ifreq)*exp(ime*fom(ifreq)*slow*1.e-3*foffs(i))
x(i)=real(phasor(i))
y(i)=aimag(phasor(i))
minx=min(minx,x(i))
maxx=max(maxx,x(i))
miny=min(miny,y(i))
maxy=max(maxy,y(i))
enddo
call pgenv(minx,maxx,miny,maxy,0,2)
call pgsave
call pgline(fntr+1,x,y)
call pgsci(2)
call pgline(fntr/2,x,y)
call pgunsa
c
return
end
c
c ----- END OF grepg_phasor.f -----
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