tests/testthat/test-flow-variables.R

In raem: Analytic Element Modeling of Steady Single-Layer Groundwater Flow

test_that("discharge works", {
  k <- 10
  top <- 10
  base <- 0
  n <- 0.2
  i <- 0.001

  m <- aem(k = k, top = top, base = base, n = n,
           uf = uniformflow(TR = k*(top-base), gradient = i, angle = 0), type = 'confined')
  Q <- discharge(m, 50, 50, 0)
  expect_equal(Q[[1]], k*i*(top-base))
  expect_equal(Q[[2]], 0)
  expect_equal(colnames(Q), c('Qx', 'Qy', 'Qz'))

  N <- 0.0005
  z <- seq(10, 0, -0.5)
  m <- aem(k = k, top = top, base = base, n = n,
           uf = uniformflow(TR = k*(top-base), gradient = i, angle = 0),
           as = areasink(0, 0, N = N, R = 1000), type = 'confined')
  Q <- discharge(m, 50, 50, z)
  expect_equal(Q[,'Qz'], -N*(z - base))

  N <- 0.0005
  z <- seq(10, 0, -0.5)
  leakage <- - 3 / (10/0.0001)
  m <- aem(k = k, top = top, base = base, n = n,
           uf = uniformflow(TR = k*(top-base), gradient = i, angle = 0),
           as = areasink(0, 0, N = N, R = 1000),
           asb = areasink(0, 0, N = leakage, R = 1000, loc = 'base'), type = 'confined')
  Q <- discharge(m, 50, 50, z)
  sat <- satthick(m, 50, 50)
  expect_equal(Q[,'Qz'], (z - base)*(-N - leakage) + leakage*sat)

})

test_that('array names for flow are correct', {
  k <- 10
  top <- 10
  base <- 0
  n <- 0.2
  i <- 0.001
  hc <- 20

  m <- aem(k = k, top = top, base = base, n = n,
           uf = uniformflow(TR = k*(top-base), gradient = i, angle = 0),
           rf = constant(-1000, 0, hc = hc))
  x <- seq(-500, 500, length = 100)
  y <- seq(-100, 100, length = 100)
  z <- 2

  Q <- discharge(m, x, y, z)
  Qg <- discharge(m, x, y, z, as.grid = TRUE, magnitude = TRUE)
  expect_equal(colnames(Q), c('Qx', 'Qy', 'Qz'))
  expect_equal(dimnames(Qg)[[4]], c('Qx', 'Qy', 'Qz', 'Q'))

  q <- darcy(m, x, y, z)
  qg <- darcy(m, x, y, z, as.grid = TRUE, magnitude = TRUE)
  expect_equal(colnames(q), c('qx', 'qy', 'qz'))
  expect_equal(dimnames(qg)[[4]], c('qx', 'qy', 'qz', 'q'))

  v <- velocity(m, x, y, z)
  vg <- velocity(m, x, y, z, as.grid = TRUE, magnitude = TRUE)
  expect_equal(colnames(v), c('vx', 'vy', 'vz'))
  expect_equal(dimnames(vg)[[4]], c('vx', 'vy', 'vz', 'v'))

  # discharge() never calls domega() with as.grid = TRUE
  # and since darcy and velocity first call discharge(), they don't either
  wg <- domega(m, x, y, as.grid = TRUE)
  expect_null(dimnames(wg))
  expect_equal(dim(wg), c(length(x), length(y)))


})

test_that('discharge from phreatic curvature is correct', {
  top <- 10
  base <- 0
  k <- 10
  z <- 5

  grad <- 0.001
  TR <- k * (top-base)
  m <- aem(k = k, top = top, base = base, n = 0.2,
           uf = uniformflow(TR = TR, gradient = grad, angle = 0),
           rf = constant(-500, 0, 10), type = 'variable')
  h <- heads(m, 0, 0)
  Qx <- TR*grad # uniformflow: constant Q, independent of saturated thickness

  q <- darcy(m, 0, 0, z)
  # last term != grad because Q is constant in uniformflow; i.e. independent of satthick
  qz_exact <- (z/h) * (Qx/h) * (-Qx/(k*h))
  expect_equal(q[[1, 'qz']], qz_exact)

  # test with well ----
  Qw <- 100
  xw <- 250; yw <- 0
  w <- well(xw, yw, Qw)
  m <- aem(k, top, base, n = 0.2, w, rf = constant(-500, 0, 8))

  x <- y <- 10
  z <- 5
  q <- darcy(m, x, y, z)
  h <- heads(m, x, y)

  dis.thiem <- function(x, y) {
    r <- sqrt((x - xw)^2 + (y - yw)^2)
    (-Qw/(2*pi*r)) * c((x - xw)/r, (y - yw)/r)
  }
  Q_thiem <- dis.thiem(x, y)
  qz_exact <- (z/h) * ((Q_thiem[1]/h) * (-Q_thiem[1]/(k*h)) + (Q_thiem[2]/h) * (-Q_thiem[2]/(k*h)))

  expect_equal(q[[1, 'qz']], qz_exact)

})

test_that('discharge sets Qz to NA when z outside aquifer', {
  top <- 10
  base <- 0
  m <- aem(k = 10, top = top, base = base, n = 0.2,
           uf = uniformflow(TR = 100, gradient = 0.001, angle = 0))
  expect_warning(Qt <- discharge(m, 0, 0, base - 1))
  expect_warning(Qb <- discharge(m, 0, 0, top + 1))
  expect_equal(Qt[[3]], NA_real_)
  expect_equal(Qb[[3]], NA_real_)
})

test_that('discharge returns array of correct dimensions', {
  k <- 10
  top <- 10
  base <- 0
  n <- 0.2
  i <- 0.001
  hc <- 20

  m <- aem(k = k, top = top, base = base, n = n,
           uf = uniformflow(TR = k*(top-base), gradient = i, angle = 0),
           rf = constant(-1000, 0, hc = hc))
  x <- 50
  y <- 50
  z <- c(0, 10)
  Q <- discharge(m, x, y, z)
  expect_equal(dim(Q), c(2, 3))
  Q <- discharge(m, x, y, z, magnitude = TRUE)
  expect_equal(dim(Q), c(2, 4))

  x <- seq(-500, 500, length = 100)
  y <- seq(-100, 100, length = 100)
  z <- 10
  Q <- discharge(m, x, y, z)
  expect_equal(dim(Q), c(100, 3))

  y <- seq(-100, 100, length = 52)
  z <- seq(10, 0, length = 10)
  # expect_warning(expect_warning(expect_warning(expect_warning(discharge(m, x, y, z))))) # 6 warnings
  Q <- discharge(m, x, y, z, as.grid = TRUE)
  expect_equal(dim(Q), c(52, 100, 10, 3))
  Q <- discharge(m, x, y, z, as.grid = TRUE, magnitude = TRUE)
  expect_equal(dim(Q), c(52, 100, 10, 4))

})