tests/testthat/test-earthtide.R

In earthtide: Parallel Implementation of 'ETERNA 3.40' for Prediction and Analysis of Earth Tides

context("test-earthtide")

test_that("earthtide works", {
  tms <- as.POSIXct("1990-01-01", tz = "UTC") + c(0, 3600)

  wave_groups <- data.frame(start = 0, end = 8)

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-10,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et$predict(method = "gravity")
  et$predict(method = "tidal_potential")
  et$predict(method = "tidal_tilt")
  et$predict(method = "vertical_displacement")
  et$predict(method = "horizontal_displacement")
  et$predict(method = "n_s_displacement")
  et$predict(method = "e_w_displacement")
  et$predict(method = "vertical_strain")
  et$predict(method = "areal_strain")
  et$predict(method = "horizontal_strain")
  et$predict(method = "volume_strain")
  et$predict(method = "ocean_tides")

  tide <- et$tide()
  expect_equal(tide$tidal_potential, c(1.422, 1.890), tolerance = 0.001)
  expect_equal(tide$tidal_tilt, c(-17.845, -20.578), tolerance = 0.001)
  expect_equal(tide$vertical_displacement, c(87.822, 110.715),
               tolerance = 0.001
  )
  expect_equal(tide$horizontal_displacement, c(-47.34171, -55.21554),
               tolerance = 2
  ) # from solidearthtide
  expect_equal(tide$n_s_displacement, c(-47.34171, -55.21554),
               tolerance = 2
  ) # from solidearthtide
  expect_equal(tide$e_w_displacement, c(31.11908, 13.03227),
               tolerance = 2
  ) # from solidearthtide
  expect_equal(tide$vertical_strain, c(-5.533, -6.964), tolerance = 0.001)
  expect_equal(tide$areal_strain, c(16.600, 20.893), tolerance = 0.001)
  expect_equal(tide$volume_strain, c(11.067, 13.929), tolerance = 0.001)
  expect_equal(tide$horizontal_strain, c(7.958, 11.823), tolerance = 0.001)
  expect_equal(tide$ocean_tides, c(146.327, 183.187), tolerance = 0.01)


  # non-equal spacing
  tms <- as.POSIXct("1990-01-01", tz = "UTC") + c(0, 3600, 7000)
  wave_groups <- data.frame(start = 0, end = 8)
  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-10,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  expect_silent(et$predict(method = "tidal_potential"))


  expect_silent(et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-4,
    catalog = "ksm04",
    wave_groups = wave_groups,
    eop = earthtide:::dut1
  ))

  expect_error(et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-4,
    catalog = "ksm04",
    wave_groups = wave_groups,
    eop = data.frame(datetime = 0)
  ))


  mult <- 1.5
  tms <- as.POSIXct("1990-01-01", tz = "UTC") + c(0, 3600)
  wave_groups <- data.frame(start = 0, end = 8, multiplier = 1.5)

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-10,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et$predict(method = "tidal_potential")

  tide <- et$tide()
  expect_equal(tide$tidal_potential, 1.5 * c(1.422, 1.890), tolerance = 0.001)




  wave_groups <- na.omit(
    eterna_wavegroups[eterna_wavegroups$time == "all", c("start", "end")]
  )

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )


  wave_groups <- na.omit(
    eterna_wavegroups[eterna_wavegroups$time == "all", c("start", "end")]
  )

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et$predict(method = "tidal_potential")
  et$lod_tide()
  et$pole_tide()
  et_r6 <- et$tide()

  et_fun <- calc_earthtide(
    utc = tms,
    do_predict = TRUE,
    method = c("tidal_potential", "lod_tide", "pole_tide"),
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  expect_equal(et_r6, et_fun)

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )
  et_mat <- et$predict(
    method = "tidal_potential",
    return_matrix = TRUE
  )
  expect_equivalent(as.matrix(et_r6[, c("tidal_potential")]), et_mat)

  et_mat2 <- calc_earthtide(
    utc = tms,
    do_predict = TRUE,
    method = c("tidal_potential"),
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups,
    return_matrix = TRUE
  )

  expect_equivalent(et_mat2, et_mat)


  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et$analyze(method = "tidal_potential")
  et_r6 <- et$tide()

  et_fun <- calc_earthtide(
    utc = tms,
    do_predict = FALSE,
    method = c("tidal_potential"),
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  expect_equal(et_r6, et_fun)




  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et_mat <- et$analyze(
    method = "tidal_potential",
    return_matrix = TRUE
  )
  expect_equivalent(as.matrix(et_r6[, -c(1)]), et_mat)

  et_mat2 <- calc_earthtide(
    utc = tms,
    do_predict = FALSE,
    method = c("tidal_potential"),
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups,
    return_matrix = TRUE
  )
  expect_equivalent(et_mat2, et_mat)





  expect_error(calc_earthtide(
    utc = tms,
    do_predict = FALSE,
    method = c("tidal_potential", "gravity"),
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-5,
    catalog = "ksm04",
    wave_groups = wave_groups
  ))



})

context("test-earthtide-threads")
test_that("earthtide works", {

  testthat::skip_on_cran()
  testthat::skip_on_travis()

    tms <- as.POSIXct("1990-01-01", tz = "UTC") + c(0, 3600)

  wave_groups <- data.frame(start = 0, end = 8)

  et <- Earthtide$new(
    utc = tms,
    latitude = 52.3868,
    longitude = 9.7144,
    elevation = 110,
    gravity = 9.8127,
    cutoff = 1.0e-10,
    catalog = "ksm04",
    wave_groups = wave_groups
  )

  et$predict(method = "gravity", n_thread = 1)
  tide_1_threads <- et$tide()
  et$predict(method = "gravity", n_thread = 2)
  tide_2_threads <- et$tide()

  expect_equal(tide_1_threads, tide_2_threads)

})