test codes

NOBUILD/Dev/01.test_codes.R

@@ -79,13 +79,16 @@ d. <- d.[d. < max(d.)]
 Du <- lapply(d., do_calc_by_depth)
 #str(Du,1)
 
-recomp <- FALSE
+recomp <- TRUE
 
+qt.nbgf <- resQt(m_dot=2e9/(5*365*86400), # 2014--2021
+		resRadius=hw, 
+		timespan=12*30*86400)
 if (!exists('cu.o') | recomp){
 cu.o <- pbapply::pbsapply(Du, cfs_isoporo, 
 	Beta.deg=opt_ang, fric=fric, Skemp=skemp, 
 	Shearmod = 10e9, nu_u = poiss, 
-	Qt = resQt(m_dot=1e6/(12*30*86400), resRadius=hw, timespan=12*30*86400),
+	Qt = qt.nbgf,
 	verbose=FALSE)
 }
 
@@ -94,7 +97,8 @@ r0 <- raster::raster(cu.o)
 rF <- raster::focal(r0, 
 	w=matrix(1, nrow=3, ncol=3), # equal-weighted average of all surrounding points
 	fun=mean, NAonly=TRUE, na.rm=TRUE) 
-cu <- as.matrix(rF)
+
+cu <- as.matrix(rF) / 1e6 # convert to ?Pa
 
 #cu <- sapply(Du, mean_stress)
 #cu <- sapply(Du, max_shear)
@@ -116,8 +120,9 @@ lCup <- c(xy, list(z = log10(cu)))
 lCun <- c(xy, list(z = log10(-cu)))
 
 fields::image.plot(Cu, asp=1, ylim=rev(range(Cu[['y']], na.rm=TRUE)),
-	col = c(NA,viridis::cividis(64, direction=-1)), 
-	zlim=max(abs(cu),na.rm=TRUE)*c(0,1))
+	col = c(NA,viridis::cividis(64, direction=-1)))
+	#, 
+	#zlim=max(abs(cu),na.rm=TRUE)*c(-1,1))
 #image(Cupos, add=TRUE, col=adjustcolor(c('white',NA), alpha=0.5))
 #contour(lCup, add=TRUE)
 #contour(lCun, lty=3, add=TRUE)

NOBUILD/Dev/LambertCodes.R

@@ -196,6 +196,7 @@ LambertTsai2020_Uniform <- function(x1, x2, resTopDepth, resThickness, resHalfWi
 	ret
 }
 
+
 #--------------------------------------------------------------
 # Plane-stress computations
 
@@ -249,6 +250,7 @@ planestress_principal_stresses.LT.diffusive <- planestress_principal_stresses.LT
 		vals
 	}
 	s1s2s3 <- t(apply(S, 1, .get_eig))
+	print(summary(s1s2s3))
 	colnames(s1s2s3) <- c('PS1','PS2','PS3')
 	cbind(s11=s1, s12=s12, s22=s2, s1s2s3)
 }
@@ -276,14 +278,20 @@ prefactor.LT.uniform <- function(x, Shearmod, nu_u, Skemp, rho_f, Qt=1, verbose=
 		rho_f <- 1000.0
 	}
 	if (!is.null(warns)) warning(warns, call.=FALSE)
-	# between eqs 8 / 9
+	#
+	# Scaling in Equation 14
+	#
+	resRadius <- x[['res']]$half.width
+	C <- Shearmod * (1 + nu_u) * Skemp / (2 * resRadius * 3 * pi * rho_f * (1 - nu_u))
+
 	# result still needs to be multiplied by Q*t
 	# where Q is net mass flux from the producing region, t is time
 	# Q = dm/dt / Area = rho_f * volume
 	# dm/dt = rho_f * volume * area
 	# good simple description: https://web.mit.edu/16.unified/www/FALL/fluids/Lectures/f06.pdf
-	C <- Shearmod * (1 + nu_u) * Skemp / (3 * pi * rho_f * (1 - nu_u))
-	C * Qt / 2
+
+	C * Qt
+
 }
 prefactor.LT.diffusive <- function(x, ...) .NotYetImplemented()
 
@@ -311,11 +319,13 @@ fault_stresses.LT.diffusive <- fault_stresses.LT.uniform <- function(x, Beta=45,
 cfs_isoporo.LT.diffusive <- cfs_isoporo.LT.uniform <- function(x, Beta.deg, fric, Skemp, verbose=TRUE, ...){
 	if (verbose) message('CFS {S1-to-fault angle = ', Beta.deg, '°, friction = ', fric, "} for isotropic undrained poroelastic response {B = ", Skemp, "}")
 	nfs <- fault_stresses(x, Beta=Beta.deg, is.deg=TRUE)
+	#print(summary(nfs))
 	C <- prefactor(x, Skemp = Skemp, ...)
 	fs <- C * nfs
 	Tau <- fs[,'Tau']
 	Snorm <- fs[,'Snorm']
 	Smean <- fs[,'Smean']
-	cfsip <- cfs_isoporo.default(tau=Tau, mu=fric, Snormal = Snorm, Smean = Smean, B=Skemp)
+	cfsip <- cfs_isoporo.default(tau=Tau, mu=fric, Snormal = Snorm, Smean = Smean, B = Skemp)
+	#print(summary(cfsip))
 	zapsmall(cfsip)
 }

NOBUILD/Dev/beeler_cfs.R

@@ -13,7 +13,10 @@ cfs_basic <- function(tau, mu, Snormal, pp){
 cfs_isoporo <- function(x, ...) UseMethod("cfs_isoporo")
 cfs_isoporo.default <- function(tau, mu, Snormal, Smean, B, ...){
 	pp.iso <- pp_isotropic(Smean, B)
-	cfs_basic(tau, mu, Snormal, pp.iso)
+	cf <- cfs_basic(tau, mu, Snormal, pp.iso)
+	print("")
+	print(summary(cbind(Smean, B, pp.iso, tau, cf)))	
+	cf
 }
 
 apparent_friction_basic <- function(mu, pp, Snormal){