Rで有限要素法:片持ち梁-中間区間の等分布荷重:たわみ量

# ============================================================
# 片持ち梁のたわみ(中間区間の等分布荷重):FEM vs 厳密解
# ============================================================
#
# 厳密解(xは自由端Aから測った距離。区間ごとに式が異なる):
#   w1 = (pb/24EI){4(b^2+3bc+3c^2)(l-x) - (b^3+4b^2c+6bc^2+4c^3)}   [0<=x<=a]
#   w2 = (pb/24EI){6(b+2c)(l-x)^2 - 4(l-x)^3 + (1/b)(a+b-x)^4}       [a<=x<=a+b]
#   w3 = (pb/12EI){3(b+2c)(l-x)^2 - 2(l-x)^3}                        [a+b<=x<=l]
#   w_max = (pb/24EI){4(b^2+3bc+3c^2)l - (b^3+4b^2c+6bc^2+4c^3)}     [x=0, 自由端]
#
#   s : FEM座標(固定端起点、s=0で固定端、s=lで自由端)
#   x : 厳密解の座標(自由端起点、x = l - s)
#
# 分布荷重は「区間[a,a+b]だけでp、それ以外はゼロ」という関数として定義し、
# これまでと同じガウス求積による等価節点荷重の計算をそのまま使う。

library(ggplot2)

# ------------------------------------------------------------
# 1. 梁の諸元と荷重の設定
# ------------------------------------------------------------
l <- 2.0
a <- 0.4
b <- 0.8
c <- l - a - b # 区間③の長さ(自動計算)
p <- 600 # 荷重区間での分布荷重の強さ [N/m]
E <- 210e9
I <- 4.1667e-6
EI <- E * I

# 荷重区間のFEM座標(固定端起点)での範囲
s_load_lo <- l - (a + b) # = c
s_load_hi <- l - a # = b + c

# 分布荷重をFEM座標sの関数として定義。区間[s_load_lo, s_load_hi]でのみp、他は0。
q_dist <- function(s) ifelse(s >= s_load_lo & s <= s_load_hi, p, 0)

# ------------------------------------------------------------
# 2. 形状関数と要素剛性行列
# ------------------------------------------------------------
shape_N <- function(xi, Le) {
  N1 <- 1 - 3 * xi^2 + 2 * xi^3
  N2 <- Le * (xi - 2 * xi^2 + xi^3)
  N3 <- 3 * xi^2 - 2 * xi^3
  N4 <- Le * (-xi^2 + xi^3)
  c(N1, N2, N3, N4)
}

beam_element_k <- function(Le) {
  (EI / Le^3) * matrix(c(
    12, 6 * Le, -12, 6 * Le,
    6 * Le, 4 * Le^2, -6 * Le, 2 * Le^2,
    -12, -6 * Le, 12, -6 * Le,
    6 * Le, 2 * Le^2, -6 * Le, 4 * Le^2
  ), nrow = 4, byrow = TRUE)
}

# ------------------------------------------------------------
# 3. 等価節点荷重をガウス求積で数値的に計算する(5点ガウス求積)
# ------------------------------------------------------------
gauss_pts <- c(
  0,
  -1 / 3 * sqrt(5 - 2 * sqrt(10 / 7)),
  1 / 3 * sqrt(5 - 2 * sqrt(10 / 7)),
  -1 / 3 * sqrt(5 + 2 * sqrt(10 / 7)),
  1 / 3 * sqrt(5 + 2 * sqrt(10 / 7))
)
gauss_wts <- c(
  128 / 225,
  (322 + 13 * sqrt(70)) / 900,
  (322 + 13 * sqrt(70)) / 900,
  (322 - 13 * sqrt(70)) / 900,
  (322 - 13 * sqrt(70)) / 900
)

beam_element_f <- function(s0, Le) {
  f_e <- numeric(4)
  for (k in seq_along(gauss_pts)) {
    xi <- (gauss_pts[k] + 1) / 2
    jac <- Le / 2
    s <- s0 + xi * Le
    q <- q_dist(s)
    f_e <- f_e + shape_N(xi, Le) * q * jac * gauss_wts[k]
  }
  f_e
}

# ------------------------------------------------------------
# 4. メッシュ生成(荷重区間の境界にちょうど節点が来るように要素数を選ぶ)
# ------------------------------------------------------------
n_elem <- 10L # Le=0.2、s_load_lo=0.8, s_load_hi=1.6 はともにLeの倍数
Le <- l / n_elem
n_node <- n_elem + 1L
n_dof <- 2L * n_node

K <- matrix(0, n_dof, n_dof)
F <- numeric(n_dof)
K_e <- beam_element_k(Le)

