| Title: | Seismic Time Series Analysis Tools |
|---|---|
| Description: | Multiple interactive codes to view and analyze seismic data, via spectrum analysis, wavelet transforms, particle motion, hodograms. Includes general time-series tools, plotting, filtering, interactive display. |
| Authors: | Jonathan M. Lees [aut, cre], Jake Anderson [ctb], Leonard Lisapaly [ctb], Dave Harris [aut, cph] |
| Maintainer: | Jonathan M. Lees <[email protected]> |
| License: | GPL (>= 2) |
| Version: | 4.2-4 |
| Built: | 2025-02-10 03:43:39 UTC |
| Source: | https://github.com/cran/RSEIS |
Multiple interactive codes to view and analyze seismic data, via spectrum analysis, wavelet transforms, particle motion, hodograms. Includes general time-series tools, plotting, filtering, interactive display.
JGET.seis view.seis swig Mine.seis VELOCITY.SEISN DISPLACE.SEISN ZOOM.SEISN wlet.drive SENSORsensitivity PLOT.MATN PLOT.SEISN PLOT.TTCURVE PLOT.ALLPX plotevol MTMdisp MTMplot NEW.getUWSTAS NEWPLOT.WPX INSTFREQS INSTresponse GLUE.GET.seis GLUEseisMAT FILT.SEISN FILT.spread CHOP.SEISN get.corner grotseis
Put1Dvel Ray.time1D setLQUAKE selAPX Get1Dvel Comp1Dvel Comp1Dvels travel.time1D
hodogram PMOT.drive complex.hodo addpoints.hodo idpoints.hodo DO.PMOT.ARR partmotnet prep1wig prepSEIS EmptySEIS GAZI
xcor2 wlet.drive wlet.do wiggle.env plotwlet STLTcurve SPECT.drive rsspec.taper evolfft GETARAIC PSTLTcurve getphaselag2 envelope hilbert LocalUnwrap lagplot applytaper autoreg butfilt choosfilt MTM.drive
yeardate YRsecdif Zdate recdatel recdate tojul getjul getmoday secdifL secdif secdifv JtimL Jtim fromjul
plocator ilocator meshgrid ymarginfo zlocator winmark vline screens RESCALE pwlet2freqs addtix circle circ letter.it jpostscript JBLACK JGRAY HOZscale gaddtix Gcols jlegend tomo.colors
BKpfile2ypx brune.doom brune.func brune.search comp.env contwlet deconinst detail.pick rdistaz rDUMPLOC EmptyPickfile ETECTG finteg fixcompname fixcomps fixUWstasLL fmod FRWDft getb1b2 getNcard getpfile getseisinfo getvertsorder gpoly GreatDist gwpix2ypx hilow hypot integ1 INVRft itoxyz jadjust.length jpolyval jstats local.file logspace makefreq mirror.matrix Mmorlet mtapspec peaks PICK.DOC pickit plt.MTM0 PLTpicks PPIX PreSet.Instr ReadSet.Instr readUW.OSTAS scal2freqs SEARCHPIX setstas setwelch shade.col SNET.drive T12.pix Thresh.J TOCART trapz tung.pulse unpackAcard uwpfile2ypx
Jonathan M. Lees<jonathan.lees.edu> Maintainer:Jonathan M. Lees<jonathan.lees.edu>
RPGM, RFOC
data("GH") swig(GH)data("GH") swig(GH)
Add points to a hodogram plot
addpoints.hodo(nbaz, dt, sx, flag = 1:10, pch = 3, col = 1)addpoints.hodo(nbaz, dt, sx, flag = 1:10, pch = 3, col = 1)
nbaz |
matrix 3 by n |
dt |
sample interval, s |
sx |
x vector |
flag |
output of idpoints.hodo |
pch |
plot character |
col |
color for plotting |
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
PMOT.drive, idpoints.hodo
Add tick marks to edge of plot
addtix(side = 3, pos = 0, tck = 0.005, at =c(0, 1), labels = FALSE, col = 2, ...)addtix(side = 3, pos = 0, tck = 0.005, at =c(0, 1), labels = FALSE, col = 2, ...)
side |
side of plot 1-4 |
pos |
position relative to side |
tck |
tick size |
at |
locations along axis |
labels |
labels for tics |
col |
color for ticks |
... |
graphical parameters, par |
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
par
Add one pick to WPX file
addWPX(WPX, ppx)addWPX(WPX, ppx)
WPX |
WPX list |
ppx |
WPX list |
Adds one pick to end of list.
WPX list
Uses, the last pick as a reference.
Jonathan M. Lees<[email protected]>
catWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s3 <- addWPX(s1, s2)s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s3 <- addWPX(s1, s2)
Apply taper to ends of a time series for spectrum analysis.
applytaper(f, p = 0.05)applytaper(f, p = 0.05)
f |
signal |
p |
percent taper |
10 percent taper is 5 percent on each end.
Tapered time series.
Jonathan M. Lees<jonathan.lees.edu>
data(CE1) Xamp <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] Tamp <- applytaper(Xamp, p = 0.05)data(CE1) Xamp <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] Tamp <- applytaper(Xamp, p = 0.05)
Write RSEIS list to a file in ASCII format.
ASCII.SEISN(GH, sel = 1, HEAD = TRUE, destdir='.' )ASCII.SEISN(GH, sel = 1, HEAD = TRUE, destdir='.' )
GH |
RSEIS list |
sel |
vector, select which ttraces to write |
HEAD |
logical, TRUE will put a header in the file |
destdir |
character, path to folder to deposit output file |
Used for data exchange for users who do not want to use RSEIS. The header consists of one line start date (yr, jd, hr, min, sec) and sample rate (dt).
Side effects - files are created.
Jonathan M. Lees<[email protected]>
## Not run: ##### this example creates an ascii version of the ##### seismic data for exchange purposes data("GH") tempd = tempdir() sel <- which(GH$COMPS == "V" & GH$STNS=="CE1" ) ASCII.SEISN(GH, sel = 1, HEAD = TRUE, destdir=tempd) ## End(Not run)## Not run: ##### this example creates an ascii version of the ##### seismic data for exchange purposes data("GH") tempd = tempdir() sel <- which(GH$COMPS == "V" & GH$STNS=="CE1" ) ASCII.SEISN(GH, sel = 1, HEAD = TRUE, destdir=tempd) ## End(Not run)
Set a time window in Epoch days for extraction from a DB file
attime12(t1, t2 = t1, origyr = 1972, pre = 0, post = 0)attime12(t1, t2 = t1, origyr = 1972, pre = 0, post = 0)
t1 |
list date-time 1 |
t2 |
list date-time 2 |
origyr |
origin year |
pre |
seconds before time 1 |
post |
seconds afer time 2 |
If t2 is missing, t1=t2.
vector |
c(t1, t2) |
Jonathan M. Lees<[email protected]>
j1 <- list(yr = 2005, jd= 214 , hr= 7 , mi= 1 ,sec= 0.5235) j2 <- list(yr=2005, jd= 214 , hr= 7 , mi= 1 ,sec= 0.5235+6) at <- attime12(j1, t2=j1, origyr=2005, pre=100, post=100) ### given an RSEIS format list data(GH) AT = SEISNtime(GH) ats = attime12(AT[[1]], t2 = AT[[2]], origyr =AT[[1]]$yr , pre = 0, post= 0)j1 <- list(yr = 2005, jd= 214 , hr= 7 , mi= 1 ,sec= 0.5235) j2 <- list(yr=2005, jd= 214 , hr= 7 , mi= 1 ,sec= 0.5235+6) at <- attime12(j1, t2=j1, origyr=2005, pre=100, post=100) ### given an RSEIS format list data(GH) AT = SEISNtime(GH) ats = attime12(AT[[1]], t2 = AT[[2]], origyr =AT[[1]]$yr , pre = 0, post= 0)
Design and apply butterworth low/high/band pass filters with augmentation of the signal on either end to suppress edge effects.
AUGMENTbutfilt(a, fl = 0, fh = 0.5, deltat = 1, type = "BP", proto = "BU", npoles = 5, chebstop = 30, trbndw = 0.3, RM = FALSE, zp = TRUE, pct = 0.1)AUGMENTbutfilt(a, fl = 0, fh = 0.5, deltat = 1, type = "BP", proto = "BU", npoles = 5, chebstop = 30, trbndw = 0.3, RM = FALSE, zp = TRUE, pct = 0.1)
a |
vector signal |
fl |
low frequency cut-off, default=0 |
fh |
high frequency cut-off, DEFAULT= (1/2dt) |
deltat |
sample rate, s, deFAULT=1 |
type |
type of filter, one of c("LP", "HP","BP" ,"BR" ), DEFAULT="BP" |
proto |
prototype, c("BU", "BE" , "C1" ,"C2"), DEFAULT="BU" |
npoles |
number of poles or order, DEFAULT=5 |
chebstop |
Chebyshev stop band attenuation, DEFAULT=30.0 |
trbndw |
Chebyshev transition bandwidth, DEFAULT=0.3 |
RM |
Remove mean value from trace, default=FALSE |
zp |
zero phase filter, default=TRUE |
pct |
Percent augmentation applied to each side, default=0.1 |
Creation of butfilt is a described by the following arguments:
low pass
high pass
band pass
band reject
Butterworth
Bessel
Chebyshev type 1
Chebyshev type 2
Arguments chebstop , trbndw are ignored for non-chebyshev filters. LP and HP filters are seet by specifying fl for HP filters and fh for LP filters, the other argumentin each case is ignored.
Mean values should be removed prior to calling this function, and then set RM=FALSE. This is true especially if tapering is applied prior to filtering.
Zero phase filter is achived by running filter back and forth. Otherwise a single pass is returned. This should be equivalent to package signal filtfilt (from MATLAB).
Augmentation involves copying the first and last percent of the signal, reversiing the time and adding to the signal on each end. This is then filtered, and removed after filter is complete. It is assumed that the important part of the signal is in the center of the time series and the edges are less critical. Then the augmented part has the same statistical content as the edges of the signal (presumably noise) and will not affect the filtered signal considerably. This is then thrown away prior to return.
Filtered time series with the augmentation removed after filter.
Jonathan M. Lees<jonathan.lees.edu>
butfilt
data(CE1) ts1 <- CE1$y zz <- AUGMENTbutfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5 ) ############## second example with plotting data(KH, package ='RSEIS' ) w = KH$JSTR[[1]] dt = KH$dt[1] x = seq(from=0, by=dt, length=length(w)); plot(x,w, type='l') par(mfrow=c(2,1) ) i=1 fl = 1/50 fh= 1/2 ftype = 'BP' ########## normal band pass filter zz = butfilt(w, fl, fh, dt, ftype , "BU") f.stamp = filterstamp(fl=fl, fh=fh, type=ftype) plot(x, zz, type='l', xlab='s', ylab='amp', main= f.stamp) title(sub='butfilt') #### zz1 = AUGMENTbutfilt(w, fl, fh, dt, type=ftype , proto="BU", zp=TRUE, pct=0.2 ) f.stamp = filterstamp(fl=fl, fh=fh, type=ftype) plot(x, zz1, type='l', xlab='s', ylab='amp', main= f.stamp) title(sub='AUGMENTbutfilt')data(CE1) ts1 <- CE1$y zz <- AUGMENTbutfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5 ) ############## second example with plotting data(KH, package ='RSEIS' ) w = KH$JSTR[[1]] dt = KH$dt[1] x = seq(from=0, by=dt, length=length(w)); plot(x,w, type='l') par(mfrow=c(2,1) ) i=1 fl = 1/50 fh= 1/2 ftype = 'BP' ########## normal band pass filter zz = butfilt(w, fl, fh, dt, ftype , "BU") f.stamp = filterstamp(fl=fl, fh=fh, type=ftype) plot(x, zz, type='l', xlab='s', ylab='amp', main= f.stamp) title(sub='butfilt') #### zz1 = AUGMENTbutfilt(w, fl, fh, dt, type=ftype , proto="BU", zp=TRUE, pct=0.2 ) f.stamp = filterstamp(fl=fl, fh=fh, type=ftype) plot(x, zz1, type='l', xlab='s', ylab='amp', main= f.stamp) title(sub='AUGMENTbutfilt')
Auto-Regressive Spectrum Estimate
autoreg(a, numf = 1024, pord = 100, PLOT = FALSE, f1 = 0.01, f2 = 50)autoreg(a, numf = 1024, pord = 100, PLOT = FALSE, f1 = 0.01, f2 = 50)
a |
signal |
numf |
number of frequency points to calculate |
pord |
order |
PLOT |
logical, TRUE=plot |
f1 |
low frequency |
f2 |
high frequency |
LIST:
amp |
amplitudes |
freq |
frequencies, Hz |
Jonathan M. Lees<jonathan.lees.edu>
fft, mtapspec, plt.MTM0
data(CE1) Xamp <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] ZIM <- autoreg(Xamp , numf=length(Xamp) , pord = 100, PLOT=FALSE, f1=.01, f2=50)data(CE1) Xamp <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] ZIM <- autoreg(Xamp , numf=length(Xamp) , pord = 100, PLOT=FALSE, f1=.01, f2=50)
Modeling the Brune spectrum with Graphical Diagnostics
brune.doom(amp, dt = 1, f1 = 0.01, f2 = 15, PLOTB = FALSE, tit = "")brune.doom(amp, dt = 1, f1 = 0.01, f2 = 15, PLOTB = FALSE, tit = "")
amp |
signal |
dt |
deltaT |
f1 |
low frequency for modeling |
f2 |
high frequency for modeling |
PLOTB |
logical, TRUE=show diagnostic plots |
tit |
title for plot |
List:
SUCCESS |
(0,1) for success or failure of modeling |
WARN |
flag = "OK" |
tstar0 |
tstar0 |
gamma |
gamma |
omega0 |
omega0 |
fc |
fc |
alpha |
alpha |
chisqrd |
chi-squared misfit over region of fitting |
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and G. T. Lindley (1994): Three-dimensional Attenuation Tomography at Loma Prieta:Inverting t* for Q, J. Geophys. Res., 99(B4), 6843-6863.
data(CE1) plot(CE1$x, CE1$y, type='l') Xamp = CE1$y[CE1$x>5.443754 & CE1$x<5.615951] BF = brune.doom( Xamp, CE1$dt ,f1=.5, f2=12 , PLOTB = TRUE)data(CE1) plot(CE1$x, CE1$y, type='l') Xamp = CE1$y[CE1$x>5.443754 & CE1$x<5.615951] BF = brune.doom( Xamp, CE1$dt ,f1=.5, f2=12 , PLOTB = TRUE)
Calculate Forward Brune model
brune.func(freq, omega0, tstar0, fc, alpha, gamma)brune.func(freq, omega0, tstar0, fc, alpha, gamma)
freq |
frequency vector |
omega0 |
low freq asymptote |
tstar0 |
T-star value |
fc |
corner frequency |
alpha |
alpha parameter |
gamma |
gamma parameter |
Brune model.
returns displacement spectrum from given parameters
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and G. T. Lindley (1994): Three-dimensional Attenuation Tomography at Loma Prieta:Inverting t* for Q, J. Geophys. Res., 99(B4), 6843-6863.
brune.doom
Model of the spectrum of a seismic arrival. Uses Brune's Model.
brune.search(infreq, inspec, f1, f2, omega0, fcorn, tstar0, gamma)brune.search(infreq, inspec, f1, f2, omega0, fcorn, tstar0, gamma)
infreq |
vector of frequencies |
inspec |
spectrum |
f1 |
low frequency, Hz |
f2 |
high frequency, Hz |
omega0 |
initial starting low frequency asymptote |
fcorn |
initial starting corner frequency |
tstar0 |
initial starting t* |
gamma |
initial starting gamma |
see paper by Lees and Lindley
list(omega0=omega0,tstar0=tstar3[3] , fc=fcorn, alpha=0, gamma=gam3[3])
omega0 |
low frequency asymptote |
fc |
corner frequency |
tstar0 |
t* |
gamma |
gamma |
alpha |
alpha parameter |
chisqrd |
chi-squared misfit over region of fitting |
Jonathan M. Lees<jonathan.lees.edu>
Lees and Lindley
MTM
data(CE1) #### set frequency range for modeling f1 <- 0.01 f2 <- 14.0 ## set up data and parameters amp <- CE1$y len2 <- 2*next2(length(amp)) a <- list(y=amp, dt=CE1$dt) Spec <- MTMdisp(a, f1=f1, f2=f2, len2=len2, PLOT=FALSE ) lspec <- Spec$displ ### get initial estimate of parameters xc <- get.corner( Spec$f , lspec, dt, f1, f2, PLOT=FALSE) jmod <- brune.search(Spec$f, lspec, f1, f2, xc$omega0, xc$corn, xc$tstar0, 2.0)data(CE1) #### set frequency range for modeling f1 <- 0.01 f2 <- 14.0 ## set up data and parameters amp <- CE1$y len2 <- 2*next2(length(amp)) a <- list(y=amp, dt=CE1$dt) Spec <- MTMdisp(a, f1=f1, f2=f2, len2=len2, PLOT=FALSE ) lspec <- Spec$displ ### get initial estimate of parameters xc <- get.corner( Spec$f , lspec, dt, f1, f2, PLOT=FALSE) jmod <- brune.search(Spec$f, lspec, f1, f2, xc$omega0, xc$corn, xc$tstar0, 2.0)
Design and apply butterworth low/high/band pass filters.
butfilt(a, fl=0, fh=0.5, deltat=1, type="BP", proto="BU", npoles=5, chebstop=30.0, trbndw=0.3, RM=FALSE, zp=TRUE )butfilt(a, fl=0, fh=0.5, deltat=1, type="BP", proto="BU", npoles=5, chebstop=30.0, trbndw=0.3, RM=FALSE, zp=TRUE )
a |
vector signal |
fl |
low frequency cut-off, default=0 |
fh |
high frequency cut-off, DEFAULT= (1/2dt) |
deltat |
sample rate, s, deFAULT=1 |
type |
type of filter, one of c("LP", "HP","BP" ,"BR" ), DEFAULT="BP" |
proto |
prototype, c("BU", "BE" , "C1" ,"C2"), DEFAULT="BU" |
npoles |
number of poles or order, DEFAULT=5 |
chebstop |
Chebyshev stop band attenuation, DEFAULT=30.0 |
trbndw |
Chebyshev transition bandwidth, DEFAULT=0.3 |
RM |
Remove mean value from trace, default=FALSE |
zp |
zero phase filter, default=TRUE |
Creation of butfilt is a described by the following arguments:
low pass
high pass
band pass
band reject
Butterworth
Bessel
Chebyshev type 1
Chebyshev type 2
Arguments chebstop , trbndw are ignored for non-chebyshev filters. LP and HP filters are seet by specifying fl for HP filters and fh for LP filters, the other argumentin each case is ignored.
Mean values should be removed prior to calling this function, and then set RM=FALSE. This is true especially if tapering is applied prior to filtering.
Zero phase filter is achived by running filter back and forth. Otherwise a single pass is returned. This should be equivalent to package signal filtfilt (from MATLAB).
Filtered time series.
originally written in FORTRAN by David Harris, converted to C and modified by Jonathan M. Lees<[email protected]>
Harris, D., 1990: XAPiir: A recursive digital filtering package. United States: N. p., Web. doi:10.2172/6416972.
AUGMENTbutfilt
data(CE1) ts1 <- CE1$y zz <- butfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5 ) ### try plotting: ### the above, by default, is zero phase. ##### next filter with non-zero-phase z2 <- butfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5, zp=FALSE ) ex = seq(from=0, by=CE1$dt, length=length(ts1)) plot(ex, ts1, type='l') lines(ex, zz, col='red') lines(ex, z2, col='blue') plot(ex[ex<0.5], ts1[ex<0.5], type='l') lines(ex[ex<0.5], zz[ex<0.5], col='red') lines(ex[ex<0.5], z2[ex<0.5], col='blue')data(CE1) ts1 <- CE1$y zz <- butfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5 ) ### try plotting: ### the above, by default, is zero phase. ##### next filter with non-zero-phase z2 <- butfilt(ts1, fl=1, fh=15, deltat=CE1$dt, type="LP" , proto="BU", npoles=5, zp=FALSE ) ex = seq(from=0, by=CE1$dt, length=length(ts1)) plot(ex, ts1, type='l') lines(ex, zz, col='red') lines(ex, z2, col='blue') plot(ex[ex<0.5], ts1[ex<0.5], type='l') lines(ex[ex<0.5], zz[ex<0.5], col='red') lines(ex[ex<0.5], z2[ex<0.5], col='blue')
Replot Function for SELBUT
BUTREPLOT(opts, ncol = 5, HOZ = TRUE, TOP = TRUE, cols = "white", main = "", xlim = c(0, 1), ylim = c(0, 1), newplot = TRUE)BUTREPLOT(opts, ncol = 5, HOZ = TRUE, TOP = TRUE, cols = "white", main = "", xlim = c(0, 1), ylim = c(0, 1), newplot = TRUE)
opts |
character list of options |
ncol |
number of columns |
HOZ |
logical, TRUE=plot horizontally |
TOP |
logical, TRUE=plot top-down |
cols |
colors |
main |
character title |
xlim |
x-limits in plotting region (user coordinates) |
ylim |
y-limits in plotting region (user coordinates) |
newplot |
logical, new plot? |
Used internally in SELBUT as a replotting function
list
M |
x,y matrix of grid |
dx |
delta x |
dy |
delta y |
rx |
range of x |
ry |
range of y |
Jonathan M. Lees<[email protected]>
SELBUT, swig
STDLAB <- c("DONE", "QUIT", "zoom.out", "zoom.in", "SELBUT", "FILT","UNFILT", "PSEL", "SGRAM", "WLET", "SPEC", "XTR" ) BUTREPLOT(STDLAB)STDLAB <- c("DONE", "QUIT", "zoom.out", "zoom.in", "SELBUT", "FILT","UNFILT", "PSEL", "SGRAM", "WLET", "SPEC", "XTR" ) BUTREPLOT(STDLAB)
Concatenate (combine) two WPX lists.
catWPX(WPX, ppx)catWPX(WPX, ppx)
WPX |
WPX list |
ppx |
WPX list |
Adds second list to the end of the first list.
WPX list
Jonathan M. Lees<[email protected]>
addWPX, setWPX, checkWPX, cleanWPX, clusterWPX, repairWPX, saveWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="BYE", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s3 <- catWPX(s1, s2)s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="BYE", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s3 <- catWPX(s1, s2)
Single Seismogram from Coso California
data(CE1)data(CE1)
list(x=0, y=0, dt=0, name ="", Tpick=0, mark ="", deltat=0)
Lees, J.M., 2004. Scattering from a fault interface in the Coso geothermal field. Journal of Volcanology and Geothermal Research, 130(1-2): 61-75.
data(CE1) plot(CE1$x, CE1$y, type='l')data(CE1) plot(CE1$x, CE1$y, type='l')
Check and verify WPX list for compliance.
checkWPX(wpx)checkWPX(wpx)
wpx |
WPX list |
Perform several checks on completeness, length of components, station names, component names and date-times of the WPX lists.
0 no problems
1 list incomplete
2 names incomplete
3 components incomplete
4 dates incomplete
No action taken in the event an error occurs - see repairWPX to fix problems.
Jonathan M. Lees<[email protected]>
addWPX,catWPX, saveWPX,cleanWPX,clusterWPX,repairWPX,setWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s1$col=NULLs1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s1$col=NULL
Choose Butterworth filter from a selection
choosfilt(thefilts = thefilts, ncol = 5)choosfilt(thefilts = thefilts, ncol = 5)
thefilts |
list of filter parameters |
ncol |
number of columns |
Used for interactive choices in swig. See example below.
filter parameter list:
ON |
logical, TRUE=filter is on |
fl |
low frequency cut-off |
fh |
high frequency cut-off |
type |
type of filter, one of c("LP", "HP","BP" ,"BR" ) |
proto |
prototype, c("BU", "BE" , "C1" ,"C2") |
Jonathan M. Lees<jonathan.lees.edu>
butfilt, RPMG
thefilts <- list(flo= c(0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 1/2, 1/50,1/100, 1/100,1,1, 0.2, 15, 5, 2,1, 100), fhi= c(1/10, 1/6, 1/5, 1/4, 1/3, 1/2, 0.2, 0.5, 1.0, 2.0, 3.0, 4.0, 7.0, 8, 1/2.0,1/5.0,1/10.0,10,5, 7.0, 100, 100, 100,10, 100), type = c("LP","LP", "LP", "LP", "LP", "LP", "LP","LP", "LP", "LP", "LP", "LP", "LP", "BP", "BP","BP","BP","BP","BP", "HP", "HP","HP", "HP","HP", "None")) if(interactive() ) choosfilt(thefilts = thefilts, ncol = 5)thefilts <- list(flo= c(0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 1/2, 1/50,1/100, 1/100,1,1, 0.2, 15, 5, 2,1, 100), fhi= c(1/10, 1/6, 1/5, 1/4, 1/3, 1/2, 0.2, 0.5, 1.0, 2.0, 3.0, 4.0, 7.0, 8, 1/2.0,1/5.0,1/10.0,10,5, 7.0, 100, 100, 100,10, 100), type = c("LP","LP", "LP", "LP", "LP", "LP", "LP","LP", "LP", "LP", "LP", "LP", "LP", "BP", "BP","BP","BP","BP","BP", "HP", "HP","HP", "HP","HP", "None")) if(interactive() ) choosfilt(thefilts = thefilts, ncol = 5)
Take a seismic structure and return a time limited version
CHOP.SEISN(GH, sel = 1:4, WIN = NULL)CHOP.SEISN(GH, sel = 1:4, WIN = NULL)
GH |
Seismic trace structure |
sel |
selection of traces |
WIN |
time window c(0,1) |
Seismic trace structure
Jonathan M. Lees<jonathan.lees.edu>
swig
data("GH") sel <- which(GH$COMPS=="V") KF <- CHOP.SEISN(GH, sel=sel, WIN = c(0 , 5) ) swig(KF, SHOWONLY=0)data("GH") sel <- which(GH$COMPS=="V") KF <- CHOP.SEISN(GH, sel=sel, WIN = c(0 , 5) ) swig(KF, SHOWONLY=0)
Draw a circle
circ()circ()
Draw a circle on new plot.
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
net
circ()circ()
Given a pickfile, clean out stations that do not ocnform
cleanpickfile(P)cleanpickfile(P)
P |
Pickfile list |
stations with name="" are removed
P |
Pickfile list |
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
P <- EmptyPickfile() cleanpickfile(P)P <- EmptyPickfile() cleanpickfile(P)
Return an empty (clean) WPX.
cleanWPX()cleanWPX()
Returns an empty list with NA's and 0's
WPX list
Used internally.
Jonathan M. Lees<[email protected]>
addWPX, catWPX, checkWPX,repairWPX,clusterWPX,saveWPX, setWPX
s0 <- cleanWPX()s0 <- cleanWPX()
Plot a seimic trace colored in time. useful for coordinating other plots to specific times along a seismic trace.
colorwig(x1, y1, COL = rainbow(100))colorwig(x1, y1, COL = rainbow(100))
x1 |
x-coordinate (time) |
y1 |
y-coordinate (amplitude) |
COL |
color palette |
Graphical Side Effects
Jonathan M. Lees<[email protected]>
data(KH) x <- KH$ex[KH$ex>95& KH$ex<125] y <- KH$JSTR[[1]][KH$ex>95& KH$ex<125] colorwig(x , y , rainbow(100))data(KH) x <- KH$ex[KH$ex>95& KH$ex<125] y <- KH$JSTR[[1]][KH$ex>95& KH$ex<125] colorwig(x , y , rainbow(100))
Combine 2 SEIS format lists into one list suitable for swig.
combineSEIS(IH, IV)combineSEIS(IH, IV)
IH |
SEIS list (swig input) |
IV |
SEIS list (swig input) |
This will take two SEIS lists and merge them into one.
SEIS list suitable for swig.
Jonathan M. Lees<[email protected]>
swig, Mine.seis, prepSEIS
####### say you have 2 databases - extract from each: ####GH = Mine.seis(at1, at2, DB1, grepsta, grepcomp, kind = -1) ####JH = Mine.seis(at1, at2, DB2, grepsta, grepcomp, kind = -1) #### merge the 2 structures data(KH) MH = KH BH = combineSEIS(KH, MH) ###### plot and interact swig(BH, SHOWONLY=TRUE )####### say you have 2 databases - extract from each: ####GH = Mine.seis(at1, at2, DB1, grepsta, grepcomp, kind = -1) ####JH = Mine.seis(at1, at2, DB2, grepsta, grepcomp, kind = -1) #### merge the 2 structures data(KH) MH = KH BH = combineSEIS(KH, MH) ###### plot and interact swig(BH, SHOWONLY=TRUE )
calculate and plot signal envelopes.
comp.env(ex, Y, PLOT = TRUE, stamps = stamps)comp.env(ex, Y, PLOT = TRUE, stamps = stamps)
ex |
x-axis |
Y |
matrix of Y values |
PLOT |
logical, TRUE=plot |
stamps |
character vectors of ids |
Takes in an common x predictor and compares the envelopes of each column in the Y matrix. All the Y's must have the same length as ex.
Graphical Side effects. returns envelope series.
Jonathan M. Lees<jonathan.lees.edu>
swig
data("GH") temp <- cbind(GH$JSTR[[1]], GH$JSTR[[2]], GH$JSTR[[3]]) atemp <- temp[1168:1500, ] ex <- seq(from=0,length=length(temp[1168:1500, 1]), by=GH$dt[1]) comp.env(ex, atemp, PLOT = TRUE, stamps = c("1","2", "3") )data("GH") temp <- cbind(GH$JSTR[[1]], GH$JSTR[[2]], GH$JSTR[[3]]) atemp <- temp[1168:1500, ] ex <- seq(from=0,length=length(temp[1168:1500, 1]), by=GH$dt[1]) comp.env(ex, atemp, PLOT = TRUE, stamps = c("1","2", "3") )
plot a pair of 1D velocity Models for comparison
Comp1Dvel(v, v2, col=c('blue', 'brown'), ...)Comp1Dvel(v, v2, col=c('blue', 'brown'), ...)
v |
List structure for model 1 |
v2 |
List structure for model 2 |
col |
2-colors for P and swave |
... |
other graphical parameters (e.g. lty, lwd) |
Graphical Side Effects
Jonathan M. Lees<[email protected]>
Plot1Dvel, Get1Dvel, travel.time1D
VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' VELNish <- list() VELNish$'zp' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vp' <- c(2.8,3.4,4.1,4.7,4.7) VELNish$'ep' <- c(0,0,0,0,0) VELNish$'zs' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vs' <- c(1.6,2,2.4,2.7,2.7) VELNish$'es' <- c(0,0,0,0,0) VELNish$'name' <- 'Nish' Comp1Dvel(VEL, VELNish)VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' VELNish <- list() VELNish$'zp' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vp' <- c(2.8,3.4,4.1,4.7,4.7) VELNish$'ep' <- c(0,0,0,0,0) VELNish$'zs' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vs' <- c(1.6,2,2.4,2.7,2.7) VELNish$'es' <- c(0,0,0,0,0) VELNish$'name' <- 'Nish' Comp1Dvel(VEL, VELNish)
Plot 1D velocity Models for comparison.
Comp1Dvels(INV, depth = 1:50)Comp1Dvels(INV, depth = 1:50)
INV |
vector of velocity models in memory |
depth |
depth range for plotting |
takes several velocity models, finds the range of all, makes a plot so that all models fit on figure.
Graphical Side Effects
Jonathan M. Lees<[email protected]>
Plot1Dvel, Comp1Dvel, Get1Dvel
VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' VELNish <- list() VELNish$'zp' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vp' <- c(2.8,3.4,4.1,4.7,4.7) VELNish$'ep' <- c(0,0,0,0,0) VELNish$'zs' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vs' <- c(1.6,2,2.4,2.7,2.7) VELNish$'es' <- c(0,0,0,0,0) VELNish$'name' <- 'Nish' Comp1Dvels(c("VEL", "VELNish"))VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' VELNish <- list() VELNish$'zp' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vp' <- c(2.8,3.4,4.1,4.7,4.7) VELNish$'ep' <- c(0,0,0,0,0) VELNish$'zs' <- c(0,0.1,0.6,1.1,21.1) VELNish$'vs' <- c(1.6,2,2.4,2.7,2.7) VELNish$'es' <- c(0,0,0,0,0) VELNish$'name' <- 'Nish' Comp1Dvels(c("VEL", "VELNish"))
HodoGram Plot
complex.hodo(nbaz, dt = dt, labs = c("Vertical", "North", "East"), COL = rainbow(100), STAMP = "")complex.hodo(nbaz, dt = dt, labs = c("Vertical", "North", "East"), COL = rainbow(100), STAMP = "")
nbaz |
n by 3 matrix |
dt |
time sample rate |
labs |
labels for the components |
COL |
color palette |
STAMP |
character stamp for identification |
sx = list graphical side effect
Jonathan M. Lees<jonathan.lees.edu>
data("GH") temp <- cbind(GH$JSTR[[1]][1168:1500], GH$JSTR[[2]][1168:1500], GH$JSTR[[3]][1168:1500]) pmolabs <- c("Vertical", "North", "East") sx <- complex.hodo(temp, dt=GH$dt[1] ,labs=pmolabs, STAMP="Example", COL=rainbow(100) )data("GH") temp <- cbind(GH$JSTR[[1]][1168:1500], GH$JSTR[[2]][1168:1500], GH$JSTR[[3]][1168:1500]) pmolabs <- c("Vertical", "North", "East") sx <- complex.hodo(temp, dt=GH$dt[1] ,labs=pmolabs, STAMP="Example", COL=rainbow(100) )
Set seismic component order
COMPorder(STNS, COMPS)COMPorder(STNS, COMPS)
STNS |
stations |
COMPS |
components |
Sets up components so they are ordered according to V, N, E. used internally in swig.
order vector
Jonathan M. Lees<[email protected]>
Contour Wavelet Transform
contwlet(baha, Ysig, dt, clev = 0.75, NLEV = 12, zscale = 1, zbound = NULL, col = col, ygrid = FALSE, WUNITS = "Volts", PEAX = NULL)contwlet(baha, Ysig, dt, clev = 0.75, NLEV = 12, zscale = 1, zbound = NULL, col = col, ygrid = FALSE, WUNITS = "Volts", PEAX = NULL)
baha |
Output of wavelet transform (image) |
Ysig |
input signal to wavelet transform |
dt |
DeltaT, sample rate |
clev |
levels for contours |
NLEV |
number of levels |
zscale |
scale of amplitudes |
zbound |
bounds for scale of interest |
col |
color for contour lines |
ygrid |
logical, TRUE=add grid lines |
WUNITS |
Units of wavelet transform |
PEAX |
peaks structure |
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
plotwlet, wlet.do, wlet.drive
Convert Seismic in SAC or SEGY format to RSEIS native format.
convert2Rseis(FLS, NEWDIR = ".", kind = 1, Iendian = "little", BIGLONG = FALSE, NEWsta = "", NEWcomp = "")convert2Rseis(FLS, NEWDIR = ".", kind = 1, Iendian = "little", BIGLONG = FALSE, NEWsta = "", NEWcomp = "")
FLS |
array of File names |
NEWDIR |
Destination directory path |
kind |
an integer 1, 2, 3; 0=R(DAT) , 1 = segy, 2 = sac, 3 = AH. |
Iendian |
Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
NEWsta |
character vector, stations associated with the vector of files |
NEWcomp |
character vector, component name associated with the vector of files |
Converts the data to R format so it can be loaded with the load command. After this conversion, files should be loaded in subsequent calls by using kind=0.
Side effects - creates new files on local system
JGET.seis extracts digital seismic data from binary files stored in the file system. The program uses readBin for I/O and passes data back to R. Currently SAC, SEGY formats are installed but it is easy to extend. AH format is available for LINUX systems, but there were problems compiling in WINDOWS and MACOS so this feature was removed. A filter for mseed format is currently being developed.
Jonathan M. Lees<[email protected]>
JGET.seis, JSAC.seis , Mine.seis
Iendian = .Platform$endian data(GH) ########## create some SAC files: apath = tempdir() J = rseis2sac(GH, sel = 1:5, path = apath, BIGLONG =FALSE ) #### get SAC file file names: Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) ##### convert each file to a saved RSEIS file, saved in apath #### reading in SAC files, kind=2 convert2Rseis(Lname, NEWDIR = apath, kind = 2, Iendian = Iendian, BIGLONG = FALSE ) #### check if files are there list.files(path=apath)Iendian = .Platform$endian data(GH) ########## create some SAC files: apath = tempdir() J = rseis2sac(GH, sel = 1:5, path = apath, BIGLONG =FALSE ) #### get SAC file file names: Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) ##### convert each file to a saved RSEIS file, saved in apath #### reading in SAC files, kind=2 convert2Rseis(Lname, NEWDIR = apath, kind = 2, Iendian = Iendian, BIGLONG = FALSE ) #### check if files are there list.files(path=apath)
Convert a julian day+time to an RSEIS date list.
convertATT(at1, yr)convertATT(at1, yr)
at1 |
julian day in Year, plus (hr+minutes+seconds) |
yr |
Year |
Calculates the data-list that RSEIS uses in calculations. The Month and Day-of-month are also returned.
List with date and time
Jonathan M. Lees<[email protected]>
recdate, recdatel, dateList, dateStamp, filedatetime, rangedatetime, yeardate, Zdate, as.POSIXct
yr = 2014 j = 233.1234 convertATT(j, yr)yr = 2014 j = 233.1234 convertATT(j, yr)
Shift traces accoring to given moveout times
correct.moveout(GH, sel = 1, tims = 0)correct.moveout(GH, sel = 1, tims = 0)
GH |
RSEIS structure list |
sel |
index of which traces to be shifted |
tims |
time shifts for each trace |
Each trace listed in sel gets shifted forward or backward according to time in tims. This is useful for shifting traces according to a given moveout curve.
RSEIS list structure returned with adjusted traces
Jonathan M. Lees<[email protected]>
Calculate the number of days per calendar year
DAYSperYEAR(yr)DAYSperYEAR(yr)
yr |
year |
days |
integer number of days for a given year |
Jonathan M. Lees<[email protected]>
years <- seq(from=1850, to=2010, by=1) DAYSperYEAR(years)years <- seq(from=1850, to=2010, by=1) DAYSperYEAR(years)
Decimate, or reduce the sample rate of a set of traces stored in event RSEIS format
DECIMATE.SEISN(TH, sel=1:length(TH$JSTR), dec=5 , type="LP", proto="BU" , fl=2, fh=10, RM=FALSE, zp=TRUE )DECIMATE.SEISN(TH, sel=1:length(TH$JSTR), dec=5 , type="LP", proto="BU" , fl=2, fh=10, RM=FALSE, zp=TRUE )
TH |
RSEIS list |
sel |
numeric, which traces to select |
dec |
numeric, number of samples to skip |
type |
type of filter (see butfilt), or FALSE for no filter |
proto |
filter proto type |
fl |
low pass frequency cut off |
fh |
high pass frequency cut off |
RM |
Remove mean value from trace, default=FALSE |
zp |
zero phase filter, default=TRUE |
Reduces the number of samples by skipping every "dec" sample.
To achieve smoothing prior to sampling, low pass filter may be applied to avoid spikes or other sampling issues.
If type is FALSE, no filter is applied and samples are taken from the input.
an RSEIS list.
The dt, n and t2 are modified in info.
Jonathan M. Lees<[email protected]>
butfilt, downsample
data(GH) dec = 250/50 ##### resample all traces by reducing from 250 to 50 samples/s DH = DECIMATE.SEISN(GH, sel=1:length(GH$JSTR), dec=dec , type="LP", proto="BU" , fl=2, fh=50, RM=FALSE, zp=TRUE ) ##### compare ##### times in ### starting second should be the same GH$info$sec[1:5] - DH$info$sec[1:5] #### number of samples should be reduced cbind(GH$info$n[1:5] , DH$info$n[1:5] ) ### ending seconds should be close but not identical cbind(GH$info$t2[1:5] , DH$info$t2[1:5] ) cbind(GH$info$dt[1:5] , DH$info$dt[1:5] ) cbind( sapply(GH$JSTR, 'length'), sapply(DH$JSTR, 'length') ) #### for visual comparison: ### par(mfrow=c(2,1) ) ## g = swig(GH, sel=which(GH$COMPS=="V" ), SHOWONLY=0 ) ## d = swig(DH, sel=which(DH$COMPS=="V" ), SHOWONLY=0 )data(GH) dec = 250/50 ##### resample all traces by reducing from 250 to 50 samples/s DH = DECIMATE.SEISN(GH, sel=1:length(GH$JSTR), dec=dec , type="LP", proto="BU" , fl=2, fh=50, RM=FALSE, zp=TRUE ) ##### compare ##### times in ### starting second should be the same GH$info$sec[1:5] - DH$info$sec[1:5] #### number of samples should be reduced cbind(GH$info$n[1:5] , DH$info$n[1:5] ) ### ending seconds should be close but not identical cbind(GH$info$t2[1:5] , DH$info$t2[1:5] ) cbind(GH$info$dt[1:5] , DH$info$dt[1:5] ) cbind( sapply(GH$JSTR, 'length'), sapply(DH$JSTR, 'length') ) #### for visual comparison: ### par(mfrow=c(2,1) ) ## g = swig(GH, sel=which(GH$COMPS=="V" ), SHOWONLY=0 ) ## d = swig(DH, sel=which(DH$COMPS=="V" ), SHOWONLY=0 )
Deconvolve instrument response from seismic data
deconinst(data, sintr, KAL, key, Calibnew, waterlevel = 1e-08)deconinst(data, sintr, KAL, key, Calibnew, waterlevel = 1e-08)
data |
Real vector of data |
sintr |
sample interval |
KAL |
Kalibrated response list |
key |
number of instrument |
Calibnew |
new instrument, complex vector or |
waterlevel |
waterlevel for low frequency division |
To avoid problems with dividing by very small numbers, water level is set =1.e-8
deconvolved signal
Calibnew(1)==3 then use a cos (hanning) taper
Jonathan M. Lees<jonathan.lees.edu>
PreSet.Instr, ReadSet.Instr, INSTresponse
Kal <- PreSet.Instr() amp <- rnorm(1024) Calibnew <- c(1,1.0, 0.0 ) dy <- deconinst(amp, 0.008, Kal,1, Calibnew, waterlevel=1.e-8)Kal <- PreSet.Instr() amp <- rnorm(1024) Calibnew <- c(1,1.0, 0.0 ) dy <- deconinst(amp, 0.008, Kal,1, Calibnew, waterlevel=1.e-8)
Delete pick to WPX file
deleteWPX(WPX, ind=1)deleteWPX(WPX, ind=1)
WPX |
WPX list |
ind |
integer, index to delete |
Deletes one pick to end of list.
WPX list
Uses, the last pick as a reference.
Jonathan M. Lees<[email protected]>
addWPX, catWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s3 <- addWPX(s1, s2) s4 <- deleteWPX(s3, ind=2:3)s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s3 <- addWPX(s1, s2) s4 <- deleteWPX(s3, ind=2:3)
Pops up three components and prepares menu items for picking
detail.pick(y, ex, dt, TIT = "")detail.pick(y, ex, dt, TIT = "")
y |
signal amplitudes |
ex |
x-axis |
dt |
deltaT, sample rate, s |
TIT |
title |
Creates interactive session for picking seismograms. Is called from swig.
KSAVE = list(x=xsave, y=ysave)
Jonathan M. Lees<jonathan.lees.edu>
swig
data(CE1) detail.pick(CE1$y, CE1$x, CE1$dt, TIT = "")data(CE1) detail.pick(CE1$y, CE1$x, CE1$dt, TIT = "")
Remove trend from time series signal
detrend(x)detrend(x)
x |
vector |
Removes the trend from a signal.
vector with linear trend removed.
Jonathan M. Lees<[email protected]>
mean
dt <- 0.001 t <- seq(0, 6, by=0.001) y <- 5*sin(2*pi*10*t) plot(t,y, type='l') y <- y + 3 * t plot(t,y, type='l') dy <- detrend(y) plot(t,dy, type='l')dt <- 0.001 t <- seq(0, 6, by=0.001) y <- 5*sin(2*pi*10*t) plot(t,y, type='l') y <- y + 3 * t plot(t,y, type='l') dy <- detrend(y) plot(t,dy, type='l')
Removes seismic instrument response and integrates to displacement.
DISPLACE.SEISN(TH, sel = 1:length(TH$JSTR), inst = 1, Kal = Kal,waterlevel = 1e-08, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU",RM=FALSE, zp=TRUE))DISPLACE.SEISN(TH, sel = 1:length(TH$JSTR), inst = 1, Kal = Kal,waterlevel = 1e-08, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU",RM=FALSE, zp=TRUE))
TH |
list structure of seismic traces |
sel |
select which tracesin list to deconvolve |
inst |
index to instrument in Kal list for calibration and instrument response |
Kal |
list of instrument responses |
waterlevel |
waterlevel for low frequency division |
FILT |
filter output, after instrumentation, see butfilt |
Instrument responses are lists of poles and zeros for each instrument defined.
Same as input list with new traces representing displacement versus velocity
Jonathan M. Lees<[email protected]>
VELOCITY.SEISN, deconinst, butfilt
data(KH) Kal <- PreSet.Instr() DH <- DISPLACE.SEISN(KH, sel = 1 , inst = 1, Kal = Kal, FILT = list(ON = FALSE, fl = 1/200, fh = 7, type = "BP", proto = "BU")) if(interactive()){ SOUT <- swig(DH, PADDLAB=c("CENTER", "fspread", "HALF", "PREV") ) }data(KH) Kal <- PreSet.Instr() DH <- DISPLACE.SEISN(KH, sel = 1 , inst = 1, Kal = Kal, FILT = list(ON = FALSE, fl = 1/200, fh = 7, type = "BP", proto = "BU")) if(interactive()){ SOUT <- swig(DH, PADDLAB=c("CENTER", "fspread", "HALF", "PREV") ) }
Calculate euclidian distances from an RSEIS seismic data list, stations and event location.
distseisnXY(GH, sta=list(nam="", x=0 , y=0 , z=0) , LOC=list(x=0, y=0 , z=0))distseisnXY(GH, sta=list(nam="", x=0 , y=0 , z=0) , LOC=list(x=0, y=0 , z=0))
GH |
Rseis list structure |
sta |
station list(x,y,z) |
LOC |
location list(x,y,z) |
d |
vector of distances in km, matching the stations in the RSEIS list. |
Locations of stations and source should be projected.
Jonathan M. Lees<[email protected]>
data(GH) ### assume the lat lon in GH are x, y (projected) staxy <- list(nam=GH$stafile$name, x=GH$stafile$lon, y=GH$stafile$lat, z=GH$stafile$z) LOC <- list(x=GH$pickfile$LOC$lon, y=GH$pickfile$LOC$lat, z=GH$pickfile$LOC$z) distseisnXY(GH, sta =staxy, LOC = LOC)data(GH) ### assume the lat lon in GH are x, y (projected) staxy <- list(nam=GH$stafile$name, x=GH$stafile$lon, y=GH$stafile$lat, z=GH$stafile$z) LOC <- list(x=GH$pickfile$LOC$lon, y=GH$pickfile$LOC$lat, z=GH$pickfile$LOC$z) distseisnXY(GH, sta =staxy, LOC = LOC)
Plot time series vertically at specified distances. Produces a seismic cross section with correct spacing between traces.
DISTxsec(GH, dist, TIM.WIN = c(0, 3600), sel, trace.width = 10, col = "black", text.col = "blue", text.font = 2, text.size = 0.8, add = FALSE, plot = TRUE)DISTxsec(GH, dist, TIM.WIN = c(0, 3600), sel, trace.width = 10, col = "black", text.col = "blue", text.font = 2, text.size = 0.8, add = FALSE, plot = TRUE)
GH |
RSEIS seismic trace structure, output of prepSEIS used in swig |
dist |
distance for each station along x-axis |
TIM.WIN |
time window for cross section |
sel |
numeric, index of selected traces to plot. |
trace.width |
Width of each trace in plot. Should be in same units as x-axis |
col |
color for traces. If vector, each trace is plotted with assigned color. |
text.col |
color for text identifying each trace. |
text.font |
font for text identifying each trace. |
text.size |
size of text for identifying each trace. |
add |
logical, Whether to add traces, or just set up the figure |
plot |
logical, whether to plotthe traces. |
Distances should be a vector for each trace in the RSEIS list.
vector of x-y coordinates of the plot.
Jonathan M. Lees<[email protected]>
swig, prepSEIS
#### example using data in the RSEIS package data(GH) #### get the source location lat.org = GH$pickfile$LOC$lat lon.org = GH$pickfile$LOC$lon #### get the station locations g1 =GH$stafile #### find the distance to each station gd = rdistaz(lat.org, lon.org, g1$lat, g1$lon ) ##### optional, filter the data sel= which( GH$COMPS == 'V') ### filter traces Fdef <- list(ON=TRUE, fl=1, fh=1, type="HP", proto="BU", RM=TRUE, zp=TRUE ) KF <- FILT.SEISN(GH, FILT=Fdef) ### match the stations in GH to the station distances m1 = match(GH$STNS , g1$name) dist.GH = gd$dist[m1] TIM.WIN = range(GH$ex) ####### prepare plot, but do not add traces A = DISTxsec(KF, dist.GH, TIM.WIN, sel, trace.width = 0.5 , add=FALSE, plot=FALSE ) ##### add traces B = DISTxsec(KF, dist.GH, TIM.WIN, sel, trace.width = 0.5 , add=TRUE, plot=TRUE, col='black' , text.col='red', text.size=1 )#### example using data in the RSEIS package data(GH) #### get the source location lat.org = GH$pickfile$LOC$lat lon.org = GH$pickfile$LOC$lon #### get the station locations g1 =GH$stafile #### find the distance to each station gd = rdistaz(lat.org, lon.org, g1$lat, g1$lon ) ##### optional, filter the data sel= which( GH$COMPS == 'V') ### filter traces Fdef <- list(ON=TRUE, fl=1, fh=1, type="HP", proto="BU", RM=TRUE, zp=TRUE ) KF <- FILT.SEISN(GH, FILT=Fdef) ### match the stations in GH to the station distances m1 = match(GH$STNS , g1$name) dist.GH = gd$dist[m1] TIM.WIN = range(GH$ex) ####### prepare plot, but do not add traces A = DISTxsec(KF, dist.GH, TIM.WIN, sel, trace.width = 0.5 , add=FALSE, plot=FALSE ) ##### add traces B = DISTxsec(KF, dist.GH, TIM.WIN, sel, trace.width = 0.5 , add=TRUE, plot=TRUE, col='black' , text.col='red', text.size=1 )
Plot particle motion arrows
DO.PMOT.ARR(E, N)DO.PMOT.ARR(E, N)
E |
East component |
N |
East Component |
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
PMOT.drive
data(GH) XLIM = c(1226, 1322 ) e = GH$JSTR[[1]][XLIM[1]:XLIM[2]] n = GH$JSTR[[2]][XLIM[1]:XLIM[2]] xx = range(e, na.rm =TRUE) yy = range(n, na.rm =TRUE) sx = range(c(xx, yy)) x = RPMG::RESCALE(e, 0, 1, sx[1], sx[2]) y = RPMG::RESCALE(n, 0, 1, sx[1], sx[2]) plot(range(x), range(y) , type='n') lines(x, y, col=grey(0.8) ) DO.PMOT.ARR(x, y)data(GH) XLIM = c(1226, 1322 ) e = GH$JSTR[[1]][XLIM[1]:XLIM[2]] n = GH$JSTR[[2]][XLIM[1]:XLIM[2]] xx = range(e, na.rm =TRUE) yy = range(n, na.rm =TRUE) sx = range(c(xx, yy)) x = RPMG::RESCALE(e, 0, 1, sx[1], sx[2]) y = RPMG::RESCALE(n, 0, 1, sx[1], sx[2]) plot(range(x), range(y) , type='n') lines(x, y, col=grey(0.8) ) DO.PMOT.ARR(x, y)
Gabor Transform with AR spectrum method
doGABOR.AR(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, pord=100, PLOT=TRUE)doGABOR.AR(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, pord=100, PLOT=TRUE)
Xamp |
signal |
DT |
sample rate interval (s) |
multi |
Multiples of time window estimate |
scale.def |
scaling flag for plotting (0=raw, 1=log, 2=sqrt) |
TWIN |
time for window |
TSKIP |
time for skip |
PCTTAP |
percent of taper to apply to individual windows |
pord |
order for the AR process (default=100) |
PLOT |
logical, TRUE=plot to device |
This is a spectrogram function similar to the Gabor Transform but uses the AR method for spectrum estimation.
list
sig |
input signal |
dt |
deltat |
numfreqs |
Number of frequencies output |
wpars |
input parameters list(Nfft=numfreqs, Ns=Ns, Nov=Nov, fl=fl, fh=fh) |
DSPEC |
spectrum image |
HIMAT |
matrix with high values of F-test at 90 percent confidence |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
The main difference between this and other similar calls is the way the windows are determined.
Jonathan M. Lees<[email protected]>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
Percival, Donald B.,Walden, Andrew T. (1993):Spectral Analysis for Physical Applications,Cambridge University Press, Cambridge, 583p.
evolfft, evolMTM, MTM.drive, GETARAIC, doGABOR.AR, DOsgram, doGABOR.MTM
data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Xamp <- Xamp[57914:72989] EV <- doGABOR.AR(Xamp, DT = KH$dt[1] , multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05)data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Xamp <- Xamp[57914:72989] EV <- doGABOR.AR(Xamp, DT = KH$dt[1] , multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05)
Time varying Auto-Regressive Spectrum (Gabor Transform) using MTM. This is a driver for MTMgabor.
doGABOR.MTM(Xamp, DT = 0.008, ppoint=95 , multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, PLOT=TRUE)doGABOR.MTM(Xamp, DT = 0.008, ppoint=95 , multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, PLOT=TRUE)
Xamp |
signal |
DT |
sample rate interval (s) |
ppoint |
percent confidence for F-test (default=95) |
multi |
Multiples of time window estimate |
scale.def |
scaling flag for plotting (0=raw, 1=log, 2=sqrt) |
TWIN |
time for window |
TSKIP |
time for skip |
PCTTAP |
percent of taper to apply to individual windows |
PLOT |
logical, TRUE=plot to device |
This is a spectrogram function similar to the Gabor Transform but uses the MTM (multi-taper method) for spectrum estimation. This is a non-interactive version of MTM.drive.
list output of MTMgabor:
sig |
input signal |
dt |
deltat |
numfreqs |
Number of frequencies output |
wpars |
input parameters list(Nfft=numfreqs, Ns=Ns, Nov=Nov, fl=fl, fh=fh) |
DSPEC |
spectrum image |
HIMAT |
matrix with high values of F-test at 90 percent confidence |
DOFMAT |
Matrix image of degrees of freedom |
FVMAT |
Matrix image of F-test values |
kdof |
test degrees of freedom=2*nwin-2 |
ppoint |
percentage point for confidence bounds |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
The main difference between this and other similar calls is the way the windows are determined.
Jonathan M. Lees<[email protected]>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
Percival, Donald B.,Walden, Andrew T. (1993):Spectral Analysis for Physical Applications,Cambridge University Press, Cambridge, 583p.
MTMgabor, evolfft, evolMTM, MTM.drive, GETARAIC, doGABOR.AR, DOsgram
data(KH) ### swig(KH) Xamp = KH$JSTR[[1]] Xamp = Xamp[57914:64914] EV = doGABOR.MTM(Xamp, DT = KH$dt[1], multi = 1, scale.def = 0, TWIN = 1, TSKIP = .1, PCTTAP = 0.05)data(KH) ### swig(KH) Xamp = KH$JSTR[[1]] Xamp = Xamp[57914:64914] EV = doGABOR.MTM(Xamp, DT = KH$dt[1], multi = 1, scale.def = 0, TWIN = 1, TSKIP = .1, PCTTAP = 0.05)
This is a dummy button function showing how buttons can be created on the fly
doMYBUTTS(butt = "", clicks = NULL, x = NULL)doMYBUTTS(butt = "", clicks = NULL, x = NULL)
butt |
character vector |
clicks |
clicks |
x |
locations |
Gabor transform with simple spectrum
DOsgram(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, PLOT=TRUE)DOsgram(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05, PLOT=TRUE)
Xamp |
signal |
DT |
sample rate interval (s) |
multi |
Multiples of time window estimate |
scale.def |
scaling flag for plotting (0=raw, 1=log, 2=sqrt) |
TWIN |
time for window |
TSKIP |
time for skip |
PCTTAP |
percent of taper to apply to individual windows |
PLOT |
logical, TRUE=plot to device |
This is a non-interactive version of SPECT.drive.
list
sig |
input signal |
dt |
deltat |
numfreqs |
Number of frequencies output |
wpars |
input parameters list(Nfft=numfreqs, Ns=Ns, Nov=Nov, fl=fl, fh=fh) |
DSPEC |
spectrum image |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
Jonathan M. Lees<[email protected]>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
evolMTM, evolfft, evolAR, plotevol
data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Xamp <- Xamp[57914:72989] Nfft <- 1024 ### fft length Ns <- 512 ### number of samples in a window Nov <- 480 ### number of samples of overlap per window fl <- 0 ### low frequency to return fh <- 12 ### high frequency to return EV <- DOsgram(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05)data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Xamp <- Xamp[57914:72989] Nfft <- 1024 ### fft length Ns <- 512 ### number of samples in a window Nov <- 480 ### number of samples of overlap per window fl <- 0 ### low frequency to return fh <- 12 ### high frequency to return EV <- DOsgram(Xamp, DT = 0.008, multi = 1, scale.def = 0, TWIN = 2, TSKIP = 0.2, PCTTAP = 0.05)
Plot wiggles
dowiggles(AMAT, dt, dx)dowiggles(AMAT, dt, dx)
AMAT |
Matrix of seismic time series |
dt |
time interval, sec |
dx |
x-spacing |
graphical side effects
Jonathan M. Lees<[email protected]>
wiggleimage, matsquiggle
S1 = symshot1() dowiggles(S1$smograms,S1$dt, S1$x)S1 = symshot1() dowiggles(S1$smograms,S1$dt, S1$x)
Interpolate a times series with a higher/lower sample rate for processes that are sensitive to low samples.
downsample(sig, dt=0.001, newdt=0.01, PLOT=FALSE )downsample(sig, dt=0.001, newdt=0.01, PLOT=FALSE )
sig |
time series vector |
dt |
sample rate s/sample |
newdt |
New, lower sample rate |
PLOT |
logical, plot both traces, default=FALSE |
Linear interpolation is performed between samples. If the newdt is an integer multiple of the old dt, The samples will not be modified.
time series vector with new sample rate.
Jonathan M. Lees<[email protected]>
data(KH) sig = KH$JSTR[[1]] #### reduce samples from 125 (0.008) to 25Hz (0.04) newdt = KH$dt[1]*5 sig2 = downsample(sig, dt = KH$dt[1], newdt = newdt ) L0 = length(sig) L1 = length(sig2) op <- par(no.readonly = TRUE) par(mfrow=c(2,1) ) plot.ts(ts(sig, deltat=KH$dt[1] ), xlab='s', ylab='Amplitude', main=paste('Orignal', L0) ) grid() plot.ts(ts(sig2, deltat=newdt ), xlab='s', ylab='Amplitude', main=paste('Downsample', L1) ) grid() par(op)data(KH) sig = KH$JSTR[[1]] #### reduce samples from 125 (0.008) to 25Hz (0.04) newdt = KH$dt[1]*5 sig2 = downsample(sig, dt = KH$dt[1], newdt = newdt ) L0 = length(sig) L1 = length(sig2) op <- par(no.readonly = TRUE) par(mfrow=c(2,1) ) plot.ts(ts(sig, deltat=KH$dt[1] ), xlab='s', ylab='Amplitude', main=paste('Orignal', L0) ) grid() plot.ts(ts(sig2, deltat=newdt ), xlab='s', ylab='Amplitude', main=paste('Downsample', L1) ) grid() par(op)
Edit, or remove items from an RSEIS data base after it has been read in.
editDB(DB, w) pathDB(DB, path1="", path2="")editDB(DB, w) pathDB(DB, path1="", path2="")
DB |
RSEIS data base |
w |
vector of index items to remove |
path1 |
character for old path |
path2 |
character for new path to replace old path |
The DB is a list. The program cycles through the elements of the list and removes all lnes that correspond to the idecies given in w.
Returns a DB list
A problem arises if the makeDB program reads in, or tries to read in files that have not data base header information. This program can eliminate these from the data base.
Jonathan M. Lees<[email protected]>
makeDB, infoDB
########## create a data set and a DB tdir = tempdir() data(GH) DD = data.frame(GH$info) WV = which(GH$COMPS=='V') L1 = length(WV) ###### GIVE = vector(mode='list') for(j in 1:L1) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ####### save files in the tempdir for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM) nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) ####### make the database cosoDB = FmakeDB(LF, kind=-1) ###### change the DB path: path1<-tdir path2<-"." ####### change the path name of the trace files newDB <- pathDB(cosoDB, path1, path2 )########## create a data set and a DB tdir = tempdir() data(GH) DD = data.frame(GH$info) WV = which(GH$COMPS=='V') L1 = length(WV) ###### GIVE = vector(mode='list') for(j in 1:L1) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ####### save files in the tempdir for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM) nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) ####### make the database cosoDB = FmakeDB(LF, kind=-1) ###### change the DB path: path1<-tdir path2<-"." ####### change the path name of the trace files newDB <- pathDB(cosoDB, path1, path2 )
Creates a structure list with no data
EmptyPickfile(GH)EmptyPickfile(GH)
GH |
RSEIS list structure |
RSEIS pickfile list
Jonathan M. Lees<jonathan.lees.edu>
EmptySEIS
data(GH) EmptyPickfile(GH)data(GH) EmptyPickfile(GH)
Creates a structure list with no data
EmptySEIS()EmptySEIS()
RSEIS list
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
EmptySEIS()EmptySEIS()
Envelope Function with Hilbert Transform
envelope(x)envelope(x)
x |
signal vector |
Uses the hilbert transform to get the envelope function.
vector of the absolute of the hilbert transform
Jonathan M. Lees<jonathan.lees.edu>
data(CE1) ev <- envelope(CE1$y) plot(CE1$x, CE1$y, type='l') lines(CE1$x,ev, col='red')data(CE1) ev <- envelope(CE1$y) plot(CE1$x, CE1$y, type='l') lines(CE1$x,ev, col='red')
Number of days since Origin Year
EPOCHday(yr, jd = 1, origyr = 1972)EPOCHday(yr, jd = 1, origyr = 1972)
yr |
year |
jd |
Julian Day |
origyr |
origin year, default=1972 |
Either jd or mo, dom can be provided
List:
jday |
number of days since the start of origin year |
origyr |
origin year used |
Jonathan M. Lees<jonathan.lees.edu>
EPOCHyear, recdate
tyears <- 1973:2009 E1 <- EPOCHday(tyears, jd=1, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 )tyears <- 1973:2009 E1 <- EPOCHday(tyears, jd=1, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 )
Get year and julian day given number of days since origin
EPOCHyear(iday, origyr = 1972)EPOCHyear(iday, origyr = 1972)
iday |
Number of days since origin |
origyr |
origin year, default=1972 |
List:
yr |
Year |
jd |
Julian day in Year |
Jonathan M. Lees<jonathan.lees.edu>
EPOCHday, recdate
tyears <- 1973:2009 E1 <- EPOCHday(tyears, jd=1, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 ) ####### here is an example using year Month and day of month ### use March 19 for each year: ii <- tojul(tyears, 3, 19)-tojul(tyears, 1, 1) E1 <- EPOCHday(tyears, jd=ii, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 )tyears <- 1973:2009 E1 <- EPOCHday(tyears, jd=1, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 ) ####### here is an example using year Month and day of month ### use March 19 for each year: ii <- tojul(tyears, 3, 19)-tojul(tyears, 1, 1) E1 <- EPOCHday(tyears, jd=ii, origyr=1972 ) EPOCHyear(E1$jday, origyr=1972 )
Event Detection for a seismic section
ETECTG(GH, sel = sel, FRWD = 8, BKWD = 8, sbef = 1, saft = 6, DFRWD = 0.5, DBKWD = 0.5, thresh = 2, Tthresh2 = 7, stretch = 1000, flo = 0.1, fhi = 5, PLOT = FALSE, Kmin = 7, perc = 0.05, kind = 1, DOARAIC = FALSE)ETECTG(GH, sel = sel, FRWD = 8, BKWD = 8, sbef = 1, saft = 6, DFRWD = 0.5, DBKWD = 0.5, thresh = 2, Tthresh2 = 7, stretch = 1000, flo = 0.1, fhi = 5, PLOT = FALSE, Kmin = 7, perc = 0.05, kind = 1, DOARAIC = FALSE)
GH |
Seismic Structure |
sel |
select traces |
FRWD |
forward window, s |
BKWD |
backward window |
sbef |
seconds before |
saft |
seconds after |
DFRWD |
seconds before |
DBKWD |
seconds after |
thresh |
threshold 1 |
Tthresh2 |
threshold 2 |
stretch |
stretch factor |
flo |
low frequency for BP filter |
fhi |
low frequency for BP filter |
PLOT |
logical, TRUE=plot diagnostics |
Kmin |
min number of picks per window |
perc |
percentage of Kmin allowed |
kind |
kind of picking |
DOARAIC |
TRUE=do auto-regressive AIC method |
Very complicated picking routine - designed for volcanic regions with emergent arrivals. Works with lots of tuning.
sel |
input selection |
JJ |
index |
PPTIM |
p-arrivals |
PP |
all arrivals |
Jonathan M. Lees<jonathan.lees.edu>
Time varying Auto-Regressive Spectrum (Gabor Transform)
evolAR(a, dt = 0, numf = 1024, pord = 100, Ns = 0, Nov = 0, fl = 0, fh = 10)evolAR(a, dt = 0, numf = 1024, pord = 100, Ns = 0, Nov = 0, fl = 0, fh = 10)
a |
signal |
dt |
sample rate interval (s) |
numf |
Number of frequencies |
pord |
Order for Auto-regressive calculation |
Ns |
Number of sample in sub-window |
Nov |
Number of sample to overlap |
fl |
low frequency to display |
fh |
high frequency to display |
This is a spectrogram function similar to the Gabor Transform but uses the Auto-Regressive method for spectrum estimation.
List
sig |
input signal |
dt |
deltat |
wpars |
input parameters |
DSPEC |
spectrum image |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
Jonathan M. Lees<[email protected]>
evolfft, evolMTM, MTM.drive, GETARAIC
data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] dt <- KH$dt[1] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') ## limit the trace, somewhat Xamp <- Xamp[12670:22669] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') Nfft<-1024 ### fft length Ns<-512 ### number of samples in a window Nov<-480 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-12 ### high frequency to return EV <- evolAR(Xamp, dt = dt, numf =Nfft , pord = 100, Ns = Ns, Nov = Nov, fl = fl, fh = fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar")data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] dt <- KH$dt[1] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') ## limit the trace, somewhat Xamp <- Xamp[12670:22669] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') Nfft<-1024 ### fft length Ns<-512 ### number of samples in a window Nov<-480 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-12 ### high frequency to return EV <- evolAR(Xamp, dt = dt, numf =Nfft , pord = 100, Ns = Ns, Nov = Nov, fl = fl, fh = fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar")
Spectrogram using simple fft (Gabor Transform)
evolfft(a, dt = 0, Nfft = 0, Ns = 0, Nov = 0, fl = 0, fh = 10, pcttap = 0.05, adjust=TRUE )evolfft(a, dt = 0, Nfft = 0, Ns = 0, Nov = 0, fl = 0, fh = 10, pcttap = 0.05, adjust=TRUE )
a |
signal |
dt |
sample rate interval (s) |
Nfft |
Number of points in fft |
Ns |
NUmber of sample in sub-window |
Nov |
number of sample to overlap |
fl |
low frequency to display |
fh |
high frequency to display |
pcttap |
Percent cosine taper for each window |
adjust |
logical, if TRUE adjust the parameters so the plot looks good (DEFAULT). If FALSE, keep user parameters. |
This is a duplication of the spectrogram function in matlab which applies Welsh's Method. Each mini-window is tapered with a cosine window.
List
sig |
input signal |
dt |
deltat |
wpars |
input parameters |
DSPEC |
spectrum image |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
Parameter adjust is by default TRUE so that the choice of Ns, Nov, and kcol will be optimized, more or less. Set this logical to FALSE to force the function to use user input parameters.
Jonathan M. Lees<jonathan.lees.edu>
evolMTM, evolAR, MTM.drive
data(CE1) #### plot signals plot(CE1$x, CE1$y, type='l') ### set parameters Nfft<-1024 ### fft length Ns<-250 ### number of samples in a window Nov<-240 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-1/(2*CE1$dt) ### high frequency to return ######## calculate the evolutive fft (Gabor Transform) EV <- evolfft(CE1$y, dt =CE1$dt , Nfft = Nfft, Ns =Ns , Nov =Nov , fl =fl , fh = 25) ### plot image, but it does not look too interesting image(EV$DSPEC) ### plot Gabor transform with special function PE <- plotevol(EV, log=0, fl=0.01, fh=100, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="fft")data(CE1) #### plot signals plot(CE1$x, CE1$y, type='l') ### set parameters Nfft<-1024 ### fft length Ns<-250 ### number of samples in a window Nov<-240 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-1/(2*CE1$dt) ### high frequency to return ######## calculate the evolutive fft (Gabor Transform) EV <- evolfft(CE1$y, dt =CE1$dt , Nfft = Nfft, Ns =Ns , Nov =Nov , fl =fl , fh = 25) ### plot image, but it does not look too interesting image(EV$DSPEC) ### plot Gabor transform with special function PE <- plotevol(EV, log=0, fl=0.01, fh=100, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="fft")
Time varying Multi-taper Spectrum (Gabor Transform)
evolMTM(a, dt = 0, numf = 1024, Ns = 0, Nov = 0, fl = 0, fh = 10)evolMTM(a, dt = 0, numf = 1024, Ns = 0, Nov = 0, fl = 0, fh = 10)
a |
Signal |
dt |
Sample rate interval (s) |
numf |
Number of points in fft |
Ns |
Number of sample in sub-window |
Nov |
Number of sample to overlap |
fl |
low frequency to display |
fh |
high frequency to display |
This is a spectrogram function similar to the Gabor Transform but uses the MTM method for spectrum estimation.
List
sig |
input signal |
dt |
deltat |
wpars |
input parameters |
DSPEC |
spectrum image |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
Jonathan M. Lees<[email protected]>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
evolfft, MTM.drive
data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] dt <- KH$dt[1] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') ## limit the trace, somewhat Xamp <- Xamp[12670:22669] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') Nfft<-4096 ### fft length Ns<-512 ### number of samples in a window Nov<-480 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-12 ### high frequency to return EV <- evolMTM(Xamp, dt = dt, numf = Nfft, Ns = Ns, Nov = Nov, fl = fl, fh = fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar") ## compare with: ## EVf <- evolfft(Xamp, dt = dt, Nfft =Nfft , Ns =Ns , Nov =Nov , fl =fl, fh = fh) ## PE <- plotevol(EVf, log=1, fl=fl, fh=fh, col=rainbow(100), ygrid=FALSE,STAMP="", STYLE="fft")data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] dt <- KH$dt[1] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') ## limit the trace, somewhat Xamp <- Xamp[12670:22669] plot(seq(from=0, length=length(Xamp), by=dt), Xamp, type='l') Nfft<-4096 ### fft length Ns<-512 ### number of samples in a window Nov<-480 ### number of samples of overlap per window fl<-0 ### low frequency to return fh<-12 ### high frequency to return EV <- evolMTM(Xamp, dt = dt, numf = Nfft, Ns = Ns, Nov = Nov, fl = fl, fh = fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar") ## compare with: ## EVf <- evolfft(Xamp, dt = dt, Nfft =Nfft , Ns =Ns , Nov =Nov , fl =fl, fh = fh) ## PE <- plotevol(EVf, log=1, fl=fl, fh=fh, col=rainbow(100), ygrid=FALSE,STAMP="", STYLE="fft")
Create a list of artifical seismic traces to illustrate examples that require a database or long sequences.
FAKEDATA(amp, OLDdt = 0.01, newdt = 0.1, yr = 2000, JD = 5, mi = 0, sec = 0, Ntraces = 48, seed = 200, noise.est = c(1, 100), verbose = FALSE)FAKEDATA(amp, OLDdt = 0.01, newdt = 0.1, yr = 2000, JD = 5, mi = 0, sec = 0, Ntraces = 48, seed = 200, noise.est = c(1, 100), verbose = FALSE)
amp |
vector, some signal that will be repeated |
OLDdt |
Orignal sample rate |
newdt |
New sample rate, usually less than the original |
yr |
year |
JD |
starting Julian day |
mi |
starting minute |
sec |
starting second |
Ntraces |
number of traces |
seed |
random seed |
noise.est |
2-vector, starting and ending sample to estimate noise level of trace |
verbose |
logical, message feed back |
The input signal can be any time series, or even a made up signal. This is just to give the look of the result something like real data. The noise level is extracted from the man and std of the real data at the samples indicated by noise.est.
The sampling rate (dt, sec/sample ) is increased mainly for speed and plotting. This may be skipped for certain functions involving spectrum analysis.
The signal is distributed randomly in each hour along the total span of the requested period, i.e. each hour has one instance of the signal.
The date is arbitrary, of course.
List of data in a format similar to the output of GET.seis.
Jonathan M. Lees<[email protected]>
GET.seis
##### get a time series data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] #### downsample to: newdt = 0.1 JK = FAKEDATA(amp, OLDdt=OLDdt, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) op <- par(no.readonly = TRUE) par(mfrow=c(length(JK), 1) ) for(i in 1:length(JK) ) { DATTIM = paste(c(unlist(JK[[i]]$DATTIM), JK[[i]]$N), collapse=' ') plotGH( JK[[i]] ) mtext(DATTIM, side=3, at=JK[[i]]$DATTIM$t2/2) } par(op)##### get a time series data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] #### downsample to: newdt = 0.1 JK = FAKEDATA(amp, OLDdt=OLDdt, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) op <- par(no.readonly = TRUE) par(mfrow=c(length(JK), 1) ) for(i in 1:length(JK) ) { DATTIM = paste(c(unlist(JK[[i]]$DATTIM), JK[[i]]$N), collapse=' ') plotGH( JK[[i]] ) mtext(DATTIM, side=3, at=JK[[i]]$DATTIM$t2/2) } par(op)
Create a character string from a date for naming unique output files.
filedatetime(orgtim, tims=0, datesep="-", timesep="_", secsep="_")filedatetime(orgtim, tims=0, datesep="-", timesep="_", secsep="_")
orgtim |
time vector of length 5: c(yr, jd, hr, mi, sec) |
tims |
seconds to add to orgtim, default=0 |
datesep |
character, seperater for the date |
timesep |
character, seperator for the time |
secsep |
character, seperator for the seconds |
filename |
character string |
Jonathan M. Lees<[email protected]>
data(GH) g1 <- getGHtime(GH) g2 <- unlist(g1) filedatetime(g2, 1)data(GH) g1 <- getGHtime(GH) g2 <- unlist(g1) filedatetime(g2, 1)
Filter Traces in a seismic structure
FILT.SEISN(TH, sel = 1:length(TH$JSTR), FILT = list(ON = TRUE, fl = 0.5, fh = 7, type = "HP", proto = "BU", RM=FALSE, zp=TRUE ), TAPER = 0.1, POSTTAPER = 0.1, AUGMENT=FALSE)FILT.SEISN(TH, sel = 1:length(TH$JSTR), FILT = list(ON = TRUE, fl = 0.5, fh = 7, type = "HP", proto = "BU", RM=FALSE, zp=TRUE ), TAPER = 0.1, POSTTAPER = 0.1, AUGMENT=FALSE)
TH |
Seismic structure |
sel |
selection of traces |
FILT |
filter definition |
TAPER |
filter taper |
POSTTAPER |
taper after filter |
AUGMENT |
Logical, FALSE |
RSEIS Seismic structure is filtered, trace by trace. If AUGMENT is TRUE, traces are augmented at beginning and end, filtered and then truncated to suppress edge effects. In that case no tapering is applied post fitler.
RSEIS Seismic structure, traces are filtered and a proc is added to the trace history.
Jonathan M. Lees<jonathan.lees.edu>
butfilt
## Fdef = choosfilt() Fdef <- list(ON=FALSE, fl=0.5, fh=7.0, type="BP", proto="BU", RM=FALSE, zp=TRUE ) data("GH") sel <- which(GH$COMPS=="V") sel <- 1:3 KF <- FILT.SEISN(GH, sel = sel, FILT=Fdef) swig(KF, sel=sel, SHOWONLY=0)## Fdef = choosfilt() Fdef <- list(ON=FALSE, fl=0.5, fh=7.0, type="BP", proto="BU", RM=FALSE, zp=TRUE ) data("GH") sel <- which(GH$COMPS=="V") sel <- 1:3 KF <- FILT.SEISN(GH, sel = sel, FILT=Fdef) swig(KF, sel=sel, SHOWONLY=0)
Show a time series and a spread of user defined filters to show signal at a variety of bandwidths.
FILT.spread(x, y, dt, fl = fl, fh = fh, sfact = 1, WIN = NULL, PLOT = TRUE, TIT = NULL, TAPER = 0.05, POSTTAPER=0.05, RM=FALSE, zp=TRUE )FILT.spread(x, y, dt, fl = fl, fh = fh, sfact = 1, WIN = NULL, PLOT = TRUE, TIT = NULL, TAPER = 0.05, POSTTAPER=0.05, RM=FALSE, zp=TRUE )
x |
x-axis |
y |
y-amplitude |
dt |
delta-t, sec |
fl |
vector of low frequency cut offs |
fh |
vector of high frequency cut offs |
sfact |
scale factor, 0,1 |
WIN |
xlimits to constrain plotting |
PLOT |
logical, plotting |
TIT |
title |
TAPER |
taper data prior to filter, percent cosine, default=NULL |
POSTTAPER |
taper output after filter, percent cosine, default=0.05 |
RM |
Remove mean value from trace, default=FALSE |
zp |
zero phase filter, default=TRUE |
Use the TAPER and POSTTAPER to reduce the edge effects prior to and after filtering.
list:
FMAT |
matrix of time series filtered |
Notes |
Notes for filter of each element of FMAT |
Jonathan M. Lees<[email protected]>
butfilt, PLOT.MATN
data(KH) dt <- KH$dt[1] y <- KH$JSTR[[1]] x <- seq(from=0, by=dt, length=length(y)) fl <- rep(1/100, 5) fh <- 1/c(1,2,5,10,20) FILT.spread(x, y, dt, fl = fl, fh = fh, sfact = 1, WIN = NULL, PLOT = TRUE, TIT = NULL, TAPER = 0.05)data(KH) dt <- KH$dt[1] y <- KH$JSTR[[1]] x <- seq(from=0, by=dt, length=length(y)) fl <- rep(1/100, 5) fh <- 1/c(1,2,5,10,20) FILT.spread(x, y, dt, fl = fl, fh = fh, sfact = 1, WIN = NULL, PLOT = TRUE, TIT = NULL, TAPER = 0.05)
Create an text stamp describing a filter
filterstamp(fl=1/2, fh=10, type="BP")filterstamp(fl=1/2, fh=10, type="BP")
fl |
vector, low frequency |
fh |
vector,high frequency |
type |
vector,type of filter |
If the frequency is less than 1, the period is displayed. For now only 3 digits are displayed. If the first argument, fl, is a list the parameters are extracted from the list and the other arguments are ignored.
stamps |
text strings |
Jonathan M. Lees<[email protected]>
FILT.spread
fl <- c(0.01, 2) fh <- c(10, 20) type <- "BP" filterstamp(fl, fh, type) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="HP", proto="BU") filterstamp(FILT) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="BP", proto="BU") filterstamp(FILT) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="LP", proto="BU") filterstamp(FILT)fl <- c(0.01, 2) fh <- c(10, 20) type <- "BP" filterstamp(fl, fh, type) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="HP", proto="BU") filterstamp(FILT) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="BP", proto="BU") filterstamp(FILT) FILT<-list(ON=TRUE, fl=1/2, fh=12, type="LP", proto="BU") filterstamp(FILT)
Integration of seismic signal in Frequency Domain. Used for converting velocity seismogram to displacement.
finteg(data, dt)finteg(data, dt)
data |
time series |
dt |
sample interval |
Integrated time series signal
To avoid problems with dividing by very small numbers, water level is set =1.e-8
Jonathan M. Lees<jonathan.lees.edu>
## waterlevel=1.e-8 dfor5 <- rnorm(1000) idfor5 <- finteg(dfor5, 0.008)## waterlevel=1.e-8 dfor5 <- rnorm(1000) idfor5 <- finteg(dfor5, 0.008)
Fix component names for uniformity
fixcompname(comp)fixcompname(comp)
comp |
4, "SHV" |
Translate the component names to something uniform that can be used for sorting and other functions.
one of "V", "N", "E"
Jonathan M. Lees<jonathan.lees.edu>
fixcompname("SHV") fixcompname("SHE")fixcompname("SHV") fixcompname("SHE")
Convert components to common names: V N E
fixcomps(oldcomps, SEGY = FALSE)fixcomps(oldcomps, SEGY = FALSE)
oldcomps |
vector of compnents |
SEGY |
logical, TRUE= segy data with compnents 4,5,6 or 1,2,3 |
Attemps to convert irregular component names to common format for later processing.
character vector
Jonathan M. Lees<jonathan.lees.edu>
fixcompname
comp <- c("v", "e") fixcomps(comp)comp <- c("v", "e") fixcomps(comp)
Replace NA values in a time series with mean values between end points of missing segments, or first and last real values in case the NA's are at the beginning or ends of traces.
fixNA(y)fixNA(y)
y |
numeric vector |
fixNA searches for stretches of NA 's in a time series and replaces the NA values with numeric values based ont he two end points of each section.
numeric vector with no NA values.
function is used primarily in filter applications.
Jonathan M. Lees<[email protected]>
butfilt
## source("~/Site/TA_DATA/CODE/fixNA.R") ### last samples are NA zig = rnorm(25) zig[10:15] = NA noNA = fixNA(zig) ### first samples are NA zig = rnorm(25) zig[1:5] = NA noNA = fixNA(zig) zig = rnorm(25) zig[1:5] = NA zig[21:25] = NA noNA = fixNA(zig) zig = rnorm(25) zig[1] = NA zig[21:25] = NA zig[10:12] = NA noNA = fixNA(zig) cbind(zig, noNA)## source("~/Site/TA_DATA/CODE/fixNA.R") ### last samples are NA zig = rnorm(25) zig[10:15] = NA noNA = fixNA(zig) ### first samples are NA zig = rnorm(25) zig[1:5] = NA noNA = fixNA(zig) zig = rnorm(25) zig[1:5] = NA zig[21:25] = NA noNA = fixNA(zig) zig = rnorm(25) zig[1] = NA zig[21:25] = NA zig[10:12] = NA noNA = fixNA(zig) cbind(zig, noNA)
Matches station locations to pickfile stations
fixUWstasLL(STAS, stafile)fixUWstasLL(STAS, stafile)
STAS |
structure of station lat, lon, z |
stafile |
station file |
Matches station locations to pickfile stations
structure of station lat, lon, z
Jonathan M. Lees<jonathan.lees.edu>
given julian day and year get month/day
fromjul(jul, yy)fromjul(jul, yy)
jul |
Julian Day |
yy |
year |
list(mo=mm, dom=dd)
Jonathan M. Lees<jonathan.lees.edu>
tojul
iyear <- 2001 jul <- 233 inine <- tojul(iyear,1,1); ijul <- inine + jul - 1; fromjul( ijul, iyear);iyear <- 2001 jul <- 233 inine <- tojul(iyear,1,1); ijul <- inine + jul - 1; fromjul( ijul, iyear);
Forward fourier Transform
FRWDft(g, n, tstart, dt)FRWDft(g, n, tstart, dt)
g |
input signal |
n |
number of points |
tstart |
start of trace |
dt |
sample interval, s |
G |
fourier compnents |
f |
frequency vector |
t |
time vector |
Jonathan M. Lees<jonathan.lees.edu>
INVRft
zil <- rnorm(300) fss <- FRWDft( zil, length(zil), 0, 0.004)zil <- rnorm(300) fss <- FRWDft( zil, length(zil), 0, 0.004)
Add tic marks to plot
gaddtix(side = 3, pos = 0, tck = 0.005, at = c(0, 1), labels = NULL, col = 2, addline = FALSE, ...)gaddtix(side = 3, pos = 0, tck = 0.005, at = c(0, 1), labels = NULL, col = 2, addline = FALSE, ...)
side |
side = 1, 2, 3, 4 |
pos |
relative to axis |
tck |
tic length |
at |
vector of positions |
labels |
vector of labels |
col |
color for plotting |
addline |
add lines |
... |
graphical parameters from par |
Graphical side effect
Jonathan M. Lees<jonathan.lees.edu>
par
plot(c(0,1), c(0,1), type='n', ann=FALSE, axes=FALSE) gaddtix(side=1, pos=0, tck=-0.01, at=seq(from=0, to=.5, by=.2) , labels=seq(from=0, to=.5, by=.2), col=1)plot(c(0,1), c(0,1), type='n', ann=FALSE, axes=FALSE) gaddtix(side=1, pos=0, tck=-0.01, at=seq(from=0, to=.5, by=.2) , labels=seq(from=0, to=.5, by=.2), col=1)
Do particle motion analysis
GAZI(ADAT, dt = 1, ex = seq(0, 100), comp = c(4, 5, 6), sta = "ZZZ", az = 0, len = 50, shift = 10, prev = 1, fileid = "", picks = NA, labs = NA)GAZI(ADAT, dt = 1, ex = seq(0, 100), comp = c(4, 5, 6), sta = "ZZZ", az = 0, len = 50, shift = 10, prev = 1, fileid = "", picks = NA, labs = NA)
ADAT |
Matrix of 3 component seismic data |
dt |
delta T (s) |
ex |
x-axis vector |
comp |
component names |
sta |
station name |
az |
azimuth of station orientation |
len |
length of time series |
shift |
amount to shift per window |
prev |
length of buffer at beginning of trace |
fileid |
character string to put on plot |
picks |
arrival times for annotation |
labs |
labels for arrival times for annotation |
list(aex=aex[1:jall], rateig=rateig[1:jall], aaz=aaz[1:jall], ai=ai[1:jall], figaz=figaz, azpar=azpar, incpar=incpar )
data("GH") temp <- cbind(GH$JSTR[[4]], GH$JSTR[[5]], GH$JSTR[[6]]) pmolabs <- c("Vertical", "North", "East") G <- GAZI(temp, dt =GH$dt[4] , comp = pmolabs, sta = GH$STNS[4] , az = 0, len =75, shift = 10, prev = 1)data("GH") temp <- cbind(GH$JSTR[[4]], GH$JSTR[[5]], GH$JSTR[[6]]) pmolabs <- c("Vertical", "North", "East") G <- GAZI(temp, dt =GH$dt[4] , comp = pmolabs, sta = GH$STNS[4] , az = 0, len =75, shift = 10, prev = 1)
Generate a ricker wavelet of a specfied frequency and length
genrick(freq, dt, nw)genrick(freq, dt, nw)
freq |
frequency of ricker wavelet |
dt |
Time sample rate (s) |
nw |
length of wavelet. |
ricker wavelet as a vector.
Original code by Leonard Lisapaly ([email protected]), converted to R by J.M. Lees.
Jonathan M. Lees<[email protected]>
dt <- 0.01 freq <- 16 nlen <- 35 G <- genrick(freq, dt, nlen) tee <- seq(from=0, by=dt, length=length(G)) plot(tee, G, type='l')dt <- 0.01 freq <- 16 nlen <- 35 G <- genrick(freq, dt, nlen) tee <- seq(from=0, by=dt, length=length(G)) plot(tee, G, type='l')
Search for low frequency asymptote, corner frequency, and fall off slope of seismic spectrum.
get.corner(INfreq, INspec, dt, f1, f2, PLOT = FALSE, VERBOSE = FALSE)get.corner(INfreq, INspec, dt, f1, f2, PLOT = FALSE, VERBOSE = FALSE)
INfreq |
frequency vector |
INspec |
spectrum |
dt |
deltaT |
f1 |
low frequency for modeling, Hz |
f2 |
High frequency for modeling, Hz |
PLOT |
logical, TRUE=plot |
VERBOSE |
TRUE=diagnostics |
This routine does not assume any particular mathematical model. It searches for a three parameters that describe two lines that mimic the displacement spectrum. The search is done via least squares.
Model of 3 parameters, best fit.
Jonathan M. Lees<jonathan.lees.edu>
brune.doom
data(CE1) ## set frequency range for modeling for this high frequency data ## we use f2 = 50, but for volcano data should be f2<15 f1 <- 0.01 f2 <- 50.0 ## set up data and parameters amp <- CE1$y len2 <- 2*next2(length(amp)) a <- list(y=amp, dt=CE1$dt) Spec <- MTMdisp(a, f1=f1, f2=f2, len2=len2, PLOT=FALSE ) lspec <- Spec$displ ### get initial estimate of parameters xc <- get.corner( Spec$f , lspec, CE1$dt, f1, f2, PLOT=FALSE)data(CE1) ## set frequency range for modeling for this high frequency data ## we use f2 = 50, but for volcano data should be f2<15 f1 <- 0.01 f2 <- 50.0 ## set up data and parameters amp <- CE1$y len2 <- 2*next2(length(amp)) a <- list(y=amp, dt=CE1$dt) Spec <- MTMdisp(a, f1=f1, f2=f2, len2=len2, PLOT=FALSE ) lspec <- Spec$displ ### get initial estimate of parameters xc <- get.corner( Spec$f , lspec, CE1$dt, f1, f2, PLOT=FALSE)
This fuction calls binary routines to read in ‘segy’, ‘sac’.
GET.seis(fnames, kind = 1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE) JGET.seis(fnames, kind = 1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE)GET.seis(fnames, kind = 1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE) JGET.seis(fnames, kind = 1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE)
fnames |
list of file names. |
kind |
an integer -1, 0, 1, 2 ; 0="RDATA" , -1="RDS", 0="RDATA", 1 = "segy", 2 = "sac", see notes below |
Iendian |
vector, Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
HEADONLY |
logical, TRUE= header information only; not seismic trace will be returned (runs a little faster). |
PLOT |
integer, <0 no plot; 0 interactive; >0 number of seconds to sleep |
RAW |
logical, default=FALSE(convert to volts) , TRUE (return counts intead of volts) |
"kind" can be numeric or character: options are 'RDS', 'RDATA', 'SEGY', 'SAC', corresponding to (-1, 0, 1, 2).
Uses readBin to extract data in SAC/SEGY format. User must know what kind of machine the data was created on for I/O purposes.
If data was created on a little endian machine but is being read on big endian machine, need to call the endian "swap" for swapping.
Iendian can be a vector if input files have different endian-ness.
If data was created on a machine with LONG=4 bytes, be sure to call the program with BIGLONG=FALSE.
The data returned is a list of lists, each element is one trace not necessarily related to the other traces in the list.
Once the data is read in, use prepSEIS to reformat the data into a list more amenable to further analysis in RSEIS.
See examples below for different cases.
List containing the seismic data and header information. Each trace consists of a list with:
fn |
original file name |
sta |
station name |
comp |
compnent |
dt |
delta t in seconds |
DATTIM |
time list |
yr |
year |
jd |
julian day |
mo |
month |
dom |
day of month |
hr |
hour |
mi |
minute |
sec |
sec |
msec |
milliseconds |
dt |
delta t in seconds |
t1 |
time start of trace |
t2 |
time end of trace |
off |
off-set |
N |
number of points in trace |
units |
units |
amp |
vector of trace values |
The easiext way to process datais to convert the data to an R-format type, using either save (kind=0) or saveRDS (kind=-1). If these are used then I/O is simple.
OLDER:
Information in the file names is ignored, so be sure to modify headers prior to using this method of extracting meta-data. (Or modify the meta data from the file names after reading in the data.)
For SEGY files, in LINUX-UNIX, use: rename, segymod (PASSCAL) to modify the headers
JGET.seis extracts digital seismic data from binary files stored in the file system. The program uses readBin for I/O and passes data back to R. Currently SAC, SEGY formats are installed but it is easy to extend. AH format is available for LINUX systems, but there were problems compiling in WINDOWS and MACOS so this feature was removed.
A filter for mseed format is currently being developed. Could use package 'IRISSeismic'
Jonathan M. Lees <[email protected]>
plotJGET, JSAC.seis , prepSEIS, Mine.seis
data(GH) DD = data.frame(GH$info) #### get only vertical traces WV = which( GH$COMPS=='V' ) L1 = length(WV) GIVE = vector(mode='list') for(j in 1:L1 ) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } #### par(mfrow=c(length(GIVE) , 1) ) # for(i in 1:length(GIVE) ) { plotGH(GIVE[[i]]) } tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) Gseis = GET.seis(LF, kind = -1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE) zed <- prepSEIS(Gseis) #### plot the data, and interact with the data swig(zed, sel=which(zed$COMPS=='V'), SHOWONLY=0) if(interactive()){ plotJGET(Gseis) } ### for data created on UNIX (SUN) but read on linux: ### S1 <- GET.seis(Lname, kind = 1, Iendian="swap", BIGLONG=FALSE, PLOT = -1) ### for data created on linux (32 bit) but read on linux 64 bit: ### S1 <- GET.seis(Lname, kind = 1, Iendian="little", BIGLONG=FALSE, PLOT = -1) ### for SEGY data created on linux (64 bit) but read on linux 32 bit: ### S1 <- GET.seis(Lname, kind = 1, Iendian="little", BIGLONG=TRUE, PLOT = -1) ### for SAC data created on MAC-OS (64 bit) but read on linux 32 bit: ### S1 <- GET.seis(Lname, kind = 2, Iendian="swap", BIGLONG=TRUE, PLOT = -1)data(GH) DD = data.frame(GH$info) #### get only vertical traces WV = which( GH$COMPS=='V' ) L1 = length(WV) GIVE = vector(mode='list') for(j in 1:L1 ) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } #### par(mfrow=c(length(GIVE) , 1) ) # for(i in 1:length(GIVE) ) { plotGH(GIVE[[i]]) } tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) Gseis = GET.seis(LF, kind = -1, Iendian=1, BIGLONG=FALSE , HEADONLY=FALSE, PLOT = -1, RAW=FALSE) zed <- prepSEIS(Gseis) #### plot the data, and interact with the data swig(zed, sel=which(zed$COMPS=='V'), SHOWONLY=0) if(interactive()){ plotJGET(Gseis) } ### for data created on UNIX (SUN) but read on linux: ### S1 <- GET.seis(Lname, kind = 1, Iendian="swap", BIGLONG=FALSE, PLOT = -1) ### for data created on linux (32 bit) but read on linux 64 bit: ### S1 <- GET.seis(Lname, kind = 1, Iendian="little", BIGLONG=FALSE, PLOT = -1) ### for SEGY data created on linux (64 bit) but read on linux 32 bit: ### S1 <- GET.seis(Lname, kind = 1, Iendian="little", BIGLONG=TRUE, PLOT = -1) ### for SAC data created on MAC-OS (64 bit) but read on linux 32 bit: ### S1 <- GET.seis(Lname, kind = 2, Iendian="swap", BIGLONG=TRUE, PLOT = -1)
Return a matrix of Slepian tapers
get.slepians(npoints = 900, nwin = 5, npi = 3)get.slepians(npoints = 900, nwin = 5, npi = 3)
npoints |
Number of points to return |
nwin |
Number of windows (default =5) |
npi |
Pi-Prolate numerber (3) |
This function onlyu returns the tapers for inspection. To apply the tapers use the function mtapspec.
Matrix: nwin vectors of npoints Slepian tapers
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
mtapspec
nwin <- 5 npi <- 3 npoints <- 900 sleps <- get.slepians(npoints, nwin, npi) matplot(sleps, type='l', xlab="Index", ylab="Taper Amplitude") legend('topleft', legend=1:nwin, lty=1:nwin, col=1:nwin)nwin <- 5 npi <- 3 npoints <- 900 sleps <- get.slepians(npoints, nwin, npi) matplot(sleps, type='l', xlab="Index", ylab="Taper Amplitude") legend('topleft', legend=1:nwin, lty=1:nwin, col=1:nwin)
Read in a velocity model
Get1Dvel(infile, PLOT = TRUE)Get1Dvel(infile, PLOT = TRUE)
infile |
Path to ascii-text model |
PLOT |
logical, TRUE=plot |
Reads Velocity model from a text file
LIST:
zp |
vector of Tops of Layers, P-wave, (km) |
vp |
vector of velocities of Layers, P-wave,(km/s) |
ep |
errors for velocities, P-wave,(km/s) |
zs |
vector of Tops of Layers, S-wave, (km) |
vs |
vector of velocities of Layers, S-wave,(km/s) |
es |
errors for velocities, S-wave,(km/s) |
name |
character, name of model |
descriptor |
character vector description of model |
Jonathan M. Lees<jonathan.lees.edu>
Plot1Dvel, Comp1Dvel, Comp1Dvels, travel.time1D
data(VELMOD1D) Get1Dvel(VELMOD1D, PLOT=TRUE)data(VELMOD1D) Get1Dvel(VELMOD1D, PLOT=TRUE)
Auto-Regressive AIC for arrival estimate, signal detection
GETARAIC(z4, DT = 0.008, Mar = 8, O1 = 2, O2 = 0.2, WW = 2, T1 = 1, PLOT = FALSE)GETARAIC(z4, DT = 0.008, Mar = 8, O1 = 2, O2 = 0.2, WW = 2, T1 = 1, PLOT = FALSE)
z4 |
signal time series |
DT |
sample rate,s |
Mar |
AR Model Order |
O1 |
window before, s |
O2 |
window after, s |
WW |
window length, s |
T1 |
initial guess, number of samples from beginning of trace |
PLOT |
logical, TRUE =plot |
Method of Sleeman for automatic phase determination.
Taic |
Arrival time of wave |
Jonathan M. Lees<jonathan.lees.edu>
Sleeman
PSTLTcurve
data(CE1) plot(CE1$x, CE1$y, type='l') Xamp = CE1$y[CE1$x>4.443754 & CE1$x<6.615951] Mar=8 z4 = Xamp DT = CE1$dt T1 = 50 O1 = 10*DT O2 = 10*DT WW = 10*DT Nz4 = length(z4) araict = GETARAIC(Xamp, DT=CE1$dt, Mar=8, T1=T1, O1=O1, O2=O2, WW=WW, PLOT=TRUE)data(CE1) plot(CE1$x, CE1$y, type='l') Xamp = CE1$y[CE1$x>4.443754 & CE1$x<6.615951] Mar=8 z4 = Xamp DT = CE1$dt T1 = 50 O1 = 10*DT O2 = 10*DT WW = 10*DT Nz4 = length(z4) araict = GETARAIC(Xamp, DT=CE1$dt, Mar=8, T1=T1, O1=O1, O2=O2, WW=WW, PLOT=TRUE)
Used for event detection
getb1b2(J, L, zwin, maxx, max2)getb1b2(J, L, zwin, maxx, max2)
J |
Thresh.J |
L |
Thresh.J |
zwin |
maximum of forwd and bakwrd windows |
maxx |
max number of points |
max2 |
all points |
vector c(b1,b2)
Used for thresholding on event detection.
Jonathan M. Lees<jonathan.lees.edu>
Thresh.J, ETECTG
Location Error Card
getEcard(ECARD)getEcard(ECARD)
ECARD |
error card from Lquake |
LOC |
character, location |
rms |
root mean square error |
meanres |
mean residual |
sdres |
standard deviation of residuals |
sdmean |
standard error of mean |
sswres |
sum squares |
ndf |
number degrees of freedom |
fixflgs |
flags for inversion |
sterrx |
error in x-direction |
sterry |
error in y-direction |
sterrz |
error in z-direction |
sterrt |
error in origin time |
mag |
mag |
sterrmag |
error for mag |
Jonathan M. Lees<jonathan.lees.edu>
get F-card information
getFcard(FCARD)getFcard(FCARD)
FCARD |
Error Ellipsoid card |
List:
azim1 |
angle, degrees |
plunge1 |
angle, degrees |
val1 |
value |
azim2 |
angle, degrees |
plunge2 |
angle, degrees |
val2 |
value |
azim3 |
angle, degrees |
plunge3 |
angle, degrees |
val3 |
value |
herr |
error |
verr |
vertical error |
Jonathan M. Lees<jonathan.lees.edu>
Extract the times of all traces relative to a reference trace on a seismic RSEIS list.
getGHtime(GH, wi = 1, pix = NULL)getGHtime(GH, wi = 1, pix = NULL)
GH |
RSEIS seismic data list |
wi |
which event to use as a reference baseline |
pix |
list of time to difference |
list: times relative to reference time:
yr |
year |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
spix |
seconds after reference |
Jonathan M. Lees<[email protected]>
secdifL, secdif
data(GH) getGHtime(GH)data(GH) getGHtime(GH)
Extract High resolution information from H-card
getHcard(hcard)getHcard(hcard)
hcard |
ascii h-card |
List:
yr |
Year |
mo |
Month |
dom |
Day of Month |
hr |
Hour |
mi |
minute |
sec |
second |
lat |
latitude |
lon |
longitude |
z |
depth |
mag |
magnitude |
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
Convert hypocenters from the IRIS website and prepare for plotting in GEOmap
getIRIS(fn, skip=0) getANSS(fn, skip=2)getIRIS(fn, skip=0) getANSS(fn, skip=2)
fn |
character, file path name |
skip |
numeric, number of lines to skip (e.g. for the header) |
Reads in a file dumped out by the website selection box.
list:
yr |
vector year |
dom |
vector, day of month |
mo |
vector, mo |
hr |
vector, hour |
mi |
vector, minute |
sec |
vector, sec |
lat |
vector, latitude |
lon |
vector, longitude |
z |
vector, depth |
mag |
vector, magnitude |
Be careful about headers and lines that need to be skipped.
for IRIS: http://www.iris.washington.edu/data/event/eventsearch.htm
For ANSS: http://www.quake.geo.berkeley.edu/anss/catalog-search.html
For NEIC (yet to be added) http://earthquake.usgs.gov/earthquakes/eqarchives/epic/epic_global.php
Jonathan M. Lees<[email protected]>
getjul
fn <- tempfile() K = c( 'Date Time Lat Lon Depth Mag Magt Nst Gap Clo RMS SRC Event ID', '----------------------------------------------------------------------------------------------', '1994/09/06 09:37:36.48 40.1330 144.6240 33.40 4.60 Mb 28 1.22 NEI 199409064025', '1994/09/06 10:00:02.97 36.4840 140.5730 66.60 4.90 Mb 39 0.88 NEI 199409064028', '1994/09/06 10:07:16.53 40.1700 144.5890 33.00 4.70 Mb 49 1.09 NEI 199409064029', '1994/09/06 17:31:52.27 42.6220 142.7000 33.00 5.00 Mb 13 0.54 NEI 199409064042') cat(file=fn, K, sep='\n') ### check: z = scan(file=fn, what='', sep='\n') g <- getANSS(fn, skip=2) g$jd <- getjul(g$yr, g$mo, g$dom)fn <- tempfile() K = c( 'Date Time Lat Lon Depth Mag Magt Nst Gap Clo RMS SRC Event ID', '----------------------------------------------------------------------------------------------', '1994/09/06 09:37:36.48 40.1330 144.6240 33.40 4.60 Mb 28 1.22 NEI 199409064025', '1994/09/06 10:00:02.97 36.4840 140.5730 66.60 4.90 Mb 39 0.88 NEI 199409064028', '1994/09/06 10:07:16.53 40.1700 144.5890 33.00 4.70 Mb 49 1.09 NEI 199409064029', '1994/09/06 17:31:52.27 42.6220 142.7000 33.00 5.00 Mb 13 0.54 NEI 199409064042') cat(file=fn, K, sep='\n') ### check: z = scan(file=fn, what='', sep='\n') g <- getANSS(fn, skip=2) g$jd <- getjul(g$yr, g$mo, g$dom)
Get Julian day
getjul(year, month, day)getjul(year, month, day)
year |
year |
month |
month |
day |
day of month |
Julian Day
Jonathan M. Lees<jonathan.lees.edu>
getmoday
getjul(2003, 11, 13)getjul(2003, 11, 13)
Get month day from julian day and year
getmoday(jul, iyear)getmoday(jul, iyear)
jul |
julian day |
iyear |
Year |
mo |
Month |
dom |
day of month |
Jonathan M. Lees<jonathan.lees.edu>
getmoday(234, 2005)getmoday(234, 2005)
extract name from N-card
getNcard(ncard)getNcard(ncard)
ncard |
ncard from UW-pickfile |
Ncard
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
Unpack PDE file as CSV file or ascii screen dump
getPDEcsv(pde = 'filename') getPDEscreen(pde = 'filename' )getPDEcsv(pde = 'filename') getPDEscreen(pde = 'filename' )
pde |
character, file name |
Download pde from: http://neic.usgs.gov/neis/epic/epic.html. csv version uses comma separated values. screen versions uses the screen dump and a parser
list of locations, times and magnitude
if using screen dump, may need to clean up file a bit first.
Jonathan M. Lees<[email protected]>
http://neic.usgs.gov/neis/epic/epic.html
###### copy/paste from the screen dump at the NEIC web site fn <- tempfile() K = c( ' PDE-Q 2008 12 31 053408.80 40.11 -77.00 1 2.4 LgGS ... ....... ', ' PDE-Q 2008 12 31 084757.50 46.75 154.41 14 4.9 mbGS ... ....... ', ' PDE-Q 2008 12 31 090228 44.53 -110.36 4 3.6 MLSLC ... ....... ', ' PDE-Q 2008 12 31 110505 33.94 -118.78 14 3.1 MLPAS 2F. ....... ', ' PDE-Q 2008 12 31 113957.56 4.91 127.43 77 5.4 MwGS ..M ....... ', ' PDE-Q 2008 12 31 140227.55 -25.35 -177.61 154 5.3 MwGS ..M ....... ') cat(file=fn, K, sep='\n') ### check: z = scan(file=fn, what='', sep='\n') g <- getPDEscreen(pde = fn)###### copy/paste from the screen dump at the NEIC web site fn <- tempfile() K = c( ' PDE-Q 2008 12 31 053408.80 40.11 -77.00 1 2.4 LgGS ... ....... ', ' PDE-Q 2008 12 31 084757.50 46.75 154.41 14 4.9 mbGS ... ....... ', ' PDE-Q 2008 12 31 090228 44.53 -110.36 4 3.6 MLSLC ... ....... ', ' PDE-Q 2008 12 31 110505 33.94 -118.78 14 3.1 MLPAS 2F. ....... ', ' PDE-Q 2008 12 31 113957.56 4.91 127.43 77 5.4 MwGS ..M ....... ', ' PDE-Q 2008 12 31 140227.55 -25.35 -177.61 154 5.3 MwGS ..M ....... ') cat(file=fn, K, sep='\n') ### check: z = scan(file=fn, what='', sep='\n') g <- getPDEscreen(pde = fn)
Read Pick File to R
getpfile(uwpickfile, stafile = NULL)getpfile(uwpickfile, stafile = NULL)
uwpickfile |
pick file |
stafile |
station file |
University of washington Format pickfiles are used. See EmptyPickfile for the structure stored.
pickfile structure
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
Use MTM spectrum to estimate phase lag between two signals.
getphaselag2(y1, y2, DT = 0.008, frange = c(0, 20), PLOT = FALSE, PLOT1 = FALSE, PLOT2 = FALSE)getphaselag2(y1, y2, DT = 0.008, frange = c(0, 20), PLOT = FALSE, PLOT1 = FALSE, PLOT2 = FALSE)
y1 |
vector times series one |
y2 |
vector times series two |
DT |
deltaT sample rate, s |
frange |
vector, frequency bounds for analysis |
PLOT |
logical, TRUE=diagnostic plot |
PLOT1 |
logical, TRUE=diagnostic plot |
PLOT2 |
logical, TRUE=diagnostic plot |
uses the slope of the cross spectrum to estimate the phase lag.
phase lag, seconds
Jonathan M. Lees<jonathan.lees.edu>
mtapspec
data("GH") Xamp1<-GH$JSTR[[1]] Xamp1<-Xamp1[1123:2000] Xamp2<- GH$JSTR[[4]] Xamp2<-Xamp2[1123:2000] plot(Xamp1,type='l') lines(Xamp2,type='l',col='red') pshift <- getphaselag2(Xamp1, Xamp2, DT=GH$info$dt[1], frange=c(5, 15), PLOT=TRUE)data("GH") Xamp1<-GH$JSTR[[1]] Xamp1<-Xamp1[1123:2000] Xamp2<- GH$JSTR[[4]] Xamp2<-Xamp2[1123:2000] plot(Xamp1,type='l') lines(Xamp2,type='l',col='red') pshift <- getphaselag2(Xamp1, Xamp2, DT=GH$info$dt[1], frange=c(5, 15), PLOT=TRUE)
get read picks
getrdpix(zloc, zenclick, sel, NH)getrdpix(zloc, zenclick, sel, NH)
zloc |
location list |
zenclick |
number of picks |
sel |
sel vector in swig |
NH |
RSEIS list |
Used internally in swig
list: rd: date/times of picks for stations and comps
Jonathan M. Lees<[email protected]>
swig
Get 24 Hours of Seismic Data
getseis24(DB, iyear = 2009, iday = 1, usta = "", acomp = "", kind = 1, Iendian=1, BIGLONG=FALSE)getseis24(DB, iyear = 2009, iday = 1, usta = "", acomp = "", kind = 1, Iendian=1, BIGLONG=FALSE)
DB |
Data base of meta-data about the seismic trace files |
iyear |
Year for extraction |
iday |
Julian day for extraction |
usta |
station to show |
acomp |
component to show |
kind |
kind of data, default=1, 0="RDATA" , -1="RDS", 0="RDATA", 1 = "segy", 2 = "sac" |
Iendian |
Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
The DB file consists of a list of information on where to find the data and what times are covered. DB is
full path to file
year
julian day
hour
minute
second
duration, seconds
origin time for epoch calculations
yr |
start year |
jd |
start julian day |
t1 |
start t1 (with epoch) |
t2 |
start t2 (with epoch day) |
ed |
epoch day |
hr |
start hour |
mi |
start minute |
sec |
start seconds |
gamp |
Amplitude of each trace |
gdt |
delta-t, sample interval, in seconds |
gnam |
station name |
gfile |
file information |
sigs |
List of time series |
zna |
List of NA values in each time series |
Jonathan M. Lees<[email protected]>
setupDB, plotseis24
data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) )data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) )
Uses a Pickfile and the Waveform file, and creates a vector ordering the waveforms by P-wave arrival.
getvertsorder(P, GU)getvertsorder(P, GU)
P |
Pickfile Structure |
GU |
Waveform structure |
Waveforms structure may already have pickfile, but this is overridden by input pickfile P.
list:
sel |
index of traces in order of first P-wave arrival |
win |
vector, c(1,2), time window from the first arrival to the last |
Jonathan M. Lees<jonathan.lees.edu>
swig
data(GH) vertord <- getvertsorder(GH$pickfile, GH) swig(GH, sel=vertord$sel, WIN=vertord$win, SHOWONLY=TRUE)data(GH) vertord <- getvertsorder(GH$pickfile, GH) swig(GH, sel=vertord$sel, WIN=vertord$win, SHOWONLY=TRUE)
Example of seismic data structure. Geothermal Earthquake.
data(GH)data(GH)
List, consisting of:
list of digital seismic data traces
vector of stations
directory
original file names
Component names, V N E, e.g.
Old Component names
vector of delta-t, sampling time intervals
Notes for plotting on panels
List, detailed information about traces, including
not used
Number of traces
time axis for plotting
colors for plotting
which traces are okay
window span time, seconds
alphanumeric time stamp
pickfile, see below
velocity model list
station information list including lat, lon, z
source name for loading
event ID number
The info list consists of:
file name
identification name
start year
start julianday
month
day of month
hour
minute
second
millisecond
delta-t
time 1
time 2
offset
number of samples
not used
not used
number of samples
The pickfile consists of:
list(yr, jd, mo, dom, hr, mi, sec, lat, lon, z, mag, gap, delta , rms, hozerr)
list(az1, dip1, az2, dip2, dir, rake1, dipaz1, rake2, dipaz2, F=list(az, dip), G=list(az, dip), U=list(az, dip), V=list(az, dip), P=list(az, dip), T=list(az,dip),sense,M=list( az1, d1, az2, d2, uaz, ud, vaz, vd, paz, pd , taz, td), UP=TRUE, icol=1, ileg, fcol='red', CNVRG, LIM =c(0,0,0,0))
list(tag, name, comp, c3, phase, sec, err, pol, flg , res)
vector, length=6
list(yr,mo,dom,hr,mi,sec,lat,lon,z,mag)
name card
list(rms,meanres,sdres,sdmean, sswres,ndf,fixflgs,sterrx,sterry,sterrz,sterrt,mag,sterrmag)
file name
Name of Picker
numeric ID
win format ID
Vector of comments
Old station names
Lees, J.M., 2004. Scattering from a fault interface in the Coso geothermal field. Journal of Volcanology and Geothermal Research, 130(1-2): 61-75.
data(GH)data(GH)
Prepare a character string stamp for idenitication of plots of of signals in swig.
ghstamp(GH, sel, WIN = c(485, 600))ghstamp(GH, sel, WIN = c(485, 600))
GH |
RSEIS list structure |
sel |
numeric index vector, selection of traces |
WIN |
time window within a trace |
The character string can be used as a stamp on plots for unique identification. Uses the info list in the RSEIS list. This function combines Zdate with the window time information.
character array for each component in the sel vector.
Jonathan M. Lees<[email protected]>
Zdate, MTM.drive, plotwlet
data(KH) ghstamp(KH) data(GH) ghstamp(GH, sel=1:3)data(KH) ghstamp(KH) data(GH) ghstamp(GH, sel=1:3)
Once a database has been mined this program re-arranges the seismograms and creates a structure used in other programs.
GLUE.GET.seis(GG)GLUE.GET.seis(GG)
GG |
list of seismograms with headers |
structure of seismograms glued together
Jonathan M. Lees<jonathan.lees.edu>
Mine.seis
Find duplicated stations in a matrix and fill in the traces that are continuations, return the new matrix and the vector duplicates
GLUEseisMAT(GFIL)GLUEseisMAT(GFIL)
GFIL |
list of data and headers, with duplicated stations glued |
New List of data and headers with same sensors/components glued together
Jonathan M. Lees<jonathan.lees.edu>
Mine.seis
Get Polynomial from Poles and Zeros
gpoly(x)gpoly(x)
x |
complex vector of poles or zeros |
vector of coefficients
Jonathan M. Lees<jonathan.lees.edu>
K <- PreSet.Instr() ## convert zeros to polynomial coefficients gpoly(K[[1]]$zeros)K <- PreSet.Instr() ## convert zeros to polynomial coefficients gpoly(K[[1]]$zeros)
Distance Along Great Circle Arc in degrees, kilometers
GreatDist(LON1, LAT1, LON2, LAT2, EARTHRAD= 6371)GreatDist(LON1, LAT1, LON2, LAT2, EARTHRAD= 6371)
LON1 |
Longitude, point1 |
LAT1 |
Latitude, point1 |
LON2 |
Longitude, point2 |
LAT2 |
Latitude, point2 |
EARTHRAD |
optional earth radius, default = 6371 |
LIST:
drad |
distance in radians |
ddeg |
distance in degrees |
dkm |
distance in kilometers |
Jonathan M. Lees <[email protected]>
### get distance between London, England and Santiago, Chile london <- c(51.53333, -0.08333333) santiago <- c(-33.46667, -70.75) GreatDist(london[2], london[1], santiago[2], santiago[1])### get distance between London, England and Santiago, Chile london <- c(51.53333, -0.08333333) santiago <- c(-33.46667, -70.75) GreatDist(london[2], london[1], santiago[2], santiago[1])
Set up a rotation matrix for a seismic trace. Rotation matrix is 3D, although this rotation only creates a rotation for conversion to radial-transverse orientation.
grotseis(ang, flip = FALSE)grotseis(ang, flip = FALSE)
ang |
Angle to rotate horizontal components, degrees from North |
flip |
Logical, TRUE=flip the vertical axis, default=FALSE |
Returns a 3 by 3 matrix used for rotationg a 3-component seismic record, usually stored as an N by 3 matrix.
Only the N-E components are rotated, although the vertical component can be flipped.
It is important to note the order components are introduced in the rotation matrix. Here we assume East is X (to the right), and North is Y (to the top).
For data that has (V,N,E) as (1,2,3) need to switch components (1,3,2)
For data with (V,E,N) use the normal (1,2,3)
If Back-Azimuth is used, radial is directed towards the source. If azimuth is used, radial is directed away from the source.
3 by 3 rotation matrix.
Positive radial is away from the source (direction of wave propagation). Positive transverse is to the right when facing the direction of wave propagation.
Jonathan M. Lees<[email protected]>
rdistaz
#### simple case: vecs <- rbind(c(0,0,1), c(0,1,0)) rbaz <- grotseis(21.76, flip=FALSE) bvec <- vecs %*% rbaz plot(c(-2,2) , c(-2,2) , asp=1, xaxs="r" , yaxs="r" , type='n' ) arrows(0, 0, 0+bvec[,2], 0+bvec[,3], col=c("red", "blue"), length=.08) arrows(0, 0, vecs[,2], vecs[,3], col=c("red", "blue"), length=.08, lty=2) text(0+bvec[1,2], 0+bvec[1,3], labels='radial', pos=3) text(0+bvec[2,2], 0+bvec[2,3], labels='transverse', pos=4) text(0+vecs[1,2], 0+vecs[1,3], labels='North', pos=3) text(0+vecs[2,2], 0+vecs[2,3], labels='East', pos=4) #### realistic case: STAXY<-list() STAXY$'x'<-c(-2.9162198461534,-2.49599248511068, -2.85909405321704,-1.96135073099434, -6.50413342506259,2.64026676599765, -3.95701139503518,-2.84082134537436, -0.0457817300378462,-2.74214190991955) STAXY$'y'<-c(-7.83435541676815,-4.46180337254565, -6.46036190991833,-5.01212763828746, -2.56091416028758, 5.31173503708142,2.10545324503380,-0.87490923667824, -0.172422188354707,-1.52055218789877) STAXY$'lat'<-c(14.685621984127,14.7159182222222, 14.6979647030651,14.710975070028, 14.7329873333333,14.8037143111518 ,14.7749104943935,14.7481391460905, 14.7544511215933,14.7423394025875) STAXY$'lon'<-c(268.420918730159,268.424817925926, 268.421447725096,268.429783940243,268.387586722222, 268.472531954619,268.41123843527,268.421611351166, 268.447574716981,268.422528671994) STAXY$'z'<-c(0.92522857142857,1.48225333333333, 1.14740517241379,1.4423781512605,1.51148, 2.53268681318681,2.70014678899083,2.04094444444444, 2.90827547169811,2.31817123287671) STAXY$'cen'<-c(14.756,-91.552) STAXY$name<-c('OBS','CAR','MAR','CAS','MTB','STA','STE','MOT','SUM','DOM') sguitoXY<-list() sguitoXY$'x'<-c(-1.78551922571555) sguitoXY$'y'<-c(-1.80850340813817) sguitoXY$'lat'<-c(14.7397535236) sguitoXY$'lon'<-c(268.4314147874) sguitoXY$'z'<-c(2.501) DAZ <- rdistaz( sguitoXY$lat, sguitoXY$lon , STAXY$lat, STAXY$lon) STAXY$az <- DAZ$baz #### plotting plot(STAXY$x, STAXY$y, asp=1, xaxs="r" , yaxs="r" ) text(STAXY$x, STAXY$y,STAXY$name, pos=3) points(0,0, pch=3) points(sguitoXY$x,sguitoXY$y , pch=8) segments(sguitoXY$x, sguitoXY$y, STAXY$x, STAXY$y, col="green", lty=2) #### be aware of the convention used: (V-N-E) or (V-E-N) ### here first vector is east, second vector is north ### if you use the V-N-E convention vecs <- rbind( c(0,1,0), c(0,0,1)) for( i in 1:length(STAXY$x)) { rbaz <- grotseis(STAXY$az[i], flip=FALSE) bvec <- vecs %*% rbaz ############## red is north, blue east ######## red is radial positive away or toward source, blue is transverse ########## blue is positive rotated to the right of red ## arrows(STAXY$x[i],STAXY$y[i], STAXY$x[i]+bvec[,2], STAXY$y[i]+bvec[,3], col=c("red", "blue"), length=.08) }#### simple case: vecs <- rbind(c(0,0,1), c(0,1,0)) rbaz <- grotseis(21.76, flip=FALSE) bvec <- vecs %*% rbaz plot(c(-2,2) , c(-2,2) , asp=1, xaxs="r" , yaxs="r" , type='n' ) arrows(0, 0, 0+bvec[,2], 0+bvec[,3], col=c("red", "blue"), length=.08) arrows(0, 0, vecs[,2], vecs[,3], col=c("red", "blue"), length=.08, lty=2) text(0+bvec[1,2], 0+bvec[1,3], labels='radial', pos=3) text(0+bvec[2,2], 0+bvec[2,3], labels='transverse', pos=4) text(0+vecs[1,2], 0+vecs[1,3], labels='North', pos=3) text(0+vecs[2,2], 0+vecs[2,3], labels='East', pos=4) #### realistic case: STAXY<-list() STAXY$'x'<-c(-2.9162198461534,-2.49599248511068, -2.85909405321704,-1.96135073099434, -6.50413342506259,2.64026676599765, -3.95701139503518,-2.84082134537436, -0.0457817300378462,-2.74214190991955) STAXY$'y'<-c(-7.83435541676815,-4.46180337254565, -6.46036190991833,-5.01212763828746, -2.56091416028758, 5.31173503708142,2.10545324503380,-0.87490923667824, -0.172422188354707,-1.52055218789877) STAXY$'lat'<-c(14.685621984127,14.7159182222222, 14.6979647030651,14.710975070028, 14.7329873333333,14.8037143111518 ,14.7749104943935,14.7481391460905, 14.7544511215933,14.7423394025875) STAXY$'lon'<-c(268.420918730159,268.424817925926, 268.421447725096,268.429783940243,268.387586722222, 268.472531954619,268.41123843527,268.421611351166, 268.447574716981,268.422528671994) STAXY$'z'<-c(0.92522857142857,1.48225333333333, 1.14740517241379,1.4423781512605,1.51148, 2.53268681318681,2.70014678899083,2.04094444444444, 2.90827547169811,2.31817123287671) STAXY$'cen'<-c(14.756,-91.552) STAXY$name<-c('OBS','CAR','MAR','CAS','MTB','STA','STE','MOT','SUM','DOM') sguitoXY<-list() sguitoXY$'x'<-c(-1.78551922571555) sguitoXY$'y'<-c(-1.80850340813817) sguitoXY$'lat'<-c(14.7397535236) sguitoXY$'lon'<-c(268.4314147874) sguitoXY$'z'<-c(2.501) DAZ <- rdistaz( sguitoXY$lat, sguitoXY$lon , STAXY$lat, STAXY$lon) STAXY$az <- DAZ$baz #### plotting plot(STAXY$x, STAXY$y, asp=1, xaxs="r" , yaxs="r" ) text(STAXY$x, STAXY$y,STAXY$name, pos=3) points(0,0, pch=3) points(sguitoXY$x,sguitoXY$y , pch=8) segments(sguitoXY$x, sguitoXY$y, STAXY$x, STAXY$y, col="green", lty=2) #### be aware of the convention used: (V-N-E) or (V-E-N) ### here first vector is east, second vector is north ### if you use the V-N-E convention vecs <- rbind( c(0,1,0), c(0,0,1)) for( i in 1:length(STAXY$x)) { rbaz <- grotseis(STAXY$az[i], flip=FALSE) bvec <- vecs %*% rbaz ############## red is north, blue east ######## red is radial positive away or toward source, blue is transverse ########## blue is positive rotated to the right of red ## arrows(STAXY$x[i],STAXY$y[i], STAXY$x[i]+bvec[,2], STAXY$y[i]+bvec[,3], col=c("red", "blue"), length=.08) }
Hilbert transform
hilbert(x)hilbert(x)
x |
time series vector |
Returns the hilbert transform. Used for calculating the envelope function.
vector
Jonathan M. Lees<jonathan.lees.edu>
fft, envelope
x <- rnorm(100) y <- hilbert(x)x <- rnorm(100) y <- hilbert(x)
Search for Extrema along time series
hilow(y)hilow(y)
y |
time series |
LIST:
hi |
indexes to peaks |
lo |
indexes to valleys |
Jonathan M. Lees<jonathan.lees.edu>
peaks
ex <- seq(from=0, to=4*pi, length = 200) y <- sin(ex) plot(ex, y, type='l') peakval <- hilow(y) abline(v=ex[peakval$hi], col='green') abline(v=ex[peakval$lo], col='red')ex <- seq(from=0, to=4*pi, length = 200) y <- sin(ex) plot(ex, y, type='l') peakval <- hilow(y) abline(v=ex[peakval$hi], col='green') abline(v=ex[peakval$lo], col='red')
HodoGram Plot
hodogram(nbaz, dt = dt, labs = c("Vertical", "North", "East"), COL =rainbow(140)[1:100] , STAMP = "")hodogram(nbaz, dt = dt, labs = c("Vertical", "North", "East"), COL =rainbow(140)[1:100] , STAMP = "")
nbaz |
n by 3 matrix |
dt |
time sample rate |
labs |
labels for the components |
COL |
color palette |
STAMP |
character stamp for identification |
sx = list graphical side effect
Jonathan M. Lees<jonathan.lees.edu>
data("GH") temp <- cbind(GH$JSTR[[1]][1168:1500], GH$JSTR[[2]][1168:1500], GH$JSTR[[3]][1168:1500]) pmolabs <- c("Vertical", "North", "East") sx <- hodogram(temp, dt=GH$dt[1] ,labs=pmolabs, STAMP="Example", COL=rainbow(100) )data("GH") temp <- cbind(GH$JSTR[[1]][1168:1500], GH$JSTR[[2]][1168:1500], GH$JSTR[[3]][1168:1500]) pmolabs <- c("Vertical", "North", "East") sx <- hodogram(temp, dt=GH$dt[1] ,labs=pmolabs, STAMP="Example", COL=rainbow(100) )
length of line connecting two points in a plane
hypot(x1, y1, x2, y2)hypot(x1, y1, x2, y2)
x1 |
x-location point 1 |
y1 |
y-location point 1 |
x2 |
x-location point 2 |
y2 |
y-location point 2 |
Euclidean distance
numeric distance
Jonathan M. Lees<[email protected]>
hypot(34, 12, 56, 89)hypot(34, 12, 56, 89)
Identification of points on a hodogram
idpoints.hodo(nbaz, sx, X, Y)idpoints.hodo(nbaz, sx, X, Y)
nbaz |
matrix 3 by n |
sx |
x vector |
X |
x-coordinates to id |
Y |
y-coordinates to id |
Used in conjunction with other interative plots.
Jonathan M. Lees<jonathan.lees.edu>
PMOT.drive
data("GH") sel<- which(GH$STNS == "CE1") temp <- cbind(GH$JSTR[[sel[1]]][1168:1500], GH$JSTR[[sel[2]]][1168:1500], GH$JSTR[[sel[3]]][1168:1500]) dt <- GH$dt[ sel[1] ] STAMP <- "GH" PMOT.drive(temp, dt, pmolabs = c("Vertical", "North", "East"), STAMP = STAMP) ## ids <- idpoints.hodo(temp, sx, zloc$x[sn1], zloc$y[sn1])data("GH") sel<- which(GH$STNS == "CE1") temp <- cbind(GH$JSTR[[sel[1]]][1168:1500], GH$JSTR[[sel[2]]][1168:1500], GH$JSTR[[sel[3]]][1168:1500]) dt <- GH$dt[ sel[1] ] STAMP <- "GH" PMOT.drive(temp, dt, pmolabs = c("Vertical", "North", "East"), STAMP = STAMP) ## ids <- idpoints.hodo(temp, sx, zloc$x[sn1], zloc$y[sn1])
Retrieve information on a seismic record
info.seis(GH)info.seis(GH)
GH |
RSEIS seismic record list |
Prints summary infromation on the traces in the seismic record
Side Effects
Jonathan M. Lees<[email protected]>
data(KH) info.seis(KH)data(KH) info.seis(KH)
Print information about the seismic database
infoDB(DB, verbose=TRUE)infoDB(DB, verbose=TRUE)
DB |
Database list |
verbose |
logical, print information to screen, default=TRUE |
list(
usta |
Unique station names |
ucomp |
Unique component names |
start |
starting date |
end |
ending date |
Jonathan M. Lees<[email protected]>
makeDB
########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB)########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB)
Insert NA in a vector at given break points
insertNAs(v, w)insertNAs(v, w)
v |
original vector |
w |
break points |
Used for plotting lines that wrap around.
vector with NA inserted
Jonathan M. Lees<[email protected]>
a <- 1:20 b <- insertNAs(a, c(5, 12)) ba <- 1:20 b <- insertNAs(a, c(5, 12)) b
Vector of frequencies
INSTFREQS(b, a, w)INSTFREQS(b, a, w)
b |
numerator, zeros |
a |
denominator, poles |
w |
frequency |
h = jpolyval(b,s) / jpolyval(a,s)
h = jpolyval(b,s) / jpolyval(a,s)
Jonathan M. Lees<jonathan.lees.edu>
K <- PreSet.Instr() b <- K[[1]]$zeros a <- K[[1]]$poles INSTFREQS(b, a, 2*pi*12)K <- PreSet.Instr() b <- K[[1]]$zeros a <- K[[1]]$poles INSTFREQS(b, a, 2*pi*12)
Extract Instrument Response from Poles and Zeros
INSTresponse(Kal, key, ff, tt = tt, plotkey = NULL)INSTresponse(Kal, key, ff, tt = tt, plotkey = NULL)
Kal |
Calibration |
key |
index to list of instruments |
ff |
frequency vector |
tt |
time vector |
plotkey |
TRUE = plot |
response is fourier transform of delta function run through the filter
List:
transfer |
transfer function |
aa |
a coeficients |
bb |
b coeficients |
resp |
real part of response |
Jonathan M. Lees<jonathan.lees.edu>
Adapted from Ken Creager's Matseis
deconinst
######## set list of possible instruments: Kal <- PreSet.Instr() ### get instrument reponse for first in list: resp1 <- INSTresponse(Kal, 1, c(0,100) , tt=c(1,0.008), plotkey=TRUE) ### plots amplitude and phase######## set list of possible instruments: Kal <- PreSet.Instr() ### get instrument reponse for first in list: resp1 <- INSTresponse(Kal, 1, c(0,100) , tt=c(1,0.008), plotkey=TRUE) ### plots amplitude and phase
integrate under the curve of a pulse
integ1(x, y, dm = -Inf, hm = +Inf)integ1(x, y, dm = -Inf, hm = +Inf)
x |
x-axis vector |
y |
y-axis vector |
dm |
lower bound |
hm |
upper bound |
vector: c(osum,cista) one with the bottom triangle included one without
Jonathan M. Lees<jonathan.lees.edu>
Inverse Fourier Transform
INVRft(G, n, tstart, dt)INVRft(G, n, tstart, dt)
G |
Input fourier transform |
n |
length of time vector |
tstart |
time series starts at tstart |
dt |
Delta t, sample rate |
G is a vector spectrum evaluated at positive and negative frequencies as defined by makefreq. tstart, dt and n define the output time vector as described above.
g is the Inverse Fourier Transform of G scaled by dt. time shift theorem has been used to account for time not starting at t=0.
g |
truncate time vector to N points |
f |
frequencies |
t |
times |
Jonathan M. Lees<jonathan.lees.edu>
makefreq, FRWDft, INSTresponse
zil <- rnorm(300) fss <- FRWDft( zil, length(zil), 0, 0.004) INVRft(fss$G, length(zil), 0, 0.004)zil <- rnorm(300) fss <- FRWDft( zil, length(zil), 0, 0.004) INVRft(fss$G, length(zil), 0, 0.004)
Convert RSEIS date list to a cmpatable date/time for calculating dates and times with base R codes.
j2posix(timeinput)j2posix(timeinput)
timeinput |
RSEIS date-time list |
Code here converts to posix, but works only down to the second, i.e. fractions of a second are dropped.
POSIX compatable date time structure.
If you need to preserve the fractional seconds (as we do in seismology) it is recommended to cut them off and add them later.
Jonathan M. Lees<[email protected]>
recdate, recdatel, dateList, dateStamp, filedatetime, rangedatetime, yeardate, Zdate, as.POSIXct
yr = 2014 j = 233.1234 A = convertATT(j, yr) j2posix(A) ### note fractional seconds are truncated.yr = 2014 j = 233.1234 A = convertATT(j, yr) j2posix(A) ### note fractional seconds are truncated.
Add zeros to the end of the data if necessary so that its length is a power of 2. It returns the data with zeros added if nessary and the length of the adjusted data.
jadjust.length(inputdata)jadjust.length(inputdata)
inputdata |
either a text file or an S object containing data |
Zero-padded 1D array.
See discussions in the text of "Practical Time-Frequency Analysis".
generate a gray scale color palette
JBLACK(n, acol=rgb(0,0,0))JBLACK(n, acol=rgb(0,0,0))
n |
number of colors to produce |
acol |
RGB color |
Creates a black color palette suitable for replacing rainbow for B/W color plots. This is inserted in case user needs to completely elliminate color from a plot that uses color palettes for fixing colors.
n characters used for color palette
Jonathan M. Lees<jonathan.lees.edu>
shade.col, rainbow, colors
pal <- JBLACK(100)pal <- JBLACK(100)
generate a gray scale color palette
JGRAY(n)JGRAY(n)
n |
number of colors to produce |
Creates a grey scale color palette suitable for replacing rainbow for grey shade plots.
n characters used for color palette
Jonathan M. Lees<jonathan.lees.edu>
shade.col, rainbow, colors
pal <- JGRAY(100) data(volcano) image(volcano, col=pal)pal <- JGRAY(100) data(volcano) image(volcano, col=pal)
Jitter a set of labels so they do not overlap
jitter.lab(x, w)jitter.lab(x, w)
x |
X-positions |
w |
widths of the labels |
New label positions are computed such that they do not overlap. They are shifted up or down. Works only on horizontal labels.
vector of integer shifts.
Jonathan M. Lees<[email protected]> Jake Anderson<[email protected]>
textrect
APAL <- c('tan2','red2','lightpink3','chocolate4','blue3','thistle4','lightcyan4', 'orangered1','purple4','darkred','dodgerblue1','gold3','chartreuse','sienna4', 'aquamarine3','mistyrose4','sienna1','darkkhaki','darkgoldenrod4','magenta4', 'pink3','orangered','darkslategray4','red3','goldenrod3','palegreen4','deepskyblue3', 'turquoise3','seagreen4','springgreen4','gold4','lightsalmon4','limegreen','orchid4', 'darkseagreen4','chartreuse3','goldenrod4','salmon2','deeppink3','forestgreen', 'lightskyblue4','mediumorchid3','deepskyblue2','chocolate2','violetred4','blue1', 'honeydew4','darkgreen','royalblue1','lightseagreen') s <- sort(sample.int(100,25)) plot(c(1,110),c(0,8),col='white') #### set up plot area PplusPHASE <- c( "P-up","P","Pdiff","PKP","PKiKP","PcP", "pP","pPdiff","pPKP","pPKiKP","sP","sPdiff","sPKP","sPKiKP") SplusPHASE <- c("S-up","S","Sdiff","SKS","sS", "sSdiff","sSKS","pS","pSdiff","pSKS") basic1 <- c("ScP", "SKP", "PKKP", "SKKP", "PP", "PKPPKP") basicPHASE <- c(PplusPHASE,SplusPHASE, basic1) PHS <- basicPHASE[1:25] x <- s y <- rep(0, length(x)) RMAT <- RPMG::textrect(x,y, PHS, xpd=TRUE, add=FALSE, font=1, cex=.8 ) newjitx <- jitter.lab(RMAT[,1] , RMAT[,3]-RMAT[,1]) y <- y+newjitx*(RMAT[,4]-RMAT[,2]) MCOL <- length(PHS) PASTCOL <- APAL[1:MCOL] RMAT <- RPMG::textrect(x,y, PHS, xpd=TRUE, add=TRUE, textcol=PASTCOL, font=1, cex=.8 )APAL <- c('tan2','red2','lightpink3','chocolate4','blue3','thistle4','lightcyan4', 'orangered1','purple4','darkred','dodgerblue1','gold3','chartreuse','sienna4', 'aquamarine3','mistyrose4','sienna1','darkkhaki','darkgoldenrod4','magenta4', 'pink3','orangered','darkslategray4','red3','goldenrod3','palegreen4','deepskyblue3', 'turquoise3','seagreen4','springgreen4','gold4','lightsalmon4','limegreen','orchid4', 'darkseagreen4','chartreuse3','goldenrod4','salmon2','deeppink3','forestgreen', 'lightskyblue4','mediumorchid3','deepskyblue2','chocolate2','violetred4','blue1', 'honeydew4','darkgreen','royalblue1','lightseagreen') s <- sort(sample.int(100,25)) plot(c(1,110),c(0,8),col='white') #### set up plot area PplusPHASE <- c( "P-up","P","Pdiff","PKP","PKiKP","PcP", "pP","pPdiff","pPKP","pPKiKP","sP","sPdiff","sPKP","sPKiKP") SplusPHASE <- c("S-up","S","Sdiff","SKS","sS", "sSdiff","sSKS","pS","pSdiff","pSKS") basic1 <- c("ScP", "SKP", "PKKP", "SKKP", "PP", "PKPPKP") basicPHASE <- c(PplusPHASE,SplusPHASE, basic1) PHS <- basicPHASE[1:25] x <- s y <- rep(0, length(x)) RMAT <- RPMG::textrect(x,y, PHS, xpd=TRUE, add=FALSE, font=1, cex=.8 ) newjitx <- jitter.lab(RMAT[,1] , RMAT[,3]-RMAT[,1]) y <- y+newjitx*(RMAT[,4]-RMAT[,2]) MCOL <- length(PHS) PASTCOL <- APAL[1:MCOL] RMAT <- RPMG::textrect(x,y, PHS, xpd=TRUE, add=TRUE, textcol=PASTCOL, font=1, cex=.8 )
Add legend to side of figure
Rewrite of the legend function for easier manipulation.
See legend() for details on input
Jonathan M. Lees<jonathan.lees.edu>
legend
plot(c(0,1), c(0,1)) u <- par('usr') LEG <- jlegend( u[1], u[4], c("Vp", "Vs"), lwd=2, col=c(4,3), plot=FALSE )plot(c(0,1), c(0,1)) u <- par('usr') LEG <- jlegend( u[1], u[4], c("Vp", "Vs"), lwd=2, col=c(4,3), plot=FALSE )
Polynomila value
jpolyval(p, x)jpolyval(p, x)
p |
coefficients |
x |
input value |
Sum of polynomial:
Jonathan M. Lees<jonathan.lees.edu>
jpolyval(c(2,3,5), 7)jpolyval(c(2,3,5), 7)
Read SEGY/SAC format binary data
JSAC.seis(fnames, Iendian = 1 , HEADONLY=FALSE, BIGLONG=FALSE, PLOT = -1, RAW=FALSE) JSEGY.seis(fnames, Iendian = 1 , HEADONLY=FALSE, BIGLONG=FALSE, PLOT = -1, RAW=FALSE)JSAC.seis(fnames, Iendian = 1 , HEADONLY=FALSE, BIGLONG=FALSE, PLOT = -1, RAW=FALSE) JSEGY.seis(fnames, Iendian = 1 , HEADONLY=FALSE, BIGLONG=FALSE, PLOT = -1, RAW=FALSE)
fnames |
vector of file names to be extracted and converted. |
Iendian |
vector, Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
HEADONLY |
logical, TRUE= header information only |
BIGLONG |
logical, TRUE=long=8 bytes |
PLOT |
integer, <0 no plot; 0 interactive; >0 number of seconds to sleep |
RAW |
logical, default=FALSE(convert to volts) , TRUE (return counts intead of volts) |
Uses readBin to extract data in SAC format. user must know what kind of machine the data was created on for I/O purposes.
For SEGY data the program is the same, although SEGY data does not have the problem of the BIGLONG so that is ignored.
For either code, a full header is returned, although the header for each format may be different.
List containing the seismic data and header information. Each trace consists of a list with:
fn |
original file name |
sta |
station name |
comp |
compnent |
dt |
delta t in seconds |
DATTIM |
time list |
yr |
year |
jd |
julian day |
mo |
month |
dom |
day of month |
hr |
hour |
mi |
minute |
sec |
sec |
msec |
milliseconds |
dt |
delta t in seconds |
t1 |
time start of trace |
t2 |
time end of trace |
off |
off-set |
N |
number of points in trace |
units |
units |
amp |
vector of trace values |
HEAD |
Full header as a data-frame of values (mixture of float and character strings) |
N |
Number of samples in trace |
units |
Units of samples, possibly: counts, volts, s, m/s, Pa, etc |
IO |
list: kind, Iendian, BIGLONG flags for I/O |
SAC created on PC (windows) or LINUX machines typically will be in little endian format. SAC created on a SUN will be in big endian format. If you want to swap endian-ness , choose swap.
MAC uses different convention.
Iendian can be a vector if input files have different endian-ness.
SAC inserts -12345 for no data.
There are other issues regarding the size of long.
The units are often questionable and depend on the processing. The user should be careful and check to see that the proper conversions and multipliers have been applied.
Jonathan M. Lees<[email protected]>
Mine.seis, rseis2sac
##### make some SAC files, then read them in data(GH) apath = tempdir() ## setwd(apath) ## apath = 'TEMP' J = rseis2sac(GH, sel =1:5, path = apath, BIGLONG =FALSE ) ####### next read them in Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) S1 <- JSAC.seis(Lname, Iendian = .Platform$endian, BIGLONG =FALSE , PLOT = -1) #### check just the first one i = 1 plotGH(S1[[i]])##### make some SAC files, then read them in data(GH) apath = tempdir() ## setwd(apath) ## apath = 'TEMP' J = rseis2sac(GH, sel =1:5, path = apath, BIGLONG =FALSE ) ####### next read them in Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) S1 <- JSAC.seis(Lname, Iendian = .Platform$endian, BIGLONG =FALSE , PLOT = -1) #### check just the first one i = 1 plotGH(S1[[i]])
returns relevant stats
jstats(d)jstats(d)
d |
vector |
Program calls R routines to gather important statistics for later use.
list:
mean |
mean value |
std |
standard deviation |
med |
median |
qdist |
quartile distance |
bstats |
boxplot quantiles |
mstats |
vector of mean and std |
N |
number of points |
Jonathan M. Lees<jonathan.lees.edu>
boxplot, mean, median
x <- rnorm(100, m=43) jstats(x)x <- rnorm(100, m=43) jstats(x)
convert JD, HR, MIN SEC to Decimal Julian Day
Jtim(jj, hr = hr, mi = mi, sec = sec, yr=NULL, origyr=NULL) JtimL(j)Jtim(jj, hr = hr, mi = mi, sec = sec, yr=NULL, origyr=NULL) JtimL(j)
jj |
Julian day |
hr |
Hour |
mi |
Minute |
sec |
Second |
yr |
year, default = NULL |
origyr |
default = NULL |
or
j |
list of the above |
Using a NULL value for yr gives the fractional julian day in a year. If yr is a legitimate year, and the origyr is provided, then the EPOCH number of days from origyr are added onto the fractional julian day. The default for origyr is 1972 for most of seismology.
If the dates span a new year, sometimes it is useful to use the earliest year as the origyr.
Julian day
Jonathan M. Lees<[email protected]>
secdif
Jtim( 9 , hr= 14 , mi= 53 ,sec= 16.7807606880087 ) Jtim( 9 , hr= 14 , mi= 53 ,sec= 16.7807606880087, yr=2019, origyr=1972 ) ######## or, j = list(jd=9 , hr= 14 , mi= 53 ,sec= 16.7807606880087) JtimL(j)Jtim( 9 , hr= 14 , mi= 53 ,sec= 16.7807606880087 ) Jtim( 9 , hr= 14 , mi= 53 ,sec= 16.7807606880087, yr=2019, origyr=1972 ) ######## or, j = list(jd=9 , hr= 14 , mi= 53 ,sec= 16.7807606880087) JtimL(j)
Seismic data from erupting Reventador Volcano. Vertical component only.
data(KH)data(KH)
KH = list( LOC=list(yr=0, jd=0, mo=0, dom=0, hr=0, mi=0, sec=0, lat=0, lon=0, z=0, mag=0, gap=0, delta=0 , rms=0, hozerr=0), MC=list(az1=0, dip1=0, az2=0, dip2=0, dir=0, rake1=0, dipaz1=0, rake2=0, dipaz2=0, F=list(az=0, dip=0), G=list(az=0, dip=0), U=list(az=0, dip=0), V=list(az=0, dip=0), P=list(az=0, dip=0), T=list(az=0, dip=0),sense=0,M=list( az1=0, d1=0, az2=0, d2=0, uaz=0, ud=0, vaz=0, vd=0, paz=0, pd =0, taz=0, td=0), UP=TRUE, icol=1, ileg="", fcol='red', CNVRG="", LIM =c(0,0,0,0) ),
STAS=list(tag="", name="", comp="", c3="", phase="", sec=0, err=0, pol="", flg=0 , res=0),
LIP=vector(length=6),
H=list(yr=0,mo=0,dom=0,hr=0,mi=0,sec=0,lat=0,lon=0,z=0,mag=0),
N=list(name=""),
E=list(rms=0,meanres=0,sdres=0,sdmean=0,sswres=0,ndf=0,fixflgs=0, sterrx=0,sterry=0,sterrz=0,sterrt=0,mag=0,sterrmag=0),
filename="",
PICKER="", UWFILEID="",winID1="",comments="", OSTAS="")
Lees, J. M., J. B. Johnson, M. Ruiz, L. Troncoso, M. Welsh, Reventador Volcano 2005: Eruptive Activity Inferred from Seismo-Acoustic Observation Journal of Volcanology and Geothermal Research in Press, 2007.
data(KH) ###### set SHOWONLY=FALSE for interactive swig(KH, SHOWONLY=0)data(KH) ###### set SHOWONLY=FALSE for interactive swig(KH, SHOWONLY=0)
Shift a times series by a specified phase lag.
lagplot(y1, dt, lag, PLOT = FALSE)lagplot(y1, dt, lag, PLOT = FALSE)
y1 |
seismic signal |
dt |
DeltaT, s |
lag |
lag, s |
PLOT |
logical, TRUE=plot |
Graphical Side Effects.
Jonathan M. Lees<jonathan.lees.edu>
getphaselag2
data(KH) ts1 = KH$JSTR[[1]] lagplot(ts1, KH$dt[1], 300, PLOT=TRUE )data(KH) ts1 = KH$JSTR[[1]] lagplot(ts1, KH$dt[1], 300, PLOT=TRUE )
return time series structure
leests(a, dt = 0.008)leests(a, dt = 0.008)
a |
vector signal |
dt |
sample rate |
list(y=y, dt=dt)
Jonathan M. Lees<jonathan.lees.edu>
x <- rnorm(10) leests(x, dt = 0.01)x <- rnorm(10) leests(x, dt = 0.01)
Legitimate picks in swig (used internally)
legitpix(sel, zloc, zenclick)legitpix(sel, zloc, zenclick)
sel |
seleceted traces in swig |
zloc |
location list |
zenclick |
number of legitimate picks |
list: ypick, ppick
Jonathan M. Lees<[email protected]>
swig
Add letters to the corners of plots in multiple figures
letter.it(a, corn = 1)letter.it(a, corn = 1)
a |
character letter for marking figure |
corn |
corner to put letter in |
Can use uppercase or lower case letters, or roman numerals.
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
par(mfrow=c(2,2)) for(i in 1:4) { x <- 1:10 y <- rnorm(10) plot(x,y) letter.it(letters[i], 2) }par(mfrow=c(2,2)) for(i in 1:4) { x <- 1:10 y <- rnorm(10) plot(x,y) letter.it(letters[i], 2) }
unwrap the phase spectrum so it does not wrap around
LocalUnwrap(p, cutoff = cutoff)LocalUnwrap(p, cutoff = cutoff)
p |
phase spectrum |
cutoff |
cut off angle = pi |
Unwrapped spectrum
Algorithm minimizes the incremental phase variation by constraining it to the range [-pi,pi]
Jonathan M. Lees<jonathan.lees.edu>
x <- 1:512 amp <- sin(1*2*pi*x/16) + sin(2*2*pi*x/16) + sin(3*2*pi*x/16) spc <- fft(amp) plot(Mod(spc), type='l') angle <- Arg(spc) plot(angle, type='l') unang <- LocalUnwrap(angle, cutoff =pi ) plot(unang, type='l')x <- 1:512 amp <- sin(1*2*pi*x/16) + sin(2*2*pi*x/16) + sin(3*2*pi*x/16) spc <- fft(amp) plot(Mod(spc), type='l') angle <- Arg(spc) plot(angle, type='l') unang <- LocalUnwrap(angle, cutoff =pi ) plot(unang, type='l')
Logarithmically spaced vector
logspace(d1, d2, n = n)logspace(d1, d2, n = n)
d1 |
lower frequency |
d2 |
upper frequency |
n |
number of frequencies |
generates a row vector of n logarithmically equally spaced
points between decades and
vector
Jonathan M. Lees<jonathan.lees.edu>
f <- logspace(1, 25)f <- logspace(1, 25)
Creates hourly spectrograms, either alternating seismic and infrasound data or sequences of one component.
longfft(DB, DAYS = c(233, 234), HRS = 1:24, sta = "KR1", comp = c("V", "I"), NPP = 6, CSCALE = FALSE, pal = rainbow(100), PS = FALSE, kind = 1, Iendian = 1, BIGLONG = FALSE) longreset(NPP, PS) longpstart(NPP = 6, asta = "", acomp = "", theday = 1, hr = 0)longfft(DB, DAYS = c(233, 234), HRS = 1:24, sta = "KR1", comp = c("V", "I"), NPP = 6, CSCALE = FALSE, pal = rainbow(100), PS = FALSE, kind = 1, Iendian = 1, BIGLONG = FALSE) longreset(NPP, PS) longpstart(NPP = 6, asta = "", acomp = "", theday = 1, hr = 0)
DB |
RSEIS Data base |
DAYS |
vector of Days to display |
HRS |
vector of hours to display |
sta |
stations to extract |
comp |
component to extract |
NPP |
Number of plot strips per page, default = 6 |
CSCALE |
scaling |
pal |
palettes to use (given two will alternate these) |
PS |
logical, TRUE postscript output |
kind |
data type, an integer -1, 0, 1, 2 ; 0=R(DAT) , -1=RDS, 0=RDATA, 1 = segy, 2 = sac |
Iendian |
Endian-ness of binary data |
BIGLONG |
logical, TRUE=long is 8 bytes |
asta |
character, one station |
acomp |
character, one component |
theday |
one day |
hr |
one hour |
Extracts dats from the DB data base and plots strips of spectrograms for perusal.
longpstart, longreset are auxilliary codes used to set up the postscript files and initialize the plotting.
Graphical Side effects
Program is set for data being ready from external sources in binary (SAC, SEGY) format. If data is in R-format already, the code may not work.
Jonathan M. Lees<[email protected]>
SPECT.drive
if(interactive()){ ##### get a time series data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] #### downsample to: newdt = 0.1 JK = FAKEDATA(amp, OLDdt=OLDdt, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(JK) ) { sig = JK[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) p1 <- RPMG::Gcols(plow=5, phi=0, N=100, pal="topo.colors", mingray=0.8) p2 <- RPMG::Gcols(plow=5, phi=0, N=100, pal="rainbow", mingray=0.8) longfft(DB, DAYS=5 , HRS=1:24 , sta=IDB$usta, comp=IDB$ucomp , NPP=6 , CSCALE=FALSE, pal = list(p1=p1, p2=p2), PS=FALSE , kind = -1, Iendian=1, BIGLONG=TRUE ) }if(interactive()){ ##### get a time series data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] #### downsample to: newdt = 0.1 JK = FAKEDATA(amp, OLDdt=OLDdt, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(JK) ) { sig = JK[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) p1 <- RPMG::Gcols(plow=5, phi=0, N=100, pal="topo.colors", mingray=0.8) p2 <- RPMG::Gcols(plow=5, phi=0, N=100, pal="rainbow", mingray=0.8) longfft(DB, DAYS=5 , HRS=1:24 , sta=IDB$usta, comp=IDB$ucomp , NPP=6 , CSCALE=FALSE, pal = list(p1=p1, p2=p2), PS=FALSE , kind = -1, Iendian=1, BIGLONG=TRUE ) }
Create a seismic Waveform Database
makeDB(path=".", pattern="R", dirs="", kind = 1, Iendian=1, BIGLONG=FALSE) FmakeDB(LF2, kind =1, Iendian=1, BIGLONG=FALSE)makeDB(path=".", pattern="R", dirs="", kind = 1, Iendian=1, BIGLONG=FALSE) FmakeDB(LF2, kind =1, Iendian=1, BIGLONG=FALSE)
path |
character, Path to directory where files and directories exist |
pattern |
character, pattern for listing of files |
dirs |
character, vector of directories to be scanned |
kind |
kind of data: RDS=-1, R(DAT)=0, segy=1; sac=2 |
Iendian |
default=1, Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE means long=8 bytes |
LF2 |
list of files |
The files are typically located in a directory structure created by programs like ref2segy, a PASSCAL program for downloading data in the field. Each file contains one seismogram, with a header. makeDB reads in all the headers and creates a list of meta-data for later use in RSEIS.
"kind" can be numeric or character: options are 'RDS', 'RDATA', 'SEGY', 'SAC', corresponding to (-1, 0, 1, 2).
Uses readBin to extract data in SAC format. user must know what kind of machine the data was created on for I/O purposes.
If data was created on a little endian machine but is being read on big endian machine, need to call the endian "swap" for swapping.
If data was created on a machine with LONG=4 bytes, be sure to call the program with BIGLONG=FALSE.
If the base directory, or the subdirectories, contain files that are not seismic data then care must be taken. Perhaps use FmakeDB to explicitly names the files for the DataBase.
If using FmakeDB a simple vector of files (full path names) should be provided.
The origin year, used for getting the Epoch year, is stored as attribute origyr.
list:
fn |
file name |
yr |
year |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
dur |
duration, seconds |
t1 |
time 1 in Epoch days |
t2 |
time 2 in Epoch days |
sta |
station name |
comp |
component name |
dt |
sample rate, seconds |
Epoch times are used to accomodate problems where julian days cross year end boundaries, so that day 366 comes before day 1 of the next year.
The origyr, kind , Iendian, BIGLONG are stored as attributes in the Database.
Jonathan M. Lees<[email protected]>
setupDB, Mine.seis , getseis24, plotseis24, EPOCHday, swig
########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1)########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1)
Create a frequency value for integration and differentiation
makefreq(n, dt)makefreq(n, dt)
n |
number of freqs |
dt |
deltat |
vector of frequencies
Jonathan M. Lees<jonathan.lees.edu>
INVRft
N <- 256 dt <- 0.008 f <- makefreq(N,dt)N <- 256 dt <- 0.008 f <- makefreq(N,dt)
Mark a 24 hour seismic display
markseis24(pjj, pix = list(yr = 2009, jd = 1, hr = 0, mi = 0, sec = 0, dur = 0), col = "red", LEGON = 3, BARON = TRUE, ARROWS = TRUE, lwd=1)markseis24(pjj, pix = list(yr = 2009, jd = 1, hr = 0, mi = 0, sec = 0, dur = 0), col = "red", LEGON = 3, BARON = TRUE, ARROWS = TRUE, lwd=1)
pjj |
Output information from plotseis24 (x,y, yr, jd) |
pix |
list: date list consisting of: yr, jd, hr, mi, sec, dur) |
col |
Color, specified as color index, character string or rgb |
LEGON |
plotting flag for legs: 0=no legs, 1=left leg, 2=right leg, 3=both legs(def ault) |
BARON |
logical:plotting flag for bar |
ARROWS |
logical: plot arrows FALSE=no arrows |
lwd |
numeric, graphical parameter, line width |
the LEGON parameter controls the small marks at the ends: Either left(1) right(2) both(3) or no legs(0) are plotted. window bars should wrap around the ends of the hour to the next hour below. The durations of the windows are supplied in seconds. If no duration is supplied, it is set to 0. If one duration is supplied it is copied to all other windows.
Graphical Side effects
Jonathan M. Lees<[email protected]>
winmark, getseis24, plotseis24
data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) ### set up pix WINS2 <- list(hr = c(12.5, 12.7) ) Apix <- WINS2$hr[seq(from=1, to=length(WINS2$hr), by=2) ] dur <- (WINS2$hr[seq(from=2, to=length(WINS2$hr), by=2) ]-Apix)*3600 ## dur <- rep(0, times=length(Apix)) ## mark the 24 hour plot pix =list(yr=rep(pjj$yr, length(Apix)), jd=rep(pjj$jd, length(Apix)) , hr=Apix, mi=rep(0, length(Apix)), sec=rep(0, length(Apix)), dur=dur) markseis24(pjj, pix=pix, col='red', ARROWS=TRUE )data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) ### set up pix WINS2 <- list(hr = c(12.5, 12.7) ) Apix <- WINS2$hr[seq(from=1, to=length(WINS2$hr), by=2) ] dur <- (WINS2$hr[seq(from=2, to=length(WINS2$hr), by=2) ]-Apix)*3600 ## dur <- rep(0, times=length(Apix)) ## mark the 24 hour plot pix =list(yr=rep(pjj$yr, length(Apix)), jd=rep(pjj$jd, length(Apix)) , hr=Apix, mi=rep(0, length(Apix)), sec=rep(0, length(Apix)), dur=dur) markseis24(pjj, pix=pix, col='red', ARROWS=TRUE )
Plot a matrix of time series as a var-squiggle display (filled in half traces)
matsquiggle(XMAT, dt1, dist = NULL, thick = 1, FLIP = FALSE, filcol='blue', tracecol="black", add=FALSE, PLOT=TRUE,xpd=TRUE, plotdir=1 )matsquiggle(XMAT, dt1, dist = NULL, thick = 1, FLIP = FALSE, filcol='blue', tracecol="black", add=FALSE, PLOT=TRUE,xpd=TRUE, plotdir=1 )
XMAT |
matrix of traces |
dt1 |
sample interval, s |
dist |
distance for each trace in the matrix |
thick |
thickness for each trace to be plotted |
FLIP |
logical, FALSE (default) plot horizontal, TRUE=plot vertical |
filcol |
color for shading |
tracecol |
color for trace |
add |
add traces to existing plot |
PLOT |
whether to create a new plotting region |
xpd |
logical, set xpd parameter (see par) |
plotdir |
1=left to right, 0=right to left (default=1) |
see varsquiggle for more details
side effects.
Jonathan M. Lees<[email protected]>
varsquiggle, varsquig
data(GH) m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### plot normal way: ### swig(GH, sel=sel, WIN=c(5,10), SHOWONLY=TRUE) ### plot with varsquiggle ### varsquiggle(GH, sel=sel, WIN=c(5,10)) ex <- seq(from=0, by=GH$dt[sel[1]], length=length(GH$JSTR[[sel[1]]])) wx <- ex>=5 & ex<=10 XMAT <- matrix(ncol=length(sel), nrow=length(which(wx))) for(i in 1:length(sel)) { XMAT[,i] <- GH$JSTR[[sel[i]]][wx] } matsquiggle(XMAT, GH$dt[sel[1]] , dist = dees$dist[sel] , thick = 1, FLIP = FALSE) axis(1) axis(2) title(xlab="Time, s", ylab="Distance, km")data(GH) m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### plot normal way: ### swig(GH, sel=sel, WIN=c(5,10), SHOWONLY=TRUE) ### plot with varsquiggle ### varsquiggle(GH, sel=sel, WIN=c(5,10)) ex <- seq(from=0, by=GH$dt[sel[1]], length=length(GH$JSTR[[sel[1]]])) wx <- ex>=5 & ex<=10 XMAT <- matrix(ncol=length(sel), nrow=length(which(wx))) for(i in 1:length(sel)) { XMAT[,i] <- GH$JSTR[[sel[i]]][wx] } matsquiggle(XMAT, GH$dt[sel[1]] , dist = dees$dist[sel] , thick = 1, FLIP = FALSE) axis(1) axis(2) title(xlab="Time, s", ylab="Distance, km")
Mine a seismic data base to extract secions of time limited data
Mine.seis(at1, at2, DB, grepsta, grepcomp, kind = 1, Iendian=1, BIGLONG=FALSE, CHOP=TRUE, verbose=FALSE, chtoken=NULL, statoken=NULL, RAW=FALSE)Mine.seis(at1, at2, DB, grepsta, grepcomp, kind = 1, Iendian=1, BIGLONG=FALSE, CHOP=TRUE, verbose=FALSE, chtoken=NULL, statoken=NULL, RAW=FALSE)
at1 |
time 1 in julian days |
at2 |
time 2 in julian days |
DB |
data base structure to searcth through that provides the files where data is to extracted from |
grepsta |
which stations to extract |
grepcomp |
which components to extract |
kind |
kind of data, -1="RDS", 0="RDATA" , 0="RDATA", 1 = "segy", 2 = "sac" |
Iendian |
Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
CHOP |
cut the data to a window using CHOP.SEISN |
verbose |
print out intermediate information for debugging |
chtoken |
channel token for selecting channels (NULL) |
statoken |
station token for selecting stations (NULL) |
RAW |
logical, default=FALSE(convert to volts) , TRUE (return counts intead of volts) |
The data base is a list or dataframe containing the files names, the beginning time (t1) and ending time (t2) for each file in the data base. Mine.seis uses grep on the file names to extract specific files from the DB list.
Mine.seis needs to know what format the data was created in: little/big endian and the size of the LONG.
If data was created on a little endian machine but is being read on big endian machine, need to call the endian "swap" for swapping.
If data was created on a machine with LONG=4 bytes, be sure to call the program with BIGLONG=FALSE.
Use sysinfo to findout the system parameters for the local system. You need to know, however, what machine the binary files were created on.
In some situation the chanel name and the station name are not embedded in the file headers - in that case use the token from the file name.
List of seismograms cut from the database
The headers in the digital (segy or SAC) data files may not necessarily match the file names. Note that program JGET.seis extracts the station name and component name from the digital header and does not use the file name. It may be prudent to force the file names and header files to match prior to using Mine.seis. For SEGY files, in LINUX-UNIX, use: rename, segymod (PASSCAL) to modify the headers.
For SAC files, use sac software.
For R-based codes save the files in a format that has the relevant information (DAT format).
Jonathan M. Lees<jonathan.lees.edu>
makeDB, GLUEseisMAT, JGET.seis, JSAC.seis, JSEGY.seis, sysinfo
data(GH) DD = data.frame(GH$info) #### get only vertical traces WV = which( GH$COMPS=='V' ) L1 = length(WV) GIVE = vector(mode='list') for(j in 1:L1 ) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } #### par(mfrow=c(length(GIVE) , 1) ) # for(i in 1:length(GIVE) ) { plotGH(GIVE[[i]]) } tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) SAMPseis <- Mine.seis(IDB$at1, IDB$at2, DB, IDB$usta[1:3], IDB$ucomp[1], kind = -1 ) w <- swig(SAMPseis, SHOWONLY=0)data(GH) DD = data.frame(GH$info) #### get only vertical traces WV = which( GH$COMPS=='V' ) L1 = length(WV) GIVE = vector(mode='list') for(j in 1:L1 ) { i = WV[j] AA = DD[i,] GIVE[[j]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } #### par(mfrow=c(length(GIVE) , 1) ) # for(i in 1:length(GIVE) ) { plotGH(GIVE[[i]]) } tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir,pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) SAMPseis <- Mine.seis(IDB$at1, IDB$at2, DB, IDB$usta[1:3], IDB$ucomp[1], kind = -1 ) w <- swig(SAMPseis, SHOWONLY=0)
mirrored representation of image matrix
mirror.matrix(x)mirror.matrix(x)
x |
matrix |
Used for flipping the output of the wavelet transform for more convenient plotting.
matrix
Jonathan M. Lees<jonathan.lees.edu>
Rwave, plotwlet, wlet.do, wlet.drive
xy <- matrix(rnorm(100), ncol=10) mirror.matrix(xy)xy <- matrix(rnorm(100), ncol=10) mirror.matrix(xy)
Make Morlet Wavelet
Mmorlet(UB = -4, LB = 4, N = 256, plot = FALSE)Mmorlet(UB = -4, LB = 4, N = 256, plot = FALSE)
UB |
upper bound |
LB |
lower bound |
N |
number of points |
plot |
logical, TRUE=plot |
create a morlet function based on the matlab style routines
time series list:
xval |
x-output |
morl |
y-output |
Jonathan M. Lees<jonathan.lees.edu>
scal2freqs, Rwave
mm <- Mmorlet(-8, 8, 256)mm <- Mmorlet(-8, 8, 256)
Multi-tape Method Spectrum
mtapspec(a, dt, klen = length(a), MTP = NULL)mtapspec(a, dt, klen = length(a), MTP = NULL)
a |
vector time series |
dt |
sample rate |
klen |
length of fft |
MTP |
MTM parameters, list:
|
MTP represent parameters that control the multi-tape pi-prolate functions used by mtapspec. See reference for details.
LIST
dat |
input data |
dt |
sample rate |
spec |
Estimated power spectrum |
dof |
degrees of freedom for each frequency |
Fv |
F-values for each frequency |
Rspec |
real part of complex spectrum |
Ispec |
imaginary part of complex spectrum |
freq |
frequencies |
df |
delta frequency |
numfreqs |
number of frequencies |
klen |
length used in fft |
mtm |
input MTM parameters, see above |
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
fft
data(CE1) a <- list(y=CE1$y[CE1$x>5.443754 & CE1$x<5.615951], dt=CE1$dt) Mspec <- mtapspec(a$y,a$dt, klen=4096, MTP=list(kind=2,nwin=5, npi=3,inorm=0) )data(CE1) a <- list(y=CE1$y[CE1$x>5.443754 & CE1$x<5.615951], dt=CE1$dt) Mspec <- mtapspec(a$y,a$dt, klen=4096, MTP=list(kind=2,nwin=5, npi=3,inorm=0) )
MTM analysis of signals
MTM.drive(a, f1 = f1, f2 = f2, len2 = 1024, COL = 2, PLOT = FALSE, PADDLAB = NULL, GUI = TRUE)MTM.drive(a, f1 = f1, f2 = f2, len2 = 1024, COL = 2, PLOT = FALSE, PADDLAB = NULL, GUI = TRUE)
a |
list(y=time series amp, dt=delta-ts, stamps=text stamps) |
f1 |
low frequency |
f2 |
high frequency |
len2 |
power of two length |
COL |
colors |
PLOT |
logical PLOT=TRUE |
PADDLAB |
vector of buttons |
GUI |
Whether to be in GUI (interactive) mode |
Graphical Side effect
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
plt.MTM0
data("GH") sel <- which(GH$COMPS=="V") amp <- list() dees <- list() stamps <- list() for( i in 1:3) { amp[[i]] <- GH$JSTR[[sel[i]]] dees[i] <- GH$dt[sel[i]] stamps[i] <- paste(GH$STNS[sel[i]], GH$COMPS[sel[i]]) } a <- list(y=amp, dt=dees, stamps=stamps) f1 <- 0.1 f2 <- floor(0.33*(1/a$dt[[1]])) speccol <- c('red', 'blue', 'purple') MTM.drive(a, f1, f2, COL=speccol, PLOT=TRUE)data("GH") sel <- which(GH$COMPS=="V") amp <- list() dees <- list() stamps <- list() for( i in 1:3) { amp[[i]] <- GH$JSTR[[sel[i]]] dees[i] <- GH$dt[sel[i]] stamps[i] <- paste(GH$STNS[sel[i]], GH$COMPS[sel[i]]) } a <- list(y=amp, dt=dees, stamps=stamps) f1 <- 0.1 f2 <- floor(0.33*(1/a$dt[[1]])) speccol <- c('red', 'blue', 'purple') MTM.drive(a, f1, f2, COL=speccol, PLOT=TRUE)
Display MTM displacement spectrum.
MTMdisp(a, f1 = f1, f2 = f2, len2 = 1024, PLOT = FALSE)MTMdisp(a, f1 = f1, f2 = f2, len2 = 1024, PLOT = FALSE)
a |
seismic velocity trace, as a ts structure (list(y=trace, dt=sample rate) |
f1 |
low frequency |
f2 |
high frequency |
len2 |
length of fft |
PLOT |
logical, TRUE=plot |
Uses Multi-taper estimate of spectrum and divides the spectrum by 1/(2*pi*f) to get integration of velocity seismogram.
Returns displacement spectrum. Graphical Side effect.
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
mtapspec
data(CE1) xvel <- list(y=CE1$y[CE1$x>5.443754 & CE1$x<5.615951], dt=CE1$dt) len2 <- next2(length(xvel$y)) Spec <- MTMdisp(xvel, f1=.01, f2=25, len2=len2, PLOT=FALSE )data(CE1) xvel <- list(y=CE1$y[CE1$x>5.443754 & CE1$x<5.615951], dt=CE1$dt) len2 <- next2(length(xvel$y)) Spec <- MTMdisp(xvel, f1=.01, f2=25, len2=len2, PLOT=FALSE )
Time varying Auto-Regressive Spectrum (Gabor Transform) using MTM
MTMgabor(a, dt = 0, ppoint=95 , numf = 1024, Ns = 0, Nov = 0, fl = 0, fh = 10)MTMgabor(a, dt = 0, ppoint=95 , numf = 1024, Ns = 0, Nov = 0, fl = 0, fh = 10)
a |
signal |
dt |
sample rate interval (s) |
ppoint |
percent confidence for F-test (default=95) |
numf |
Number of frequencies |
Ns |
Number of sample in sub-window |
Nov |
Number of sample to overlap |
fl |
low frequency to display |
fh |
high frequency to display |
This is a spectrogram function similar to the Gabor Transform but uses the MTM (multi-taper method) for spectrum estimation. This is a non-interactive version of MTM.drive.
List
sig |
input signal |
dt |
deltat |
numfreqs |
Number of frequencies output |
wpars |
input parameters list(Nfft=numfreqs, Ns=Ns, Nov=Nov, fl=fl, fh=fh) |
DSPEC |
spectrum image |
HIMAT |
matrix with high values of F-test at 90 percent confidence |
DOFMAT |
Matrix image of degrees of freedom |
FVMAT |
Matrix image of F-test values |
kdof |
test degrees of freedom=2*nwin-2 |
ppoint |
percentage point for confidence bounds |
freqs |
output frequencies (y axis) |
tims |
output times (x-axis) |
Jonathan M. Lees<[email protected]>
Percival and Walden;
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
Percival, Donald B.,Walden, Andrew T. (1993):Spectral Analysis for Physical Applications,Cambridge University Press, Cambridge, 583p.
evolfft, evolMTM, MTM.drive, GETARAIC, doGABOR.AR, DOsgram, doGABOR.MTM
data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Nfft <- 1024 ### fft length Ns <- 512 ### number of samples in a window Nov <- 480 ### number of samples of overlap per window fl <- 0 ### low frequency to return fh <- 12 ### high frequency to return dt <- KH$dt[1] #### shorten the signal here, just for speed on the example: sig = Xamp[37501:75001] EV <- MTMgabor(sig, dt = dt, numf =Nfft , Ns = Ns, Nov = Nov, fl = fl, fh= fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar")data(KH) ### swig(KH) Xamp <- KH$JSTR[[1]] Nfft <- 1024 ### fft length Ns <- 512 ### number of samples in a window Nov <- 480 ### number of samples of overlap per window fl <- 0 ### low frequency to return fh <- 12 ### high frequency to return dt <- KH$dt[1] #### shorten the signal here, just for speed on the example: sig = Xamp[37501:75001] EV <- MTMgabor(sig, dt = dt, numf =Nfft , Ns = Ns, Nov = Nov, fl = fl, fh= fh) PE <- plotevol(EV, log=1, fl=0.01, fh=fh, col=rainbow(100), ygrid=FALSE, STAMP="", STYLE="ar")
Plots output of MTM specturm
MTMplot(a, f1 = f1, f2 = f2, len2 = 1024, PLOT = FALSE, PADDLAB = NULL, GUI = TRUE)MTMplot(a, f1 = f1, f2 = f2, len2 = 1024, PLOT = FALSE, PADDLAB = NULL, GUI = TRUE)
a |
signal |
f1 |
lower frequency |
f2 |
upper frequency |
len2 |
number of points in spectrum |
PLOT |
logical, TRUE=plot |
PADDLAB |
Labels for buttons |
GUI |
use a GUI to display for other interactions |
Uses Lees' MTM code.
list(len2=len2, f=f, f1=f1, f2=f2, displ=displ, ampsp=amp, flag=flag )
len2 |
next power of 2 for fft calculation |
f |
frequencies |
f1 |
lower freq |
f2 |
upper freq |
displ |
kind of display |
ampsp |
amplitude spectrum |
flag |
Jonathan M. Lees<jonathan.lees.edu>
MTM.drive, MTMdisp, plt.MTM0
Match Picks with stations and return station structure
NEW.getUWSTAS(PICS)NEW.getUWSTAS(PICS)
PICS |
Picks in pickfile |
matches Picks with stations
STAS structure
Jonathan M. Lees<jonathan.lees.edu>
adds picks to existing seismic section
NEWPLOT.WPX(t0, STNS, COMPS, YPX, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)NEWPLOT.WPX(t0, STNS, COMPS, YPX, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)
t0 |
starting time for window |
STNS |
stations to match |
COMPS |
components to match |
YPX |
list of picks |
FILL |
fill color |
FORCE |
logical, TRUE=plot picks on all traces |
cex |
character expansion |
srt |
string rotation angle |
Used in conjunction with swig program
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
swig
######## no example available now######## no example available now
Return next power of two greater than n
next2(x)next2(x)
x |
length of vector |
integer value
Jonathan M. Lees<jonathan.lees.edu>
k <- 1236 next2(k)k <- 1236 next2(k)
Data from Delta-O18 Isotope record of climate change. Periodicities of this data show the Milancovic cycles.
data(OH)data(OH)
OH = list( LOC=list(yr=0, jd=0, mo=0, dom=0, hr=0, mi=0, sec=0, lat=0, lon=0, z=0, mag=0, gap=0, delta=0 , rms=0, hozerr=0), MC=list(az1=0, dip1=0, az2=0, dip2=0, dir=0, rake1=0, dipaz1=0, rake2=0, dipaz2=0, F=list(az=0, dip=0), G=list(az=0, dip=0), U=list(az=0, dip=0), V=list(az=0, dip=0), P=list(az=0, dip=0), T=list(az=0, dip=0),sense=0,M=list( az1=0, d1=0, az2=0, d2=0, uaz=0, ud=0, vaz=0, vd=0, paz=0, pd =0, taz=0, td=0), UP=TRUE, icol=1, ileg="", fcol='red', CNVRG="", LIM =c(0,0,0,0) ),
STAS=list(tag="", name="", comp="", c3="", phase="", sec=0, err=0, pol="", flg=0 , res=0),
LIP=vector(length=6),
H=list(yr=0,mo=0,dom=0,hr=0,mi=0,sec=0,lat=0,lon=0,z=0,mag=0),
N=list(name=""),
E=list(rms=0,meanres=0,sdres=0,sdmean=0,sswres=0,ndf=0, fixflgs=0,sterrx=0,sterry=0,sterrz=0,sterrt=0,mag=0,sterrmag=0),
filename="",
PICKER="", UWFILEID="",winID1="",comments="", OSTAS="")
The sample unit here is set to 0.3 which is 10000 times the correct sample rat.
Lees, J. M. and J. Park (1995): Multiple-taper spectral analysis: A stand-alone C-subroutine: Computers & Geology: 21, 199-236.
data(OH) xx <- swig( OH, sel=which(OH$COMPS == "V"), SHOWONLY=0)data(OH) xx <- swig( OH, sel=which(OH$COMPS == "V"), SHOWONLY=0)
change from multiple R-screens to one
one()one()
par(mfrow=c(2,1)) plot(rnorm(10), rnorm(10) ) plot(rnorm(10), rnorm(10) ) one() plot(rnorm(10), rnorm(10) )par(mfrow=c(2,1)) plot(rnorm(10), rnorm(10) ) plot(rnorm(10), rnorm(10) ) one() plot(rnorm(10), rnorm(10) )
Convert output of XTR button to RSEIS list.
P2GH(P1)P2GH(P1)
P1 |
Output of swig after clicking XTR |
Running swig out after a selection of a window and the XTR button, one can create an RSEIS structure for further use in swig.
RSEIS list
Jonathan M. Lees<jonathan.lees.edu>
swig, prepSEIS
if(interactive()){ data(GH) #### click twice and select the XTR button P1 <- swig(GH) LH <- P2GH(P1) L1 <- swig(LH) }if(interactive()){ data(GH) #### click twice and select the XTR button P1 <- swig(GH) LH <- P2GH(P1) L1 <- swig(LH) }
Parse and Extact information from a screen dump of PDE (preliminary earthquake estimates) from the internet,
parse.pde(card)parse.pde(card)
card |
character, one line from the PDE file |
Parsing is done by column specification. Uses screen dump format. see http://neic.usgs.gov/neis/epic/epic.html
Time, Location and Magnitude: list(yr, jd, mo, dom, hr, mi, sec, lat, lon, depth, z, mag)
May try using the CSV version of the dump.
Jonathan M. Lees<[email protected]>
http://neic.usgs.gov/neis/epic/epic.html
getPDEcsv, getPDEscreen
###### copy/paste from the screen dump at the NEIC web site K = c( ' PDE-Q 2008 12 31 053408.80 40.11 -77.00 1 2.4 LgGS ... ....... ', ' PDE-Q 2008 12 31 084757.50 46.75 154.41 14 4.9 mbGS ... ....... ') G = parse.pde(K[1])###### copy/paste from the screen dump at the NEIC web site K = c( ' PDE-Q 2008 12 31 053408.80 40.11 -77.00 1 2.4 LgGS ... ....... ', ' PDE-Q 2008 12 31 084757.50 46.75 154.41 14 4.9 mbGS ... ....... ') G = parse.pde(K[1])
station and component are assumed to be the last elements of a file name - this function returns a list with these text strings.
parseFN2STA(fn, ista, icomp, sep="\\.", dir=0 )parseFN2STA(fn, ista, icomp, sep="\\.", dir=0 )
fn |
text file name |
ista |
index of station name counting from the end of the file name |
icomp |
index of station name counting from the end of the file name |
sep |
separator token in file name |
dir |
integer, default=0, direction for counting. see details |
Some seismic data formats store the station in the file name rather than the seismic header. The default (dir=0) assumes that the station name and the component name are the last items on the file name seperated by a period. So ista and icomp are computed from the end of the file name, i.e. ista=1 and icomp=0. If (dir=1) the counting is from the beginning of the string and the count starts at 1. Remember to count double tokens, they return a blank.
list(sta='text station name', comp='compname')
Jonathan M. Lees<[email protected]>
parseFN2STA('/data/wadati/bourbon/GUATEMALA/SEGY/R009.01/07.009.22.25.34.CAS.E') fn <- "2011-11-06-0637-21S.SI01__003_SI01__SH_N_SAC" parseFN2STA(fn, 4, 1, sep="_" ) ### or: parseFN2STA(fn, 4, 7, sep="_", dir=1 )parseFN2STA('/data/wadati/bourbon/GUATEMALA/SEGY/R009.01/07.009.22.25.34.CAS.E') fn <- "2011-11-06-0637-21S.SI01__003_SI01__SH_N_SAC" parseFN2STA(fn, 4, 1, sep="_" ) ### or: parseFN2STA(fn, 4, 7, sep="_", dir=1 )
Show Particle Motion on Stereonet
partmotnet(temp, LINES = FALSE, STAMP = STAMP, COL = rainbow(100))partmotnet(temp, LINES = FALSE, STAMP = STAMP, COL = rainbow(100))
temp |
matrix of 3-component seismic data |
LINES |
logical, TRUE=draw lines |
STAMP |
identification stamp |
COL |
color palette |
Show seismic particle motion on a sphere color coded by time.
graphical side effect
Jonathan M. Lees<jonathan.lees.edu>
data("GH") temp = list(x=GH$JSTR[[1]][1168:1500], y=GH$JSTR[[2]][1168:1500], z=GH$JSTR[[3]][1168:1500]) sx = partmotnet(temp, STAMP="Example", LINES=TRUE, COL=rainbow(100) )data("GH") temp = list(x=GH$JSTR[[1]][1168:1500], y=GH$JSTR[[2]][1168:1500], z=GH$JSTR[[3]][1168:1500]) sx = partmotnet(temp, STAMP="Example", LINES=TRUE, COL=rainbow(100) )
Converta list of individual PDE events to a list of lat, lon, z...etc
PDE2list(PDF)PDE2list(PDF)
PDF |
list of individual events |
uses getmem
list
Jonathan M. Lees<[email protected]>
getmem, getPDEcsv, parse.pde,getPDEscreen
Find peak amplitudes in a time series signal.
peaks(series, span = 3, do.pad = TRUE)peaks(series, span = 3, do.pad = TRUE)
series |
signal |
span |
span for window |
do.pad |
padding |
This function originated in a note from Brian Ripley.
vector of peak indexes
Brian Ripley
data(CE1) plot(CE1$x, CE1$y, type='l') pp <- seq(from=53, to=80, by=1) plot(CE1$x[pp], CE1$y[pp], type='l') aa <- peaks(CE1$y[pp], span=3) abline(v=CE1$x[pp[aa]], col='red')data(CE1) plot(CE1$x, CE1$y, type='l') pp <- seq(from=53, to=80, by=1) plot(CE1$x[pp], CE1$y[pp], type='l') aa <- peaks(CE1$y[pp], span=3) abline(v=CE1$x[pp[aa]], col='red')
Prints brief documentation for buttons in swig
PICK.DOC(w)PICK.DOC(w)
w |
vector of buttons needed |
Buttons are defined in advance
printed side effect
Jonathan M. Lees<jonathan.lees.edu>
swig
if(interactive() ) PICK.DOC(6:23)if(interactive() ) PICK.DOC(6:23)
print swig information to screen
pickgeninfo()pickgeninfo()
Jonathan M. Lees<[email protected]>
swig
pickgeninfo()pickgeninfo()
Update the WPX (pick data frame) list with a new pick.
pickhandler(i1 = 1, ppick = 0, kzap = "Y", err = NA, res=0, ycol = rgb(0, 0, 1), pol=0, flg=0, onoff=1, NPX = 1, WPX = WPX, NH)pickhandler(i1 = 1, ppick = 0, kzap = "Y", err = NA, res=0, ycol = rgb(0, 0, 1), pol=0, flg=0, onoff=1, NPX = 1, WPX = WPX, NH)
i1 |
Index of trace |
ppick |
time for pick in seconds |
kzap |
character label of pick |
err |
error for pick |
res |
residual(or duration) |
ycol |
color for pick |
pol |
polarity of pick |
flg |
flag for pick |
onoff |
turn or off for pick |
NPX |
index of pick in WPX |
WPX |
Pick data frame |
NH |
List of traces |
Returns WPX data frame with new pick added (or replaced).
If WPX is missing, it is created. If NH is missing (no seismic traces) program returns NULL.
Jonathan M. Lees<[email protected]>
swig, YPIX, WPIX, NOPIX, REPIX, PickWin, pADDPIX, Ppic, POLSWITCH, Pup
Automatic Picking Algorithm
pickit(ay, deltat = 0.008, MED = 225, FRWD = 8, BKWD = 8, sbef = 1, saft = 6, thresh = 2, Tthresh2 = 7, stretch = 1000, flo = 0.1, fhi = 5, Kmin = 7, dthresh = 0.01, threshbot = 1.01)pickit(ay, deltat = 0.008, MED = 225, FRWD = 8, BKWD = 8, sbef = 1, saft = 6, thresh = 2, Tthresh2 = 7, stretch = 1000, flo = 0.1, fhi = 5, Kmin = 7, dthresh = 0.01, threshbot = 1.01)
ay |
signal |
deltat |
sample rate |
MED |
use median smoothing? |
FRWD |
forward window, s |
BKWD |
backward window |
sbef |
seconds before |
saft |
seconds after |
thresh |
threshold 1 |
Tthresh2 |
threshold 2 |
stretch |
stretch factor |
flo |
low frequency for BP filter |
fhi |
low frequency for BP filter |
Kmin |
min number of picks per window |
dthresh |
delta threshold |
threshbot |
threshold bottom limit |
used internally. This code uses several methods for getting best pick.
list(RAT=A$rat, x=x, ay=ay, fy=fy, deltat=deltat, J=J$J , Z=Z, a1=a1, a2=a2, thresh=thresh, Tthresh2=Tthresh2, Kmin=Kmin)
Jonathan M. Lees<jonathan.lees.edu>
ETECTG
Pick zooms on 24 hour display.
pickseis24(w, DB, usta, ucomp, kind=-1, Iendian=1, BIGLONG=FALSE)pickseis24(w, DB, usta, ucomp, kind=-1, Iendian=1, BIGLONG=FALSE)
w |
picking windows from output of plotseis24 and winseis24 |
DB |
Database of seismic trace meta data |
usta |
stations to extract |
ucomp |
components to extract |
kind |
an integer -1, 0, 1, 2 ; 0="RDATA" , -1="RDS", 0="RDATA", 1 = "segy", 2 = "sac", see notes below |
Iendian |
vector, Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
Use sequence of 2 clicks per zoom window on the plotseis24 display.
Graphical Side effects. Program starts swig
Jonathan M. Lees<[email protected]>
swig, winseis24 , plotseis24 , getseis24
if(interactive()) { data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) w = winseis24(pjj) dev.new() pickseis24(w, DB, IDB$usta[1], IDB$ucomp[1] ) }if(interactive()) { data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) w = winseis24(pjj) dev.new() pickseis24(w, DB, IDB$usta[1], IDB$ucomp[1] ) }
Locator function with set parameters
plocator(COL = 1, NUM = FALSE, YN = NULL, style = 0)plocator(COL = 1, NUM = FALSE, YN = NULL, style = 0)
COL |
color |
NUM |
number of points |
YN |
number of windows to span for lines |
style |
0,1,2 for differnt style of plotting vertical lines |
if the window is divided into YN horizontal regions, style =2 will plot segments only within regions based on y-value of locator().
list:
x |
x-locations |
y |
y-locations |
n |
number of points |
Jonathan M. Lees<jonathan.lees.edu>
locator
plot(c(0,1), c(0,1), type='n') for(i in 1:5) { abline(h=i/6) } if(interactive()) plocator(COL = 1, NUM = 4, YN = 6, style = 2)plot(c(0,1), c(0,1), type='n') for(i in 1:5) { abline(h=i/6) } if(interactive()) plocator(COL = 1, NUM = 4, YN = 6, style = 2)
plot all phase arrival picks
PLOT.ALLPX(t0, STNS, COMPS, YPX, PHASE = NULL, POLS = TRUE, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)PLOT.ALLPX(t0, STNS, COMPS, YPX, PHASE = NULL, POLS = TRUE, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)
t0 |
time for start of window, s |
STNS |
station names to plot |
COMPS |
components to plot |
YPX |
y-picks (times) |
PHASE |
Phases to plot |
POLS |
polaritiy information (up, down) |
FILL |
fill color |
FORCE |
logical, force all phases plotted on all traces |
cex |
character expansion |
srt |
string rotation angle, degrees |
for use in conjunction with PLOT.SEISN program
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
PLOT.SEISN, swig
data(GH) WPX = data.frame(GH$pickfile$STAS) T0 = data.frame(GH$info)[1,] sel = which(GH$COMPS=='V') PLOT.SEISN(GH, sel=sel) PLOT.ALLPX(T0, GH$STNS, GH$COMPS, WPX, PHASE='P',FORCE=TRUE)data(GH) WPX = data.frame(GH$pickfile$STAS) T0 = data.frame(GH$info)[1,] sel = which(GH$COMPS=='V') PLOT.SEISN(GH, sel=sel) PLOT.ALLPX(T0, GH$STNS, GH$COMPS, WPX, PHASE='P',FORCE=TRUE)
Matrix of several seismograms
PLOT.MATN(ascd, tim=1, dt=1, T1=0, WIN=c(0,1), labs="", notes=notes, sfact=1,ampboost=0, shift=NULL, LOG="", COL='red', add=1, AXES=1, units=NULL, VS=FALSE)PLOT.MATN(ascd, tim=1, dt=1, T1=0, WIN=c(0,1), labs="", notes=notes, sfact=1,ampboost=0, shift=NULL, LOG="", COL='red', add=1, AXES=1, units=NULL, VS=FALSE)
ascd |
N by K matrix of seismograms where |
tim |
time values fo x-axis |
dt |
sample interval, seconds |
T1 |
Time for starting sample (default=0) |
WIN |
vector, time window for zoom |
labs |
vector of labels for each panel |
notes |
vector of notes for each panel |
sfact |
scaling factor, 1=window, 2=trace |
ampboost |
increase each amplitude by this multiplier |
shift |
vector, shift each trace by these time |
LOG |
log x-axis |
COL |
vector of colors or indexes to colors |
add |
numeric, to existing plot. add = 1,2,3 if add=1 plot and add traces, add =2 plot, but no traces, add = 3 no plot, but add traces. DEFAULT=1 |
AXES |
numeric, 0,1,2,3,4; default=1 |
units |
label for units of Y-axis |
VS |
var-squiggle display |
Plots a matrix of seismograms that each have the same starting time. For the AXES argument, 0 = no axes, AXES=1 plot scale for largest amplitude band and a multiplier for all others, AXES=2 left side, AXES=3 right side, AXES=4 alternate sides
Graphical side effects and,
n |
n |
windiv |
matrix of n rows, with columns=(window Y min, window Y max, user Y min, user Y max) |
Jonathan M. Lees<[email protected]>
swig, matsquiggle, dowiggles, varsquiggle
dt <- 0.001 t <- seq(0, 6, by=0.001) thefreqs <- seq(from=10, to=100, by=10) theamps <- runif(length(thefreqs)) # sample rate is 1000 Hz, 0.001 seconds 601 samples x <- NULL for(i in 1:length(thefreqs)) { x <- cbind(x, theamps[i]*sin(2*pi*thefreqs[i]*t)) } PLOT.MATN(x, dt = dt)dt <- 0.001 t <- seq(0, 6, by=0.001) thefreqs <- seq(from=10, to=100, by=10) theamps <- runif(length(thefreqs)) # sample rate is 1000 Hz, 0.001 seconds 601 samples x <- NULL for(i in 1:length(thefreqs)) { x <- cbind(x, theamps[i]*sin(2*pi*thefreqs[i]*t)) } PLOT.MATN(x, dt = dt)
Seismic traces are plotted on a panel horizontally.
PLOT.SEISN(GH, tim = 1, dt = 1, sel =c(1:4) , WIN =c(1,0) , labs=c("CE1") , notes = "CE1.V", subnotes=NA, tags ="CE1.V" , sfact = 1, LOG = "", COL = 'red', add = 1, pts = FALSE, YAX = 1, TIT = NULL, SHIFT = NULL,COLLAPSE=FALSE, rm.mean = TRUE, UNITS = "volts", MARK = TRUE, xtickfactor = 1, vertline=NA )PLOT.SEISN(GH, tim = 1, dt = 1, sel =c(1:4) , WIN =c(1,0) , labs=c("CE1") , notes = "CE1.V", subnotes=NA, tags ="CE1.V" , sfact = 1, LOG = "", COL = 'red', add = 1, pts = FALSE, YAX = 1, TIT = NULL, SHIFT = NULL,COLLAPSE=FALSE, rm.mean = TRUE, UNITS = "volts", MARK = TRUE, xtickfactor = 1, vertline=NA )
GH |
RSEIS data structure |
tim |
tim axis vector, seconds |
dt |
deltaT, sample rate |
sel |
select which traces from GH |
WIN |
initial time window for plot |
labs |
character string vector, labels for units on y-axes, depends on YAX |
notes |
character string vector, labels on upper right of each panel |
subnotes |
character string vector, labels on lower-right of each panel |
tags |
character string vector, labels next to right end of trace (usually numbers) |
sfact |
scaling flag, 1=scale individually(DEFAULT), 2 = scale by window |
LOG |
log for x-axis |
COL |
color vector for plotting traces |
add |
integer: add to plot=1,2,3, add=1 plot and add traces, add =2 plot, but no traces, add = 3 no plot, but add traces |
pts |
add points |
YAX |
type of Yaxis label, 1,2,3 DEFAULT=1 only one y-axis others scaled; 2=all y-axes are plotted on left; 3=all y-axes plotted, alternating left and right |
TIT |
title |
SHIFT |
vector, shift each trace along x-axis by associated moveout time |
COLLAPSE |
logical, Collapse all traces onto one panel, default=FALSE |
,
rm.mean |
remove mean from traces |
UNITS |
character, units of traces (see labs) |
MARK |
character marking for earthquake |
xtickfactor |
Factor for multiplying the x-axis tick markers (default=1; for minutes=60, hrs=3600, days=24*3600) |
vertline |
time list (yr, jd, hr, mi sec) for plotting vertical lines on window. Default=NA |
panel of N traces are plotted. For YAX, default is YAX=1, plot an axis with no units label and scale all the traces to
Graphical Side effect. list(n=nn, dy=dy, minS=minS, maxS=maxS, meanS=meanS, DX=range(tim[tflag]) )
Jonathan M. Lees<jonathan.lees.edu>
swig
data("GH") m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### set up good colors pcols <- seiscols(GH) ### select only vertical components PLOT.SEISN(GH, sel=sel) GH$units <- rep("m/s", times=length(GH$KNOTES)) GH$pcols <- pcols ###### simple plot of GH structure YN <- PLOT.SEISN(GH, WIN=c(5,12)) ###### a color must be provided for all traces. ###### simple plot of GH structure, with selection and colors YN <- PLOT.SEISN(GH, WIN=c(5,12), sel=sel, COL=rainbow(length(sel)) ) #### alternating Y axes YN <- PLOT.SEISN(GH, WIN=c(5,12) , dt=GH$dt[sel], sel=sel, sfact=1 , notes=GH$KNOTES[sel], YAX =3, UNITS = TRUE ,labs = GH$units[sel], COL=pcols , TIT="test") #### Y axes on same side YN <- PLOT.SEISN(GH, WIN=c(5,12) , dt=GH$dt[sel], sel=sel, sfact=1 , notes=GH$KNOTES[sel], YAX =2, UNITS = TRUE ,labs = GH$units[sel], COL=pcols , TIT="test")data("GH") m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### set up good colors pcols <- seiscols(GH) ### select only vertical components PLOT.SEISN(GH, sel=sel) GH$units <- rep("m/s", times=length(GH$KNOTES)) GH$pcols <- pcols ###### simple plot of GH structure YN <- PLOT.SEISN(GH, WIN=c(5,12)) ###### a color must be provided for all traces. ###### simple plot of GH structure, with selection and colors YN <- PLOT.SEISN(GH, WIN=c(5,12), sel=sel, COL=rainbow(length(sel)) ) #### alternating Y axes YN <- PLOT.SEISN(GH, WIN=c(5,12) , dt=GH$dt[sel], sel=sel, sfact=1 , notes=GH$KNOTES[sel], YAX =3, UNITS = TRUE ,labs = GH$units[sel], COL=pcols , TIT="test") #### Y axes on same side YN <- PLOT.SEISN(GH, WIN=c(5,12) , dt=GH$dt[sel], sel=sel, sfact=1 , notes=GH$KNOTES[sel], YAX =2, UNITS = TRUE ,labs = GH$units[sel], COL=pcols , TIT="test")
Seismic traces are plotted on a panel horizontally, with spacing according to distance from source.
PLOT.TTCURVE(GH, STAXY = NULL, DIST = c(0, 10), DY = 0.1, tim = 1, dt = 1, sel = c(1:4), WIN = c(1, 0), labs = c("CE1"), notes = "CE1.V", tags = "CE1.V", sfact = 1, COL = "red", add = 1, pts = FALSE, YAX = FALSE, TIT = NULL, SHIFT = NULL, rm.mean = TRUE, UNITS = "volts", MARK = TRUE)PLOT.TTCURVE(GH, STAXY = NULL, DIST = c(0, 10), DY = 0.1, tim = 1, dt = 1, sel = c(1:4), WIN = c(1, 0), labs = c("CE1"), notes = "CE1.V", tags = "CE1.V", sfact = 1, COL = "red", add = 1, pts = FALSE, YAX = FALSE, TIT = NULL, SHIFT = NULL, rm.mean = TRUE, UNITS = "volts", MARK = TRUE)
GH |
Seismic data Structure |
STAXY |
Station Locations and distances in KM |
DIST |
Distance range, km |
DY |
height of each wiggle |
tim |
time span for plotting |
dt |
sample interval, seconds |
sel |
select which traces to plot |
WIN |
vector, time window for zoom |
labs |
vector of labels for each panel |
notes |
vector of notes for each panel |
tags |
character string vector, labels |
sfact |
scaling flag |
COL |
col vector |
add |
add to plot |
pts |
add points |
YAX |
Yaxis label |
TIT |
title |
SHIFT |
shift traces |
rm.mean |
remove mean from traces |
UNITS |
character, units of traces |
MARK |
character marking for earthquake |
Graphical Side effect.
list(n=nn, dy=dy, minS=minS, maxS=maxS, meanS=meanS, DX=range(tim[tflag]), DY=DY, DIST=DIST )
This program is similar to PLOT.SEISN but traces are plotting with increasing distance from a set point. The distances are calculated prior to execution and passed as a vector or structure.
Jonathan M. Lees<[email protected]>
PLOT.SEISN
Plot 1D velocity model showing P-wave and S-wave layered models.
Plot1Dvel(v, tit = NULL, col=c('blue', 'brown'), ...)Plot1Dvel(v, tit = NULL, col=c('blue', 'brown'), ...)
v |
Velocity models |
tit |
Title for plot (character) |
col |
2-colors for P and swave |
... |
other graphical parameters (e.g. lty, lwd) |
Velocity model consists of a list of P and S depths and layer velocity values. See example below.
Graphical Side effect
Errors are not required, although future versions may include the plotting of error bars.
Jonathan M. Lees<[email protected]>
Get1Dvel, Comp1Dvel, Comp1Dvels, travel.time1D
VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' Plot1Dvel(VEL, tit = 'This is an Example' )VEL <- list() VEL$'zp' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vp' <- c(1.1,2.15,3.2,4.25,5.3,6.25,6.7,6.9,7,7.2) VEL$'ep' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'zs' <- c(0,0.25,0.5,0.75,1,2,4,5,10,12) VEL$'vs' <- c(0.62,1.21,1.8,2.39,2.98,3.51,3.76,3.88,3.93,4.04) VEL$'es' <- c(0,0,0,0,0,0,0,0,0,0) VEL$'name' <- '/data/wadati/lees/Site/Hengil/krafla.vel' Plot1Dvel(VEL, tit = 'This is an Example' )
plot theoretical arrival times for a seismic section
plotarrivals(x, THEORY, add = FALSE)plotarrivals(x, THEORY, add = FALSE)
x |
matrix of wiggles |
THEORY |
theoretical arrivals |
add |
logical, if TRUE=Add to existing plot |
plots go from top of page down
graphical side effect
Used for adding information to wiggle plots.
Jonathan M. Lees<[email protected]>
symshot1, wiggleimage
S1 <- symshot1() wiggleimage(S1$smograms , dt=(-S1$dt), dx=S1$dx) plotarrivals(S1$x, S1$THEORY, add = TRUE)S1 <- symshot1() wiggleimage(S1$smograms , dt=(-S1$dt), dx=S1$dx) plotarrivals(S1$x, S1$THEORY, add = TRUE)
makes a plot of the data base files stored on disk.
plotDB(DB)plotDB(DB)
DB |
List, Data Base created by makeDB or setupDB |
Graphical Side effects
Jonathan M. Lees<[email protected]>
makeDB, setupDB
########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) ## IDB = infoDB(DB) plotDB(DB)########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) ## IDB = infoDB(DB) plotDB(DB)
Plot Spectrogram
plotevol(DEVOL, log = 0, fl = 0, fh = 10, col = col, ylog = FALSE, ygrid = FALSE, AXE = c(1, 2, 3, 4), CSCALE = FALSE, WUNITS = "Volts", STAMP = NULL, STYLE = "fft") plotevol2(DEVOL, log = 0, fl = 0, fh = 10, col = col, ylog = FALSE, ygrid = FALSE, AXE = c(1, 2, 3, 4), CSCALE = FALSE, WUNITS = "Volts", STAMP = NULL, STYLE = "fft", add=FALSE, IMAGE=TRUE, WIG=TRUE ) blankevol(DEVOL, log=0, fl=0, fh=10 , col=col, ylog=FALSE, ygrid=FALSE, AXE=c(1,2,3,4), CSCALE=FALSE, WUNITS="Volts", STAMP=NULL, STYLE="fft", WIG=TRUE )plotevol(DEVOL, log = 0, fl = 0, fh = 10, col = col, ylog = FALSE, ygrid = FALSE, AXE = c(1, 2, 3, 4), CSCALE = FALSE, WUNITS = "Volts", STAMP = NULL, STYLE = "fft") plotevol2(DEVOL, log = 0, fl = 0, fh = 10, col = col, ylog = FALSE, ygrid = FALSE, AXE = c(1, 2, 3, 4), CSCALE = FALSE, WUNITS = "Volts", STAMP = NULL, STYLE = "fft", add=FALSE, IMAGE=TRUE, WIG=TRUE ) blankevol(DEVOL, log=0, fl=0, fh=10 , col=col, ylog=FALSE, ygrid=FALSE, AXE=c(1,2,3,4), CSCALE=FALSE, WUNITS="Volts", STAMP=NULL, STYLE="fft", WIG=TRUE )
DEVOL |
spectrogram structure |
log |
scale by logarithm |
fl |
low frequency |
fh |
high frequency |
col |
color palette |
ylog |
scale Y-axis by log |
ygrid |
logical, TRUE=add grid |
AXE |
sides to add axis |
CSCALE |
logical, TRUE=add color scale |
WUNITS |
character string for units |
STAMP |
character string for identification |
STYLE |
Plotting style. Default, "fft"=plot half the spectrum image , else plot whole spectrum |
add |
logical, add to existing plot, default=FALSE |
IMAGE |
logical, whether to plot the image or not |
WIG |
logical, whether to plot the wiggle or not |
Plot Spectrogram. Because the fft function returns positive and negative frequencies, ff STYLE="fft" then the image matrix is reduced IMAT = t(DSPEC[1:(numfreqs/2),]) otherwise IMAT = t(DSPEC).
plotevol2 is used to add secondary spectra to ones already plotted, or to manage graphical paramters, or create other plots that match the graphical presentation of the spectrogram (plots of frequency versus time, but not images)
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
evolfft
data(CE1) Xamp <- CE1$y DT <- CE1$dt tsecs <- DT*(length(Xamp)*.02) multi <- 2 scale.def <- 1 TWOSEC <- tsecs*(1/DT) NS <- floor(multi*TWOSEC) NOV <- floor(multi*(TWOSEC-.2*TWOSEC)) Nfft<-4096 pal <- rainbow(100) fl <- 0 fh <- 1/(2*DT) flshow <- .5 fhshow <- 120 DEV <- evolfft(Xamp,DT , Nfft=Nfft, Ns=NS , Nov=NOV, fl=fl, fh=fh ) PE <- plotevol(DEV, log=scale.def, fl=flshow, fh=fhshow, col=pal, ygrid=FALSE, STAMP="HITHERE", STYLE="fft")data(CE1) Xamp <- CE1$y DT <- CE1$dt tsecs <- DT*(length(Xamp)*.02) multi <- 2 scale.def <- 1 TWOSEC <- tsecs*(1/DT) NS <- floor(multi*TWOSEC) NOV <- floor(multi*(TWOSEC-.2*TWOSEC)) Nfft<-4096 pal <- rainbow(100) fl <- 0 fh <- 1/(2*DT) flshow <- .5 fhshow <- 120 DEV <- evolfft(Xamp,DT , Nfft=Nfft, Ns=NS , Nov=NOV, fl=fl, fh=fh ) PE <- plotevol(DEV, log=scale.def, fl=flshow, fh=fhshow, col=pal, ygrid=FALSE, STAMP="HITHERE", STYLE="fft")
Quick and dirty plot of a seismic trace as recorded and save using stream2GHnosens or other RSEIS savers.
plotGH(h)plotGH(h)
h |
This is a standard GH object as defined in RSEIS |
The input is a list that has, as a minimum the following items: 'amp', 'dt', 'sta', 'comp', 'DATTIM'. Item 'amp', a time series vector is converted to a ts object.
Side effects
Jonathan M. Lees<[email protected]>
RSEIS::prepSEIS, RSEIS::prep1wig, RSEIS::PLOT.SEISN, RSEIS::swig
data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) #### convert to individual traces, ### here just use the first one: i = 1 AA = DD[i,] zh = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) ###### plot plotGH(zh)data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) #### convert to individual traces, ### here just use the first one: i = 1 AA = DD[i,] zh = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) ###### plot plotGH(zh)
Plot JGET output using interactive swig
plotJGET(J, SHOWONLY = FALSE)plotJGET(J, SHOWONLY = FALSE)
J |
list, output of JGETseis |
SHOWONLY |
logical, if SHOWONLY== TRUE, no interaction |
Program combines prepSEIS and swig
GH list ready for use in other RSEIS programs. See prepSEIS for details
Jonathan M. Lees<[email protected]>
JGET.seis, prepSEIS, swig
data(GH) Iendian = .Platform$endian apath = tempdir() ## setwd(apath) ## Iendian = .Platform$endian ## apath = './TEMP' ### dir.create(apath) J = rseis2sac(GH, sel = 1:5, path = apath, BIGLONG =FALSE ) Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) J <- JGET.seis(Lname,kind=2,BIGLONG=FALSE,HEADONLY=FALSE,Iendian=Iendian,PLOT=0) if(interactive()) { plotJGET(J) }data(GH) Iendian = .Platform$endian apath = tempdir() ## setwd(apath) ## Iendian = .Platform$endian ## apath = './TEMP' ### dir.create(apath) J = rseis2sac(GH, sel = 1:5, path = apath, BIGLONG =FALSE ) Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) J <- JGET.seis(Lname,kind=2,BIGLONG=FALSE,HEADONLY=FALSE,Iendian=Iendian,PLOT=0) if(interactive()) { plotJGET(J) }
Plot 24 hours of seismic data using output of getseis24.
plotseis24(JJ, dy = 1/18, FIX = 24, SCALE = 0, FILT = list(ON = FALSE, fl = 0.05, fh = 20, type = "BP", proto = "BU"), RCOLS = c(rgb(0.2, 0.2, 1), rgb(0.2, 0.2, 0.2)), add=FALSE )plotseis24(JJ, dy = 1/18, FIX = 24, SCALE = 0, FILT = list(ON = FALSE, fl = 0.05, fh = 20, type = "BP", proto = "BU"), RCOLS = c(rgb(0.2, 0.2, 1), rgb(0.2, 0.2, 0.2)), add=FALSE )
JJ |
output list of getseis24 |
dy |
Delta-y in percentage of trace |
FIX |
Fix 24 hour plot. If FIX is less than 24, the plot will show only that number of hours. |
SCALE |
scale, 0=scale each trace, 1=scale window |
FILT |
filter data |
RCOLS |
colors |
add |
logical, if TRUE, add to existing plot (i.e. do not issue a plot command) |
Plots full 24 hours of data. The list returned can be used by winseis24 to get picks and windows for zooming.
The FIX argument is currently not available.
list:
x |
x-axis |
y |
y-axis |
yr |
year |
jd |
julian day |
Jonathan M. Lees<[email protected]>
getseis24, winseis24
data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) )data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) )
Plot Wavelet Transform
plotwlet(baha, Ysig, dt, zscale = 1, zbound = NULL, col = rainbow(100), ygrid = FALSE, STAMP = "", xlab="Time, s" , units="", scaleloc=c(0.4,0.95))plotwlet(baha, Ysig, dt, zscale = 1, zbound = NULL, col = rainbow(100), ygrid = FALSE, STAMP = "", xlab="Time, s" , units="", scaleloc=c(0.4,0.95))
baha |
Output of wlet.do |
Ysig |
signal processed |
dt |
sample rate |
zscale |
scale of image |
zbound |
limits on scale |
col |
color palette |
ygrid |
add grid |
STAMP |
character string for identification |
xlab |
character, label for the x-axis |
units |
character, units on signal |
scaleloc |
2-vector, percentatge of bottom margin for the color scale |
This function plots the wavelet transform in a way that is similar to the spectogram plots.
list( y=, why=why, yBounds=c(0,perc), x=x, yat=raxspec)
y |
input signal |
why |
scaled image |
yBounds |
vector of boundaries |
x |
x axis |
yat |
y axis tic marks |
Graphical side effects.
Jonathan M. Lees<jonathan.lees.edu>
cwt, pwlet2freqs, wlet.do, wlet.drive
Plot MTM structure
plt.MTM0(frange, prange, plxy, M, freqs, amp, a, dof = dof, Fv = Fv, COL = 2)plt.MTM0(frange, prange, plxy, M, freqs, amp, a, dof = dof, Fv = Fv, COL = 2)
frange |
frequency range |
prange |
point range |
plxy |
log x,y axes |
M |
structure from MTM |
freqs |
frequencies |
amp |
amplitude |
a |
list(y=original data, dt=deltat) |
dof |
degrees of freedom |
Fv |
F-values |
COL |
color |
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
Lees, J. M. and Park, J., 1995: Multiple-taper spectral analysis: A stand-alone C-subroutine, Computers and Geology, 21(2), 199-236.
MTM.drive
data(CE1) plot(CE1$x, CE1$y, type='l') len <- length(CE1$y) len2 <- 2*next2(len) Mspec <- mtapspec(CE1$y, CE1$dt, klen=len2, MTP=list(kind=1,nwin=5, npi=3,inorm=0) ) f<-Mspec$freq M <- 1 f1 <- 0.01 f2 <- 100 plxy <- '' flag <- f>=f1 & f <= f2; freqs <- list(f[flag]) mydof <- NULL myFv <- NULL amp <- Mspec$spec[1:length(f)] amp <- list(amp[flag]) a <- list(y=CE1$y, dt=CE1$dt) frange <- range(freqs, na.rm = TRUE) prange <- range(amp , na.rm = TRUE) ### plot(freqs[[1]], amp[[1]]) plt.MTM0(frange, prange, plxy, M, freqs, amp, a, dof=mydof, Fv=myFv, COL=4)data(CE1) plot(CE1$x, CE1$y, type='l') len <- length(CE1$y) len2 <- 2*next2(len) Mspec <- mtapspec(CE1$y, CE1$dt, klen=len2, MTP=list(kind=1,nwin=5, npi=3,inorm=0) ) f<-Mspec$freq M <- 1 f1 <- 0.01 f2 <- 100 plxy <- '' flag <- f>=f1 & f <= f2; freqs <- list(f[flag]) mydof <- NULL myFv <- NULL amp <- Mspec$spec[1:length(f)] amp <- list(amp[flag]) a <- list(y=CE1$y, dt=CE1$dt) frange <- range(freqs, na.rm = TRUE) prange <- range(amp , na.rm = TRUE) ### plot(freqs[[1]], amp[[1]]) plt.MTM0(frange, prange, plxy, M, freqs, amp, a, dof=mydof, Fv=myFv, COL=4)
Add lines at phase arrival times
PLTpicks(picks, labs = NA, cols = NA)PLTpicks(picks, labs = NA, cols = NA)
picks |
vector of times relative to the start of the plot |
labs |
labels for picks |
cols |
colors for picks |
picks = vector of times relative to the start of the plot (seismogram)
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
ex <- seq(from=0, to=4*pi, length = 200) y <- sin(ex) picks = c(0.5*pi, 2.3*pi) plot(ex, y, type='l') PLTpicks(picks, labs =c("P","P") , cols =c('red','green') ) PLTpicks(picks+2, labs =c("S","PKIKP") , cols ='blue' )ex <- seq(from=0, to=4*pi, length = 200) y <- sin(ex) picks = c(0.5*pi, 2.3*pi) plot(ex, y, type='l') PLTpicks(picks, labs =c("P","P") , cols =c('red','green') ) PLTpicks(picks+2, labs =c("S","PKIKP") , cols ='blue' )
Plot Hodogram and show seismic particle motion
PMOT.drive(temp, dt, pmolabs = c("Vertical", "North", "East"), STAMP = "", baz = 0)PMOT.drive(temp, dt, pmolabs = c("Vertical", "North", "East"), STAMP = "", baz = 0)
temp |
matrix of 3-component seismic signal |
dt |
sample interval (delta-T, seconds) |
pmolabs |
labels for traces |
STAMP |
Character string Identification stamp |
baz |
Back Azimuth, degrees |
Input matrix should V, N, E. Baz is not implemented yet.
Graphical Side Effect.
Jonathan M. Lees<jonathan.lees.edu>
data("GH") sel <- which(GH$STNS == "CE1") YMAT <- cbind(GH$JSTR[[sel[1]]][1168:1500], GH$JSTR[[sel[2]]][1168:1500], GH$JSTR[[sel[3]]][1168:1500]) dt <- GH$dt[ sel[1] ] ftime <- Zdate(GH$info, sel[1], 1) if(interactive()){ PMOT.drive(YMAT, dt, pmolabs = c("Vertical", "North", "East"), STAMP =ftime ) }data("GH") sel <- which(GH$STNS == "CE1") YMAT <- cbind(GH$JSTR[[sel[1]]][1168:1500], GH$JSTR[[sel[2]]][1168:1500], GH$JSTR[[sel[3]]][1168:1500]) dt <- GH$dt[ sel[1] ] ftime <- Zdate(GH$info, sel[1], 1) if(interactive()){ PMOT.drive(YMAT, dt, pmolabs = c("Vertical", "North", "East"), STAMP =ftime ) }
Reformat posix time stamp to RSEIS list
posix2RSEIS(p)posix2RSEIS(p)
p |
posix time, either lt or ct |
returns a list of data/time in format RSEIS understands
Jonathan M. Lees<[email protected]>
j2posix
### make up a time: P1 = as.POSIXct(Sys.time(), "America/New_York") # in New York R1 = posix2RSEIS(P1) ## also unlist( as.POSIXlt(P1))### make up a time: P1 = as.POSIXct(Sys.time(), "America/New_York") # in New York R1 = posix2RSEIS(P1) ## also unlist( as.POSIXlt(P1))
Add Pick Marks and Labels
PPIX(zloc, YN = NULL, col = 1, lab = "")PPIX(zloc, YN = NULL, col = 1, lab = "")
zloc |
locator output |
YN |
number of panels |
col |
color for picks |
lab |
labels for picks |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
Takes list of traces and prepares new list for analysis in RSEIS
prep1wig(wig=vector(), dt=1, sta="STA", comp="CMP", units="UNITS", starttime=list(yr=0, jd=1,mo=1,dom=1, hr=1,mi=1,sec=0) )prep1wig(wig=vector(), dt=1, sta="STA", comp="CMP", units="UNITS", starttime=list(yr=0, jd=1,mo=1,dom=1, hr=1,mi=1,sec=0) )
wig |
vector of time series |
dt |
sample interval |
sta |
character, station name |
comp |
character,component name |
units |
character, units of signal |
starttime |
list(yr=1972, jd=1,mo=1,dom=1,hr=1,mi=1,sec=0) |
prep1wig is offered to reformat a time series
for input to program swig()
Rsac output list
amp |
amplitude |
dt |
sample rate |
nzyear |
year |
nzhour |
hour |
nzmin |
minutes |
nzsec |
seconds |
nzmsec |
msec |
b |
sac stuff |
e |
sac stuff |
o |
sac stuff |
fn |
character, file name |
sta |
character |
comp |
character |
DATTIM |
list of date and time |
N |
number of points |
units |
character |
Jonathan M. Lees<jonathan.lees.edu>
swig, prepSEIS
data(sunspots) AA <- attributes(sunspots) starttime<-list(yr=AA$tsp[1], jd=1,mo=1,dom=1,hr=0,mi=0,sec=0) ES <- prep1wig(wig=sunspots, dt=1/12, sta="STA", comp="CMP", units="UNITS", starttime=starttime ) EH<-prepSEIS(ES) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") ###### set SHOWONLY=FALSE for interactive xx <- swig( EH, STDLAB = STDLAB, SHOWONLY=0) #################### #################### #################### example with multiple signals dt <- 0.001 t <- seq(0, 6, by=0.001) ###### sample rate = 1000 Hz, 0.001 seconds 601 samples ### set up the fequencies and amplitudes for signals that have 2 frequencies afreqs1 <- c(50, 40,10, 5 ) amps1 <- c(6, 2,3, 2 ) #### afreqs2 <- c(120,30,20, 30 ) amps2 <- c(10,5, 9, 2 ) x <- cbind( amps1[1]*sin(2*pi*afreqs1[1]*t) + amps2[1]* sin(2*pi*afreqs2[1]*t), amps1[2]*sin(2*pi*afreqs1[2]*t) + amps2[2]* sin(2*pi*afreqs2[2]*t), amps1[3]*sin(2*pi*afreqs1[3]*t) + amps2[3]* sin(2*pi*afreqs2[3]*t), amps1[4]*sin(2*pi*afreqs1[4]*t) + amps2[4]* sin(2*pi*afreqs2[4]*t)) d <- dim(x) ######## names of signals mysta<-c("R1", "R2", "R3", "R4") MYLIST <- list() starttime <- list(yr=2008, jd=1,mo=1,dom=1,hr=0,mi=0,sec=0) ############ set up the initial list of wiggles for(i in 1:d[2]) { A <- prep1wig(wig =x[,i], sta=mysta[i], dt=dt, comp="DO", units= "amp", starttime=starttime) A[[1]]$DATTIM$yr <- 2000 MYLIST <- c(MYLIST, A) } ### reorganize into RSEIS format: PH1 <- prepSEIS(MYLIST) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") swig(PH1, STDLAB = STDLAB)data(sunspots) AA <- attributes(sunspots) starttime<-list(yr=AA$tsp[1], jd=1,mo=1,dom=1,hr=0,mi=0,sec=0) ES <- prep1wig(wig=sunspots, dt=1/12, sta="STA", comp="CMP", units="UNITS", starttime=starttime ) EH<-prepSEIS(ES) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") ###### set SHOWONLY=FALSE for interactive xx <- swig( EH, STDLAB = STDLAB, SHOWONLY=0) #################### #################### #################### example with multiple signals dt <- 0.001 t <- seq(0, 6, by=0.001) ###### sample rate = 1000 Hz, 0.001 seconds 601 samples ### set up the fequencies and amplitudes for signals that have 2 frequencies afreqs1 <- c(50, 40,10, 5 ) amps1 <- c(6, 2,3, 2 ) #### afreqs2 <- c(120,30,20, 30 ) amps2 <- c(10,5, 9, 2 ) x <- cbind( amps1[1]*sin(2*pi*afreqs1[1]*t) + amps2[1]* sin(2*pi*afreqs2[1]*t), amps1[2]*sin(2*pi*afreqs1[2]*t) + amps2[2]* sin(2*pi*afreqs2[2]*t), amps1[3]*sin(2*pi*afreqs1[3]*t) + amps2[3]* sin(2*pi*afreqs2[3]*t), amps1[4]*sin(2*pi*afreqs1[4]*t) + amps2[4]* sin(2*pi*afreqs2[4]*t)) d <- dim(x) ######## names of signals mysta<-c("R1", "R2", "R3", "R4") MYLIST <- list() starttime <- list(yr=2008, jd=1,mo=1,dom=1,hr=0,mi=0,sec=0) ############ set up the initial list of wiggles for(i in 1:d[2]) { A <- prep1wig(wig =x[,i], sta=mysta[i], dt=dt, comp="DO", units= "amp", starttime=starttime) A[[1]]$DATTIM$yr <- 2000 MYLIST <- c(MYLIST, A) } ### reorganize into RSEIS format: PH1 <- prepSEIS(MYLIST) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") swig(PH1, STDLAB = STDLAB)
Takes list of traces and prepares new list for analysis in RSEIS
prepSEIS(GG)prepSEIS(GG)
GG |
Output list of Rsac function GET.seis |
prepSEIS is offered to reformat the output of a list of seismic traces (or other time series) for inpout to program swig()
RSEIS list
Jonathan M. Lees<jonathan.lees.edu>
swig, JGET.seis, GET.seis(package="Rsac"), Package:Rsac
data(sunspots) ES <- prep1wig(wig=sunspots, dt=1/12, sta="STA", comp="CMP", units="UNITS" ) EH <- prepSEIS(ES) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") xx <- swig( EH, STDLAB = STDLAB) ################################### ###################################data(sunspots) ES <- prep1wig(wig=sunspots, dt=1/12, sta="STA", comp="CMP", units="UNITS" ) EH <- prepSEIS(ES) STDLAB <- c("DONE", "zoom out", "refresh", "restore", "XTR", "SPEC", "SGRAM" ,"WLET") xx <- swig( EH, STDLAB = STDLAB) ################################### ###################################
A set of standard known instrument responses.
PreSet.Instr()PreSet.Instr()
List of instrument responses. Each is a list:
np |
Number of poles |
poles |
complex vector of poles |
nz |
number of zeros |
zeros |
complex vector of zeros |
Knorm |
normalization factor |
Sense |
sensitivity factor |
Jonathan M. Lees<jonathan.lees.edu>
ReadSet.Instr
MYset <- PreSet.Instr() MYset[[1]]MYset <- PreSet.Instr() MYset[[1]]
ST/LT ratio curve for sutomated picking routines
PSTLTcurve(y, dt = 0.008, fwlen = 125, bwlen = 125, perc = 0.05, stretch = 1000, MED = 255, PLOT = FALSE)PSTLTcurve(y, dt = 0.008, fwlen = 125, bwlen = 125, perc = 0.05, stretch = 1000, MED = 255, PLOT = FALSE)
y |
signal |
dt |
deltaT (s) |
fwlen |
forward window |
bwlen |
backward window |
perc |
percent cut-off |
stretch |
stretch curve |
MED |
Median smoothing parameter |
PLOT |
logical, TRUE=PLOT |
list(flag=1, ind=ix, eye=eye, mix=mix, SNR=SNR, s2=s2, rat=therat)
flag |
flag on success |
ind |
index of pick estimate 1 |
eye |
index of pick estimate 2 |
mix |
index of pick estimate 3 |
SNR |
Signal/Noise ratio |
s2 |
sum squared |
rat |
ratio curve |
Jonathan M. Lees<jonathan.lees.edu>
require(stats) data(CE1) plot(CE1$x, CE1$y, type='l') z <- CE1$y[ CE1$x>5.352622 & CE1$x<5.589836] x <- CE1$x[ CE1$x>5.352622 & CE1$x<5.589836] G <- PSTLTcurve(z, dt = CE1$dt, fwlen = 10, bwlen = 10, perc = 0.05, stretch = 10, MED = 11, PLOT = FALSE) ### get time from beginning of trace tpick <- x[G$ind] abline(v=x[G$ind], col='red', lty=2)require(stats) data(CE1) plot(CE1$x, CE1$y, type='l') z <- CE1$y[ CE1$x>5.352622 & CE1$x<5.589836] x <- CE1$x[ CE1$x>5.352622 & CE1$x<5.589836] G <- PSTLTcurve(z, dt = CE1$dt, fwlen = 10, bwlen = 10, perc = 0.05, stretch = 10, MED = 11, PLOT = FALSE) ### get time from beginning of trace tpick <- x[G$ind] abline(v=x[G$ind], col='red', lty=2)
Dump a velocity model to an ascii file
Put1Dvel(vel, outfile)Put1Dvel(vel, outfile)
vel |
Velocity Model Structure |
outfile |
File name |
Side Effects
Jonathan M. Lees<[email protected]>
Get1Dvel, travel.time1D
Convert Wavelet Axis to Frequency
pwlet2freqs(noctave, nvoice, dt, flip = TRUE, tab.FREQ, plot = FALSE, perc = 0.85)pwlet2freqs(noctave, nvoice, dt, flip = TRUE, tab.FREQ, plot = FALSE, perc = 0.85)
noctave |
number of octives |
nvoice |
number of voices |
dt |
sample rate (s) |
flip |
logical, whether to flip the orientation |
tab.FREQ |
vector of frequencies |
plot |
logical, TRUE=add to plot |
perc |
percent of range to consider |
This function is used to add a y-axis to a wavelet transform plot.
list:
why |
y-axis coordinate on wavelet transform |
Iat |
location |
efs |
frequencies |
Jonathan M. Lees<jonathan.lees.edu>
wlet.do
pfreqs <- c(0.5, 1, 2,3,4,5, 10, 14) zp <- pwlet2freqs(noctave= 6, nvoice= 20, 0.004, flip = TRUE, pfreqs, plot = FALSE, perc = 0.85)pfreqs <- c(0.5, 1, 2,3,4,5, 10, 14) zp <- pwlet2freqs(noctave= 6, nvoice= 20, 0.004, flip = TRUE, pfreqs, plot = FALSE, perc = 0.85)
Return the range of dates and times for any list with a date/time list
rangedatetime(D)rangedatetime(D)
D |
info list from RSEIS seismic data list |
min |
date time list |
max |
date time list |
Jonathan M. Lees<[email protected]>
data(GH) rangedatetime(GH$info)data(GH) rangedatetime(GH$info)
Travel time and raypath from source to reciever in 1D local model.
Ray.time1D(indelta, inhpz, instaz, inlay, ztop, vel)Ray.time1D(indelta, inhpz, instaz, inlay, ztop, vel)
indelta |
distance in KM |
inhpz |
depth of hypocenter, km |
instaz |
elevation of station |
inlay |
number of layers |
ztop |
vector, tops of layers |
vel |
vector, velocities in layers |
Uses local 1D velocity model, not appropriate for spherical earth.
list:
dtdr |
derivative of t w.r.t. horizontal distance |
dtdz |
derivative of t w.r.t. z, depth |
angle |
incidence angle, degrees |
tt |
travel time, s |
nnod |
number of nodes |
znod |
node depths, km |
rnod |
node offset distances, km |
Jonathan M. Lees<jonathan.lees.edu>
travel.time1D, Get1Dvel
data(VELMOD1D) v <- VELMOD1D indelta=23.; inhpz=7.; instaz=0.; nz = length(v$zp) tees <- travel.time1D(indelta, inhpz, instaz, nz , v$zp , v$vp) rays <- Ray.time1D(indelta, inhpz, instaz, nz , v$zp , v$vp) plot(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod],type="n", xlab="distance, km" , ylab="Depth, km") abline(h=-v$zp, lty=2, col=grey(0.80) ) points(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod], pch=8, col='green') lines(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod]) points(rays$rnod[rays$nnod] , -rays$znod[rays$nnod], pch=6, col='red', cex=2) ##### to coordinate this in space, need to rotate about ##### the line between source and receiver locationsdata(VELMOD1D) v <- VELMOD1D indelta=23.; inhpz=7.; instaz=0.; nz = length(v$zp) tees <- travel.time1D(indelta, inhpz, instaz, nz , v$zp , v$vp) rays <- Ray.time1D(indelta, inhpz, instaz, nz , v$zp , v$vp) plot(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod],type="n", xlab="distance, km" , ylab="Depth, km") abline(h=-v$zp, lty=2, col=grey(0.80) ) points(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod], pch=8, col='green') lines(rays$rnod[1:rays$nnod] , -rays$znod[1:rays$nnod]) points(rays$rnod[rays$nnod] , -rays$znod[rays$nnod], pch=6, col='red', cex=2) ##### to coordinate this in space, need to rotate about ##### the line between source and receiver locations
Calculate distance, Azimuth and Back-Azimuth from two points on Globe.
rdistaz(olat, olon, tlat, tlon)rdistaz(olat, olon, tlat, tlon)
olat |
origin latitude, degrees |
olon |
origin longitude, degrees |
tlat |
target latitude, degrees |
tlon |
target longitude, degrees |
The azimuth is returned in degrees from North.
Program is set up for one origin (olat, olon) pair and many target (tlat, tlon) pairs given as vectors.
If multiple olat and olon are given, the program returns a list of outputs for each.
If olat or any tlat is greater than 90 or less than -90, NA is returned and error flag is 0.
If any tlat and tlon is equal to olat and olon, the points are coincident. In that case the distances are set to zero, but the az and baz are NA, and the error flag is set to 0.
List:
del |
Delta, angle in degrees |
az |
Azimuth, angle in degrees |
baz |
Back Azimuth, angle in degrees from target to origin |
dist |
Distance in km |
err |
0 or 1, error flag. 0=error, 1=no error, see details |
Jonathan M. Lees<[email protected]>
along.great, getgreatarc
#### one point d <- rdistaz(12, 23, -32, -65) d #### many random target points org <- c(80.222, -100.940) targ <- cbind(runif(10, 10, 50), runif(10, 20, 100)) rdistaz(org[1], org[2], targ[,1], targ[,2]) ############ if origin and target are identical ##### the distance is zero, but the az and baz are not defined rdistaz(80.222, -100.940, 80.222, -100.940) ######################## set one of the targets equal to the origin targ[7,1] <- org[1] targ[7,2] <- org[2] rdistaz(org[1], org[2], targ[,1], targ[,2]) #### put in erroneous latitude data targ[3,1] <- -91.3 rdistaz(org[1], org[2], targ[,1], targ[,2]) ########### ### New York and Chapel Hill NY =list(lat=40.6698, lon=286.0562) CH = list(lat=35.92761, lon=280.9594) ## h = GEOmap::distaz(CH$lat, CH$lon, NY$lat, NY$lon) h = rdistaz(CH$lat, CH$lon, NY$lat, NY$lon) ####### get great circle ray path RAY = GEOmap::getgreatarc(CH$lat, CH$lon, NY$lat, NY$lon, 100) #### get great circle through north pole Nor1 = GEOmap::getgreatarc(CH$lat, CH$lon, 90, CH$lon, 100) PROJ = GEOmap::setPROJ(2, CH$lat, CH$lon) RAY.XY = GEOmap::GLOB.XY(RAY$lat, RAY$lon, PROJ) Nor1.XY = GEOmap::GLOB.XY(Nor1$lat, Nor1$lon, PROJ) VEE1 = c(Nor1.XY$x[2]-Nor1.XY$x[1], Nor1.XY$y[2]-Nor1.XY$y[1]) VEE2 = c(RAY.XY$x[2]-RAY.XY$x[1], RAY.XY$y[2]-RAY.XY$y[1] ) VEE1 = VEE1/sqrt(sum(VEE1^2) ) VEE2 = VEE2/sqrt(sum(VEE2^2) ) ###### get angle from north: ANG = acos( sum(VEE1*VEE2) ) *180/pi #### compare with h print(paste(h$az, ANG, h$az-ANG) )#### one point d <- rdistaz(12, 23, -32, -65) d #### many random target points org <- c(80.222, -100.940) targ <- cbind(runif(10, 10, 50), runif(10, 20, 100)) rdistaz(org[1], org[2], targ[,1], targ[,2]) ############ if origin and target are identical ##### the distance is zero, but the az and baz are not defined rdistaz(80.222, -100.940, 80.222, -100.940) ######################## set one of the targets equal to the origin targ[7,1] <- org[1] targ[7,2] <- org[2] rdistaz(org[1], org[2], targ[,1], targ[,2]) #### put in erroneous latitude data targ[3,1] <- -91.3 rdistaz(org[1], org[2], targ[,1], targ[,2]) ########### ### New York and Chapel Hill NY =list(lat=40.6698, lon=286.0562) CH = list(lat=35.92761, lon=280.9594) ## h = GEOmap::distaz(CH$lat, CH$lon, NY$lat, NY$lon) h = rdistaz(CH$lat, CH$lon, NY$lat, NY$lon) ####### get great circle ray path RAY = GEOmap::getgreatarc(CH$lat, CH$lon, NY$lat, NY$lon, 100) #### get great circle through north pole Nor1 = GEOmap::getgreatarc(CH$lat, CH$lon, 90, CH$lon, 100) PROJ = GEOmap::setPROJ(2, CH$lat, CH$lon) RAY.XY = GEOmap::GLOB.XY(RAY$lat, RAY$lon, PROJ) Nor1.XY = GEOmap::GLOB.XY(Nor1$lat, Nor1$lon, PROJ) VEE1 = c(Nor1.XY$x[2]-Nor1.XY$x[1], Nor1.XY$y[2]-Nor1.XY$y[1]) VEE2 = c(RAY.XY$x[2]-RAY.XY$x[1], RAY.XY$y[2]-RAY.XY$y[1] ) VEE1 = VEE1/sqrt(sum(VEE1^2) ) VEE2 = VEE2/sqrt(sum(VEE2^2) ) ###### get angle from north: ANG = acos( sum(VEE1*VEE2) ) *180/pi #### compare with h print(paste(h$az, ANG, h$az-ANG) )
For saving vectors to a file after the locator function has been executed.
rDUMPLOC(zloc, dig = 12)rDUMPLOC(zloc, dig = 12)
zloc |
x,y list of locator positions |
dig |
number of digits in output |
Side effects: print to screen
Jonathan M. Lees<[email protected]>
G <- list() G$x <- c(-1.0960,-0.9942,-0.8909,-0.7846,-0.6738,-0.5570,-0.4657,-0.3709, -0.2734,-0.1740,-0.0734, 0.0246, 0.1218, 0.2169, 0.3086, 0.3956, 0.4641, 0.5293, 0.5919, 0.6530, 0.7131) G$y <- c(-0.72392,-0.62145,-0.52135,-0.42599,-0.33774,-0.25896,-0.20759, -0.16160,-0.11981,-0.08105,-0.04414,-0.00885, 0.02774, 0.06759, 0.11262, 0.16480, 0.21487, 0.27001, 0.32895, 0.39044, 0.45319) g <- G rDUMPLOC(g, dig = 5)G <- list() G$x <- c(-1.0960,-0.9942,-0.8909,-0.7846,-0.6738,-0.5570,-0.4657,-0.3709, -0.2734,-0.1740,-0.0734, 0.0246, 0.1218, 0.2169, 0.3086, 0.3956, 0.4641, 0.5293, 0.5919, 0.6530, 0.7131) G$y <- c(-0.72392,-0.62145,-0.52135,-0.42599,-0.33774,-0.25896,-0.20759, -0.16160,-0.11981,-0.08105,-0.04414,-0.00885, 0.02774, 0.06759, 0.11262, 0.16480, 0.21487, 0.27001, 0.32895, 0.39044, 0.45319) g <- G rDUMPLOC(g, dig = 5)
Read one SEGY/SAC file
read1segy(fname, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE) read1sac(fname, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE )read1segy(fname, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE) read1sac(fname, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE )
fname |
character, file name |
Iendian |
Endian of the input file name |
HEADONLY |
logical, TRUE=return only header (default=FALSE) |
BIGLONG |
logical, indicating whether long is 8 or 4 bytes. |
Segy format files are in integer format. The time series ususally represents counts recorded in a data acquisition system. The header includes meta-data and other identifying information.
SAC data is stored as floats, typically volts.
list of header and times series
The Endian-ness of the input files is set by the system that created them. If the read1segy or read1sac does not make sense, try a different endian or BIGLONG setting.
Jonathan M. Lees<[email protected]>
write1sac, write1segy, sac2rseis, segy2rseis, prepSEIS
data(GH) theENDIAN =.Platform$endian apath = tempdir() J = rseis2segy(GH, sel=1:5, path=apath , BIGLONG=FALSE ) Lname <- list.files(path=J , pattern='SEGY', full.names=TRUE) zed = read1segy(Lname[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = FALSE)data(GH) theENDIAN =.Platform$endian apath = tempdir() J = rseis2segy(GH, sel=1:5, path=apath , BIGLONG=FALSE ) Lname <- list.files(path=J , pattern='SEGY', full.names=TRUE) zed = read1segy(Lname[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = FALSE)
Read Instrument Response, poles and zeros, in IRIS SEED format.
ReadInstr(fn)ReadInstr(fn)
fn |
File name with Poles and Zeros |
RSEIS currently has a function (ReadSet.Instr) to read pole/zero files, but it seems to expect a format different from what one gets from IRIS. This one is compatible with pole/zero files produced by rdseed when converting seed files from the DMC to SAC files.
List of poles and zeros compatible for swig decon
Jake Anderson<[email protected]>
ReadSet.Instr
###### create a SAC format response file: temp.file= tempfile("PZ") cat(file=temp.file, c( "ZEROS 4", "-999.0260 0.0000", "POLES 6", "-0.1480 0.1480", "-0.1480 -0.1480", "-314.1600 0.0000", "-9904.8000 3786.0000", "-9904.8000 -3786.0000", "-12507.0000 0.0000", "CONSTANT 4.540182e+20"), sep='\n') RESP <- ReadInstr(temp.file)###### create a SAC format response file: temp.file= tempfile("PZ") cat(file=temp.file, c( "ZEROS 4", "-999.0260 0.0000", "POLES 6", "-0.1480 0.1480", "-0.1480 -0.1480", "-314.1600 0.0000", "-9904.8000 3786.0000", "-9904.8000 -3786.0000", "-12507.0000 0.0000", "CONSTANT 4.540182e+20"), sep='\n') RESP <- ReadInstr(temp.file)
Read in an instrument response file, or
ReadSet.Instr(file)ReadSet.Instr(file)
file |
name of file to read, or vector of character strings from the file |
If file is a path to a file it is read in and processed. If file is a vector of character strings from a file that has already been read in, the file is processed directly. The tag names (ZEROS, POLES, SENSE, CONSTANT) can be upper,lower or mixed case. Alternative to SENSE = sensitivity, and CONSTANT=norm or knorm.
list:
np |
Number of poles |
poles |
complex vector of poles |
nz |
number of zeros |
zeros |
complex vector of zeros |
Knorm |
normalization factor |
Sense |
sensitivity factor |
Jonathan M. Lees<jonathan.lees.edu>
### in this case a file has already been read in: CMG <- c( "ZEROS 2", "0.0000E+00 0.0000E+00", "0.0000E+00 0.0000E+00", "POLES 3", "-0.1480E+00 0.1480E+00", "-0.1480E+00 -0.1480E+00", "-50.0 0.0", "CONSTANT 1.0", "SENSE 800") ReadSet.Instr(CMG)### in this case a file has already been read in: CMG <- c( "ZEROS 2", "0.0000E+00 0.0000E+00", "0.0000E+00 0.0000E+00", "POLES 3", "-0.1480E+00 0.1480E+00", "-0.1480E+00 -0.1480E+00", "-50.0 0.0", "CONSTANT 1.0", "SENSE 800") ReadSet.Instr(CMG)
PArse out UW O-cards from Pickfile
readUW.OSTAS(OS1)readUW.OSTAS(OS1)
OS1 |
cards starting with O |
vector of station names not picked
Jonathan M. Lees<jonathan.lees.edu>
Rectify a date that may be out of wack.
recdate(jd=0, hr=0, mi=0, sec=0, yr=0) recdatel(X)recdate(jd=0, hr=0, mi=0, sec=0, yr=0) recdatel(X)
jd |
Julian Day |
hr |
hours |
mi |
minutes |
sec |
seconds |
yr |
year |
or
X |
list of date |
Returns date with correct numbers. So if number of seconds is greater than 60, will add to minutes...
jd |
Julian Day |
hr |
hours |
mi |
minutes |
sec |
seconds |
yr |
year |
Default value for jd is 1, the rest are 0. This function now should successfully span year breaks. Leap years are correctly accounted for too.
Jonathan M. Lees<jonathan.lees.edu>
showdatetime, DAYSperYEAR, fromjul,getjul, tojul, getmoday
recdate(76, 23, 22, yr=2000) ########### example spanning leap year ## start on Day 1, but subtract 36 hours and proceed to plus 36 hours hrs <- seq(from=-36, to=36, by=2) rd <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2009) write.table(data.frame(rd)) ########### example spanning non-leap year rd2 <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2008) write.table(data.frame(rd2))recdate(76, 23, 22, yr=2000) ########### example spanning leap year ## start on Day 1, but subtract 36 hours and proceed to plus 36 hours hrs <- seq(from=-36, to=36, by=2) rd <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2009) write.table(data.frame(rd)) ########### example spanning non-leap year rd2 <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2008) write.table(data.frame(rd2))
Repair a WPX list that may be deficient in one or more of its components.
repairWPX(wpx)repairWPX(wpx)
wpx |
Pick information, dataframe |
Program checks a few of the elelments and tries to fix potential problems.
WPX dataframe
Jonathan M. Lees<[email protected]>
addWPX, catWPX, checkWPX,cleanWPX,clusterWPX,saveWPX, setWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s1$col <- NULL s2 <- repairWPX(s1)s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s1$col <- NULL s2 <- repairWPX(s1)
Replace pick in WPX file
replaceWPX(WPX, onepx , ind=1)replaceWPX(WPX, onepx , ind=1)
WPX |
WPX list |
onepx |
WPX list with one pick |
ind |
integer, index to replace |
Replaces one pick at index provided.
WPX list
Replaces in the location provided. No test is made to determine if there is a pick already there. Maybe future versions will allow multiple replacements.
Jonathan M. Lees<[email protected]>
addWPX, catWPX, deleteWPX, selWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s4 <- replaceWPX(s1,s2, ind=4)s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) s2 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(1)) s4 <- replaceWPX(s1,s2, ind=4)
Convert RSEIS to SEGY/SAC format
rseis2segy(GH, sel = 1, win = c(0, 1), path = ".", BIGLONG = FALSE) rseis2sac(GH, sel = 1, win = c(0, 1), path = ".", BIGLONG = FALSE)rseis2segy(GH, sel = 1, win = c(0, 1), path = ".", BIGLONG = FALSE) rseis2sac(GH, sel = 1, win = c(0, 1), path = ".", BIGLONG = FALSE)
GH |
RSEIS format list |
sel |
select traces to convert |
win |
vector, t1 and t2 window each trace |
path |
path to directory where files are created |
BIGLONG |
logical, indicating whether long is 8 or 4 bytes. |
This is the converse of the segy2rseis routine.
Segy format files are in integer format. The time series ususally represents counts recorded in a data acquisition system. The header includes meta-data and other identifying information.
Side effects in file system
The Endian-ness of the output file will be the native endian-ness of the system.
Jonathan M. Lees<[email protected]>
write1segy, write1sac, read1sac, read1segy, sac2rseis, segy2rseis
data(KH) apath = tempdir() J = rseis2segy(KH, sel=1, path=apath, BIGLONG=FALSE ) L = list.files(path=J, full.names=TRUE) Z = read1segy(L[1], Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE) # data(KH) # apath = tempdir() J = rseis2sac(KH, sel = 1, win = c(0, 1), path = apath, BIGLONG = FALSE) L = list.files(path=J, full.names=TRUE) Z = read1sac(L[1], Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE)data(KH) apath = tempdir() J = rseis2segy(KH, sel=1, path=apath, BIGLONG=FALSE ) L = list.files(path=J, full.names=TRUE) Z = read1segy(L[1], Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE) # data(KH) # apath = tempdir() J = rseis2sac(KH, sel = 1, win = c(0, 1), path = apath, BIGLONG = FALSE) L = list.files(path=J, full.names=TRUE) Z = read1sac(L[1], Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE)
Convert one trace from an RSEIS seismic list to a ts time-series object.
rseis2ts(GH, sel = 1, notes = "")rseis2ts(GH, sel = 1, notes = "")
GH |
List structure of seismic traces from RSEIS |
sel |
numeric index of one trace. |
notes |
character string of notes |
Function extracts one trace and associated information from an RSEIS structure and returns a ts, time-series, object.
ts object
Jonathan M. Lees<[email protected]>
data(GH) H = rseis2ts(GH, 1, notes='Coso Trace 1') plot(H) title(main=attr(H, 'info')$notes)data(GH) H = rseis2ts(GH, 1, notes='Coso Trace 1') plot(H) title(main=attr(H, 'info')$notes)
Taper function for spectrum analysis
rsspec.taper(x, p = 0.1)rsspec.taper(x, p = 0.1)
x |
time series trace |
p |
percent taper |
Cosine taper at ends of trace.
tapered trace is returned.
Jonathan M. Lees<jonathan.lees.edu>
data(CE1) Xamp <- CE1$y[CE1$x > 5.443754 & CE1$x<5.615951] ### 10% cosine taper: xtap <- rsspec.taper(Xamp, p = 0.1)data(CE1) Xamp <- CE1$y[CE1$x > 5.443754 & CE1$x<5.615951] ### 10% cosine taper: xtap <- rsspec.taper(Xamp, p = 0.1)
Column Ruler for determining columns to read.
ruler(a = "")ruler(a = "")
a |
character string, optional |
This routine is set up to help get the columns for specific column oriented data. The ruler is dumped out below the character string for comparison. If no string is provided, just the rule is dumped. Use routine substr to extract the data from the columns.
Side effects
Jonathan M. Lees<[email protected]>
substr
aa <- paste(runif(n=5), collapse='-') aa = substr(aa, 1, 72) ruler(aa)aa <- paste(runif(n=5), collapse='-') aa = substr(aa, 1, 72) ruler(aa)
Save WPIX from swig output
save.wpix(KOUT, fn = "wpix.out")save.wpix(KOUT, fn = "wpix.out")
KOUT |
List output from swig |
fn |
file name for saving. |
Takes the output list from swig, specifically the WPX component and writes a table to the file system. This function is embedded in view.seis.
Side effects: file is created and appended to.
User must have write permission to the file.
Jonathan M. Lees<[email protected]>
view.seis, swig
Save a WPX list to a file on the local file system.
saveWPX(twpx, destdir = ".")saveWPX(twpx, destdir = ".")
twpx |
WPX list |
destdir |
character, destination directory, default=getwd() |
Creates a file with the list as in native binary format. This file can be loaded with the standard load function in R. The name of the file is created by using the minimum time extracted from the WPX list. The suffix on the file name is RDATA. When reading in, the object created is named "twpx" for further processing.
Side effects on file system. The name of the output file is returned.
User must have write access to the destination directory.
Jonathan M. Lees<[email protected]>
addWPX, catWPX, checkWPX, cleanWPX, clusterWPX, repairWPX, setWPX
tdir = tempdir() s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) hh <- saveWPX(s1, destdir = tdir ) ### read in the data load(hh) data.frame(twpx)tdir = tempdir() s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5)) hh <- saveWPX(s1, destdir = tdir ) ### read in the data load(hh) data.frame(twpx)
Get frequencies associated with the wavelet transform.
scal2freqs(octs, dt, plot = FALSE)scal2freqs(octs, dt, plot = FALSE)
octs |
number of octaves |
dt |
sample rate, s |
plot |
logical, TRUE=plot |
Use morelet wavelet to estimate frequency from wavelet transform.
frequency values
Jonathan M. Lees<jonathan.lees.edu>
Mmorlet, fft
noctave <- 6 nvoice <- 20 dt <- 0.004 i1 <- sort(rep(c(1:noctave), times=nvoice)) jj <- rep(c(0:(nvoice-1)), times=noctave) sa <- 2^(i1+jj/nvoice) efs <- scal2freqs(sa, dt)noctave <- 6 nvoice <- 20 dt <- 0.004 i1 <- sort(rep(c(1:noctave), times=nvoice)) jj <- rep(c(0:(nvoice-1)), times=noctave) sa <- 2^(i1+jj/nvoice) efs <- scal2freqs(sa, dt)
Open n devices for plotting.
screens(n)screens(n)
n |
number of devices required |
If k screens are open and k >= n, nothing is done.
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
devices
if(interactive() ) screens(2)if(interactive() ) screens(2)
Search through pick strucutre to select phase arrivals
SEARCHPIX(KPX, IPX, tol = 0.5)SEARCHPIX(KPX, IPX, tol = 0.5)
KPX |
user locator pix |
IPX |
set of pix in memory |
tol |
tolerance, s |
returns index vector of picks that satisfy: wn = which( abs(t2-t1) < tol)
index vector
Jonathan M. Lees<jonathan.lees.edu>
data(GH, package='RSEIS') IPX = data.frame( uwpfile2ypx(GH$pickfile ) ) ####### take for example on pick KPX = IPX[6, ] SEARCHPIX(KPX, IPX, tol = 0.5)data(GH, package='RSEIS') IPX = data.frame( uwpfile2ypx(GH$pickfile ) ) ####### take for example on pick KPX = IPX[6, ] SEARCHPIX(KPX, IPX, tol = 0.5)
Difference between two Date/Times (Julian Day)
secdif(jd1, hr1, mi1, sec1, jd2, hr2, mi2, sec2)secdif(jd1, hr1, mi1, sec1, jd2, hr2, mi2, sec2)
jd1 |
Julian Day |
hr1 |
hour |
mi1 |
minute |
sec1 |
second |
jd2 |
Julian Day |
hr2 |
hour |
mi2 |
minute |
sec2 |
second |
Returns T2-T1. Year is not included.
numeric |
seconds |
Jonathan M. Lees<jonathan.lees.edu>
secdifL
T1 <- list(jd=12, hr=13, mi=23, sec=21) T2 <- list(jd=14, hr=23, mi=23, sec=2) secdif(T1$jd, T1$hr, T1$mi, T1$sec, T2$jd, T2$hr, T2$mi, T2$sec)T1 <- list(jd=12, hr=13, mi=23, sec=21) T2 <- list(jd=14, hr=23, mi=23, sec=2) secdif(T1$jd, T1$hr, T1$mi, T1$sec, T2$jd, T2$hr, T2$mi, T2$sec)
Given two date/time lists, return seconds diffrence
secdifL(T1, T2)secdifL(T1, T2)
T1 |
list(jd, hr, mi, sec) |
T2 |
list(jd, hr, mi, sec) |
Year is not included in this calculation.
numeric |
seconds |
Jonathan M. Lees<jonathan.lees.edu>
secdif
T1 <- list(jd=12, hr=13, mi=23, sec=21) T2 <- list(jd=14, hr=23, mi=23, sec=2) secdifL(T1, T2)T1 <- list(jd=12, hr=13, mi=23, sec=21) T2 <- list(jd=14, hr=23, mi=23, sec=2) secdifL(T1, T2)
Given two date/time vectors, return seconds diffrence
secdifv(T1, T2)secdifv(T1, T2)
T1 |
c(jd, hr, mi, sec) |
T2 |
c(jd, hr, mi, sec) |
Year is not included in this calculation.
numeric |
seconds |
Jonathan M. Lees<jonathan.lees.edu>
secdif
T1 <- c(12, 13, 23, 21) T2 <- c(14, 23, 23, 2) secdifv(T1, T2)T1 <- c(12, 13, 23, 21) T2 <- c(14, 23, 23, 2) secdifv(T1, T2)
Read in multiple segy files, and create a list of seismic traces.
segy2rseis(fnames, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE) sac2rseis(fnames, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE)segy2rseis(fnames, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE) sac2rseis(fnames, Iendian = 1, HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE)
fnames |
character vector of file names. |
Iendian |
Endian-ness of the files |
HEADONLY |
logical, TRUE=read only the header information. default=FALSE |
BIGLONG |
logical, indicating whether long is 8 or 4 bytes. |
PLOT |
logical, TRUE = plot traces |
RAW |
logical, TRUE=do not convert data to volts |
Segy format files are in integer format. The time series ususally represents counts recorded in a data acquisition system. The header includes meta-data and other identifying information.
List of seismic traces.
The Endian-ness of the input files is set by the system that created them. If the read1segy or read1sac does not make sense, try a different endian or BIGLONG setting.
Jonathan M. Lees<[email protected]>
read1sac, read1segy, sac2rseis, prepSEIS
##### make some SAC files, then read them in data(GH) apath = tempdir() ## setwd(apath) ## apath = 'TEMP' J = rseis2sac(GH, sel =1:5, path = apath, BIGLONG =FALSE ) Iendian = .Platform$endian ####### next read them in Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) H = sac2rseis(Lname , Iendian =Iendian , HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE) #### should have 5 traces, look at elements of the first one: names(H[[1]]) plotGH(H[[1]])##### make some SAC files, then read them in data(GH) apath = tempdir() ## setwd(apath) ## apath = 'TEMP' J = rseis2sac(GH, sel =1:5, path = apath, BIGLONG =FALSE ) Iendian = .Platform$endian ####### next read them in Lname <- list.files(path=J , pattern='SAC', full.names=TRUE) H = sac2rseis(Lname , Iendian =Iendian , HEADONLY = FALSE, BIGLONG = FALSE, PLOT = -1, RAW = FALSE) #### should have 5 traces, look at elements of the first one: names(H[[1]]) plotGH(H[[1]])
Convert a SEIS list to a list of seismograms each independent.
SEIS2list(GH)SEIS2list(GH)
GH |
SEIS list (swig input) |
The list returned is useful for editing or modifying the seismic data prior to swig.
List of seismograms.
Jonathan M. Lees<[email protected]>
plotGH, swig
data(GH) gg = SEIS2list(GH) ## for(i in 1:length(gg) ) i = 1 { plotGH(gg[[i]]); Sys.sleep(0.2) }data(GH) gg = SEIS2list(GH) ## for(i in 1:length(gg) ) i = 1 { plotGH(gg[[i]]); Sys.sleep(0.2) }
Given an RSEIS list of seismic data return a set of colors associated with the structure that colors each trace and its components the same color.
seiscols(GH, acols="black", M="STNS")seiscols(GH, acols="black", M="STNS")
GH |
Seismic RSEIS list |
acols |
vector of colors to choose from |
M |
character, "STNS" = stations, "COMPS" = components |
colors |
alpha/numeric vector of colors |
Jonathan M. Lees<[email protected]>
data(GH) GH$pcol <- seiscols(GH) swig(GH, sel=which(GH$COMPS=="V"), WIN=c(3, 10), SHOWONLY=TRUE) xcol <- seiscols(GH, acols=c("black", "darkmagenta", "forestgreen") ) GH$pcol <- xcol swig(GH, sel=which(GH$COMPS=="V"), , SHOWONLY=TRUE)data(GH) GH$pcol <- seiscols(GH) swig(GH, sel=which(GH$COMPS=="V"), WIN=c(3, 10), SHOWONLY=TRUE) xcol <- seiscols(GH, acols=c("black", "darkmagenta", "forestgreen") ) GH$pcol <- xcol swig(GH, sel=which(GH$COMPS=="V"), , SHOWONLY=TRUE)
Return date/time of trace with earliest date/time.
SEISNtime(GH)SEISNtime(GH)
GH |
RSEIS seismic list |
yr |
year |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
w1 |
which one, index to GH |
Jonathan M. Lees<[email protected]>
data(GH) SEISNtime(GH)data(GH) SEISNtime(GH)
Use RSEIS structure to get convenient ordering of seismic data
seisorder(GH, ORD, VNE = c("V", "N", "E"))seisorder(GH, ORD, VNE = c("V", "N", "E"))
GH |
RSEIS list |
ORD |
predetermined ordering, list(name, dist) |
VNE |
Order, for components, default=c("V", "N", "E") |
Uses information aboutthe location of the stations to determine appropriate order. Order can be determined from the location of the stations, or from the travel times.
Vector of indeces of GH in correct order
If ORD is provided from travel times, it uses this instead
Jonathan M. Lees<[email protected]>
JGET.seis
data(GH) staf <- GH$stafile ################ get the distances from the source to the stations d1 <- GreatDist(GH$pickfile$LOC$lon, GH$pickfile$LOC$lat, staf$lon, staf$lat) ### staf has the names of the stations already, so insert the order via ### dist staf$dist <- d1$dkm sorder <- seisorder(GH, staf, VNE= c("V", "N", "E")) if(interactive()){ swig(GH, sel=sorder) }data(GH) staf <- GH$stafile ################ get the distances from the source to the stations d1 <- GreatDist(GH$pickfile$LOC$lon, GH$pickfile$LOC$lat, staf$lon, staf$lat) ### staf has the names of the stations already, so insert the order via ### dist staf$dist <- d1$dkm sorder <- seisorder(GH, staf, VNE= c("V", "N", "E")) if(interactive()){ swig(GH, sel=sorder) }
select a subset of picks from a larger data base
selAPX(APX, ista = NULL, icomp = c("V", "N", "E")) selWPX(APX, ind=NULL, ista = NULL, icomp = c("V", "N", "E"))selAPX(APX, ista = NULL, icomp = c("V", "N", "E")) selWPX(APX, ind=NULL, ista = NULL, icomp = c("V", "N", "E"))
APX |
Pick Data Frame |
ista |
vector of stations to select |
icomp |
vector of components |
ind |
index of picks to select (negitive values imply omission) |
returns subset list
Jonathan M. Lees<jonathan.lees.edu>
Select buttons interactively.
SELBUT(OPTS, onoff = 1, ocols = "white", default = "opt")SELBUT(OPTS, onoff = 1, ocols = "white", default = "opt")
OPTS |
character list of buttons |
onoff |
which buttons are active |
ocols |
colors for plotting |
default |
default list of buttons |
Used in swig. OPtions can be added, subtracted, deleted, or completely filled out based on interactive choice.
character list of chosen options.
Jonathan M. Lees<[email protected]>
swig
if(interactive()){ STDLAB <- c("DONE", "QUIT", "zoom.out", "zoom.in", "SELBUT", "FILT","UNFILT", "PSEL", "SGRAM", "WLET", "SPEC", "XTR" ) onoff = rep(0, length(STDLAB)) onoff[1:5] <- 1 SELBUT(STDLAB, onoff=onoff) }if(interactive()){ STDLAB <- c("DONE", "QUIT", "zoom.out", "zoom.in", "SELBUT", "FILT","UNFILT", "PSEL", "SGRAM", "WLET", "SPEC", "XTR" ) onoff = rep(0, length(STDLAB)) onoff[1:5] <- 1 SELBUT(STDLAB, onoff=onoff) }
Pick stations and components interactively. This is a routine used in swig.
selpgen(MH, newdev = TRUE, STAY = FALSE)selpgen(MH, newdev = TRUE, STAY = FALSE)
MH |
RSEIS list |
newdev |
logical, whether to create a new device. |
STAY |
logical, whether to keep device active. |
vector of index to list of stations and components
Jonathan M. Lees<[email protected]>
swig
Pick stations and components interactively. This is a routine used in swig.
SELSTA(GH, sel=1, newdev = TRUE, STAY = FALSE)SELSTA(GH, sel=1, newdev = TRUE, STAY = FALSE)
GH |
RSEIS list |
sel |
vector of index to selected traces |
newdev |
logical, whether to create a new device. |
STAY |
logical, whether to keep device active. |
vector of index to list of stations and components
Jonathan M. Lees<[email protected]>
swig
data(GH) SELSTA(GH, sel=1:7 , newdev = TRUE, STAY = FALSE)data(GH) SELSTA(GH, sel=1:7 , newdev = TRUE, STAY = FALSE)
Extract a set of stations from a longer station file.
selstas(sta, ind)selstas(sta, ind)
sta |
station list (name, lat, lon, z) |
ind |
index to station list = positive is select, negative is remove |
station list with those indeces either removed or save.
Jonathan M. Lees<[email protected]>
From published sensitivities of seismic and acoustic sensors.
SENSORsensitivity(K = 1)SENSORsensitivity(K = 1)
K |
number of sensor from list |
Sensitivity
Current choices are: c("40T", "3T", "L28", "LD", "EL", "MC", "EL(SANGAY)")
Jonathan M. Lees<jonathan.lees.edu>
Johnson, J.B., R.C. Aster, M.C. Ruiz, S.D. Malone, P.J. McChesney,J.M. Lees, and P.R. Kyle, Interpretation and utility of infrasonic records from erupting volcanoes, J. Volc. Geoth. Res., 121 (1-2), 15-63, 2003.
SENSORsensitivity(3) SENSORsensitivity(5)SENSORsensitivity(3) SENSORsensitivity(5)
Prepare a set of arrival picks for swig plotting.
setPrePix(R1, tt, name, flag = "K", col = "blue")setPrePix(R1, tt, name, flag = "K", col = "blue")
R1 |
Location and time of event source. (list) |
tt |
Vector of travel times, seconds. |
name |
Station names |
flag |
Phase Identifier, character |
col |
Color |
List of picks suitable for swig plotting.
R1 should have yr, jp, hr, mi, sec at the least.
Jonathan M. Lees<[email protected]>
setWPX
T1 = as.POSIXct("2020-08-20 06:30:17.15 UTC", "UTC") R1 = posix2RSEIS(T1) name = c("MERT", "KRN", "KUA") tt = c(1,2,3) wpx = setPrePix(R1, tt, name, flag = "K", col = "blue")T1 = as.POSIXct("2020-08-20 06:30:17.15 UTC", "UTC") R1 = posix2RSEIS(T1) name = c("MERT", "KRN", "KUA") tt = c(1,2,3) wpx = setPrePix(R1, tt, name, flag = "K", col = "blue")
Read station information and set in list
setstas(stafile)setstas(stafile)
stafile |
character, station file name path |
reads in ASCII data file.
LIST
name |
character, station name |
lat |
numeric, decimal degrees |
lon |
numeric, decimal degrees |
z |
numeric, decimal degrees |
Jonathan M. Lees<jonathan.lees.edu>
data(GH) tsta = GH$stafile tfile = tempfile() write.table(file=tfile, tsta, row.names=FALSE, col.names=FALSE ) sta <- setstas(tfile)data(GH) tsta = GH$stafile tfile = tempfile() write.table(file=tfile, tsta, row.names=FALSE, col.names=FALSE ) sta <- setstas(tfile)
Set up a data base storing the location and times for a set of seismic data.
setupDB(DB, token = TRUE, split = "\\.")setupDB(DB, token = TRUE, split = "\\.")
DB |
|
token |
logical, use tokens in the file names of the fn's to extract station and component names for selection. default=TRUE |
split |
character string to split if using token, default is a period. |
If token is FALSE, then the station name and component are selected using substr, i.e. by column number.
DB with epoch time and station information appended,
t1 |
epoch start time |
t2 |
expoch end time = t1+nsamps*sample rate n seconds |
sta |
station |
comp |
component |
Program attaches station identification used for grepping.
Jonathan M. Lees<[email protected]>
EPOCHday, T12.pix, Mine.seis
########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM) nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) ## IDB = infoDB(DB) plotDB(DB)########## to illustrate, we make a set of individual seismograms data(GH) L1 = length(GH$JSTR) DD = data.frame(GH$info) GIVE = vector(mode='list') for(i in 1:L1) { AA = DD[i,] GIVE[[i]] = list(fn = AA$fn, sta =GH$STNS[i] , comp = GH$COMP[i], dt = AA$dt, DATTIM = AA, N = AA$n1, units = NA, coords = NA, amp = GH$JSTR[[i]] ) } ########### save the seismic data in a temporary directory #### each trace in a separate file tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM) nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) ## IDB = infoDB(DB) plotDB(DB)
Prepares a matrix for estimation of power spectrum via Welch's method. Also, is can be used for spectrogram.
setwelch(X, win = min(80, floor(length(X)/10)), inc = min(24, floor(length(X)/30)), coef = 64, wintaper=0.05)setwelch(X, win = min(80, floor(length(X)/10)), inc = min(24, floor(length(X)/30)), coef = 64, wintaper=0.05)
X |
Time series vector |
win |
window length |
inc |
increment |
coef |
coefficient for fft |
wintaper |
percent taper window taper |
List:
values |
Matrix of fft's staggered along the trace |
windowsize |
window length used |
increment |
increment used |
wintaper |
percent taper window taper |
originally written by Andreas Weingessel, modified Jonathan M. Lees<[email protected]>
Welch, P.D. (1967) The use of Fast Fourier Transform for the estimation of power spectra: a method based on time averaging over short, modified periodograms IEEE Trans. Audio Electroacoustics 15, 70-73.
stft
dt <- 0.001 t <- seq(0, 6, by=dt) x <- 6*sin(2*pi*50*t) + 10* sin(2*pi*120*t) y <- x + rnorm(length(x), mean=0, sd=10) plot(t,y, type='l') title('sin(2*pi*50*t) + sin(2*pi*120*t)+ rnorm') Y <- fft(y) Pyy <- Y * Conj(Y) N <- length(y) n <- length(Pyy)/2 Syy <- (Mod(Pyy[1:n])^2)/N fn <- 1/(2*dt) f <- (0:(length(Syy)-1))*fn/length(Syy) plot(f, Syy, type='l', log='y' , xlim=c(0, 150)); abline(v=c(50, 120),col='blue', lty=2) plot(f, Syy, type='l', log='y' , xlim=c(0, 150)); abline(v=c(50, 120),col='blue', lty=2) win <- 1024 inc <- min(24, floor(length(y)/30)) coef <- 2048 w <- setwelch(y, win=win, inc=inc, coef=coef, wintaper=0.2) KK <- apply(w$values, 2, FUN="mean") fw <- seq(from=0, to=0.5, length=coef)/(dt) plot(fw, KK^2, log='', type='l' , xlim=c(0, 150)) ; abline(v=c(50, 120), col='blue', lty=2) Wyy <- (KK^2)/w$windowsize plot(f, Syy, type='l', log='y' , xlim=c(0, 150)) lines(fw,Wyy , col='red') DBSYY <- 20*log10(Syy/max(Syy)) DBKK <- 20*log10(Wyy/max(Wyy)) plot(f, DBSYY, type='l' , xlim=c(0, 150), ylab="Db", xlab="Hz") lines(fw, DBKK, col='red') title("Compare simple periodogam with Welch's Method")dt <- 0.001 t <- seq(0, 6, by=dt) x <- 6*sin(2*pi*50*t) + 10* sin(2*pi*120*t) y <- x + rnorm(length(x), mean=0, sd=10) plot(t,y, type='l') title('sin(2*pi*50*t) + sin(2*pi*120*t)+ rnorm') Y <- fft(y) Pyy <- Y * Conj(Y) N <- length(y) n <- length(Pyy)/2 Syy <- (Mod(Pyy[1:n])^2)/N fn <- 1/(2*dt) f <- (0:(length(Syy)-1))*fn/length(Syy) plot(f, Syy, type='l', log='y' , xlim=c(0, 150)); abline(v=c(50, 120),col='blue', lty=2) plot(f, Syy, type='l', log='y' , xlim=c(0, 150)); abline(v=c(50, 120),col='blue', lty=2) win <- 1024 inc <- min(24, floor(length(y)/30)) coef <- 2048 w <- setwelch(y, win=win, inc=inc, coef=coef, wintaper=0.2) KK <- apply(w$values, 2, FUN="mean") fw <- seq(from=0, to=0.5, length=coef)/(dt) plot(fw, KK^2, log='', type='l' , xlim=c(0, 150)) ; abline(v=c(50, 120), col='blue', lty=2) Wyy <- (KK^2)/w$windowsize plot(f, Syy, type='l', log='y' , xlim=c(0, 150)) lines(fw,Wyy , col='red') DBSYY <- 20*log10(Syy/max(Syy)) DBKK <- 20*log10(Wyy/max(Wyy)) plot(f, DBSYY, type='l' , xlim=c(0, 150), ylab="Db", xlab="Hz") lines(fw, DBKK, col='red') title("Compare simple periodogam with Welch's Method")
Create list of windows picks suitable for plotting in swig.
setwpix(phase = NULL, col = NULL, yr = NULL, jd = NULL, hr = NULL, mi = NULL, sec = NULL, dur = NULL, name = NULL, comp = NULL, dispcomp = NULL)setwpix(phase = NULL, col = NULL, yr = NULL, jd = NULL, hr = NULL, mi = NULL, sec = NULL, dur = NULL, name = NULL, comp = NULL, dispcomp = NULL)
phase |
phase name |
col |
color for plotting |
yr |
year |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
dur |
duration |
name |
name of station |
comp |
component |
dispcomp |
display on which component |
Some phases should be displayed on only certain components of a station.
list of window picks
Jonathan M. Lees<[email protected]>
swig
data(KH) orgtim <- c( 2005,214,7,1,10.7313152551651 ) tims <- c( 0,46.7119,102.438451,113.092049,123.54077 ) psecs <- NULL nam <- NULL aphases <- NULL sta <- "9024" for(j in 1:length(tims)) { psecs <- c(psecs, tims[j]+orgtim[5]) nam <- c(nam, sta) aphases <- c(aphases, paste(sep="", "K", j) ) } pp <- setwpix(phase=aphases , col="blue", yr=orgtim[1], jd=orgtim[2], hr=orgtim[3], mi=orgtim[4], sec=psecs, dur=0, name=nam , comp="V") W <- secdifL(KH$info, pp) win <- c(min(W)-5, max(W)+5 ) swig(KH, APIX=pp, WIN=win , SHOWONLY=TRUE)data(KH) orgtim <- c( 2005,214,7,1,10.7313152551651 ) tims <- c( 0,46.7119,102.438451,113.092049,123.54077 ) psecs <- NULL nam <- NULL aphases <- NULL sta <- "9024" for(j in 1:length(tims)) { psecs <- c(psecs, tims[j]+orgtim[5]) nam <- c(nam, sta) aphases <- c(aphases, paste(sep="", "K", j) ) } pp <- setwpix(phase=aphases , col="blue", yr=orgtim[1], jd=orgtim[2], hr=orgtim[3], mi=orgtim[4], sec=psecs, dur=0, name=nam , comp="V") W <- secdifL(KH$info, pp) win <- c(min(W)-5, max(W)+5 ) swig(KH, APIX=pp, WIN=win , SHOWONLY=TRUE)
Create a WPX list from vector input or relavent parameters.
setWPX(phase = NULL, col = NULL, yr = NULL, jd = NULL, hr = NULL, mi = NULL, sec = NULL, dur = NULL, name = NULL, comp = NULL, dispcomp = NULL, onoff = NULL)setWPX(phase = NULL, col = NULL, yr = NULL, jd = NULL, hr = NULL, mi = NULL, sec = NULL, dur = NULL, name = NULL, comp = NULL, dispcomp = NULL, onoff = NULL)
phase |
character, phase names |
col |
character, colors |
yr |
numeric, year |
jd |
numeric, julian day |
hr |
numeric, hour |
mi |
numeric, minute |
sec |
numeric, second |
dur |
numeric, duration(s) |
name |
character, station name |
comp |
character, component |
dispcomp |
character, display string |
onoff |
numeric, flag for turning pick on or off |
Utility for setting up a WPX list for further processing.
WPX list.
Used internally.
Jonathan M. Lees<[email protected]>
addWPX, catWPX, checkWPX, cleanWPX, clusterWPX, repairWPX, saveWPX
s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5))s1 <- setWPX(name="HI", yr=2011, jd=231, hr=4, mi=3, sec = runif(5))
Create an empty window pick list. This is used primarily internally.
setypx()setypx()
List:
tag |
tag for identification of station and component |
name |
station name |
comp |
component name |
c3 |
compnent name with secondary tags |
phase |
phase |
err |
error |
pol |
polarity |
flg |
flag |
res |
residual |
dur |
duration |
yr |
year |
mo |
month |
dom |
day of month |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
col |
color |
onoff |
logical, ON or OFF for plotting |
Jonathan M. Lees<[email protected]>
setwpix
a <- setypx() print(a)a <- setypx() print(a)
Print Date and Time as yyyy-mo-do hr:mi:se msec
showdatetime(rd, AMPM = FALSE, verbose=TRUE)showdatetime(rd, AMPM = FALSE, verbose=TRUE)
rd |
date time list, jd hr mi sec yr |
AMPM |
24 hour time (AMPM=FALSE) or 12 hour clock (AMPM=TRUE) |
verbose |
logical, print information to screen, default=TRUE |
Side Effects
Jonathan M. Lees<[email protected]>
hrs <- seq(from=-36, to=36, by=2) rd <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2009) showdatetime(rd) showdatetime(rd, AMPM=TRUE)hrs <- seq(from=-36, to=36, by=2) rd <- recdate(jd=1, hr=hrs, mi=34, sec=23+runif(n=length(hrs), 0, 59) , yr=2009) showdatetime(rd) showdatetime(rd, AMPM=TRUE)
Convolve spikes with wavelets
sigconv(wigmat, wavepulse)sigconv(wigmat, wavepulse)
wigmat |
matrix, spikes |
wavepulse |
wavelet for convolution |
Convolution is done in Frequency domain on each trace
Matrix, waveforms
Jonathan M. Lees<[email protected]>
wiggleimage, symshot1, genrick
S1 <- symshot1() ############## S1$THEORY$treflex d <- dim(S1$smograms) G1 <- matrix( rep(0, length=d[1]*d[2]), ncol=d[2], nrow=d[1]) ############ set up the spike set for reflexions for(i in 1:3){ p <- round( S1$THEORY$treflex[i,]/S1$dt ); G1[cbind(p , 1:d[2]) ] <- 1 } #### plot the spikes wiggleimage(0.1*G1, dt = -S1$dt, dx = S1$x, col = "black") ### make a ricker wavelet wavelet <- genrick(25,S1$dt,35) klem <- 11 ### nwave <- RPMG::RESCALE(wavelet, 0, 1, wavelet[1], max(wavelet)) ############## convolve the wavelet with the set of spikes H1 <- sigconv(G1, nwave) ############ plot wiggleimage(0.1*H1, dt = -S1$dt, dx = S1$x, col = "black")S1 <- symshot1() ############## S1$THEORY$treflex d <- dim(S1$smograms) G1 <- matrix( rep(0, length=d[1]*d[2]), ncol=d[2], nrow=d[1]) ############ set up the spike set for reflexions for(i in 1:3){ p <- round( S1$THEORY$treflex[i,]/S1$dt ); G1[cbind(p , 1:d[2]) ] <- 1 } #### plot the spikes wiggleimage(0.1*G1, dt = -S1$dt, dx = S1$x, col = "black") ### make a ricker wavelet wavelet <- genrick(25,S1$dt,35) klem <- 11 ### nwave <- RPMG::RESCALE(wavelet, 0, 1, wavelet[1], max(wavelet)) ############## convolve the wavelet with the set of spikes H1 <- sigconv(G1, nwave) ############ plot wiggleimage(0.1*H1, dt = -S1$dt, dx = S1$x, col = "black")
convolve a set of spikes for extended ground roll. This is a special case of sigconv.
sigconvGR(wigmat, wavepulse, dt)sigconvGR(wigmat, wavepulse, dt)
wigmat |
matrix of traces with spikes |
wavepulse |
wavelet |
dt |
sampling interval |
This is similar to the sigconv program but it assumes that the ground roll is extrened in time and space as the wave expands.
Matrix, waveforms
the program spreads the sinusoidal wavelet along a band to simulate ground-roll head wave noise.
Jonathan M. Lees<[email protected]>
wiggleimage, symshot1, genrick, sigconv
S1 <- symshot1() dt <- S1$dt ########### these are the reflections S1$GRrec d <- dim(S1$smograms) G1 <- matrix( rep(0, length=d[1]*d[2]), ncol=d[2], nrow=d[1]) ### these are the refractions S1$THEORY$trefrac p <- round( S1$THEORY$trefrac[1,]/S1$dt ); G1[cbind(p , 1:d[2]) ] <- 1 #### plot the spikes wiggleimage(0.1*G1, dt = -S1$dt, dx = S1$x, col = "black") grlen <- floor(.6/dt) fgr <- 10 tape <- applytaper( rep(1, grlen), p = 0.2) tgr <- seq(from=0, by=dt, length=grlen) siggr <- tape*sin(2*pi*fgr*tgr) ############## convolve the wavelet with the set of spikes H1 <- sigconvGR(G1, siggr, dt) ############ plot wiggleimage(0.1*H1, dt = -S1$dt, dx = S1$x, col = "black")S1 <- symshot1() dt <- S1$dt ########### these are the reflections S1$GRrec d <- dim(S1$smograms) G1 <- matrix( rep(0, length=d[1]*d[2]), ncol=d[2], nrow=d[1]) ### these are the refractions S1$THEORY$trefrac p <- round( S1$THEORY$trefrac[1,]/S1$dt ); G1[cbind(p , 1:d[2]) ] <- 1 #### plot the spikes wiggleimage(0.1*G1, dt = -S1$dt, dx = S1$x, col = "black") grlen <- floor(.6/dt) fgr <- 10 tape <- applytaper( rep(1, grlen), p = 0.2) tgr <- seq(from=0, by=dt, length=grlen) siggr <- tape*sin(2*pi*fgr*tgr) ############## convolve the wavelet with the set of spikes H1 <- sigconvGR(G1, siggr, dt) ############ plot wiggleimage(0.1*H1, dt = -S1$dt, dx = S1$x, col = "black")
stereonet representation of particle motion
SNET.drive(intempmat, pmolabs = c("Vertical", "North", "East"), STAMP = "")SNET.drive(intempmat, pmolabs = c("Vertical", "North", "East"), STAMP = "")
intempmat |
matrix of 3-component seismogram |
pmolabs |
labels for components |
STAMP |
Identification stamp |
Interactive driver for partmotnet.
Graphical Side effect
Jonathan M. Lees<jonathan.lees.edu>
partmotnet
data("GH") temp <- cbind(GH$JSTR[[1]], GH$JSTR[[2]], GH$JSTR[[3]]) atemp <- temp[1168:1500, ] SNET.drive(atemp, pmolabs = c("Vertical", "North", "East"), STAMP = "")data("GH") temp <- cbind(GH$JSTR[[1]], GH$JSTR[[2]], GH$JSTR[[3]]) atemp <- temp[1168:1500, ] SNET.drive(atemp, pmolabs = c("Vertical", "North", "East"), STAMP = "")
Interactive Spectrogram Driver
SPECT.drive(Xamp, DT = 0.008, NEW = TRUE, STAMP = NULL , freqlim=c(0, 20, 0, 20), winparams=c(4096,256, 204 ))SPECT.drive(Xamp, DT = 0.008, NEW = TRUE, STAMP = NULL , freqlim=c(0, 20, 0, 20), winparams=c(4096,256, 204 ))
Xamp |
signal trace |
DT |
deltaT sample interval, s |
NEW |
logical, TRUE=recalculate spectrum |
STAMP |
character stamp for identification |
freqlim |
vector of 4 frequency limits: min max for calculations, min max for display. Default=see below |
winparams |
vector of 3 window parameters: Number of points for FFT, number of time samples for window, number of overlap samples: default=see below |
Interactive buttons are set internally. The parameters freqlim and winparams can be changed - these are simply the starting parameters for the initial display.
For winparams, the parameters are set to be appropriate for sample rates of typical seismic data, 100-125 samples per second. The number of points in the FFT are initially set to 4096 and the time window is set to 256. The overlap is calculated by subtracting 20 percent of the time window, so the overlap is 80 percent. Of course, the number of samples in a window must be less than the length of input time series.
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
plotevol, RPMG
data(CE1) ######### Xamp = CE1$y[CE1$x>5.443754 & CE1$x<5.615951] Xamp = CE1$y plot(Xamp, type='l') DT = CE1$dt if(interactive() ) { SPECT.drive(Xamp, DT = DT, NEW = TRUE, STAMP = NULL) }data(CE1) ######### Xamp = CE1$y[CE1$x>5.443754 & CE1$x<5.615951] Xamp = CE1$y plot(Xamp, type='l') DT = CE1$dt if(interactive() ) { SPECT.drive(Xamp, DT = DT, NEW = TRUE, STAMP = NULL) }
Spectrum is a wrapper function for stats::fft and RSEIS::mtapspec. For a given method (multi-taper spectrum or fft spectrum) and spectrum type (power, energy, amplitude, or phase), it returns the spectrum in physical units (obeying Parseval's theorem) and the corresponding frequency axis.
Spectrum(x, dt, one_sided = TRUE, type = 1, method = 1)Spectrum(x, dt, one_sided = TRUE, type = 1, method = 1)
x |
Time series for which a spectrum is to be calculated (assumed to be in volts) |
dt |
Sample interval for x (assumed to be in seconds) |
one_sided |
Logical: should the spectrum be a function of positive frequencies only (f < nyquist frequency) and spectral density doubled to be consistent with that (TRUE, default), or should the spectrum be provided for all frequencies, positive and negative? |
type |
Type of spectrum: 1 (default) is power spectrum; 2 is energy spectrum; 3 is amplitude spectrum; 4 is phase spectrum |
method |
Method used to calculate spectrum. 1 (default) is fft; 2 is multi-taper. |
Phase spectrum is currently enabled only for method = 1 (fft). All possible energy and power spectra obey Parseval's relation (sum(s)*df ~= mean(x^2) for power; sum(s)*df ~= sum(x^2)*dt for energy). Parseval's relation may not be exact due to approximations used in making the spectrum one-sided or in the multi-taper method.
Input units are assumed to be volts and seconds; if other input units are used, adjust output units accordingly.
List with following elements.
f |
frequency axis (Hz; cycles per second, not radians per second) |
df |
interval for frequency axis (Hz) |
spectrum |
spectral values corresponding to f |
type |
spectrum type: Power, Energy, Amplitude, or Phase |
units |
Units of spectrum (assuming that input units are volts and seconds) |
Jake Anderson
RSEIS::mtapspec stats::fft
## example time series x = rnorm(1000) dt = 0.01 ## power spectrum, multi-taper method, one-sided S = Spectrum(x, dt, type = 1, method = 2, one_sided = TRUE) sum(S$spectrum) * S$df ## frequency-domain power mean(x^2) ## time-domain power ## energy spectrum, fft method, two-sided S = Spectrum(x, dt, type = 2, method = 1, one_sided = FALSE) sum(S$spectrum) * S$df ## frequency-domain energy sum(x^2) * dt ## time-domain energy## example time series x = rnorm(1000) dt = 0.01 ## power spectrum, multi-taper method, one-sided S = Spectrum(x, dt, type = 1, method = 2, one_sided = TRUE) sum(S$spectrum) * S$df ## frequency-domain power mean(x^2) ## time-domain power ## energy spectrum, fft method, two-sided S = Spectrum(x, dt, type = 2, method = 1, one_sided = FALSE) sum(S$spectrum) * S$df ## frequency-domain energy sum(x^2) * dt ## time-domain energy
Calculate the short term, long term average ratios of the squared amplitude in a time series.
STALTA(y, fwlen = 125, bwlen = 125)STALTA(y, fwlen = 125, bwlen = 125)
y |
vector, or time series |
fwlen |
forward number of samples |
bwlen |
backward number of samples |
Calculates the ratio of the forward/backard mean square sum.
vector of ratios
All filtering or pre and post analysis should be done outside of ratio curve estimate.
Jonathan M. Lees<[email protected]>
STLTcurve, PSTLTcurve
### easy example find P and S-wave arrivals, low noise data(GH) i = 6 z = GH$JSTR[[i]] z.curve = STALTA(z, fwlen = 10, bwlen = 325) ex = seq(from=0, length=length(z), by=GH$dt[i]) par(mfrow=c(2, 1) ) plot(ex, z, type='l') plot(ex, z.curve, type = 'l' ) aa = peaks(z.curve, span = 11, do.pad = TRUE) wa = which( aa & z.curve>50 ) abline(v=wa*GH$dt[i] , col='red') par(mfg=c(1,1) ) abline(v=wa*GH$dt[i] , col='red')### easy example find P and S-wave arrivals, low noise data(GH) i = 6 z = GH$JSTR[[i]] z.curve = STALTA(z, fwlen = 10, bwlen = 325) ex = seq(from=0, length=length(z), by=GH$dt[i]) par(mfrow=c(2, 1) ) plot(ex, z, type='l') plot(ex, z.curve, type = 'l' ) aa = peaks(z.curve, span = 11, do.pad = TRUE) wa = which( aa & z.curve>50 ) abline(v=wa*GH$dt[i] , col='red') par(mfg=c(1,1) ) abline(v=wa*GH$dt[i] , col='red')
Get short-term average long-term verage ratio curve for picking
STLTcurve(y, dt = 0.008, fwlen = 125, bwlen = 125, stretch = 1000, MED = 255, PLOT = FALSE)STLTcurve(y, dt = 0.008, fwlen = 125, bwlen = 125, stretch = 1000, MED = 255, PLOT = FALSE)
y |
signal |
dt |
sample rate |
fwlen |
forward window, number of samples |
bwlen |
back window length, number of samples |
stretch |
stretch multiplier |
MED |
median smoother |
PLOT |
logical, TRUE=plot diagnostics |
Uses C-code and fast tanking algorithm written at UW
sample to significant change in ratio curve
Jonathan M. Lees<jonathan.lees.edu>
PSTLTcurve
data(CE1) y = CE1$y DT = CE1$dt sy = STLTcurve(y, dt=DT, fwlen = 25, bwlen = 25, stretch=1000, MED=255, PLOT=FALSE) par(mfrow=c(2,1)) plot(CE1$x, CE1$y, type='l') plot(CE1$x,sy$rat, type='l')data(CE1) y = CE1$y DT = CE1$dt sy = STLTcurve(y, dt=DT, fwlen = 25, bwlen = 25, stretch=1000, MED=255, PLOT=FALSE) par(mfrow=c(2,1)) plot(CE1$x, CE1$y, type='l') plot(CE1$x,sy$rat, type='l')
Main Interactive Program for plotting and analyzing seismic waveform data.
swig(GH, sel = 1:length(GH$dt), ORD = NULL, WIN = NULL, APIX = NULL, PHASE = NULL, STDLAB = NULL, PADDLAB = NULL, TEMPBUT=NULL, SHOWONLY = FALSE, CHOP = FALSE, TIT = "", pts = FALSE, forcepix = FALSE, pcex=0.7, SCALE = 1, ilocstyle=1, velfile = "", stafile = "", LOC = NULL, prefilt=list(fl=.2, fh=15, type="HP", proto="BU"), filters=NULL, YAX = 1 , xtickfactor = 1, vertline=NA, destdir='.')swig(GH, sel = 1:length(GH$dt), ORD = NULL, WIN = NULL, APIX = NULL, PHASE = NULL, STDLAB = NULL, PADDLAB = NULL, TEMPBUT=NULL, SHOWONLY = FALSE, CHOP = FALSE, TIT = "", pts = FALSE, forcepix = FALSE, pcex=0.7, SCALE = 1, ilocstyle=1, velfile = "", stafile = "", LOC = NULL, prefilt=list(fl=.2, fh=15, type="HP", proto="BU"), filters=NULL, YAX = 1 , xtickfactor = 1, vertline=NA, destdir='.')
GH |
Seismic data structure |
sel |
selection of traces from structure |
ORD |
order to plot traces |
WIN |
vector c(t1, t2) for window of traces to be shown |
APIX |
structure of arrival time picks |
PHASE |
phase to display, "P", "S", etc |
STDLAB |
label of buttons |
PADDLAB |
label of phase-pick buttons |
TEMPBUT |
temporary, user defined buttons |
SHOWONLY |
logical, TRUE=non-interactive |
CHOP |
whether to chop the signal |
TIT |
title for the top of plot |
pts |
whether to plot specific points on the plot |
forcepix |
logical, force all phase picks to be shown on all traces |
pcex |
Pick label size expansion (cex), default=0.7 |
SCALE |
flag, 1,2= scale according to window or trace (default=1, scale by trace) |
ilocstyle |
integer, style of click graphic, one of -1, 0, 1, 2, 3, indicating: points, abline, segs, segs+abline, segs+long-abline , default=1 |
velfile |
velocity structure or file name |
stafile |
station structure or file name |
LOC |
source location structure (lat, lon, depth) |
prefilt |
default filter definition list(fl=.2, fh=15, type="HP", proto="BU") |
filters |
a list of filters for choosfilt, the list consists of 3 vectors: flo, fhi and type defining the filter choices. |
YAX |
type of Yaxis label, 1,2,3 DEFAULT=1 only one y-axis others scaled; 2=all y-axes are plotted on left; 3=all y-axes plotted, alternating left and right |
xtickfactor |
Factor for multiplying the x-axis tick markers (default=1; for minutes=60, hrs=3600, days=24*3600) |
vertline |
time list (yr, jd, hr, mi sec) for plotting vertical lines on window. Default=NA |
destdir |
Destination directory(folder) for writing output to disk, default = current directory |
This is the main program that drives the other analysis in RSEIS. GH is a list consisting of header (meta-data) and time series information. See documentation on GH to get complete description.
A set of filters can be defined by the user, see choosfilt
Default Buttons, can be created by: STDLAB = c("DONE", "QUIT","zoom out", "zoom in", "Left", "Right", "restore", "Pinfo","WINFO", "XTR", "SPEC", "SGRAM" ,"WLET", "FILT", "UNFILT", "SCALE", "Postscript")
If the user has defined STDLAB.DEFAULT and PADDLAB.DEFAULT in the .Rprofile or .First commands, these will override the default in the function definition.
Various structures are returned based on interactive selections of the user.
Howeverr, the default return list:
but |
last button pushed |
sloc |
location of last set of clicks |
WPX |
set of saved WPIX (window picks |
BRUNINFO |
Brune Model information |
DETLINFO |
Detailed information about traces |
mark |
mark (MARK button was pressed |
PUSHED |
list of all buttons pressed prior to exit |
If using the filters for button FILT, it is useful to have a "None" in case no filter is desired (i.e. user changes mind).
Jonathan M. Lees<jonathan.lees.edu>
PICK.DOC, GH, RPGM, choosfilt
data("GH") ### This loads a structure STDLAB <- c("DONE", "QUIT","zoom out", "zoom in", "Left", "Right", "restore", "Pinfo","WINFO", "XTR", "SPEC", "SGRAM" ,"WLET", "FILT", "UNFILT", "SCALE", "Postscript") sel <- GH$COMPS=="V" if(interactive() ) { p <- swig(GH, sel=sel, STDLAB=STDLAB) print(p) } if(interactive()) { p <- swig(GH, sel=sel, WIN=c(4,14) , STDLAB=c("DONE", "LAME", "DAME") ) print(p) } ############ example with filter data(KH) thefilts <- list(flo= c(0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 1/2, 1/50,1/100, 1/100, 1/100,1/100,1/100,1,1, 0.2, 15, 5, 2,1, 100), fhi= c(1/10, 1/6, 1/5, 1/4, 1/3, 1/2, 0.2, 0.5, 1.0, 2.0, 3.0, 4.0, 7.0, 8, 1/2.0,1/5.0,1/10.0, 1/20, 1/30,1/40,10,5, 7.0, 100, 100, 100,10, 100), type = c("LP","LP", "LP", "LP", "LP", "LP", "LP","LP", "LP", "LP", "LP", "LP", "LP", "BP", "BP","BP","BP","BP","BP", "BP","BP","BP", "HP", "HP","HP", "HP","HP", "None")) if(interactive()) { swig(KH, filters=thefilts) }else{ swig(KH, filters=thefilts, SHOWONLY=TRUE ) }data("GH") ### This loads a structure STDLAB <- c("DONE", "QUIT","zoom out", "zoom in", "Left", "Right", "restore", "Pinfo","WINFO", "XTR", "SPEC", "SGRAM" ,"WLET", "FILT", "UNFILT", "SCALE", "Postscript") sel <- GH$COMPS=="V" if(interactive() ) { p <- swig(GH, sel=sel, STDLAB=STDLAB) print(p) } if(interactive()) { p <- swig(GH, sel=sel, WIN=c(4,14) , STDLAB=c("DONE", "LAME", "DAME") ) print(p) } ############ example with filter data(KH) thefilts <- list(flo= c(0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 1/2, 1/50,1/100, 1/100, 1/100,1/100,1/100,1,1, 0.2, 15, 5, 2,1, 100), fhi= c(1/10, 1/6, 1/5, 1/4, 1/3, 1/2, 0.2, 0.5, 1.0, 2.0, 3.0, 4.0, 7.0, 8, 1/2.0,1/5.0,1/10.0, 1/20, 1/30,1/40,10,5, 7.0, 100, 100, 100,10, 100), type = c("LP","LP", "LP", "LP", "LP", "LP", "LP","LP", "LP", "LP", "LP", "LP", "LP", "BP", "BP","BP","BP","BP","BP", "BP","BP","BP", "HP", "HP","HP", "HP","HP", "None")) if(interactive()) { swig(KH, filters=thefilts) }else{ swig(KH, filters=thefilts, SHOWONLY=TRUE ) }
plot all phase arrival picks
swig.ALLPX(t0, STNS, COMPS, YPX, PHASE = NULL, POLS = TRUE, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)swig.ALLPX(t0, STNS, COMPS, YPX, PHASE = NULL, POLS = TRUE, FILL = FALSE, FORCE = TRUE, cex = cex, srt = srt)
t0 |
time for start of window, s |
STNS |
station names to plot |
COMPS |
components to plot |
YPX |
y-picks (times) |
PHASE |
Phases to plot |
POLS |
polaritiy information (up, down) |
FILL |
fill color |
FORCE |
logical, force all phases plotted on all traces |
cex |
character expansion |
srt |
string rotation angle, degrees |
for use in conjunction with PLOT.SEISN program
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
PLOT.SEISN, swig
##### this example needs some work: data(GH) WPX = uwpfile2ypx(GH$pickfile) swig(GH, SHOWONLY=TRUE ) swig.ALLPX(GH$pickfile$LOC , GH$STNS, GH$COMPS, WPX, PHASE='P', FORCE=TRUE)##### this example needs some work: data(GH) WPX = uwpfile2ypx(GH$pickfile) swig(GH, SHOWONLY=TRUE ) swig.ALLPX(GH$pickfile$LOC , GH$STNS, GH$COMPS, WPX, PHASE='P', FORCE=TRUE)
Simulate an exploration style seismic shot with ground roll, air wave, refractions and reflections.
symshot1(PLOT = FALSE)symshot1(PLOT = FALSE)
PLOT |
logical, TRUE=plot the wiggles. DEFAULT=FALSE |
Arrivals are calculated based on geometric considerations with a 1D layered model.
smograms |
Matrix: columns are individual traces |
dt |
sample interval in time, s |
x |
x locations |
dx |
spacing in X-direction |
REFL |
reflection information |
REFR |
refraction image |
GRrec |
ground roll image |
AIRrec |
air wave image |
THEORY |
List of theoretical values |
trefrac |
refraction arrival times |
treflex |
reflection arrival times |
tair |
Air arrival times |
velair |
velocity for the air wave |
mod |
Layered Model |
MOdel is relatively simple:
Jonathan M. Lees<[email protected]>
Sherrif
wiggleimage, symshot
S1 <- symshot1() wiggleimage(S1$smograms, dt = -S1$dt, dx = S1$x, col = "black")S1 <- symshot1() wiggleimage(S1$smograms, dt = -S1$dt, dx = S1$x, col = "black")
Extract OS system information
sysinfo()sysinfo()
Returns parts of the output of variables .Machine and .Platform.
Endian Problem
these should be used for reading binary data when crossing platforms. If binary files are created on a little-endian platform, but are being read on a big-endian platform, then one should use "swap".
SizeOf Problem
Many older machines use 4 bytes for LONG. Newer 64 bit machines use 8 bytes for LONG = so this is a big problem.
A=.Machine, B=.Platform
Jonathan M. Lees<[email protected]>
.Machine, .Platform
sysinfo()sysinfo()
Modify opick data frame and add T2=T1+dur
T12.pix(A)T12.pix(A)
A |
pick data.frame |
Given t1 and duration, returns to structure, t2=t1+dur.
pick data.frame with t2 as a member.
Jonathan M. Lees<jonathan.lees.edu>
Taper traces in a seismic structure using a cosine function on the ends.
TAPER.SEISN(TH, sel = 1:length(TH$JSTR), TAPER = 0.1 )TAPER.SEISN(TH, sel = 1:length(TH$JSTR), TAPER = 0.1 )
TH |
Seismic structure |
sel |
selection of traces |
TAPER |
filter taper, percent cosine taper |
Seismic structure
Seismic structure
Jonathan M. Lees<jonathan.lees.edu>
butfilt
data("GH") sel <- which(GH$COMPS=="V") sel <- 1:3 KF <- TAPER.SEISN(GH, sel = sel, TAPER=0.1) swig(KF, sel=sel, SHOWONLY=0)data("GH") sel <- which(GH$COMPS=="V") sel <- 1:3 KF <- TAPER.SEISN(GH, sel = sel, TAPER=0.1) swig(KF, sel=sel, SHOWONLY=0)
determine cut off for ratio curve
Thresh.J(y, thresh)Thresh.J(y, thresh)
y |
signal |
thresh |
inital threshold |
Attempts to automatically optimize the threshold for automated picking. Used deep in picking algorithm.
list(J=J, L=L)
Jonathan M. Lees<jonathan.lees.edu>
Convert to cartesian coordinates
TOCART(az, nadir)TOCART(az, nadir)
az |
degrees, azimuth |
nadir |
degrees, dip |
LIST
x |
x-coordinate |
y |
y-coordinate |
z |
z-coordinate |
az |
degrees, azimuth |
nadir |
degrees, dip |
Jonathan M. Lees <[email protected]>
tocartL
TOCART(132, 69)TOCART(132, 69)
Convert to Julian Day. Used for calculations.
tojul(year, month, day)tojul(year, month, day)
year |
year |
month |
month |
day |
day |
Julian Days
Jonathan M. Lees<jonathan.lees.edu>
tojul(1953, 3, 19)tojul(1953, 3, 19)
Color Palette ranging from red to blue through black.
tomo.colors(n, alpha = 1)tomo.colors(n, alpha = 1)
n |
number of colors |
alpha |
hsv color parameter |
color palette
Jonathan M. Lees<jonathan.lees.edu>
rainbow, colors, hsv
tomo.colors(25, alpha = 1)tomo.colors(25, alpha = 1)
Integrate using trapezoidal rule
trapz(y, dt, rm.mean=TRUE)trapz(y, dt, rm.mean=TRUE)
y |
Input signal |
dt |
sample interval time, seconds |
rm.mean |
logical, whether to remove the mean prior to integration (TRUE) |
vector: Integrated signal
Jonathan M. Lees<[email protected]>
x <- rnorm(100) trapz(x, 0.01)x <- rnorm(100) trapz(x, 0.01)
Travel time from source to reciever in 1D local model.
travel.time1D(indelta, inhpz, instaz, inlay, ztop, vel) many.time1D(indelta, inhpz, instaz, inlay, ztop, vel)travel.time1D(indelta, inhpz, instaz, inlay, ztop, vel) many.time1D(indelta, inhpz, instaz, inlay, ztop, vel)
indelta |
distance in KM |
inhpz |
depth of hypocenter, km |
instaz |
elevation of station |
inlay |
number of layers |
ztop |
vector, tops of layers |
vel |
vector, velocities in layers |
Uses local 1D velocity model, not appropriate for spherical earth. The many.time1D version will take a vector of distances (indelta) and either one station elevation or a vector.
The station elevation should be referenced to the top of the velocity model, not necessarily sea level. Usually this is set to zero and a station correction is used to take into account the topographic and other geologic effects.
list:
dtdr |
derivative of t w.r.t. horizontal distance |
dtdz |
derivative of t w.r.t. z, depth |
angle |
incidence angle, degrees |
tt |
travel time, s |
Jonathan M. Lees<jonathan.lees.edu>
Ray.time1D, Get1Dvel
data(VELMOD1D) v <- VELMOD1D tees <- travel.time1D(23, 7, 0, length(v$zs) , v$zp , v$vp) print(tees)data(VELMOD1D) v <- VELMOD1D tees <- travel.time1D(23, 7, 0, length(v$zs) , v$zp , v$vp) print(tees)
Given a seiries of pulses, do analysis on each one
tung.pulse(r, q, dt)tung.pulse(r, q, dt)
r |
x-coordinates |
q |
y-coordinates |
dt |
deltat, sample interval |
Calculates, min, max of edges and center, then models the pulse with a triangular pulse and integrates.
vector=c(Ex[1], Ex[2], Ey[1], Ey[2], Cx, Cy, ar2, DefInt[1], DefInt[2], sum0) where:
Ex |
left minimum |
Ey |
right minimum |
Cx, Cy
|
center (max?) |
ar2 |
area of triangle |
DefInt[1] |
integral under curve |
DefInt[2] |
integral under curve ( bottom triangle removed) |
sum0 |
RMS amplitude |
Jonathan M. Lees<jonathan.lees.edu>
peaks
if(interactive()){ data(CE1) ex <- CE1$x[CE1$x>5.453291 &CE1$x< 5.507338] why <- CE1$y[CE1$x>5.453291 &CE1$x< 5.507338] plot(ex, why, type='l') tung.pulse(ex, why, CE1$dt) }if(interactive()){ data(CE1) ex <- CE1$x[CE1$x>5.453291 &CE1$x< 5.507338] why <- CE1$y[CE1$x>5.453291 &CE1$x< 5.507338] plot(ex, why, type='l') tung.pulse(ex, why, CE1$dt) }
Parse Acard from UW-format pickfile
unpackAcard(AC)unpackAcard(AC)
AC |
ascii acard |
Reads and Parses A-cards from UW foprmatted data.
List:
yr |
Year |
mo |
Month |
dom |
Day of Month |
hr |
Hour |
mi |
minute |
sec |
second |
lat |
latitude |
lon |
longitude |
z |
depth |
mag |
magnitude |
gap |
gap in station coverage |
delta |
distance to nearest station |
rms |
root mean square residual |
hozerr |
horizontal error |
Jonathan M. Lees<jonathan.lees.edu>
Read in ASCII version of pickfile. This is the output list used to plot picks on swig, often called WPX or YPX in other functions.
uwpfile2ypx(P)uwpfile2ypx(P)
P |
pickfile |
list:
STAS |
input structure |
yr |
year |
mo |
month |
dom |
day of month |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
col |
color |
onoff |
logical, TRUE plot trace |
Jonathan M. Lees<jonathan.lees.edu>
data("GH") WW = RSEIS::uwpfile2ypx(GH$pickfile) vertord <- getvertsorder(GH$pickfile, GH) R1 = rangedatetime(WW) R2 = rangedatetime(GH$info) S1 = secdifL(R2$min, R1$min) swig(GH, sel=vertord$sel, APIX=WW, WIN=c(S1-1, 15) , SHOWONLY=0)data("GH") WW = RSEIS::uwpfile2ypx(GH$pickfile) vertord <- getvertsorder(GH$pickfile, GH) R1 = rangedatetime(WW) R2 = rangedatetime(GH$info) S1 = secdifL(R2$min, R1$min) swig(GH, sel=vertord$sel, APIX=WW, WIN=c(S1-1, 15) , SHOWONLY=0)
Plot one seismogram in Var-Squiggle mode - like on an exploration record section with half the wiggled shaded.
varsquig(x, y, L = locator(2), FLIP = FALSE, filcol="blue", tracecol="red", var = 0, xpd=TRUE )varsquig(x, y, L = locator(2), FLIP = FALSE, filcol="blue", tracecol="red", var = 0, xpd=TRUE )
x |
X (time axis) coordinates |
y |
Y amplitudes |
L |
rectangular region on plot where plotting occurs |
FLIP |
logical - whether to flip the amplitudes by -1 |
filcol |
color for shading |
tracecol |
color for trace |
var |
logical, whether to shade |
xpd |
logical, set xpd parameter (see par) |
A set of traces can be plotted after the plotting region has been set.
Graphical Side Effects
varsquig is meant to be used within other program not as a stand alone routine. The plotting region must be set up prior to plotting. The time series is scaled to fitt in the rectangular region defined by L.
Jonathan M. Lees<[email protected]>
varsquiggle
data(KH) x <- KH$ex[KH$ex>95& KH$ex<125] y <- KH$JSTR[[1]][KH$ex>95& KH$ex<125] plot(x , y , type='l') u <- par('usr') L <- list(x=c(u[1], u[2]), y = c(u[3], u[4])) plot(L$x, L$y, type='n') varsquig(x, y, L=L , FLIP=FALSE, filcol="blue", tracecol="blue", var=TRUE) plot(L$x, L$y, type='n') varsquig(x, y, L=L , FLIP=FALSE, filcol="red", tracecol="blue", var=FALSE)data(KH) x <- KH$ex[KH$ex>95& KH$ex<125] y <- KH$JSTR[[1]][KH$ex>95& KH$ex<125] plot(x , y , type='l') u <- par('usr') L <- list(x=c(u[1], u[2]), y = c(u[3], u[4])) plot(L$x, L$y, type='n') varsquig(x, y, L=L , FLIP=FALSE, filcol="blue", tracecol="blue", var=TRUE) plot(L$x, L$y, type='n') varsquig(x, y, L=L , FLIP=FALSE, filcol="red", tracecol="blue", var=FALSE)
Plot A seismic section using Var-Squiggle, like an exploration seismic record.
varsquiggle(GH, sel = c(1, 2), WIN = c(0, 1), dist=NULL, thick=1 , FLIP=FALSE, filcol='blue', tracecol='blue', xpd=TRUE, plotdir=1 )varsquiggle(GH, sel = c(1, 2), WIN = c(0, 1), dist=NULL, thick=1 , FLIP=FALSE, filcol='blue', tracecol='blue', xpd=TRUE, plotdir=1 )
GH |
Seismic List |
sel |
selection of seismic traces |
WIN |
time window |
dist |
distance from the source |
thick |
thickness of plotting region per trace |
FLIP |
logical, whether to plot vertical or horizontal, default FALSE, TRUE = vertical |
filcol |
color for shading |
tracecol |
color for trace |
xpd |
logical, set xpd parameter (see par) |
plotdir |
1=left to right, 0=right to left (default=1) |
Traces are plotted and scaled each with its own window. The distance vector provides the location on the seismic record.
Graphical Side effects
Jonathan M. Lees<[email protected]>
matsquiggle, varsquig
data(GH) m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### plot normal way: swig(GH, sel=sel, WIN=c(5,10), SHOWONLY=TRUE) ### plot with varsquiggle varsquiggle(GH, sel=sel, WIN=c(5,10))data(GH) m <- match( GH$STNS, GH$stafile$name) LATS <- GH$stafile$lat[m] LONS <- GH$stafile$lon[m] dees <- rdistaz( GH$pickfile$LOC$lat, GH$pickfile$LOC$lon, LATS, LONS) sel <- which(GH$COMPS=="V") sel <- sel[order(dees$dist[sel])] ### plot normal way: swig(GH, sel=sel, WIN=c(5,10), SHOWONLY=TRUE) ### plot with varsquiggle varsquiggle(GH, sel=sel, WIN=c(5,10))
Seismic Velocity Model for Coso California
data(VELMOD1D)data(VELMOD1D)
LIST:
vector of Tops of Layers, P-wave, (km)
vector of velocities of Layers, P-wave,(km/s)
errors for velocities, P-wave,(km/s)
vector of Tops of Layers, S-wave, (km)
vector of velocities of Layers, S-wave,(km/s)
errors for velocities, S-wave,(km/s)
character, name of model
character vector description of model
Velocity model from a text file
Wu, H., and J. M. Lees (1999), Three-dimensional P- and S-wave velocity structures of the Coso Geothermal Area, California, from microseismic traveltime data, J. Geophys. Res. 104, 13,217-13,233.
data(VELMOD1D) Get1Dvel(VELMOD1D, PLOT=TRUE)data(VELMOD1D) Get1Dvel(VELMOD1D, PLOT=TRUE)
Removes seismic instrument response and corrects for sensitivity of seismoc instrument, returning units of m/s rather than volts.
VELOCITY.SEISN(TH, sel = 1:length(TH$JSTR), inst = 1, Kal = Kal,waterlevel = 1e-08, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU"))VELOCITY.SEISN(TH, sel = 1:length(TH$JSTR), inst = 1, Kal = Kal,waterlevel = 1e-08, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU"))
TH |
list structure of seismic traces |
sel |
select which tracesin list to deconvolve |
inst |
index to instrument in Kal list for calibration and instrument response |
Kal |
list of instrument responses |
waterlevel |
waterlevel for low frequency division |
FILT |
filter output, after instrumentation |
Instrument responses are lists of poles and zeros for each instrument defined.
Same as input list with new traces representing velocity versus volts
Jonathan M. Lees<[email protected]>
DISPLACE.SEISN, deconinst
Kal <- PreSet.Instr() data(KH) inst <- rep(0, length(KH$STNS)) VH <- VELOCITY.SEISN(KH, sel = 1, inst = 1, Kal = Kal, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU"))Kal <- PreSet.Instr() data(KH) inst <- rep(0, length(KH$STNS)) VH <- VELOCITY.SEISN(KH, sel = 1, inst = 1, Kal = Kal, FILT = list(ON = FALSE, fl = 1/30, fh = 7, type = "HP", proto = "BU"))
Veiw seismic data (segy) window on an hourly basis.
view.seis(aday, ihour, inkhour, SAVEFILE, days, DB, usta, acomp, STDLAB =c("QUIT", "NEXT", "PREV", "HALF"), kind = -1, Iendian=1, BIGLONG=FALSE, TZ=NULL)view.seis(aday, ihour, inkhour, SAVEFILE, days, DB, usta, acomp, STDLAB =c("QUIT", "NEXT", "PREV", "HALF"), kind = -1, Iendian=1, BIGLONG=FALSE, TZ=NULL)
aday |
index of which day to use in vector days |
ihour |
hour to start |
inkhour |
increment in hours for viewing panel |
SAVEFILE |
file to save window picks in |
days |
vector of days to select from |
DB |
data base list of file names and start-times and durations |
usta |
stations to select |
acomp |
compnents to select |
STDLAB |
vector of buttons, DEFAULT = c("QUIT", "NEXT", "PREV", "HALF", "WPIX", "zoom out", "refresh", "restore", "SPEC", "SGRAM" ,"WLET", "FILT", "Pinfo", "WINFO") |
kind |
an integer -1, 0, 1, 2 ; 0="RDATA" , -1="RDS", 0="RDATA", 1 = "segy", 2 = "sac", see notes below |
Iendian |
vector, Endian-ness of the data: 1,2,3: "little", "big", "swap". Default = 1 (little) |
BIGLONG |
logical, TRUE=long=8 bytes |
TZ |
Number of hours to add to GMT to get local time |
The program view.seis assumes the data is stored in files accessable by the user and that the DB list has been scanned in and parsed.
"kind" can be numeric or character: options are 'RDS', 'RDATA', 'SEGY', 'SAC', corresponding to (-1, 0, 1, 2)
Graphical side effects and save.wpix stores appended picks.
On LINUX systems I wrote these (non-R) programs to set up the data base for segy data:FLS.prl, segydatabase. To get these contact me directly. TZ is (-6) for Guatemala.
Jonathan M. Lees<[email protected]>
swig, save.wpix
if(interactive() ) { data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) pday <- 5 SAVEFILE <- tempfile() ihour <- 15 inkhour <- .5 ### days is a list of days (and associated years) that are in teh DB days <- list(jd=c(4, 5, 6), yr=c(2000, 2000, 2000) ) aday = which(pday == days$jd) #### aday refers to one of the days listed in the days structure view.seis(aday, ihour, inkhour, SAVEFILE, days, DB, IDB$usta, IDB$ucomp, TZ=(-6)) }if(interactive() ) { data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) pday <- 5 SAVEFILE <- tempfile() ihour <- 15 inkhour <- .5 ### days is a list of days (and associated years) that are in teh DB days <- list(jd=c(4, 5, 6), yr=c(2000, 2000, 2000) ) aday = which(pday == days$jd) #### aday refers to one of the days listed in the days structure view.seis(aday, ihour, inkhour, SAVEFILE, days, DB, IDB$usta, IDB$ucomp, TZ=(-6)) }
calculate euclidian vector length
vlen(A1)vlen(A1)
A1 |
vector |
Euclidian Length
Jonathan M. Lees<jonathan.lees.edu>
vlen(c(23, 43))vlen(c(23, 43))
add vertical line on trace panel
vline(x, per = 1, COL = 1, NUM = FALSE, LAB = 1:length(x), lwd = 0, lty = 1)vline(x, per = 1, COL = 1, NUM = FALSE, LAB = 1:length(x), lwd = 0, lty = 1)
x |
vector of x-locations |
per |
percent of window |
COL |
color |
NUM |
number lines |
LAB |
character labels |
lwd |
line width |
lty |
line type |
adds vertical lines to plot
Graphical side Effects
Jonathan M. Lees<jonathan.lees.edu>
plocator
plot(c(0,1), c(0,1), type='n') vline(runif(4), COL ='red')plot(c(0,1), c(0,1), type='n') vline(runif(4), COL ='red')
Gets an envelope and lpots on a time series
wiggle.env(x, y)wiggle.env(x, y)
x |
x-coordinate |
y |
y-coordinate |
Uses Peaks and smooth.pline to estimate envelope
list |
structure from smooth.spline |
Jonathan M. Lees<jonathan.lees.edu>
smooth.spline, peaks, hilbert
## data("CE1.Example.RDATA") ## load("CE1.Example.RDATA") data(CE1) plot(CE1$x, CE1$y, type='l') wiggle.env(CE1$x, CE1$y) we = wiggle.env(CE1$x, CE1$y) lines(we$x, we$y, col='red')## data("CE1.Example.RDATA") ## load("CE1.Example.RDATA") data(CE1) plot(CE1$x, CE1$y, type='l') wiggle.env(CE1$x, CE1$y) we = wiggle.env(CE1$x, CE1$y) lines(we$x, we$y, col='red')
Plot a seismic section as shot record
wiggleimage(Arot, dt = 1, dx = 1, col = "black")wiggleimage(Arot, dt = 1, dx = 1, col = "black")
Arot |
Matrix: columns are individual traces |
dt |
Sample rate, seconds |
dx |
spacing in x-direction. If a vector is given, it is used instead and dx is taken from the difference of the first to elements. |
col |
color for plotting wiggles |
Plot is arranged with time going down the page
Graphical side effects
Jonathan M. Lees<[email protected]>
matsquiggle, varsquiggle
S1 = symshot1() wiggleimage(S1$smograms, dt = -S1$dt, dx = S1$x, col = "black")S1 = symshot1() wiggleimage(S1$smograms, dt = -S1$dt, dx = S1$x, col = "black")
Window a time slice of seismic data and extract from a GH structure.
WINGH(GH, sel = 1, WIN = c(0,1) )WINGH(GH, sel = 1, WIN = c(0,1) )
GH |
RSEIS seismic list |
sel |
Select which traces to extract |
WIN |
Time window to extract (seconds from the beginning of the first trace.) |
Preserves the data structure of the GH list. The purpose of this function is to extract a small subset of data from a larger data set (or longer time series) for subsequent processing.
New GH structure.
Jonathan M. Lees<[email protected]>
swig
if(interactive()){ data(GH) swig(GH, sel=which(GH$COMPS=="V" )) jh = WINGH(GH, sel = which(GH$COMPS=="V" ), WIN = c(3.821281, 12.861820) ) swig(jh) ## compare with: swig(GH, sel=which(GH$COMPS=="V" ), WIN = c(3.821281, 12.861820)) }if(interactive()){ data(GH) swig(GH, sel=which(GH$COMPS=="V" )) jh = WINGH(GH, sel = which(GH$COMPS=="V" ), WIN = c(3.821281, 12.861820) ) swig(jh) ## compare with: swig(GH, sel=which(GH$COMPS=="V" ), WIN = c(3.821281, 12.861820)) }
Add Mark up to current seismic trace with a bar desgnating a window selection.
winmark(a1, a2, side = 1, bar = NULL, leg = NULL, col = col, lwd = 1, lty = 1, arrows = FALSE, alen = 0.1, leglen = 0.15, LEGON = 3, BARON = TRUE)winmark(a1, a2, side = 1, bar = NULL, leg = NULL, col = col, lwd = 1, lty = 1, arrows = FALSE, alen = 0.1, leglen = 0.15, LEGON = 3, BARON = TRUE)
a1 |
x1-location |
a2 |
x2-location |
side |
side where bar is drawn, as in axes: 1=bottom,2=left,3=top,4=right |
bar |
location of bar |
leg |
location of leg |
col |
color |
lwd |
line width |
lty |
line type |
arrows |
logical, add arrows to ends of legs |
alen |
length of arrow heads, inches, default=0.125 |
leglen |
length of arrows aas percent of usr("par"), default=0.125 |
LEGON |
plotting flag for legs: 0=no legs, 1=left leg, 2=right leg, 3=both legs(default) |
BARON |
logical:plotting flag for bar |
Used for marking seismic traces. The window marker looks like a staple, three segments are drawn, a bar and two legs. The thickness of the legs are determined by bar and leg, unless these are missing. if they are missing parameter side is used to set the locations, and leglen determines the length of the legs. If either bar or leg are missing the parameters are derived from par("usr") and are applied to whole window. side switches the orientation of the staple mark, with the legs pointing according away from named the axis.
Graphical Side Effect
Jonathan M. Lees<jonathan.lees.edu>
plot(c(0,1), c(0,1), type='n', xlab='', ylab='' ) winmark(.3, .7, side=3, col='brown', arrows=TRUE, leglen=.4) winmark(.3, .7, side=1, col='blue', arrows=TRUE, leglen=.5) winmark(.3, .7, side=2, col='green', arrows=TRUE, alen=.05, leglen=.4) winmark(.3, .7, leg=.65, bar=.6, side=4, col='orange', arrows=TRUE, alen=.1, leglen=.125) winmark(.3, .7, bar=.65, leg=.6, side=4, col='seagreen', arrows=TRUE, alen=.1, leglen=.125) ############# examples with different legs showing plot(c(0,1), c(0,1), type='n', xlab='', ylab='' ) winmark(.3, .7, side=3, col='brown', arrows=TRUE, leglen=.4, LEGON=1) winmark(.3, .4, side=1, col='brown', arrows=TRUE, leglen=.4, LEGON=2) winmark(.7, .9, side=1, col='blue', arrows=TRUE, leglen=.4, LEGON=0)plot(c(0,1), c(0,1), type='n', xlab='', ylab='' ) winmark(.3, .7, side=3, col='brown', arrows=TRUE, leglen=.4) winmark(.3, .7, side=1, col='blue', arrows=TRUE, leglen=.5) winmark(.3, .7, side=2, col='green', arrows=TRUE, alen=.05, leglen=.4) winmark(.3, .7, leg=.65, bar=.6, side=4, col='orange', arrows=TRUE, alen=.1, leglen=.125) winmark(.3, .7, bar=.65, leg=.6, side=4, col='seagreen', arrows=TRUE, alen=.1, leglen=.125) ############# examples with different legs showing plot(c(0,1), c(0,1), type='n', xlab='', ylab='' ) winmark(.3, .7, side=3, col='brown', arrows=TRUE, leglen=.4, LEGON=1) winmark(.3, .4, side=1, col='brown', arrows=TRUE, leglen=.4, LEGON=2) winmark(.7, .9, side=1, col='blue', arrows=TRUE, leglen=.4, LEGON=0)
Locator for plotseis24
winseis24(pjj, pch = 3, col = "red")winseis24(pjj, pch = 3, col = "red")
pjj |
out put of plotseis24 |
pch |
plotting character when clicking |
col |
color for plotting when clicking |
After extracting 24 hours and plotting with plotseis24, use winseis24 to click on the plot and return times for further analysis or zooming.
list:
hr |
hours picked |
yr |
year |
jd |
julian day |
Jonathan M. Lees<[email protected]>
plotseis24, getseis24
if(interactive()){ data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) ###### here is the picking: wpicks = winseis24(pjj) }if(interactive()){ data(KH) amp = KH$JSTR[[1]] OLDdt = KH$dt[1] newdt = 0.1 yr = 2000 GIVE = FAKEDATA(amp, OLDdt=0.01, newdt = 0.1, yr = 2000, JD = 4, mi = 12, sec = 0, Ntraces = 24*3, seed=200, noise.est=c(1, 100) , verbose=TRUE ) tdir = tempdir() for(i in 1:length(GIVE) ) { sig = GIVE[[i]] d1 = dateStamp(sig$DATTIM, sep='_') nam1 = paste(d1,sig$sta, sig$comp, sep='_') nam2 = paste0(nam1, '.RDS') nam3 = paste(tdir, nam2, sep='/') saveRDS(file=nam3, sig) } ######################## Now read files and make the DataBase: LF = list.files(path=tdir, pattern='.RDS', full.names=TRUE) DB = FmakeDB(LF, kind=-1) IDB = infoDB(DB) START = list(yr =yr , jd= 5 , hr= 0 , mi= 0 ,sec= 0) END = list(yr =yr , jd= 7 , hr= 0 , mi= 0 ,sec= 0) h = getseis24(DB, iyear = 2000, iday = 5, usta = IDB$usta, acomp = IDB$ucomp, kind = -1, Iendian=1, BIGLONG=FALSE) pjj <- plotseis24(h, dy=1/18, FIX=24, SCALE=1, FILT=list(ON=FALSE, fl=0.05 , fh=20.0, type="BP", proto="BU"), RCOLS=c(rgb(0.2, .2, 1), rgb(.2, .2, .2)) ) ###### here is the picking: wpicks = winseis24(pjj) }
Wavelet transform
wlet.do(why, dt, noctave = 6, nvoice = 20, w0=5, flip = TRUE, ploty = TRUE, zscale = 1, col = terrain.colors(100), STAMP = STAMP, units="", scaleloc=c(0.4,0.95))wlet.do(why, dt, noctave = 6, nvoice = 20, w0=5, flip = TRUE, ploty = TRUE, zscale = 1, col = terrain.colors(100), STAMP = STAMP, units="", scaleloc=c(0.4,0.95))
why |
signal |
dt |
sample rate (s) |
noctave |
number of octaves, default=6 |
nvoice |
number of voices, nvoice = 20 |
w0 |
central frequency for morlet wavelet, default=5 |
flip |
logical, whether to flip the orientation |
ploty |
logical, whether to plot y |
zscale |
scale of the image |
col |
color palette |
STAMP |
cahracter stamp for identification |
units |
character, units to put on plot |
scaleloc |
2-vector, percentatge of bottom margin for the color scale |
This function uses the cwt (package:Rwave) code to calculate the continuous wavelet transform, but plots it differently. Morelet wavelet is used by default. The cwt produces an image, the modulus of the transform, which is passed on to wlet.do along with the number of octaves and the number of voices. Plotting parameters are passed to the function so that replotting can be accomplished (use plotwlet) without having to recalculate the transform.
Plotting parameters are passed on to the plotting function, plotwlet.
baha |
list: wavelet transform image, noctave = number of octaves, nvoice = number of voices, w0= central freq, flip = logical, whether image is flipped (default=TRUE) |
PE |
plotting information list: why=y-axis, dt=time series sample, interval, zscale=(1,2,3) image scaling, col=color map, ygrid = logical(default=FALSE), STAMP = character string |
Jonathan M. Lees<jonathan.lees.edu>
Rwave, cwt , plotwlet, contwlet , pwlet2freqs, wlet.drive
data(CE1) plot(CE1$x, CE1$y, type='l') require(Rwave) out <- wlet.do(CE1$y, CE1$dt, flip = FALSE, ploty = TRUE)data(CE1) plot(CE1$x, CE1$y, type='l') require(Rwave) out <- wlet.do(CE1$y, CE1$dt, flip = FALSE, ploty = TRUE)
interactive wavelet transform driver
wlet.drive(Xamp, DT = 0.008, noctave = 6, nvoice = 20, w0=5, STAMP = NULL)wlet.drive(Xamp, DT = 0.008, noctave = 6, nvoice = 20, w0=5, STAMP = NULL)
Xamp |
vector of signal |
DT |
sample interval (s) |
noctave |
number of octaves, default=6 |
nvoice |
number of voices, nvoice = 20 |
w0 |
central frequency for morlet wavelet, default=5 |
STAMP |
character string for identification |
Graphical Side Effects
Jonathan M. Lees<jonathan.lees.edu>
RPGM, plotwlet, wlet.do
data(CE1) plot(CE1$x, CE1$y, type='l') if(interactive() ) wlet.drive(CE1$y, CE1$dt, STAMP=CE1$name)data(CE1) plot(CE1$x, CE1$y, type='l') if(interactive() ) wlet.drive(CE1$y, CE1$dt, STAMP=CE1$name)
Write out one segy binary format file.
write1segy(alist, fn = NULL, BIGLONG = FALSE) write1sac(alist, fn = NULL, BIGLONG = FALSE)write1segy(alist, fn = NULL, BIGLONG = FALSE) write1sac(alist, fn = NULL, BIGLONG = FALSE)
alist |
list of traces with segy/sac header and an integer/real format time series |
fn |
Output file name |
BIGLONG |
logical, indicating whether long is 8 or 4 bytes. |
Segy format files are in integer format. The time series ususally represents counts recorded in a data acquisition system. The header includes meta-data and other identifying information.
Side effects in the file system.
The Endian-ness of the output file will be the native endian-ness of the system.
Jonathan M. Lees<[email protected]>
rseis2segy, read1sac, read1segy
## Not run: theENDIAN = .Platform$endian BIGLONG = FALSE ### write1segy is in rseis2segy data(KH) apath = tempdir() J = rseis2segy(KH, sel=1, path=apath, BIGLONG=BIGLONG ) L = list.files(path=J, full.names=TRUE) Z = read1segy(L[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = BIGLONG) plot(Z$amp, type='l') ########## same with SAC files: J = rseis2sac(KH, sel = 1, win = c(0, 1), path = apath, BIGLONG = BIGLONG) L = list.files(path=J, pattern='.SAC', full.names=TRUE) Z = read1sac(L[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = BIGLONG) plot(Z$amp, type='l') ## End(Not run)## Not run: theENDIAN = .Platform$endian BIGLONG = FALSE ### write1segy is in rseis2segy data(KH) apath = tempdir() J = rseis2segy(KH, sel=1, path=apath, BIGLONG=BIGLONG ) L = list.files(path=J, full.names=TRUE) Z = read1segy(L[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = BIGLONG) plot(Z$amp, type='l') ########## same with SAC files: J = rseis2sac(KH, sel = 1, win = c(0, 1), path = apath, BIGLONG = BIGLONG) L = list.files(path=J, pattern='.SAC', full.names=TRUE) Z = read1sac(L[1], Iendian = theENDIAN, HEADONLY = FALSE, BIGLONG = BIGLONG) plot(Z$amp, type='l') ## End(Not run)
write UW pickfile
writeUW.Acard(LOC)writeUW.Acard(LOC)
LOC |
location structure |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.Commentcard(comments)writeUW.Commentcard(comments)
comments |
comment vector |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.DOTcard(STAS)writeUW.DOTcard(STAS)
STAS |
station structure |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.Ecard(E)writeUW.Ecard(E)
E |
Ecard |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.Fcard(F)writeUW.Fcard(F)
F |
F-card info |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.Hcard(H)writeUW.Hcard(H)
H |
H-card |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.Ncard(N)writeUW.Ncard(N)
N |
Name |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
write UW pickfile
writeUW.OSTAScard(OSTAS)writeUW.OSTAScard(OSTAS)
OSTAS |
OSTAS |
Side Effects
Jonathan M. Lees<jonathan.lees.edu>
Write UW formatted ascii pickfile
writeUWpickfile(A, output = "")writeUWpickfile(A, output = "")
A |
Pickfile structure |
output |
output file |
Side Effects. Used to save ASCII versions of pickfiles for other processing.
Jonathan M. Lees<jonathan.lees.edu>
EmptyPickfile
swig Button Extract seismic data in RSEIS and save in GH format for exchange.
X2RSEIS(nh, g)X2RSEIS(nh, g)
nh |
RSEIS seismic data format |
g |
swig parameters |
This function is used internally in RSEIS as a button in swig. The program should be run in a directory that has write permission.
The data is saved as a GH list.
No value, writes to disk
Jonathan M. Lees<[email protected]>
XTR, X2SAC, swig
if(interactive()){ ### get data: GH <- Mine.seis(at1, at2, DB, NULL , NULL, kind = 1, Iendian=1) w <- swig(GH, PADDLAB=c("X2SAC","X2RSEIS","YPIX" ) ) }if(interactive()){ ### get data: GH <- Mine.seis(at1, at2, DB, NULL , NULL, kind = 1, Iendian=1) w <- swig(GH, PADDLAB=c("X2SAC","X2RSEIS","YPIX" ) ) }
swig Button Extract seismic data in RSEIS and save in SAC format for exchange.
X2SAC(nh, g)X2SAC(nh, g)
nh |
RSEIS seismic data format |
g |
swig parameters |
This function is used internally in RSEIS as a button in swig. The program should be run in a directory that has write permission.
No value, writes to disk
Jonathan M. Lees<[email protected]>
XTR, X2RSEIS, swig
if(interactive()){ ### get data: GH <- Mine.seis(at1, at2, DB, NULL , NULL, kind = 1, Iendian=1) w <- swig(GH, PADDLAB=c("X2SAC","X2RSEIS","YPIX" ) ) }if(interactive()){ ### get data: GH <- Mine.seis(at1, at2, DB, NULL , NULL, kind = 1, Iendian=1) w <- swig(GH, PADDLAB=c("X2SAC","X2RSEIS","YPIX" ) ) }
Cross correlation of two signals
xcor2(a1, a2, DT, PLOT = FALSE, LAG = 100)xcor2(a1, a2, DT, PLOT = FALSE, LAG = 100)
a1 |
input signal 1 |
a2 |
input signal 1 |
DT |
deltaT in seconds |
PLOT |
logical TRUE=plot |
LAG |
time lag for correlation function |
Illustrates the cross correlation of two time series.
ccf |
Return list from function ccf |
mlag |
maximum lag in time |
mccx |
value of ccf at max lag mlag |
mlag2 |
maximum absolute value lag |
mccx2 |
value of ccf at mlag2 |
Jonathan M. Lees<jonathan.lees.edu>
ccf
data(CE1) ts1 <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] ts2 <- CE1$y[CE1$x>5.760959] ts2 <- ts2[1:length(ts1)] ts1 <- ts1-mean(ts1) ts2 <- ts2-mean(ts2) xc <- xcor2(ts1, ts2, CE1$dt , PLOT = TRUE)data(CE1) ts1 <- CE1$y[CE1$x>5.443754 & CE1$x<5.615951] ts2 <- CE1$y[CE1$x>5.760959] ts2 <- ts2[1:length(ts1)] ts1 <- ts1-mean(ts1) ts2 <- ts2-mean(ts2) xc <- xcor2(ts1, ts2, CE1$dt , PLOT = TRUE)
Cross product of two vectors
xprod(A1, A2)xprod(A1, A2)
A1 |
3 component vector of x,y,z |
A2 |
3 component vector of x,y,z |
3 component vector of A1 cross A2
Jonathan M. Lees <[email protected]>
B1 <- c(4,9,2) B2 <- c(2,-5,4) xprod(B1, B2)B1 <- c(4,9,2) B2 <- c(2,-5,4) xprod(B1, B2)
defining functions for swig
XTR(nh, g) NEXT(nh, g) PREV(nh, g) HALF(nh, g) MARK(nh, g) DOC(nh, g) REFRESH(nh, g) RESTORE(nh, g) ZOOM.out(nh, g) ZOOM.in(nh, g) RIGHT(nh, g) LEFT(nh, g) SCALE(nh, g) PSEL(nh, g) FLIP(nh, g) PTS(nh, g) FILT(nh, g) UNFILT(nh, g) SPEC(nh, g) WWIN(nh, g) SGRAM(nh, g) WLET(nh, g) XTR(nh, g) Pinfo(nh, g) TSHIFT(nh, g) RMS(nh, g) LocStyle(nh, g) CENTER(nh, g) fspread(nh, g) Xwin(nh, g)XTR(nh, g) NEXT(nh, g) PREV(nh, g) HALF(nh, g) MARK(nh, g) DOC(nh, g) REFRESH(nh, g) RESTORE(nh, g) ZOOM.out(nh, g) ZOOM.in(nh, g) RIGHT(nh, g) LEFT(nh, g) SCALE(nh, g) PSEL(nh, g) FLIP(nh, g) PTS(nh, g) FILT(nh, g) UNFILT(nh, g) SPEC(nh, g) WWIN(nh, g) SGRAM(nh, g) WLET(nh, g) XTR(nh, g) Pinfo(nh, g) TSHIFT(nh, g) RMS(nh, g) LocStyle(nh, g) CENTER(nh, g) fspread(nh, g) Xwin(nh, g)
nh |
waveform list for RSEIS |
g |
plotting parameter list for interactive program |
Buttons can be defined on the fly.
The return value depends on the nature of the function as it is returned to the main code swig. Choices for returning to swig are: break, replot, revert, replace, donothing, exit.
Jonathan M. Lees<[email protected]>
swig
if(interactive()){ MYFUNC<-function(nh, g) { print("pressed MYFUNC") g$sel d <- data.frame(list(stations=nh$STNS[g$sel], components=nh$COMPS[g$sel])) print(d) g$action <- "replot" invisible(list(global.vars=g)) } STDLAB <- c("DONE", "QUIT", "SELBUT" , "PSEL", "MYFUNC" ) data(GH) JJ <- swig(GH, sel=1:10, STDLAB=STDLAB) }if(interactive()){ MYFUNC<-function(nh, g) { print("pressed MYFUNC") g$sel d <- data.frame(list(stations=nh$STNS[g$sel], components=nh$COMPS[g$sel])) print(d) g$action <- "replot" invisible(list(global.vars=g)) } STDLAB <- c("DONE", "QUIT", "SELBUT" , "PSEL", "MYFUNC" ) data(GH) JJ <- swig(GH, sel=1:10, STDLAB=STDLAB) }
Extract one time series trace from an RSEIS data list
xtract.trace(GH, sel = 1, WIN = c(0, 1))xtract.trace(GH, sel = 1, WIN = c(0, 1))
GH |
RSEIS list |
sel |
select trace index |
WIN |
time window on trace, relative to start |
An attribute of dt (sample time interval) is attached to the time series for use in plotting.
vector |
amplitudes |
Jonathan M. Lees<[email protected]>
data(GH) x1 <- xtract.trace(GH, sel = 1, WIN = c(0, 1)) plot(x1, type='l')data(GH) x1 <- xtract.trace(GH, sel = 1, WIN = c(0, 1)) plot(x1, type='l')
contract a date to decimal years
yeardate(yr, jd, hr, mi, sec)yeardate(yr, jd, hr, mi, sec)
yr |
year |
jd |
julian day |
hr |
hour |
mi |
minute |
sec |
second |
decimal time
Jonathan M. Lees<jonathan.lees.edu>
secdif
yeardate(2005, 98, 12, 16, 32)yeardate(2005, 98, 12, 16, 32)
defining functions for swig
YPIX(nh, g) WPIX(nh, g) NOPIX(nh, g) REPIX(nh, g) DELpix(nh, g) PickWin(nh, g) pADDPIX(nh, g, phase) Ppic(nh, g) Spic(nh, g) Apic(nh, g) POLSWITCH(nh, g, dir) Pup(nh, g) Pnil(nh, g) Pdown(nh, g) FILLPIX(nh, g) RIDPIX(nh, g) SEEPIX(nh, g) ROT.RT(nh, g) JustV(nh, g) JustE(nh, g) JustN(nh, g) JustF(nh, g) SHOW3(nh, g)YPIX(nh, g) WPIX(nh, g) NOPIX(nh, g) REPIX(nh, g) DELpix(nh, g) PickWin(nh, g) pADDPIX(nh, g, phase) Ppic(nh, g) Spic(nh, g) Apic(nh, g) POLSWITCH(nh, g, dir) Pup(nh, g) Pnil(nh, g) Pdown(nh, g) FILLPIX(nh, g) RIDPIX(nh, g) SEEPIX(nh, g) ROT.RT(nh, g) JustV(nh, g) JustE(nh, g) JustN(nh, g) JustF(nh, g) SHOW3(nh, g)
nh |
waveform list for RSEIS |
g |
plotting parameter list for interactive program |
phase |
phase name (P, S, A, etc...) |
dir |
vertical up, down or nil |
Buttons can be defined on the fly.
Multiple picks on a panel
window picks (start and end)
remove the picks
un-remove the picks
Delete pix near clicks
Pick window for 3 component picking
add picks
P-wave arrival (only one per station)
S-wave arrival (only one per station)
acoustic-wave arrival (only one per station)
flip polarity
Polarity Up
Polarity nil
Polarity down
Fill the pick from bottom to top of panel
remove pick
print current picks to screen
Rotate to radial and transverse (need event and station locations
Display only vertical components
Display only east components
Display only north components
Display only infrasound (F) components
Display All 3 components
Used internally in PickWin to move to next station
The return value depends on the nature of the function as it is returned to the main code swig. Choices for returning to swig are: break, replot, revert, replace, donothing, exit.
Jonathan M. Lees<[email protected]>
swig, XTR
if(interactive()){ MYFUNC<-function(nh, g) { print("pressed MYFUNC") d <- data.frame(list(stations=nh$STNS, components=nh$COMPS)) print(d) g$action <- "replot" invisible(list(global.vars=g)) } STDLAB <- c("DONE", "QUIT", "SELBUT" , "MYFUNC" ) data(GH) JJ <- swig(GH, sel=1:10, STDLAB=STDLAB) }if(interactive()){ MYFUNC<-function(nh, g) { print("pressed MYFUNC") d <- data.frame(list(stations=nh$STNS, components=nh$COMPS)) print(d) g$action <- "replot" invisible(list(global.vars=g)) } STDLAB <- c("DONE", "QUIT", "SELBUT" , "MYFUNC" ) data(GH) JJ <- swig(GH, sel=1:10, STDLAB=STDLAB) }
Difference between two Date/Times (Julian Day)
YRsecdif(jd1, hr1, mi1, sec1, jd2, hr2, mi2, sec2, yr1 = 0, yr2 = 0) YRsecdifL(T1, T2)YRsecdif(jd1, hr1, mi1, sec1, jd2, hr2, mi2, sec2, yr1 = 0, yr2 = 0) YRsecdifL(T1, T2)
jd1 |
Julian Day |
hr1 |
hour |
mi1 |
minute |
sec1 |
second |
jd2 |
Julian Day |
hr2 |
hour |
mi2 |
minute |
sec2 |
second |
yr1 |
year 1 |
yr2 |
year 2 |
T1 |
list 1 with date time |
T2 |
list 2 with date time |
Returns T2-T1, year is used.
numeric |
seconds |
Jonathan M. Lees<jonathan.lees.edu>
secdifL, secdif
T1 <- list(jd=12, hr=13, mi=23, sec=21, yr=1964 ) T2 <- list(jd=14, hr=23, mi=23, sec=2, yr=1976) YRsecdif(T1$jd, T1$hr, T1$mi, T1$sec, T2$jd, T2$hr, T2$mi, T2$sec, 1964, 1976) #### or YRsecdifL(T1, T2)T1 <- list(jd=12, hr=13, mi=23, sec=21, yr=1964 ) T2 <- list(jd=14, hr=23, mi=23, sec=2, yr=1976) YRsecdif(T1$jd, T1$hr, T1$mi, T1$sec, T2$jd, T2$hr, T2$mi, T2$sec, 1964, 1976) #### or YRsecdifL(T1, T2)
Make character vector from dates
Zdate(info, sel=1, t1=0, sep='_') dateList(datevec) dateStamp(datelist, sep='_')Zdate(info, sel=1, t1=0, sep='_') dateList(datevec) dateStamp(datelist, sep='_')
info |
info structure from trace structure |
sel |
selection of which ones to extract, default=1:length(info$jd) |
t1 |
time offset, seconds, default=0 |
sep |
character for separating the components in the string, default=":" |
datevec |
vector with yr, jd, mo, day, hr, mi, sec |
datelist |
output of dateList |
Format date stamp for plotting and identification. Used for STAMP.
character strings
If using Zdate to create a file name, becareful about the separator. A colon in the file name on PC and MAC systems can be confusing for the OS.
Jonathan M. Lees<jonathan.lees.edu>
swig, dateStamp, ghstamp, filedatetime
data("GH") sel <- which(GH$COMPS == "V") ftime <- Zdate(GH$info, sel[1:5], 1) dvec <- c(2009, 134, 5, 14, 10, 32, 24.5, 0) A <- dateList(dvec) dateStamp(A, sep=".") dateStamp(A, sep="_")data("GH") sel <- which(GH$COMPS == "V") ftime <- Zdate(GH$info, sel[1:5], 1) dvec <- c(2009, 134, 5, 14, 10, 32, 24.5, 0) A <- dateList(dvec) dateStamp(A, sep=".") dateStamp(A, sep="_")
Locator function with set parameters
zlocator(COL = 1, ID = FALSE, NUM = FALSE, YN = NULL, style = 0)zlocator(COL = 1, ID = FALSE, NUM = FALSE, YN = NULL, style = 0)
COL |
color |
ID |
logical, identify points |
NUM |
number of points |
YN |
number of windows to span for lines |
style |
0,1,2 for differnt style of plotting vertical lines |
if the window is divided into YN horizontal regions, style =2 will plot segments only within regions based on y-value of locator().
list:
x |
x-locations |
y |
y-locations |
n |
number of points |
Jonathan M. Lees<jonathan.lees.edu>
plocator, locator
plot(c(0,1), c(0,1), type='n') for(i in 1:5) { abline(h=i/6) } if(interactive() )zlocator(COL = 1, NUM = 4, YN = 6, style = 2)plot(c(0,1), c(0,1), type='n') for(i in 1:5) { abline(h=i/6) } if(interactive() )zlocator(COL = 1, NUM = 4, YN = 6, style = 2)
Zoom interactively on Seismic panel data.
ZOOM.SEISN(GH, sel = 1:length(GH$dt), WIN = NULL)ZOOM.SEISN(GH, sel = 1:length(GH$dt), WIN = NULL)
GH |
Seismic trace structure |
sel |
selection of traces |
WIN |
time window c(0,1) |
Seismic trace structure
Jonathan M. Lees<jonathan.lees.edu>
swig
data("GH") sel <- which(GH$COMPS=="V") KF <- ZOOM.SEISN(GH, sel=sel, WIN = c(0 , 5) ) if(interactive()){ swig(KF) }data("GH") sel <- which(GH$COMPS=="V") KF <- ZOOM.SEISN(GH, sel=sel, WIN = c(0 , 5) ) if(interactive()){ swig(KF) }