R/Z3Darrow.R In RFOC: Graphics for Spherical Distributions and Earthquake Focal Mechanisms

````Z3Darrow` <-
function(len = 1 , basethick = 0.1, headlen = .6, headlip=.1 )
{

if(missing(len)) {  len = 1 }
if(missing(basethick)) {  basethick = 0.1 }

aglyph = list()
anorm = list()

###########  base rect part
###########  Bottom
i = 1
aglyph[[i]] = matrix(c(-basethick, -basethick, 0,
-basethick, basethick,0,
basethick, basethick,0,
basethick, -basethick, 0) ,  ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(0,0,-1)

##  upper
i = 1+i
aglyph[[i]] = matrix(c(   -basethick, basethick,0,
-basethick, basethick,len,
basethick, basethick, len,
basethick,  basethick, 0) ,ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(0,1,0)

###  left
i = 1+i
aglyph[[i]] = matrix(c(  -basethick, -basethick,0,
-basethick, -basethick,len,
-basethick,  basethick,len,
-basethick, basethick, 0) ,ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(-1,0,0)

### lower
i = 1+i
aglyph[[i]] = matrix(c( basethick, -basethick,0,
basethick, -basethick,len,
-basethick,  -basethick,len,
-basethick,  -basethick, 0 ) ,ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(0,-1,0)

i = 1+i
aglyph[[i]] = matrix(c( basethick, -basethick, 0,
basethick, basethick, 0,
basethick, basethick,len,
basethick, -basethick, len ) ,ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(1,0,0)

###########  top
i = 1+i
aglyph[[i]] = matrix(c(-basethick,-basethick, len,
basethick , -basethick,len,
basethick , basethick,len,
-basethick, basethick,len) ,  ncol=3, nrow=4, byrow=TRUE)
anorm[[i]] = c(0,0,1)

## if(FALSE){
###  bottom of pyramid
i = 1+i
anorm[[i]] = c(0,0,-1)
##  right panel
i = 1+i
aglyph[[i]] = matrix(c(  0,  0, len+headlen,
) ,  ncol=3, nrow=3, byrow=TRUE)
anorm[[i]]  = RSEIS::xprod( aglyph[[i]][2,]-aglyph[[i]][1,], aglyph[[i]][3,]-aglyph[[i]][1,])
##  upper
i = 1+i
aglyph[[i]] = matrix(c(    0,         0, len+headlen,
anorm[[i]]  = RSEIS::xprod( aglyph[[i]][2,]-aglyph[[i]][1,], aglyph[[i]][3,]-aglyph[[i]][1,])

###  left
i = 1+i
anorm[[i]]  = RSEIS::xprod( aglyph[[i]][2,]-aglyph[[i]][1,], aglyph[[i]][3,]-aglyph[[i]][1,])

##  lower
i = 1+i
anorm[[i]]  = RSEIS::xprod( aglyph[[i]][2,]-aglyph[[i]][1,], aglyph[[i]][3,]-aglyph[[i]][1,])

## }

centroid = rep(0, length=3)
np = 0
for(i in 1:length(aglyph))
{
centroid[1] = centroid[1]+sum(aglyph[[i]][,1])
centroid[2] = centroid[2]+sum(aglyph[[i]][,2])
centroid[3] = centroid[3]+sum(aglyph[[i]][,3])
np = np+length(aglyph[[i]][,1])
}

centroid = centroid/np

attr(aglyph, "centroid") = centroid
attr(aglyph, "np") = np
#####   if(TRUE)
#####   {
#########  test to make sure all the vectors are point in correct direction
#####   for(i in 1:length(aglyph))
#####   {
#####    XX = RSEIS::xprod( aglyph[[i]][2,]-aglyph[[i]][1,], aglyph[[i]][3,]-aglyph[[i]][2,])
#####print(paste(sep=' ', c(i, XX) ))
#####  }
#####   }

return(list(aglyph=aglyph, anorm=anorm ) )

}
```

Try the RFOC package in your browser

Any scripts or data that you put into this service are public.

RFOC documentation built on Jan. 20, 2018, 9:46 a.m.