for (e in seq_len(n_elem)) {
  s0 <- (e - 1) * Le
  f_e <- beam_element_f(s0, Le)
  dofs <- c(2 * e - 1, 2 * e, 2 * e + 1, 2 * e + 2)
  K[dofs, dofs] <- K[dofs, dofs] + K_e
  F[dofs] <- F[dofs] + f_e
}

# ------------------------------------------------------------
# 5. 境界条件(固定端: w=0, θ=0)
# ------------------------------------------------------------
fixed_dofs <- c(1, 2)
free_dofs <- setdiff(seq_len(n_dof), fixed_dofs)

u <- numeric(n_dof)
u[free_dofs] <- solve(K[free_dofs, free_dofs], F[free_dofs])

w_fem <- u[seq(1, n_dof, by = 2)]
th_fem <- u[seq(2, n_dof, by = 2)]

s_nodes <- seq(0, l, length.out = n_node)
x_nodes <- l - s_nodes

# ------------------------------------------------------------
# 6. 厳密解との比較(区間ごとに式を使い分ける)
# ------------------------------------------------------------
w_exact_fn <- function(x) {
  lx <- l - x
  ifelse(
    x <= a,
    (p * b) / (24 * EI) * (4 * (b^2 + 3 * b * c + 3 * c^2) * lx - (b^3 + 4 * b^2 * c + 6 * b * c^2 + 4 * c^3)),
    ifelse(
      x <= a + b,
      (p * b) / (24 * EI) * (6 * (b + 2 * c) * lx^2 - 4 * lx^3 + (1 / b) * (a + b - x)^4),
      (p * b) / (12 * EI) * (3 * (b + 2 * c) * lx^2 - 2 * lx^3)
    )
  )
}

comparison <- data.frame(
  自由端起点_x_m = round(x_nodes, 3),
  FEM近似解_mm = round(w_fem * 1000, 8),
  厳密解_mm = round(w_exact_fn(x_nodes) * 1000, 8),
  差_mm = w_fem * 1000 - w_exact_fn(x_nodes) * 1000
)
print(comparison)

cat("\n自由端でのたわみ量:\n")
cat("  FEM近似解:", w_fem[n_node] * 1000, "mm\n")
cat("  厳密解    :", w_exact_fn(0) * 1000, "mm\n")

# ------------------------------------------------------------
# 7. 可視化
# ------------------------------------------------------------
hermite_w <- function(xi, Le, w1, th1, w2, th2) {
  N1 <- 1 - 3 * xi^2 + 2 * xi^3
  N2 <- Le * (xi - 2 * xi^2 + xi^3)
  N3 <- 3 * xi^2 - 2 * xi^3
  N4 <- Le * (-xi^2 + xi^3)
  N1 * w1 + N2 * th1 + N3 * w2 + N4 * th2
}

fem_curve <- do.call(rbind, lapply(seq_len(n_elem), function(e) {
  xi_seq <- seq(0, 1, length.out = 20)
  w1v <- w_fem[e]
  th1v <- th_fem[e]
  w2v <- w_fem[e + 1]
  th2v <- th_fem[e + 1]
  s_local <- s_nodes[e] + xi_seq * Le
  data.frame(x = l - s_local, w_mm = hermite_w(xi_seq, Le, w1v, th1v, w2v, th2v) * 1000)
}))

x_fine <- seq(0, l, length.out = 300)
exact_curve <- data.frame(x = x_fine, w_mm = w_exact_fn(x_fine) * 1000)

p1 <- ggplot() +
  geom_line(data = exact_curve, aes(x = x, y = w_mm, color = "厳密解"), linewidth = 1.2) +
  geom_line(
    data = fem_curve, aes(x = x, y = w_mm, color = "FEM(要素内補間)"),
    linetype = "dashed", linewidth = 0.8
  ) +
  geom_point(
    data = data.frame(x = x_nodes, w_mm = w_fem * 1000),
    aes(x = x, y = w_mm, color = "FEM(節点)"), size = 2
  ) +
  geom_vline(xintercept = c(a, a + b), linetype = "dotted", color = "gray50") +
  scale_color_manual(values = c(
    "厳密解" = "gray40", "FEM(要素内補間)" = "steelblue",
    "FEM(節点)" = "firebrick"
  ), name = "") +
  labs(
    title = "中間区間の等分布荷重を受ける片持ち梁:FEM vs 厳密解",
    subtitle = paste0("要素数 = ", n_elem, "(荷重区間の境界にちょうど節点があり完全一致)"),
    x = "自由端からの距離 x [m]", y = "たわみ量 w [mm]"
  ) +
  theme_minimal(base_size = 12)

print(p1)