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

neue bunte Optionen fuer grepg

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: 173
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 4f9253c2
......@@ -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_contr.o grepg_prepcol.o
make.incdep: *.f
incdep > make.incdep
......
......@@ -60,6 +60,11 @@ c * and average removal
c * and contrast manipulation
c V2.17 10/04/00 switching of real and imag part polynomial fit
c V2.18 12/04/00 introduced option -d (pick curve background)
c V2.19 23/05/00 * introduced RGB-color foreground
c * only use pgimag now
c * you may select either HLS interpolation or RGB
c interpolation
c * you may specify a background for color ramp
c
c======================================================================
program grepg
......@@ -73,7 +78,7 @@ c
character titleformat*130
c program version:
character*79 version
parameter(version='GREPG V2.18 plot green amplitudes')
parameter(version='GREPG V2.19 plot green amplitudes')
c declare variables for io
character*80 filename
......@@ -108,7 +113,6 @@ c declare internal variables
real du, pi2
character*120 title, xlabel, ylabel
real transform(6)
integer maxcol,mincol
c lower limit for plot values
double precision lowlimit
parameter(lowlimit=1.e-20)
......@@ -127,7 +131,7 @@ c cursor routine
real pickdx
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=37)
parameter(maxopt=40)
character*2 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -136,10 +140,11 @@ c commandline
logical implot, replot, aliaspick, plinear, suppress, gmtoutput
logical readpickfile, verbose, whitepaper, deftitle, defxlab, defylab
logical phasecolor,phaseswitch,conlab,moveavg,polytrend,avgtrend
logical inccontr
logical inccontr, setforeground, setbackground, hlsinterpol
real linelength, tracedx, charheight, contrth, contrord
real tenpower, scalingslim, normvalue, normlimit
real phaseshift,grayify
real phaseshift,grayify, rgb_red, rgb_green, rgb_blue
real rgbb_red, rgbb_green, rgbb_blue
integer setlinewidth, avglength, npolytrend, npolymode
character*80 gmtxyzfile, pickfile, titlestring
character*80 xlabelstring, ylabelstring, wedgestring, phasestring
......@@ -160,14 +165,15 @@ c phase function pi constant
c here are the keys to our commandline options
data optid/2h-d,2h-i,2h-c,2h-r,2h-q,2h-p,2h-g,2h-l,2h-D,2h-s,2h-I,2h-R,
& 2h-P,2h-L,2h-S,2h-m,2h-G,2h-H,2h-F,2h-v,2h-N,2h-T,2h-W,2h-X,2h-Y,
& 2h-n,2h-A,2h-M,2h-C,2h-B,2h-a,2h-O,2h-f,2h-t,2h-Q,2h-K,2h-b/
& 2h-n,2h-A,2h-M,2h-C,2h-B,2h-a,2h-O,2h-f,2h-t,2h-Q,2h-K,2h-b,2h-x,
& 2h-y,2h-h/
data opthasarg/.TRUE.,2*.FALSE.,.TRUE.,.FALSE.,.TRUE.,.FALSE.,.TRUE.,
& 7*.FALSE.,4*.TRUE.,.FALSE.,2*.TRUE.,.FALSE.,5*.TRUE.,.FALSE.,
& 5*.TRUE.,.FALSE.,2*.TRUE./
& 5*.TRUE.,.FALSE.,4*.TRUE.,.FALSE./
data optarg/3hx11,2*1h-,5h1.,1.,1h-,3h2.5,1h-,1h1,7*1h-,2h0.,
& 7hxyz.out,2h1.,2*1h-,5h5.,4.,5htitle,1h-,6hxlabel,6hylabel,3h-1.,
& 9hamplitude,2h0.,1h-,9hphase [],6h0.,10.,7h20,10,2,1h9,3h6,1,1h-,
& 6h4.,0.3,2h3./
& 6h4.,0.3,2h3.,2*8h0.,0.,0.,1h-/
c======================================================================
c give basic information
......@@ -185,7 +191,7 @@ c give basic information
print *,
&' [-O i,m,s] [-a a,g] [-f n] [-t n,m] [-Q}'
print *,
&' [-K o,t] [-b width]'
&' [-K o,t] [-b width] [-x R,G,B] [-y R,G,B] [-h]'
print *,
&'or: grepg -help'
if (iargc().lt.1) stop 'ERROR: missing arguments'
......@@ -291,6 +297,9 @@ c give basic information
print *,' -Y label define y-label for plot'
print *,' -A label define amplitude wedge annotation label for plot'
print *,' -B label define phase wedge annotation label for plot'
print *,' -x R,G,B set foreground color to RGB-value'
print *,' -y R,G,B set background color for color ramp to RGB-value'
print *,' -h use HLS interpolation for color ramp'
print *,' '
print *,'additional information to be plotted'
print *,'------------------------------------'
......@@ -425,6 +434,11 @@ c
read(optarg(36), *) contrord, contrth
plflag_bgcurve=optset(37)
read(optarg(37), *) plpar_bgcurvewidth
setforeground=optset(38)
read(optarg(38), *) rgb_red,rgb_green,rgb_blue
setbackground=optset(39)
read(optarg(39), *) rgbb_red,rgbb_green,rgbb_blue
hlsinterpol=optset(40)
c
c covariances
if (replot) implot=.false.
......@@ -788,20 +802,21 @@ c
call pgscr(1, 0.,0.,0.)
endif
c
c set foreground color
c -------------------
if (setforeground) then
call pgscr(1, rgb_red, rgb_green, rgb_blue)
endif
c
c prepare color table for phase gray shading plot
c -----------------------------------------------
c
if (phaseswitch) then
call pgqcir(mincol,maxcol)
if (maxcol.lt.(mincol+5)) stop 'ERROR: too few colors available'
do i=mincol,maxcol
value=2.*pi*float(i-mincol)/float(maxcol-mincol)+phaseshift*pi/180.
value=0.5*(1.+cos(value))*grayify
if (whitepaper) then
value=1.-value
endif
call pgscr(i,value,value,value)
enddo
if (setbackground) call pgscr(0, rgbb_red, rgbb_green, rgbb_blue)
call grepg_prepcol(phaseswitch,phaseshift,grayify,hlsinterpol)
if (whitepaper) then
call pgscr(0, 1.,1.,1.)
else
call pgscr(0, 0.,0.,0.)
endif
c
c ---------------------
......@@ -875,13 +890,13 @@ c
& 360., phasestring, whitepaper)
elseif (plinear) then
print *,'plot linear grayscale amplitude data...'
call pgwedg('RG', 0.3, 3., maxvalue,
& minvalue, wedgestring)
call pgwedg('RI', 0.3, 3., minvalue,
& maxvalue, wedgestring)
else
c we use our own wedge for logarithmic scales
print *,'plot log10 grayscale amplitude data...'
call tf_pglogwedg('RG', 0.3, 3., maxvalue,
& minvalue, wedgestring)
call tf_pglogwedg('RI', 0.3, 3., minvalue,
& maxvalue, wedgestring)
endif
call pgupdt
c
......@@ -901,9 +916,9 @@ c
& 0., 360., transform)
else
print *,'plotting amplitude grayscale...'
call pggray(plotdata, maxslo, maxfreq,
call pgimag(plotdata, maxslo, maxfreq,
& 1, plotslo, 1, plotfreq,
& maxvalue, minvalue, transform)
& minvalue, maxvalue, transform)
endif
if (gmtoutput) then
print *,'write GMT xyz-file ',
......
......@@ -6,6 +6,16 @@ c 14/10/99 by Thomas Forbriger (IfG Stuttgart)
c
c plot color wedge
c Just copied from TJP-Code
c
c NOTICE: meanings of I ang G flags have changed here:
c I: plot wedge for full color phase and amplitude plot by using the HUE
c value to represent the phase angle
c G: use selfmade color map to represent angle values from 0. to 360. deg.
c
c They main purpose of this routine is to:
c 1. provide the full color phase angle wedge
c 2. to create a wedge with axis labels suitable for the range from 0. to
c 360. (i.e. stepwidth of major tick marks is 45.)
c
c REVISIONS and CHANGES
c 14/10/99 V1.0 Thomas Forbriger
......
c this is <grepg_prepcol.f>
c------------------------------------------------------------------------------
cS
c ($Source: /home/tforb/svnbuild/cvssource/CVS/thof/src/green/grepg/grepg_prepcol.f,v $)
c ($Id: grepg_prepcol.f,v 1.1 2000-05-23 18:34:26 thof Exp $)
c
c 23/05/2000 by Thomas Forbriger (IfG Stuttgart)
c
c prepare colors
c
c REVISIONS and CHANGES
c 23/05/2000 V1.0 Thomas Forbriger
c
c==============================================================================
c
subroutine grepg_prepcol(pswitch,pshift,grayfac,hlssystem)
c
c declare parameters
c pswtich: create a phase plotting scale
c pshift: phaseshift value
c grayfac: grayify value
c hlssystem: use hls system for color mapping
c
logical pswitch,hlssystem
real pshift, grayfac
c
cE
c declare local variables
integer mincol, maxcol, i
real value, r,g,b,hm,lm,sm,hd,ld,sd,h,l,s,pi
parameter(pi=3.141592653589793115997963468)
character*(*) grepg_prepcol_id
parameter (grepg_prepcol_id='$Id: grepg_prepcol.f,v 1.1 2000-05-23 18:34:26 thof Exp $')
c
c------------------------------------------------------------------------------
c go
call pgqcir(mincol,maxcol)
if (maxcol.lt.(mincol+5)) stop 'ERROR: too few colors available'
if (hlssystem) then
call pgqcr(0,r,g,b)
call grxhls(r,g,b,hm,lm,sm)
call pgqcr(1,r,g,b)
call grxhls(r,g,b,hd,ld,sd)
else
call pgqcr(0,hm,lm,sm)
call pgqcr(1,hd,ld,sd)
endif
hd=hd-hm
ld=ld-lm
sd=sd-sm
do i=mincol,maxcol
if (pswitch) then
value=2.*pi*float(i-mincol)/float(maxcol-mincol)+pshift*pi/180.
value=0.5*(1.+cos(value))*grayfac
else
value=float(i-mincol)/float(maxcol-mincol)
endif
h=value*hd+hm
l=value*ld+lm
s=value*sd+sm
if (hlssystem) then
call pgshls(i,h,l,s)
else
call pgscr(i,h,l,s)
endif
enddo
c
return
c the following line prevents the linker from removing the ID string
99 print *, grepg_prepcol_id
end
c
c ----- END OF grepg_prepcol.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