# type
mutable struct DQMCStack{GreensEltype<:Number, HoppingEltype<:Number} <: AbstractDQMCStack
  eye_flv::Matrix{Float64}
  eye_full::Matrix{Float64}
  ones_vec::Vector{Float64}

  u_stack::Array{GreensEltype, 3}
  d_stack::Matrix{Float64}
  t_stack::Array{GreensEltype, 3}

  Ul::Matrix{GreensEltype}
  Ur::Matrix{GreensEltype}
  Dl::Vector{Float64}
  Dr::Vector{Float64}
  Tl::Matrix{GreensEltype}
  Tr::Matrix{GreensEltype}

  greens::Matrix{GreensEltype}
  greens_temp::Matrix{GreensEltype}
  log_det::Float64 # contains logdet of greens_{mc.p.slices+1} === greens_1
                            # after we calculated a fresh greens in propagate()

  U::Matrix{GreensEltype}
  D::Vector{Float64}
  T::Matrix{GreensEltype}
  tmp::Matrix{GreensEltype}

  ranges::Array{UnitRange, 1}
  n_elements::Int
  current_slice::Int # running internally over 0:mc.p.slices+1, where 0 and mc.p.slices+1 are artifcial to prepare next sweep direction.
  direction::Int

  # # -------- Global update backup
  # gb_u_stack::Array{GreensEltype, 3}
  # gb_d_stack::Matrix{Float64}
  # gb_t_stack::Array{GreensEltype, 3}

  # gb_greens::Matrix{GreensEltype}
  # gb_log_det::Float64

  # gb_conf::Array{Float64, 3}
  # # --------

  # preallocated, reused arrays
  curr_U::Matrix{GreensEltype}
  eV::Matrix{GreensEltype}

  # hopping matrices
  hopping_matrix_exp::Matrix{HoppingEltype} # mu included
  hopping_matrix_exp_inv::Matrix{HoppingEltype} # mu included

  # checkerboard hopping matrices
  checkerboard::Matrix{Int} # src, trg, bondid
  groups::Vector{UnitRange}
  n_groups::Int
  chkr_hop_half::Vector{SparseMatrixCSC{HoppingEltype, Int64}}
  chkr_hop_half_inv::Vector{SparseMatrixCSC{HoppingEltype, Int64}}
  chkr_hop_half_dagger::Vector{SparseMatrixCSC{HoppingEltype, Int64}}
  chkr_hop::Vector{SparseMatrixCSC{HoppingEltype, Int64}} # without prefactor 0.5 in matrix exponentials
  chkr_hop_inv::Vector{SparseMatrixCSC{HoppingEltype, Int64}}
  chkr_hop_dagger::Vector{SparseMatrixCSC{HoppingEltype, Int64}}
  chkr_mu_half::SparseMatrixCSC{HoppingEltype, Int64}
  chkr_mu_half_inv::SparseMatrixCSC{HoppingEltype, Int64}
  chkr_mu::SparseMatrixCSC{HoppingEltype, Int64}
  chkr_mu_inv::SparseMatrixCSC{HoppingEltype, Int64}

  DQMCStack{GreensEltype, HoppingEltype}() where {GreensEltype<:Number, HoppingEltype<:Number} = begin
    # @assert isleaftype(GreensEltype);
    # @assert isleaftype(HoppingEltype);
    @assert isconcretetype(GreensEltype);
    @assert isconcretetype(HoppingEltype);
    new()
  end
end

# type helpers
geltype(::Type{DQMCStack{G,H}}) where {G,H} = G
heltype(::Type{DQMCStack{G,H}}) where {G,H} = H
geltype(mc::DQMC{M, CB, CT, S}) where {M, CB, CT, S} = geltype(S)
heltype(mc::DQMC{M, CB, CT, S}) where {M, CB, CT, S} = heltype(S)

# type initialization
function initialize_stack(mc::DQMC)
  GreensEltype = geltype(mc)
  HoppingEltype = heltype(mc)
  N = mc.model.l.sites
  flv = mc.model.flv

  mc.s.eye_flv = Matrix{Float64}(I, flv,flv)
  mc.s.eye_full = Matrix{Float64}(I, flv*N,flv*N)
  mc.s.ones_vec = ones(flv*N)

  mc.s.n_elements = convert(Int, mc.p.slices / mc.p.safe_mult) + 1

  mc.s.u_stack = zeros(GreensEltype, flv*N, flv*N, mc.s.n_elements)
  mc.s.d_stack = zeros(Float64, flv*N, mc.s.n_elements)
  mc.s.t_stack = zeros(GreensEltype, flv*N, flv*N, mc.s.n_elements)

  mc.s.greens = zeros(GreensEltype, flv*N, flv*N)
  mc.s.greens_temp = zeros(GreensEltype, flv*N, flv*N)

  mc.s.Ul = Matrix{GreensEltype}(I, flv*N, flv*N)
  mc.s.Ur = Matrix{GreensEltype}(I, flv*N, flv*N)
  mc.s.Tl = Matrix{GreensEltype}(I, flv*N, flv*N)
  mc.s.Tr = Matrix{GreensEltype}(I, flv*N, flv*N)
  mc.s.Dl = ones(Float64, flv*N)
  mc.s.Dr = ones(Float64, flv*N)

  mc.s.U = zeros(GreensEltype, flv*N, flv*N)
  mc.s.D = zeros(Float64, flv*N)
  mc.s.T = zeros(GreensEltype, flv*N, flv*N)
  mc.s.tmp = zeros(GreensEltype, flv*N, flv*N)

  # # Global update backup
  # mc.s.gb_u_stack = zero(mc.s.u_stack)
  # mc.s.gb_d_stack = zero(mc.s.d_stack)
  # mc.s.gb_t_stack = zero(mc.s.t_stack)
  # mc.s.gb_greens = zero(mc.s.greens)
  # mc.s.gb_log_det = 0.
  # mc.s.gb_conf = zero(mc.conf)

  mc.s.ranges = UnitRange[]

  for i in 1:mc.s.n_elements - 1
    push!(mc.s.ranges, 1 + (i - 1) * mc.p.safe_mult:i * mc.p.safe_mult)
  end

  mc.s.curr_U = zero(mc.s.U)
  mc.s.eV = zeros(GreensEltype, flv*N, flv*N)

  # mc.s.hopping_matrix_exp = zeros(HoppingEltype, flv*N, flv*N)
  # mc.s.hopping_matrix_exp_inv = zeros(HoppingEltype, flv*N, flv*N)
  nothing
end

# hopping
function init_hopping_matrices(mc::DQMC{M,CB}, m::Model) where {M, CB<:Checkerboard}
  init_hopping_matrix_exp(mc, m)
  CB <: CheckerboardTrue && init_checkerboard_matrices(mc, m)
  nothing
end
function init_hopping_matrix_exp(mc::DQMC, m::Model)
  N = m.l.sites
  flv = m.flv
  dtau = mc.p.delta_tau

  T = hopping_matrix(mc, m)
  size(T) == (flv*N, flv*N) || error("Hopping matrix should have size "*
                                "$((flv*N, flv*N)) but has size $(size(T)) .")
  mc.s.hopping_matrix_exp = exp(-0.5 * dtau * T)
  mc.s.hopping_matrix_exp_inv = exp(0.5 * dtau * T)
  nothing
end

# checkerboard
rem_eff_zeros!(X::AbstractArray) = map!(e -> abs.(e)<1e-15 ? zero(e) : e,X,X)
function init_checkerboard_matrices(mc::DQMC, m::Model)
  s = mc.s
  l = m.l
  flv = m.flv
  H = heltype(mc)
  N = m.l.sites
  dtau = mc.p.delta_tau
  mu = m.mu

  s.checkerboard, s.groups, s.n_groups = build_checkerboard(l)
  n_grps = s.n_groups
  cb = s.checkerboard

  T = reshape(hopping_matrix(mc, m), (N, flv, N, flv))

  s.chkr_hop_half = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
  s.chkr_hop_half_inv = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
  s.chkr_hop = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)
  s.chkr_hop_inv = Vector{SparseMatrixCSC{H, Int}}(undef, n_grps)

  for (g, gr) in enumerate(s.groups)
    Tg = zeros(H, N, flv, N, flv)
    for i in gr
      src, trg = cb[1:2,i]
      for f1 in 1:flv, f2 in 1:flv
        Tg[trg, f1, src, f2] = T[trg, f1, src, f2]
      end
    end

    Tgg = reshape(Tg, (N*flv, N*flv))
    s.chkr_hop_half[g] = sparse(rem_eff_zeros!(exp(-0.5 * dtau * Tgg)))
    s.chkr_hop_half_inv[g] = sparse(rem_eff_zeros!(exp(0.5 * dtau * Tgg)))
    s.chkr_hop[g] = sparse(rem_eff_zeros!(exp(- dtau * Tgg)))
    s.chkr_hop_inv[g] = sparse(rem_eff_zeros!(exp(dtau * Tgg)))
  end

  s.chkr_hop_half_dagger = adjoint.(s.chkr_hop_half)
  s.chkr_hop_dagger = adjoint.(s.chkr_hop)

  mus = diag(reshape(T, (N*flv, N*flv)))
  s.chkr_mu_half = spdiagm(0 => exp.(-0.5 * dtau * mus))
  s.chkr_mu_half_inv = spdiagm(0 => exp.(0.5 * dtau * mus))
  s.chkr_mu = spdiagm(0 => exp.(-dtau * mus))
  s.chkr_mu_inv = spdiagm(0 => exp.(dtau * mus))

  # hop_mat_exp_chkr = foldl(*,s.chkr_hop_half) * sqrt.(s.chkr_mu)
  # r = effreldiff(s.hopping_matrix_exp,hop_mat_exp_chkr)
  # r[find(x->x==zero(x),hop_mat_exp_chkr)] = 0.
  # println("Checkerboard - Exact ≈ ", round(maximum(absdiff(s.hopping_matrix_exp,hop_mat_exp_chkr)), 4))
  nothing
end

# stack construction
"""
Build stack from scratch.
"""
function build_stack(mc::DQMC)
  mc.s.u_stack[:, :, 1] = mc.s.eye_full
  mc.s.d_stack[:, 1] = mc.s.ones_vec
  mc.s.t_stack[:, :, 1] = mc.s.eye_full

  @inbounds for i in 1:length(mc.s.ranges)
    add_slice_sequence_left(mc, i)
  end

  mc.s.current_slice = mc.p.slices + 1
  mc.s.direction = -1

  nothing
end
"""
Updates stack[idx+1] based on stack[idx]
"""
function add_slice_sequence_left(mc::DQMC, idx::Int)
  copyto!(mc.s.curr_U, mc.s.u_stack[:, :, idx])

  # println("Adding slice seq left $idx = ", mc.s.ranges[idx])
  for slice in mc.s.ranges[idx]
    multiply_slice_matrix_left!(mc, mc.model, slice, mc.s.curr_U)
  end

  mc.s.curr_U *= spdiagm(0 => mc.s.d_stack[:, idx])
  mc.s.u_stack[:, :, idx + 1], mc.s.d_stack[:, idx + 1], T = udt(mc.s.curr_U)
  mc.s.t_stack[:, :, idx + 1] =  T * mc.s.t_stack[:, :, idx]
end
"""
Updates stack[idx] based on stack[idx+1]
"""
function add_slice_sequence_right(mc::DQMC, idx::Int)
  copyto!(mc.s.curr_U, mc.s.u_stack[:, :, idx + 1])

  for slice in reverse(mc.s.ranges[idx])
    multiply_daggered_slice_matrix_left!(mc, mc.model, slice, mc.s.curr_U)
  end

  mc.s.curr_U *=  spdiagm(0 => mc.s.d_stack[:, idx + 1])
  mc.s.u_stack[:, :, idx], mc.s.d_stack[:, idx], T = udt(mc.s.curr_U)
  mc.s.t_stack[:, :, idx] = T * mc.s.t_stack[:, :, idx + 1]
end

# Green's function calculation
"""
Calculates G(slice) using mc.s.Ur,mc.s.Dr,mc.s.Tr=B(slice)' ... B(M)' and
mc.s.Ul,mc.s.Dl,mc.s.Tl=B(slice-1) ... B(1)
"""
function calculate_greens(mc::DQMC)
    # U, D, T = udt(mc.s.greens) after this
    mc.s.U, mc.s.D, mc.s.T = udt_inv_one_plus(
        UDT(mc.s.Ul, mc.s.Dl, mc.s.Tl),
        UDT(mc.s.Ur, mc.s.Dr, mc.s.Tr),
        tmp = mc.s.U, tmp2 = mc.s.T, tmp3 = mc.s.tmp,
        internaluse = true
    )
    mul!(mc.s.tmp, mc.s.U, Diagonal(mc.s.D))
    mul!(mc.s.greens, mc.s.tmp, mc.s.T)
    mc.s.greens
end

"""
Only reasonable immediately after calculate_greens()!
"""
function calculate_logdet(mc::DQMC)
    mc.s.log_det = real(
        log(complex(det(mc.s.U))) +
        sum(log.(mc.s.D)) +
        log(complex(det(mc.s.T)))
    )
  # mc.s.log_det = real(logdet(mc.s.U) + sum(log.(mc.s.D)) + logdet(mc.s.T))
end

# Green's function propagation
@inline function wrap_greens!(mc::DQMC, gf::Matrix, curr_slice::Int, direction::Int)
  if direction == -1
    multiply_slice_matrix_inv_left!(mc, mc.model, curr_slice - 1, gf)
    multiply_slice_matrix_right!(mc, mc.model, curr_slice - 1, gf)
  else
    multiply_slice_matrix_left!(mc, mc.model, curr_slice, gf)
    multiply_slice_matrix_inv_right!(mc, mc.model, curr_slice, gf)
  end
  nothing
end
# @inline function wrap_greens(mc::DQMC, gf::Matrix,slice::Int,direction::Int)
#   temp = copy(gf)
#   wrap_greens!(mc, temp, slice, direction)
#   return temp
# end
function propagate(mc::DQMC)
  if mc.s.direction == 1
    if mod(mc.s.current_slice, mc.p.safe_mult) == 0
      mc.s.current_slice +=1 # slice we are going to
      if mc.s.current_slice == 1
        mc.s.Ur[:, :], mc.s.Dr[:], mc.s.Tr[:, :] = mc.s.u_stack[:, :, 1], mc.s.d_stack[:, 1], mc.s.t_stack[:, :, 1]
        mc.s.u_stack[:, :, 1] = mc.s.eye_full
        mc.s.d_stack[:, 1] = mc.s.ones_vec
        mc.s.t_stack[:, :, 1] = mc.s.eye_full
        mc.s.Ul[:,:], mc.s.Dl[:], mc.s.Tl[:,:] = mc.s.u_stack[:, :, 1], mc.s.d_stack[:, 1], mc.s.t_stack[:, :, 1]

        calculate_greens(mc) # greens_1 ( === greens_{m+1} )
        calculate_logdet(mc)

      elseif 1 < mc.s.current_slice <= mc.p.slices
        idx = Int((mc.s.current_slice - 1)/mc.p.safe_mult)

        mc.s.Ur[:, :], mc.s.Dr[:], mc.s.Tr[:, :] = mc.s.u_stack[:, :, idx+1], mc.s.d_stack[:, idx+1], mc.s.t_stack[:, :, idx+1]
        add_slice_sequence_left(mc, idx)
        mc.s.Ul[:,:], mc.s.Dl[:], mc.s.Tl[:,:] = mc.s.u_stack[:, :, idx+1], mc.s.d_stack[:, idx+1], mc.s.t_stack[:, :, idx+1]

        if mc.p.all_checks
          mc.s.greens_temp = copy(mc.s.greens)
        end

        wrap_greens!(mc, mc.s.greens_temp, mc.s.current_slice - 1, 1)

        calculate_greens(mc) # greens_{slice we are propagating to}

        if mc.p.all_checks
          greensdiff = maximum(abs.(mc.s.greens_temp - mc.s.greens)) # OPT: could probably be optimized through explicit loop
          if greensdiff > 1e-7
            @printf("->%d \t+1 Propagation instability\t %.1e\n", mc.s.current_slice, greensdiff)
          end
        end

      else # we are going to mc.p.slices+1
        idx = mc.s.n_elements - 1
        add_slice_sequence_left(mc, idx)
        mc.s.direction = -1
        mc.s.current_slice = mc.p.slices+1 # redundant
        propagate(mc)
      end

    else
      # Wrapping
      wrap_greens!(mc, mc.s.greens, mc.s.current_slice, 1)
      mc.s.current_slice += 1
    end

  else # mc.s.direction == -1
    if mod(mc.s.current_slice-1, mc.p.safe_mult) == 0
      mc.s.current_slice -= 1 # slice we are going to
      if mc.s.current_slice == mc.p.slices
        mc.s.Ul[:, :], mc.s.Dl[:], mc.s.Tl[:, :] = mc.s.u_stack[:, :, end], mc.s.d_stack[:, end], mc.s.t_stack[:, :, end]
        mc.s.u_stack[:, :, end] = mc.s.eye_full
        mc.s.d_stack[:, end] = mc.s.ones_vec
        mc.s.t_stack[:, :, end] = mc.s.eye_full
        mc.s.Ur[:,:], mc.s.Dr[:], mc.s.Tr[:,:] = mc.s.u_stack[:, :, end], mc.s.d_stack[:, end], mc.s.t_stack[:, :, end]

        calculate_greens(mc) # greens_{mc.p.slices+1} === greens_1
        calculate_logdet(mc) # calculate logdet for potential global update

        # wrap to greens_{mc.p.slices}
        wrap_greens!(mc, mc.s.greens, mc.s.current_slice + 1, -1)

      elseif 0 < mc.s.current_slice < mc.p.slices
        idx = Int(mc.s.current_slice / mc.p.safe_mult) + 1
        mc.s.Ul[:, :], mc.s.Dl[:], mc.s.Tl[:, :] = mc.s.u_stack[:, :, idx], mc.s.d_stack[:, idx], mc.s.t_stack[:, :, idx]
        add_slice_sequence_right(mc, idx)
        mc.s.Ur[:,:], mc.s.Dr[:], mc.s.Tr[:,:] = mc.s.u_stack[:, :, idx], mc.s.d_stack[:, idx], mc.s.t_stack[:, :, idx]

        if mc.p.all_checks
          mc.s.greens_temp = copy(mc.s.greens)
        end

        calculate_greens(mc)

        if mc.p.all_checks
          greensdiff = maximum(abs.(mc.s.greens_temp - mc.s.greens)) # OPT: could probably be optimized through explicit loop
          if greensdiff > 1e-7
            @printf("->%d \t-1 Propagation instability\t %.1e\n", mc.s.current_slice, greensdiff)
          end
        end

        wrap_greens!(mc, mc.s.greens, mc.s.current_slice + 1, -1)

      else # we are going to 0
        idx = 1
        add_slice_sequence_right(mc, idx)
        mc.s.direction = 1
        mc.s.current_slice = 0 # redundant
        propagate(mc)
      end

    else
      # Wrapping
      wrap_greens!(mc, mc.s.greens, mc.s.current_slice, -1)
      mc.s.current_slice -= 1
    end
  end
  nothing
end


# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# Description
# ==============================================================================
#
#   Tests related to ECI to ECI transformations using satellite state vector.
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# References
# ==============================================================================
#
#   [1] Vallado, D. A (2013). Fundamentals of Astrodynamics and Applications.
#       Microcosm Press, Hawthorn, CA, USA.
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

# Get the current EOP Data.
#
# TODO: The EOP data obtained from IERS website does not match the values in the
# examples in [1]. However, this should be enough, because 1) the individual
# functions at the low level are tested using the same values of [1], and 2) the
# difference is smaller than 30 cm.

eop_iau1980  = read_iers_eop("./eop_IAU1980.txt",  Val(:IAU1980))
eop_iau2000a = read_iers_eop("./eop_IAU2000A.txt", Val(:IAU2000A))

# File: ./src/transformations/sv_eci_to_eci.jl
# ============================================

################################################################################
#                                  IAU-76/FK5
################################################################################

# Functions: sv_eci_to_eci
# ------------------------

# The rotations functions were already heavily tested on `eci_to_eci.jl` file.
# Hence, here we will do only some minor testing involving the following
# transformations:
#
#   GCRF <=> J2000 (FK5)
#   MOD  <=> TOD   (FK5)
#   GCRF <=> CIRS  (IAU2006)

# GCRF <=> J2000
# ==============

################################################################################
#                                 Test Results
################################################################################
#
# Scenario 01
# ===========
#
# Example 3-15: Performing IAU-76/FK5 reduction.
#
# According to this example and Table 3-6, using:
#
#   UTC    = April 6, 2004, 07:51:28.386009
#   r_gcrf = 5102.50895790   i + 6123.01140070   j + 6378.13692820   k [km]
#   v_gcrf =   -4.7432201570 i +    0.7905364970 j +    5.5337557270 k [km/s]
#
# one gets:
#
#   r_j2000 = 5102.50960000   i + 6123.01152000   j + 6378.13630000   k [km]
#   v_j2000 =   -4.7432196000 i +    0.7905366000 j +    5.5337561900 k [km/s]
#
################################################################################

@testset "Function sv_eci_to_eci GCRF <=> J2000" begin
    JD_UTC = date_to_jd(2004, 4, 6, 7, 51, 28.386009)

    ## GCRF => J2000
    ## =============

    r_gcrf   = [5102.50895790; 6123.01140070; 6378.13692820]
    v_gcrf   = [-4.7432201570; 0.7905364970; 5.5337557270]
    sv_gcrf  = orbsv(JD_UTC, r_gcrf, v_gcrf)
    sv_j2000 = sv_eci_to_eci(sv_gcrf, GCRF(), J2000(), JD_UTC, eop_iau1980)

    @test sv_j2000.t === JD_UTC

    @test sv_j2000.r[1] ≈ +5102.50960000 atol=1e-4
    @test sv_j2000.r[2] ≈ +6123.01152000 atol=1e-4
    @test sv_j2000.r[3] ≈ +6378.13630000 atol=1e-4

    @test sv_j2000.v[1] ≈ -4.7432196000  atol=1e-7
    @test sv_j2000.v[2] ≈ +0.7905366000  atol=1e-7
    @test sv_j2000.v[3] ≈ +5.5337561900  atol=1e-7

    ## J2000 => GCRF
    ## =============

    r_j2000  = [5102.50960000; 6123.01152000; 6378.13630000]
    v_j2000  = [-4.7432196000; 0.7905366000; 5.5337561900]
    sv_j2000 = orbsv(JD_UTC, r_j2000, v_j2000)
    sv_gcrf  = sv_eci_to_eci(sv_j2000, J2000(), GCRF(), JD_UTC, eop_iau1980)

    @test sv_gcrf.t === JD_UTC

    @test sv_gcrf.r[1] ≈ +5102.50895790 atol=1e-4
    @test sv_gcrf.r[2] ≈ +6123.01140070 atol=1e-4
    @test sv_gcrf.r[3] ≈ +6378.13692820 atol=1e-4

    @test sv_gcrf.v[1] ≈ -4.7432201570  atol=1e-7
    @test sv_gcrf.v[2] ≈ +0.7905364970  atol=1e-7
    @test sv_gcrf.v[3] ≈ +5.5337557270  atol=1e-7

end

# MOD <=> TOD
# ============

################################################################################
#                                 Test Results
################################################################################
#
# Scenario 01
# ===========
#
# Example 3-15: Performing IAU-76/FK5 reduction.
#
# According to this example and Table 3-6, using:
#
#   UTC    = April 6, 2004, 07:51:28.386009
#   r_mod = 5094.02837450   i + 6127.87081640   j + 6380.24851640   k [km]
#   v_mod =   -4.7462630520 i +    0.7860140450 j +    5.5317905620 k [km/s]
#
# one gets:
#
#   r_tod = 5094.51620300   i + 6127.36527840   j + 6380.34453270   k [km]
#   v_tod =   -4.7460883850 i +    0.7860783240 j +    5.5319312880 k [km/s]
#
################################################################################

@testset "Function sv_eci_to_eci MOD <=> TOD" begin
    JD_UTC = date_to_jd(2004, 4, 6, 7, 51, 28.386009)

    ## MOD => TOD
    ## ===========

    r_mod  = [5094.02837450; 6127.87081640; 6380.24851640]
    v_mod  = [-4.7462630520; 0.7860140450; 5.5317905620]
    sv_mod = orbsv(JD_UTC, r_mod, v_mod)
    sv_tod = sv_eci_to_eci(sv_mod, MOD(), JD_UTC, TOD(), JD_UTC, eop_iau1980)

    @test sv_tod.t === JD_UTC

    @test sv_tod.r[1] ≈ +5094.51620300 atol=1e-4
    @test sv_tod.r[2] ≈ +6127.36527840 atol=1e-4
    @test sv_tod.r[3] ≈ +6380.34453270 atol=1e-4

    @test sv_tod.v[1] ≈ -4.7460883850  atol=1e-7
    @test sv_tod.v[2] ≈ +0.7860783240  atol=1e-7
    @test sv_tod.v[3] ≈ +5.5319312880  atol=1e-7

    ## TOD => MOD
    ## ===========

    r_tod  = [5094.51620300; 6127.36527840; 6380.34453270]
    v_tod  = [-4.7460883850; 0.7860783240; 5.5319312880]
    sv_tod = orbsv(JD_UTC, r_tod, v_tod)
    sv_mod = sv_eci_to_eci(sv_tod, TOD(), JD_UTC, MOD(), JD_UTC, eop_iau1980)

    @test sv_mod.t === JD_UTC

    @test sv_mod.r[1] ≈ +5094.02837450 atol=1e-4
    @test sv_mod.r[2] ≈ +6127.87081640 atol=1e-4
    @test sv_mod.r[3] ≈ +6380.24851640 atol=1e-4

    @test sv_mod.v[1] ≈ -4.7462630520  atol=1e-7
    @test sv_mod.v[2] ≈ +0.7860140450  atol=1e-7
    @test sv_mod.v[3] ≈ +5.5317905620  atol=1e-7

end

################################################################################
#                                IAU-2006/2010
################################################################################

## GCRF <=> CIRS
## =============

################################################################################
#                                 Test Results
################################################################################
#
# Scenario 01
# ===========
#
# Example 3-14: Performing an IAU-2000 reduction [1, p. 220]
#
# According to this example and Table 3-6, using:
#
# NOTE: It seems that the results in the Example 3-14 is computed **without**
# the `dX` and `dY` corrections, whereas in the Table 3-6 they are computed
# **with** the corrections.
#
#   UTC    = April 6, 2004, 07:51:28.386009
#   r_cirs = -5100.01840470   i + 6122.78636480   j + 6380.34453270   k [km]
#   v_cirs =    -4.7453803300 i -    0.7903414530 j +    5.5319312880 k [km/s]
#
# one gets the following (this is the result in Table 3-6):
#
#   r_gcrf = 5102.50895290  i + 6123.01139910 j + 6378.13693380 k [km]
#   v_gcrf =  -4.7432201610 i + 0.7905364950  j + 5.5337557240  k [km/s]
#
################################################################################

@testset "Function sv_eci_to_eci GCRF <=> CIRS" begin
    JD_UTC = date_to_jd(2004, 4, 6, 7, 51, 28.386009)

    ## GCRF => CIRS
    ## ===========

    r_gcrf  = [5102.50895290; 6123.01139910; 6378.13693380]
    v_gcrf  = [-4.7432201610; 0.7905364950; 5.5337557240]
    sv_gcrf = orbsv(JD_UTC, r_gcrf, v_gcrf)
    sv_cirs = sv_eci_to_eci(sv_gcrf, GCRF(), CIRS(), JD_UTC, eop_iau2000a)

    @test sv_cirs.t === JD_UTC

    @test sv_cirs.r[1] ≈ +5100.01840470 atol=1e-4
    @test sv_cirs.r[2] ≈ +6122.78636480 atol=1e-4
    @test sv_cirs.r[3] ≈ +6380.34453270 atol=1e-4

    @test sv_cirs.v[1] ≈ -4.7453803300  atol=1e-7
    @test sv_cirs.v[2] ≈ +0.7903414530  atol=1e-7
    @test sv_cirs.v[3] ≈ +5.5319312880  atol=1e-7

    ## CIRS => GCRF
    ## ===========

    r_cirs  = [+5100.01840470; +6122.78636480; +6380.34453270]
    v_cirs  = [-4.7453803300; +0.7903414530; +5.5319312880]
    sv_cirs = orbsv(JD_UTC, r_cirs, v_cirs)
    sv_gcrf = sv_eci_to_eci(sv_cirs, CIRS(), GCRF(), JD_UTC, eop_iau2000a)

    @test sv_gcrf.t === JD_UTC

    @test sv_gcrf.r[1] ≈ +5102.50895290 atol=1e-4
    @test sv_gcrf.r[2] ≈ +6123.01139910 atol=1e-4
    @test sv_gcrf.r[3] ≈ +6378.13693380 atol=1e-4

    @test sv_gcrf.v[1] ≈ -4.7432201610  atol=1e-7
    @test sv_gcrf.v[2] ≈ +0.7905364950  atol=1e-7
    @test sv_gcrf.v[3] ≈ +5.5337557240  atol=1e-7

end


# TernaryLayer and TernaryMERA types, and methods thereof.
# To be `included` in MERAKit.jl.

"""
    TernaryLayer{ST, ET, Tan} <: SimpleLayer

The type for layers of a ternary MERA.

Each layer consists of two tensors, a 2-to-2 disentangler, often called `u`, and a 3-to-1
isometry, often called `w`.

The type parameters are `ST` for space type, e.g. `ComplexSpace` or `SU2Space`; `ET` for
element type, e.g. `Complex{Float64}`; and `Tan` for whether this layer is a tangent layer
or not.  If `Tan = false`, the layer in question is an actual MERA layer. If `Tan = true` it
consists, instead of the actual tensors, of Stiefel/Grassmann tangent vectors of these
tensors.

`TernaryLayer` implements the iteration interface, returning first the disentangler, then
the isometry.

Index numbering convention is as follows, where the physical indices are at the bottom:
Disentangler:
```
 3│    4│
 ┌┴─────┴┐
 │   u   │
 └┬─────┬┘
 1│    2│
```

Isometry:
```
    4│
 ┌───┴───┐
 │   w   │
 └┬──┬──┬┘
 1│ 2│ 3│
```
"""
struct TernaryLayer{ST, ET, Tan} <: SimpleLayer
    # Even though the types are here marked as any, they are restricted to be specific,
    # concrete types dependent on ST, ET and Tan, both in the constructor and in
    # getproperty.
    disentangler::Any
    isometry::Any

    function TernaryLayer{ST, ET, Tan}(disentangler, isometry) where {ST, ET, Tan}
        DisType = disentangler_type(ST, ET, Tan)
        IsoType = ternaryisometry_type(ST, ET, Tan)
        disconv = convert(DisType, disentangler)::DisType
        isoconv = convert(IsoType, isometry)::IsoType
        return new{ST, ET, Tan}(disconv, isoconv)
    end
end

function TernaryLayer(disentangler::DisType, isometry::IsoType) where {
    ST,
    DisType <: AbstractTensorMap{ST, 2, 2},
    IsoType <: AbstractTensorMap{ST, 3, 1}
}
    ET = eltype(DisType)
    @assert eltype(IsoType) === ET
    return TernaryLayer{ST, ET, false}(disentangler, isometry)
end

function TernaryLayer(disentangler::DisTanType, isometry::IsoTanType) where {
    ST,
    DisType <: AbstractTensorMap{ST, 2, 2},
    IsoType <: AbstractTensorMap{ST, 3, 1},
    DisTanType <: Stiefel.StiefelTangent{DisType},
    IsoTanType <: Grassmann.GrassmannTangent{IsoType},
}
    ET = eltype(DisType)
    @assert eltype(IsoType) === ET
    return TernaryLayer{ST, ET, true}(disentangler, isometry)
end

function Base.getproperty(l::TernaryLayer{ST, ET, Tan}, sym::Symbol) where {ST, ET, Tan}
    if sym === :disentangler
        T = disentangler_type(ST, ET, Tan)
    elseif sym === :isometry
        T = ternaryisometry_type(ST, ET, Tan)
    else
        T = Any
    end
    return getfield(l, sym)::T
end

"""
    TernaryMERA{N}

A ternary MERA is a MERA consisting of `TernaryLayer`s.
"""
TernaryMERA{N} = GenericMERA{N, T, O} where {T <: TernaryLayer, O}
layertype(::Type{TernaryMERA}) = TernaryLayer
#Base.show(io::IO, ::Type{TernaryMERA}) = print(io, "TernaryMERA")
#Base.show(io::IO, ::Type{TernaryMERA{N}}) where {N} = print(io, "TernaryMERA{($N)}")

# Implement the iteration and indexing interfaces.
# See simplelayer.jl for details.
_tuple(layer::TernaryLayer) = (layer.disentangler, layer.isometry)

function operatortype(::Type{TernaryLayer{ST, ET, false}}) where {ST, ET}
    return tensormaptype(ST, 2, 2, ET)
end
operatortype(::Type{TernaryLayer{ST, ET, true}}) where {ST, ET} = Nothing

TensorKit.spacetype(::Type{TernaryLayer{ST, ET, Tan}}) where {ST, ET, Tan} = ST

scalefactor(::Type{<:TernaryLayer}) = 3

causal_cone_width(::Type{<:TernaryLayer}) = 2

Base.eltype(::Type{TernaryLayer{ST, ET, Tan}}) where {ST, ET, Tan} = ET

outputspace(layer::TernaryLayer) = space(layer.disentangler, 1)
inputspace(layer::TernaryLayer) = space(layer.isometry, 4)'
internalspace(layer::TernaryLayer) = space(layer.isometry, 1)
internalspace(m::TernaryMERA, depth) = internalspace(getlayer(m, depth))

function expand_inputspace(layer::TernaryLayer, V_new)
    u, w = layer
    w = pad_with_zeros_to(w, 4 => V_new')
    return TernaryLayer(u, w)
end

function expand_outputspace(layer::TernaryLayer, V_new)
    u, w = layer
    u = pad_with_zeros_to(u, 1 => V_new, 2 => V_new)
    w = pad_with_zeros_to(w, 2 => V_new)
    return TernaryLayer(u, w)
end

function expand_internalspace(layer::TernaryLayer, V_new)
    u, w = layer
    u = pad_with_zeros_to(u, 3 => V_new', 4 => V_new')
    w = pad_with_zeros_to(w, 1 => V_new, 3 => V_new)
    return TernaryLayer(u, w)
end

function randomlayer(
    ::Type{TernaryLayer}, ::Type{T}, Vin, Vout, Vint = Vout; random_disentangler = false
) where {T}
    w = randomisometry(T, Vint ⊗ Vout ⊗ Vint, Vin)
    u = initialize_disentangler(T, Vout, Vint, random_disentangler)
    return TernaryLayer(u, w)
end

function ascending_fixedpoint(layer::TernaryLayer)
    width = causal_cone_width(layer)
    Vtotal = ⊗(ntuple(n->inputspace(layer), Val(width))...)
    return id(storagetype(operatortype(layer)), Vtotal)
end

function scalingoperator_initialguess(l::TernaryLayer, irreps...)
    width = causal_cone_width(l)
    V = inputspace(l)
    interlayer_space = ⊗(ntuple(n->V, Val(width))...)
    outspace = interlayer_space
    inspace = interlayer_space
    for irrep in irreps
        inspace = inspace ⊗ spacetype(V)(irrep => 1)
    end
    typ = eltype(l)
    t = TensorMap(randn, typ, outspace ← inspace)
    return t
end

function gradient(layer::TernaryLayer, env::TernaryLayer; metric = :euclidean)
    u, w = layer
    uenv, wenv = env
    # The environment is the partial derivative. We need to turn that into a tangent vector
    # of the Stiefel manifold point u or w.
    # The factor of two is from the partial_x + i partial_y derivative of the cost function,
    # and how it depends on both v and v^dagger.
    ugrad = Stiefel.project!(2*uenv, u; metric = metric)
    wgrad = Grassmann.project!(2*wenv, w)
    return TernaryLayer(ugrad, wgrad)
end

function precondition_tangent(layer::TernaryLayer, tan::TernaryLayer, rho)
    u, w = layer
    utan, wtan = tan
    @planar rho_wl[-1; -11] := rho[-1 1; -11 1]
    @planar rho_wr[-1; -11] := rho[1 -1; 1 -11]
    rho_w = (rho_wl + rho_wr) / 2.0
    @planar(
        rho_u[-1 -2; -11 -12] :=
        w'[12; 1 2 -11] * w'[22; -12 3 4] *
        rho[11 21; 12 22] *
        w[1 2 -1; 11] * w[-2 3 4; 21]
    )
    utan_prec = precondition_tangent(utan, rho_u)
    wtan_prec = precondition_tangent(wtan, rho_w)
    return TernaryLayer(utan_prec, wtan_prec)
end

# # # Invariants

function space_invar_intralayer(layer::TernaryLayer)
    u, w = layer
    matching_bonds = (
        (space(u, 3)', space(w, 3)),
        (space(u, 4)', space(w, 1)),
    )
    allmatch = all(pair -> ==(pair...), matching_bonds)
    # Check that the dimensions are such that isometricity can hold.
    allmatch &= all((u, w)) do v
        codom, dom = fuse(codomain(v)), fuse(domain(v))
        infimum(dom, codom) == dom
    end
    return allmatch
end

function space_invar_interlayer(layer::TernaryLayer, next_layer::TernaryLayer)
    u, w = layer.disentangler, layer.isometry
    unext, wnext = next_layer.disentangler, next_layer.isometry
    matching_bonds = (
        (space(w, 4)', space(unext, 1)),
        (space(w, 4)', space(unext, 2)),
        (space(w, 4)', space(wnext, 2)),
    )
    allmatch = all(pair -> ==(pair...), matching_bonds)
    return allmatch
end

# # # Ascending and descending superoperators

# TODO Fix this to work with anyons.
#"""
#Return the ascending superoperator of the one site in the middle of the isometries in a
#TernaryMERA, as a TensorMap. Unlike most ascending superoperators, this one is actually
#affordable to construct as a full tensor.
#"""
#ascending_superop_onesite(m::TernaryMERA) = ascending_superop_onesite(getlayer(m, Inf))
#
#function ascending_superop_onesite(layer::TernaryLayer)
#    w = layer.isometry
#    @planar superop[-1 -2; -11 -12] := w'[-11; 1 -1 2] * w[1 -2 2; -12]
#    return superop
#end

const TernaryOperator{S} = AbstractTensorMap{S, 2, 2}
const ChargedTernaryOperator{S} = AbstractTensorMap{S, 2, 3}
const DoubleChargedTernaryOperator{S} = AbstractTensorMap{S, 2, 4}

function ascend(
    op::Union{TernaryOperator, ChargedTernaryOperator, DoubleChargedTernaryOperator},
    layer::TernaryLayer
) where {S1}
    u, w = layer
    l = ascend_left(op, layer)
    r = ascend_right(op, layer)
    m = ascend_mid(op, layer)
    scaled_op = (l+r+m)/3
    return scaled_op
end

function ascend(op::SquareTensorMap{1}, layer::TernaryLayer)
    return ascend(expand_support(op, causal_cone_width(TernaryLayer)), layer)
end

# TODO Think about how to best remove the code duplication of having the separate methods
# for ordinary, charged, and double charged operators. Note also that there's a mix of using
# @tensor and @planar.
function ascend_left(op::ChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @tensor(
        scaled_op[-100 -200; -300 -400 -1000] :=
        w[51 52 53; -300] * w[54 11 12; -400] *
        u[41 42; 53 54] *
        op[31 32; 52 41 -1000] *
        u'[21 55; 32 42] *
        w'[-100; 51 31 21] * w'[-200; 55 11 12]
    )
    return scaled_op
end

function ascend_right(op::ChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @tensor(
        scaled_op[-100 -200; -300 -400 -1000] :=
        w[11 12 65; -300] * w[63 61 62; -400] *
        u[51 52; 65 63] *
        op[31 41; 52 61 -1000] *
        u'[64 21; 51 31] *
        w'[-100; 11 12 64] * w'[-200; 21 41 62]
    )
    return scaled_op
end

function ascend_mid(op::ChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 6X^6
    @tensor(
        scaled_op[-100 -200; -300 -400 -1000] :=
        w[31 32 41; -300] * w[51 21 22; -400] *
        u[1 2; 41 51] *
        op[11 12; 1 2 -1000] *
        u'[42 52; 11 12] *
        w'[-100; 31 32 42] * w'[-200; 52 21 22]
    )
    return scaled_op
end

function ascend_left(op::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        scaled_op[-100 -200; -300 -400] :=
        w[51 52 53; -300] * w[54 11 12; -400] *
        u[41 42; 53 54] *
        op[31 32; 52 41] *
        u'[21 55; 32 42] *
        w'[-100; 51 31 21] * w'[-200; 55 11 12]
    )
    return scaled_op
end

function ascend_right(op::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        scaled_op[-100 -200; -300 -400] :=
        w[11 12 65; -300] * w[63 61 62; -400] *
        u[51 52; 65 63] *
        op[31 41; 52 61] *
        u'[64 21; 51 31] *
        w'[-100; 11 12 64] * w'[-200; 21 41 62]
    )
    return scaled_op
end

function ascend_mid(op::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 6X^6
    @planar(
        scaled_op[-100 -200; -300 -400] :=
        w[31 32 41; -300] * w[51 21 22; -400] *
        u[1 2; 41 51] *
        op[11 12; 1 2] *
        u'[42 52; 11 12] *
        w'[-100; 31 32 42] * w'[-200; 52 21 22]
    )
    return scaled_op
end

function ascend_left(op::DoubleChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        temp1[-1 -2 -3 -4; -11 -12 -13 -14] :=
        op[31 32; -1 -11 -12 -13] *
        u'[21 -4; 32 -14] *
        w'[-3; -2 31 21]
    )
    temp2 = braid(temp1, (11, 12, 13, 14, 15, 1, 100, 16), (1, 2, 3, 7, 6, 4), (5, 8))
    @planar(
        temp3[-100 -1000 -2000 -200; -300 -400] :=
        w[51 52 53; -300] * w[54 11 12; -400] *
        u[41 42; 53 54] *
        temp2[52 51 -100 -1000 -2000 55; 41 42] *
        w'[-200; 55 11 12]
    )
    scaled_op = braid(temp3, (11, 100, 1, 12, 13, 14), (1, 4), (5, 6, 3, 2))
    return scaled_op
end

function ascend_right(op::DoubleChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        temp1[-1 -2 -3 -4 -5 -6; -11 -12] :=
        op[31 41; -12 -6 -5 -4] *
        u'[-1 21; -11 31] *
        w'[-2; 21 41 -3]
    )
    temp2 = braid(temp1, (11, 12, 13, 100, 1, 14, 15, 16), (1, 2, 4, 5, 3, 6), (7, 8))
    @planar(
        temp3[-100 -200 -1000 -2000; -300 -400] :=
        w[11 12 65; -300] * w[63 61 62; -400] *
        u[51 52; 65 63] *
        temp2[64 -200 -1000 -2000 62 61; 51 52] *
        w'[-100; 11 12 64]
    )
    scaled_op = braid(temp3, (11, 12, 100, 1, 13, 14), (1, 2), (5, 6, 4, 3))
    return scaled_op
end

function ascend_mid(op::DoubleChargedTernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 6X^6
    @planar(
        temp1[-1 -2; -3 -4 -5 -6] :=
        u[1 2; -3 -4] *
        op[11 12; 1 2 -5 -6] *
        u'[-1 -2; 11 12]
    )
    temp2 = braid(temp1, (11, 12, 13, 14, 1, 100), (1, 6, 5, 2), (3, 4))
    @planar(
        temp3[-100 -1000 -2000 -200; -300 -400] :=
        w[31 32 41; -300] * w[51 21 22; -400] *
        temp2[42 -1000 -2000 52; 41 51] *
        w'[-100; 31 32 42] * w'[-200; 52 21 22]
    )
    scaled_op = braid(temp3, (11, 100, 1, 12, 13, 14), (1, 4), (5, 6, 3, 2))
    return scaled_op
end

function descend_left(rho::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        scaled_rho[-100 -200; -300 -400] :=
        u'[61 62; -400 63] *
        w'[51; 52 -300 61] * w'[21; 62 11 12] *
        rho[42 22; 51 21] *
        w[52 -100 41; 42] * w[31 11 12; 22] *
        u[-200 63; 41 31]
    )
    return scaled_rho
end

function descend_right(rho::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        scaled_rho[-100 -200; -300 -400] :=
        u'[62 61; 63 -300] *
        w'[21; 11 12 62] * w'[51; 61 -400 52] *
        rho[22 42; 21 51] *
        w[11 12 41; 22] * w[31 -200 52; 42] *
        u[63 -100; 41 31]
    )
    return scaled_rho
end

function descend_mid(rho::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    # Cost: 6X^6
    @planar(
        scaled_rho[-100 -200; -300 -400] :=
        u'[61 62; -300 -400] *
        w'[21; 11 12 61] * w'[41; 62 31 32] *
        rho[22 42; 21 41] *
        w[11 12 51; 22] * w[52 31 32; 42] *
        u[-100 -200; 51 52]
    )
    return scaled_rho
end

function descend(rho::TernaryOperator, layer::TernaryLayer)
    u, w = layer
    l = descend_left(rho, layer)
    r = descend_right(rho, layer)
    m = descend_mid(rho, layer)
    scaled_rho = (l+r+m)/3
    return scaled_rho
end

# # # Optimization

function environment(op, layer::TernaryLayer, rho; vary_disentanglers = true)
    if vary_disentanglers
        env_u = environment_disentangler(op, layer, rho)
    else
        # The adjoint is just for type stability.
        env_u = zero(layer.disentangler')'
    end
    env_w = environment_isometry(op, layer, rho)
    return TernaryLayer(env_u, env_w)
end

function minimize_expectation_ev(
    layer::TernaryLayer, env::TernaryLayer; vary_disentanglers = true
)
    u = if vary_disentanglers
        projectisometric(env.disentangler; alg = Polar())
    else
        layer.disentangler
    end
    w = projectisometric(env.isometry; alg = Polar())
    return TernaryLayer(u, w)
end

function environment_disentangler(h::TernaryOperator, layer, rho)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env1[-1 -2; -3 -4] :=
        rho[31 21; 63 22] *
        w[61 51 41; 31] * w[42 11 12; 21] *
        u[52 -2; 41 42] *
        h[62 -1; 51 52] *
        w'[63; 61 62 -3] * w'[22; -4 11 12]
    )

    # Cost: 6X^6
    @planar(
        env2[-1 -2; -3 -4] :=
        rho[41 51; 42 52] *
        w[21 22 61; 41] * w[62 31 32; 51] *
        u[11 12; 61 62] *
        h[-1 -2; 11 12] *
        w'[42; 21 22 -3] * w'[52; -4 31 32]
    )

    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env3[-1 -2; -3 -4] :=
        rho[21 31; 22 63] *
        w[12 11 42; 21] * w[41 51 61; 31] *
        u[-1 52; 42 41] *
        h[-2 62; 52 51] *
        w'[22; 12 11 -3] * w'[63; -4 62 61]
    )

    env = (env1 + env2 + env3)/3
    return env
end

function environment_isometry(h::TernaryOperator, layer, rho)
    u, w = layer
    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env1[-1 -2 -3; -4] :=
        rho[81 84; 82 -4] *
        w[62 41 31; 81] * w[83 -2 -3; 84] *
        u[42 52; 31 83] *
        h[61 51; 41 42] *
        u'[63 -1; 51 52] *
        w'[82; 62 61 63]
    )

    # Cost: 6X^6
    @planar(
        env2[-1 -2 -3; -4] :=
        rho[41 62; 42 -4] *
        w[11 12 52; 41] * w[61 -2 -3; 62] *
        u[31 32; 52 61] *
        h[21 22; 31 32] *
        u'[51 -1; 21 22] *
        w'[42; 11 12 51]
    )

    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env3[-1 -2 -3; -4] :=
        rho[31 33; 32 -4] *
        w[21 11 51; 31] * w[41 61 -3; 33] *
        u[72 62; 51 41] *
        h[71 -2; 62 61] *
        u'[73 -1; 72 71] *
        w'[32; 21 11 73]
    )

    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env4[-1 -2 -3; -4] :=
        rho[33 31; -4 32] *
        w[-1 61 41; 33] * w[51 11 21; 31] *
        u[62 72; 41 51] *
        h[-2 71; 61 62] *
        u'[-3 73; 71 72] *
        w'[32; 73 11 21]
    )

    # Cost: 6X^6
    @planar(
        env5[-1 -2 -3; -4] :=
        rho[62 41; -4 42] *
        w[-1 -2 61; 62] * w[52 12 11; 41] *
        u[32 31; 61 52] *
        h[22 21; 32 31] *
        u'[-3 51; 22 21] *
        w'[42; 51 12 11]
    )

    # Cost: 2X^8 + 2X^7 + 2X^6
    @planar(
        env6[-1 -2 -3; -4] :=
        rho[84 81; -4 82] *
        w[-1 -2 83; 84] * w[31 41 62; 81] *
        u[52 42; 83 31] *
        h[51 61; 42 41] *
        u'[-3 63; 52 51] *
        w'[82; 63 61 62]
    )

    env = (env1 + env2 + env3 + env4 + env5 + env6)/3
    return env
end


export iauAtco13
"""
ICRS RA,Dec to observed place.  The caller supplies UTC, site
coordinates, ambient air conditions and observing wavelength.

SOFA models are used for the Earth ephemeris, bias-precession-
nutation, Earth orientation and refraction.

This function is part of the International Astronomical Union's
SOFA (Standards of Fundamental Astronomy) software collection.

Status:  support function.

Given:
   rc,dc  double   ICRS right ascension at J2000.0 (radians, Note 1)
   pr     double   RA proper motion (radians/year; Note 2)
   pd     double   Dec proper motion (radians/year)
   px     double   parallax (arcsec)
   rv     double   radial velocity (km/s, +ve if receding)
   utc1   double   UTC as a 2-part...
   utc2   double   ...quasi Julian Date (Notes 3-4)
   dut1   double   UT1-UTC (seconds, Note 5)
   elong  double   longitude (radians, east +ve, Note 6)
   phi    double   latitude (geodetic, radians, Note 6)
   hm     double   height above ellipsoid (m, geodetic, Notes 6,8)
   xp,yp  double   polar motion coordinates (radians, Note 7)
   phpa   double   pressure at the observer (hPa = mB, Note 8)
   tc     double   ambient temperature at the observer (deg C)
   rh     double   relative humidity at the observer (range 0-1)
   wl     double   wavelength (micrometers, Note 9)

Returned:
   aob    double*  observed azimuth (radians: N=0,E=90)
   zob    double*  observed zenith distance (radians)
   hob    double*  observed hour angle (radians)
   dob    double*  observed declination (radians)
   rob    double*  observed right ascension (CIO-based, radians)
   eo     double*  equation of the origins (ERA-GST)

Returned (function value):
         int      status: +1 = dubious year (Note 4)
                           0 = OK
                           -1 = unacceptable date

Notes:

   1.  Star data for an epoch other than J2000.0 (for example from the
   Hipparcos catalog, which has an epoch of J1991.25) will require
   a preliminary call to iauPmsafe before use.

   2.  The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt.

   3.  utc1+utc2 is quasi Julian Date (see Note 2), apportioned in any
   convenient way between the two arguments, for example where utc1
   is the Julian Day Number and utc2 is the fraction of a day.

   However, JD cannot unambiguously represent UTC during a leap
   second unless special measures are taken.  The convention in the
   present function is that the JD day represents UTC days whether
   the length is 86399, 86400 or 86401 SI seconds.

   Applications should use the function iauDtf2d to convert from
   calendar date and time of day into 2-part quasi Julian Date, as
   it implements the leap-second-ambiguity convention just
   described.

   4.  The warning status "dubious year" flags UTCs that predate the
   introduction of the time scale or that are too far in the
   future to be trusted.  See iauDat for further details.

   5.  UT1-UTC is tabulated in IERS bulletins.  It increases by exactly
   one second at the end of each positive UTC leap second,
   introduced in order to keep UT1-UTC within +/- 0.9s.  n.b. This
   practice is under review, and in the future UT1-UTC may grow
   essentially without limit.

   6.  The geographical coordinates are with respect to the WGS84
   reference ellipsoid.  TAKE CARE WITH THE LONGITUDE SIGN:  the
   longitude required by the present function is east-positive
   (i.e. right-handed), in accordance with geographical convention.

   7.  The polar motion xp,yp can be obtained from IERS bulletins.  The
   values are the coordinates (in radians) of the Celestial
   Intermediate Pole with respect to the International Terrestrial
   Reference System (see IERS Conventions 2003), measured along the
   meridians 0 and 90 deg west respectively.  For many
   applications, xp and yp can be set to zero.

   8.  If hm, the height above the ellipsoid of the observing station
   in meters, is not known but phpa, the pressure in hPa (=mB),
   is available, an adequate estimate of hm can be obtained from
   the expression

         hm = -29.3 * tsl * log ( phpa / 1013.25 );

   where tsl is the approximate sea-level air temperature in K
   (See Astrophysical Quantities, C.W.Allen, 3rd edition, section
   52).  Similarly, if the pressure phpa is not known, it can be
   estimated from the height of the observing station, hm, as
   follows:

         phpa = 1013.25 * exp ( -hm / ( 29.3 * tsl ) );

   Note, however, that the refraction is nearly proportional to
   the pressure and that an accurate phpa value is important for
   precise work.

   9.  The argument wl specifies the observing wavelength in
   micrometers.  The transition from optical to radio is assumed to
   occur at 100 micrometers (about 3000 GHz).

   10. The accuracy of the result is limited by the corrections for
   refraction, which use a simple A*tan(z) + B*tan^3(z) model.
   Providing the meteorological parameters are known accurately and
   there are no gross local effects, the predicted observed
   coordinates should be within 0.05 arcsec (optical) or 1 arcsec
   (radio) for a zenith distance of less than 70 degrees, better
   than 30 arcsec (optical or radio) at 85 degrees and better
   than 20 arcmin (optical) or 30 arcmin (radio) at the horizon.

   Without refraction, the complementary functions iauAtco13 and
   iauAtoc13 are self-consistent to better than 1 microarcsecond
   all over the celestial sphere.  With refraction included,
   consistency falls off at high zenith distances, but is still
   better than 0.05 arcsec at 85 degrees.

   11. "Observed" Az,ZD means the position that would be seen by a
   perfect geodetically aligned theodolite.  (Zenith distance is
   used rather than altitude in order to reflect the fact that no
   allowance is made for depression of the horizon.)  This is
   related to the observed HA,Dec via the standard rotation, using
   the geodetic latitude (corrected for polar motion), while the
   observed HA and RA are related simply through the Earth rotation
   angle and the site longitude.  "Observed" RA,Dec or HA,Dec thus
   means the position that would be seen by a perfect equatorial
   with its polar axis aligned to the Earth's axis of rotation.

   12. It is advisable to take great care with units, as even unlikely
   values of the input parameters are accepted and processed in
   accordance with the models used.

Called:
   iauApco13    astrometry parameters, ICRS-observed, 2013
   iauAtciq     quick ICRS to CIRS
   iauAtioq     quick CIRS to observed

This revision:   2016 February 2

SOFA release 2018-01-30

Copyright (C) 2018 IAU SOFA Board.  See notes at end.
"""
# int iauAtco13(double rc, double dc,
#               double pr, double pd, double px, double rv,
#               double utc1, double utc2, double dut1,
#               double elong, double phi, double hm, double xp, double yp,
#               double phpa, double tc, double rh, double wl,
#               double *aob, double *zob, double *hob,
#               double *dob, double *rob, double *eo)

function iauAtco13(rc::Real, dc::Real, pr::Real, pd::Real,
                   px::Real, rv::Real, utc1::Real, utc2::Real,
                   dut1::Real, elong::Real, phi::Real, hm::Real,
                   xp::Real, yp::Real, phpa::Real, tc::Real,
                   rh::Real, wl::Real)

   # Allocate return values
   ref_aob = Ref{Float64}(0.0)
   ref_zob = Ref{Float64}(0.0)
   ref_hob = Ref{Float64}(0.0)
   ref_dob = Ref{Float64}(0.0)
   ref_rob = Ref{Float64}(0.0)
   ref_eo  = Ref{Float64}(0.0)

   status = ccall((:iauAtco13, libsofa_c), Cint,
            (Cdouble, Cdouble, Cdouble, Cdouble,
            Cdouble, Cdouble, Cdouble, Cdouble,
            Cdouble, Cdouble, Cdouble, Cdouble,
            Cdouble, Cdouble, Cdouble, Cdouble,
            Cdouble, Cdouble,
            Ref{Cdouble}, Ref{Cdouble}, Ref{Cdouble},
            Ref{Cdouble}, Ref{Cdouble}, Ref{Cdouble}),
            convert(Float64, rc), convert(Float64, dc),
            convert(Float64, pr), convert(Float64, pd),
            convert(Float64, px), convert(Float64, rv),
            convert(Float64, utc1), convert(Float64, utc2),
            convert(Float64, dut1), convert(Float64, elong),
            convert(Float64, phi), convert(Float64, hm),
            convert(Float64, xp), convert(Float64, yp),
            convert(Float64, phpa), convert(Float64, tc),
            convert(Float64, rh), convert(Float64, wl),
            ref_aob, ref_zob, ref_hob, ref_dob, ref_rob, ref_eo)

   return status, ref_aob[], ref_zob[], ref_hob[], ref_dob[], ref_rob[], ref_eo[]
end


## return copy of `a` with midi channel changed to `v`
function channel(v::Int, a::Atom)
	@assert 1 <= v <= 16
	if in(:cha,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.cha = v
	end
	a
end

## return copy of `a` with duration and offset multiplied by `v`
function dilate(v::Rat, a::Atom)
	@assert v > 0
	if in(:dur,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.ofs *= v
		a.dur *= v
	end
	a
end

## return copy of `a` with `v` added to offset
function sshift(v::Rat, a::Atom)
	a = deepcopy(a)
	a.ofs += v
	a
end

## return copy of `a` with velocity mutiplied by `v`
function accel(v::Float64, a::Atom)
	@assert 0 < v
	if in(:vel,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.vel *= v
	end
	a
end

## return copy of `a` with `v` added to note inteval value
function transl(v::Int, a::Atom)
	if in(:itv,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.itv += v
	end
	a
end

## return copy of `a` with `v` added to note octave value
function octave(v::Int, a::Atom)
	if in(:ocv,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.ocv = v
	end
	a
end

## return copy of `a` with note scale changed to `v`
function sscale(v::Scales.Scale, a::Atom)
	if in(:sca,fieldnames(typeof(a)))
		a = deepcopy(a)
		a.sca = v
	end
	a
end

## tests if atom default fields have valid values
function atomTest(a::Atom)
	if in(:cha,fieldnames(typeof(a))) ; @assert 1 <= a.cha <= 16 ; end
	if isa(a,Duratom)
		if in(:dur,fieldnames(typeof(a))) ; @assert 0 < a.dur ; end
	else
		if in(:dur,fieldnames(typeof(a))) ; @assert 0 <= a.dur ; end
	end
	if in(:ocv,fieldnames(typeof(a))) ; @assert 1 <= a.ocv <= 5 ; end
	if in(:vel,fieldnames(typeof(a))) ; @assert 0 < a.vel ; end
	a
end

## play a note (on and off midi events)
type Note <: Duratom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	itv::Int			# interval value
	ocv::Int			# octave
	vel::Float64		# velocity
	sca::Scales.Scale	# scale

	Note(ofs,dur,cha,itv,ocv,vel,sca) = atomTest(new(ofs,dur,cha,itv,ocv,vel,sca))
end

## select instrument bank
type BankSel <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	bank::Int			# bank number

	BankSel(ofs,cha,bank) = ( @assert 0<=bank<=16383 ; atomTest(new(ofs,0//1,cha,bank)) )
end

## select instrument program
type ProgSel <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	prog::Int			# program

	ProgSel(ofs,cha,prog) = ( @assert 0<=prog<=127 ; atomTest(new(ofs,0//1,cha,prog)) )
end

## set channel volume
type VolSet <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	vol::Float64		# volume [0,1]

	VolSet(ofs,cha,vol) = ( @assert 0<=vol<=1 ; atomTest(new(ofs,0//1,cha,vol)) )
end

## pitch wheel bend
type PitchWheel <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	val::Int			# value {0..2^14-1}

	PitchWheel(ofs,cha,val) = ( @assert 0<=val<=16383 ; atomTest(new(ofs,0//1,cha,val)) )
end

## channel aftertouch
type ChanAfter <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	val::Int			# value {0..127}

	ChanAfter(ofs,cha,val) = ( @assert 0<=val<=127 ; atomTest(new(ofs,0//1,cha,val)) )
end

## channel contol 7bit
type Control7 <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	num::Int			# control number {64..127}
	val::Int			# control value {0..127}

	Control7(ofs,cha,num,val) = ( @assert 0<=val<=127 && 64<=num<=127 ; atomTest(new(ofs,0//1,cha,num,val)) )
end

## channel contol 14bit
type Control14 <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	cha::Int			# channel
	num::Int			# control number {0..31}
	val::Int			# control value {0..2^14-1}

	Control14(ofs,cha,num,val) = ( @assert 0<=val<=16383 && 0<=num<=31 ; atomTest(new(ofs,0//1,cha,num,val)) )
end

## track marker
type Marker <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	name::AbstractString	# marker name

	Marker(ofs,name) = ( @assert length(name) > 0 ; atomTest(new(ofs,0//1,name)) )
end

## set track time signature
type TimeSignature <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	num::Int			# numerator
	den::Int			# denominator as logarithm of 2
	clocks::Int			# divisions per quarter note
	sub::Int			# subdivisions

	TimeSignature(ofs,num,den,clocks,sub) = ( @assert 1<=num<=32 && 0<=den<=6 && 1<=clocks<64 && 1<=sub<64 ; atomTest(new(ofs,0//1,num,den,clocks,sub)) )
end

## track tempo
type Tempo <: Atom
	ofs::Rat			# offset
	dur::Rat			# duration
	bpm::Int			# beats per minute

	Tempo(ofs,bpm) = ( @assert 12<=bpm<=1728 ; atomTest(new(ofs,0//1,bpm)) )
end

## functions for writing Atoms to a MidiTrack; uses Jumidi functions; returns a's end time in MidiTrack ticks

function toTrack!(mt::MidiTrack, a::Note)
	t1 = timm(mt,a.ofs) ; t2 = t1 + tim(mt,a.dur) ; @assert t1 < t2-1
	ve = ftoi7(a.vel) ; pch::Int = Scales.getPitch(a.sca,a.ocv,a.itv) ; @assert 0 <= pch < 128
	noteOn!(mt,a.ofs,a.cha,pch,ve)
	noteOff!(mt,a.ofs+a.dur,a.cha,pch,ve)
	t2
end

toTrack!(mt::MidiTrack, a::BankSel) = bankSel!(mt,a.ofs,a.cha,a.bank)

toTrack!(mt::MidiTrack, a::ProgSel) = progSel!(mt,a.ofs,a.cha,a.prog)

toTrack!(mt::MidiTrack, a::VolSet) = control14!(mt,a.ofs,a.cha,7,ftoi14(a.vol))

toTrack!(mt::MidiTrack, a::PitchWheel) = pitchWheel!(mt,a.ofs,a.cha,a.val)

toTrack!(mt::MidiTrack, a::ChanAfter) = chanAfter!(mt,a.ofs,a.cha,a.val)

toTrack!(mt::MidiTrack, a::Control7) = control7!(mt,a.ofs,a.cha,a.num,a.val)

toTrack!(mt::MidiTrack, a::Control14) = control14!(mt,a.ofs,a.cha,a.num,a.val)

toTrack!(mt::MidiTrack, a::Marker) = trackMarker!(mt,a.ofs,a.name)

toTrack!(mt::MidiTrack, a::TimeSignature) = timeSigSet!(mt,a.ofs,a.num,a.den,a.clocks,a.sub)

toTrack!(mt::MidiTrack, a::Tempo) = tempoSet!(mt,a.ofs,a.bpm)

function Base.isequal(x::Atom, y::Atom)
	if typeof(x) != typeof(y) ; return false ; end
	for t in fieldnames(typeof(x))
		v1 = getfield(x,t)
		v2 = getfield(y,t)
		if !isequal(v1,v2) ; return false ; end
	end
	true
end


using JuMP; using NCDatasets; using AxisArrays; using CalliopeJuMP.Util;

function load_conversion_plus_constraints(model_dict)
    sets = model_dict["sets"]
    constraint_dict = Dict()

    constraint_dict["balance_conversion_plus_primary_constraint"] = (
        build_constraint(
            ["loc_techs_balance_conversion_plus_primary_constraint",
             "timesteps"], "balance_conversion_plus_primary", model_dict
        )
    )

    constraint_dict["carrier_production_max_conversion_plus_constraint"] = (
        build_constraint(
            ["loc_techs_carrier_production_max_conversion_plus_constraint",
             "timesteps"], "carrier_production_max_conversion_plus", model_dict
        )
    )

    if haskey(sets, "loc_techs_carrier_production_min_conversion_plus_constraint")
        constraint_dict["carrier_production_min_conversion_plus_constraint"] = (
            build_constraint(
                ["loc_techs_carrier_production_min_conversion_plus_constraint",
                "timesteps"], "carrier_production_min_conversion_plus", model_dict
            )
        )
    end

    if haskey(sets, "loc_techs_cost_var_conversion_plus_constraint")
        constraint_dict["cost_var_conversion_plus_constraint"] = (
            build_constraint(
                ["costs", "loc_techs_cost_var_conversion_plus_constraint", "timesteps"],
                "cost_var_conversion_plus", model_dict
            )
        )
    end

    if haskey(sets, "loc_techs_balance_conversion_plus_in_2_constraint")
        constraint_dict["balance_conversion_plus_in_2_constraint"] = (
            build_constraint(
                ["loc_techs_balance_conversion_plus_in_2_constraint", "timesteps"],
                "balance_conversion_plus_tiers", model_dict, tier="in_2"
            )
        )
    end

    if haskey(sets, "loc_techs_balance_conversion_plus_in_3_constraint")
        constraint_dict["balance_conversion_plus_in_3_constraint"] = (
            build_constraint(
                ["loc_techs_balance_conversion_plus_in_3_constraint", "timesteps"],
                "balance_conversion_plus_tiers", model_dict, tier="in_3"
            )
        )
    end

    if haskey(sets, "loc_techs_balance_conversion_plus_out_2_constraint")
        constraint_dict["balance_conversion_plus_out_2_constraint"] = (
            build_constraint(
                ["loc_techs_balance_conversion_plus_out_2_constraint", "timesteps"],
                "balance_conversion_plus_tiers", model_dict, tier="out_2"
            )
        )
    end

    if haskey(sets, "loc_techs_balance_conversion_plus_out_3_constraint")
        constraint_dict["balance_conversion_plus_out_3_constraint"] = (
            build_constraint(
                ["loc_techs_balance_conversion_plus_out_3_constraint", "timesteps"],
                "balance_conversion_plus_tiers", model_dict, tier="out_3"
            )
        )
    end

    return constraint_dict
end

function balance_conversion_plus_primary_constraint_rule(backend_model, set_indices, model_dict)
    """
    Balance energy carrier consumption and production for carrier_in and carrier_out
    """
    loc_tech, timestep = set_indices
    variables = model_dict["variables"]
    parameters = model_dict["parameters"]

    loc_tech_carriers_out = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, "out"]
    )
    loc_tech_carriers_in = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, "in"]
    )

    energy_eff = get_param(model_dict, "energy_eff", [loc_tech], timestep)

    carrier_prod = sum(
        variables["carrier_prod"][loc_tech_carrier, timestep] /
        get_param(model_dict, "carrier_ratios", [loc_tech_carrier, "out"])
        for loc_tech_carrier in loc_tech_carriers_out
    )
    carrier_con = sum(
        variables["carrier_con"][loc_tech_carrier, timestep] *
        get_param(model_dict, "carrier_ratios", [loc_tech_carrier, "in"])
        for loc_tech_carrier in loc_tech_carriers_in
    )

    return @constraint(backend_model, carrier_prod == -1 * carrier_con * energy_eff)
end

function carrier_production_max_conversion_plus_constraint_rule(backend_model, set_indices, model_dict)
    """
    Set maximum conversion_plus carrier production.
    """
    loc_tech, timestep = set_indices
    variables = model_dict["variables"]
    parameters = model_dict["parameters"]

    timestep_resolution = model_dict["parameters"]["timestep_resolution"][timestep]
    loc_tech_carriers_out = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, "out"]
    )

    carrier_prod = sum(variables["carrier_prod"][loc_tech_carrier, timestep]
                 for loc_tech_carrier in loc_tech_carriers_out)

    return @constraint(backend_model, carrier_prod <= timestep_resolution * variables["energy_cap"][loc_tech])
end

function carrier_production_min_conversion_plus_constraint_rule(backend_model, set_indices, model_dict)
    """
    Set minimum conversion_plus carrier production.
    """
    loc_tech, timestep = set_indices
    variables = model_dict["variables"]
    parameters = model_dict["parameters"]

    timestep_resolution = model_dict["parameters"]["timestep_resolution"][timestep]
    min_use = get_param(model_dict, "energy_cap_min_use", [loc_tech], timestep)

    loc_tech_carriers_out = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, "out"]
    )

    carrier_prod = sum(variables["carrier_prod"][loc_tech_carrier, timestep]
                       for loc_tech_carrier in loc_tech_carriers_out)

    return @constraint(backend_model, carrier_prod >=
        timestep_resolution * variables["energy_cap"][loc_tech] * min_use
    )
end

function cost_var_conversion_plus_constraint_rule(backend_model, set_indices, model_dict)
    """
    Add time-varying conversion_plus technology costs
    """
    cost, loc_tech, timestep = set_indices
    variables = model_dict["variables"]
    parameters = model_dict["parameters"]
    sets = model_dict["sets"]
    expressions = model_dict["expressions"]

    weight = parameters["timestep_weights"][timestep]

    loc_tech_carrier = parameters["lookup_primary_loc_tech_carriers"][loc_tech]

    var_cost = 0

    if loc_tech_carrier in sets["loc_tech_carriers_prod"]
        cost_om_prod = get_param(model_dict, "cost_om_prod", [loc_tech, cost], timestep)
        if cost_om_prod > 0
            var_cost += (
                cost_om_prod * weight *
                variables["carrier_prod"][loc_tech_carrier, timestep]
            )
        end
    end

    if loc_tech_carrier in sets["loc_tech_carriers_con"]
        cost_om_con = get_param(model_dict, "cost_om_con", [loc_tech, cost], timestep)
        if cost_om_con > 0
            var_cost += (
                cost_om_con * weight *
                variables["carrier_con"][loc_tech_carrier, timestep]
            )
        end
    end

    expressions["cost_var_rhs"][cost, loc_tech, timestep] = var_cost

    return @constraint(backend_model,
        variables["cost_var"][cost, loc_tech, timestep]
        == expressions["cost_var_rhs"][cost, loc_tech, timestep]
    )
end

function balance_conversion_plus_tiers_constraint_rule(backend_model, set_indices, model_dict, tier)
    """
    Force all carrier_in_2/carrier_in_3 and carrier_out_2/carrier_out_3 to follow
    carrier_in and carrier_out (respectively).
    """
    loc_tech, timestep = set_indices
    parameters = model_dict["parameters"]
    primary_tier, decision_variable = get_conversion_plus_io(model_dict, tier)

    loc_tech_carriers_1 = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, primary_tier]
    )
    loc_tech_carriers_2 = split_comma_list(
        parameters["lookup_loc_techs_conversion_plus"][loc_tech, tier]
    )

    c_1 = sum(decision_variable[loc_tech_carrier, timestep]
        / get_param(model_dict, "carrier_ratios", [loc_tech_carrier, primary_tier])
        for loc_tech_carrier in loc_tech_carriers_1)
    c_2 = sum(decision_variable[loc_tech_carrier, timestep]
        / get_param(model_dict, "carrier_ratios", [loc_tech_carrier, tier])
        for loc_tech_carrier in loc_tech_carriers_2)
    c_min = parameters["carrier_ratios_min"][loc_tech, tier]

    return @constraint(backend_model, c_1 * c_min == c_2)
end


function king_in_check(board::Bitboard, color::String="white")
    if color == "white"
        if board.K & board.black_attacks == EMPTY
            return false
        end
    else
        if board.k & board.white_attacks == EMPTY
            return false
        end
    end
    return kingtrace(board, color)
end

function square_in_check(board::Bitboard, ui::UInt64, color::String="white")
    if color == "white"
        if ui & board.a[1] != EMPTY
            return true
        end
        if ui & board.a[2] != EMPTY
            return true
        end
        if ui & board.a[4] != EMPTY || ui & board.a[3] != EMPTY
            squares, edges = orthogonal_attack(board.taken, ui)
            for rook in board.r
                if rook in edges
                    return true
                end
            end
            for queen in board.q
                if queen in edges
                    return true
                end
            end
        end
        if ui & board.a[5] != EMPTY || ui & board.a[3] != EMPTY
            squares, edges = cross_attack(board.taken, ui)
            for bishop in board.b
                if bishop in edges
                    return true
                end
            end
            for queen in board.q
                if queen in edges
                    return true
                end
            end
        end
        return false
    else
        if ui & board.A[1] != EMPTY
            return true
        end
        if ui & board.A[2] != EMPTY
            return true
        end
        if ui & board.A[4] != EMPTY || ui & board.A[3] != EMPTY
            squares, edges = orthogonal_attack(board.taken, ui)
            for rook in board.R
                if rook in edges
                    return true
                end
            end
            for queen in board.Q
                if queen in edges
                    return true
                end
            end
        end
        if ui & board.A[5] != EMPTY || ui & board.A[3] != EMPTY
            squares, edges = cross_attack(board.taken, ui)
            for bishop in board.B
                if bishop in edges
                    return true
                end
            end
            for queen in board.Q
                if queen in edges
                    return true
                end
            end
        end
        return false
    end
end

function kingtrace(board::Bitboard, color::String="white")
    if color == "white"
        return square_in_check(board, board.K, color)
    else
        return square_in_check(board, board.k, color)
    end
end

function check_mate(board::Bitboard, color::String="white")
    if color == "white"
        king = board.K
    else
        king = board.k
    end

    if length(get_current_king_valid(board, color)) != 0
        return false
    else
        if length(get_all_valid_moves(board, color)) == 0
            return true
        else
            return false
        end
    end
end


################################################################################
# Use the Julia-PerpleX interface to run the same isobaric Perplex calculation
# with different solution models to compare results

## --- Import some useful packages
    using StatGeochem
    using Plots; gr();
    using Statistics, DelimitedFiles, SpecialFunctions

## --- Configure

    # Absolute paths to perplex resources
    perplexdir = joinpath(resourcepath,"perplex-stable")
    scratchdir = "./scratch/" # Location of directory to store output files

    # Attempt to install perplex, if not already extant
    if !isfile(joinpath(perplexdir,"vertex"))
        # Make sure resourcepath exists
        run(`mkdir -p $resourcepath`)

        # Download Perplex v6.8.7 -- known to work with interface used here
        file = download("https://storage.googleapis.com/statgeochem/perplex-stable-6.8.7.zip", joinpath(resourcepath,"perplex-stable.zip"))

        # # For a more updated perplex version, also try
        # file = download("https://petrol.natur.cuni.cz/~ondro/perplex-sources-stable.zip", joinpath(resourcepath,"perplex-stable.zip"))

        run(`unzip -u $file -d $resourcepath`) # Extract
        system("cd $perplexdir; make") # Compile
    end

## --- # # # # # # # # # # # # # Initial composition # # # # # # # # # # # # # #
    ## McDonough Pyrolite
    #elements =    [ "SIO2", "TIO2", "AL2O3",  "FEO",  "MNO",  "MGO",  "CAO", "NA2O",  "K2O",  "H2O",  "CO2",]
    #composition = [45.1242, 0.2005, 4.4623, 8.0723, 0.1354, 37.9043, 3.5598, 0.3610, 0.0291, 0.1511, 0.0440,]

    ## Kelemen (2014) primitive continental basalt. H2O and CO2 are guesses
    #elements =    [ "SIO2", "TIO2", "AL2O3",  "FEO",  "MNO",  "MGO",  "CAO", "NA2O",  "K2O",  "H2O",  "CO2",]
    #composition = [50.0956, 0.9564, 15.3224, 8.5103, 0.1659, 9.2520, 9.6912, 2.5472, 0.8588, 2.0000, 0.6000,]

    # Kelemen (2014) primitive continental basalt excluding Mn and Ti since most melt models can"t handle them..
    elements =    [ "SIO2", "AL2O3",  "FEO",  "MGO",  "CAO", "NA2O",  "K2O",  "H2O",  "CO2",]
    composition = [50.0956, 15.3224, 8.5103, 9.2520, 9.6912, 2.5472, 0.8588, 2.0000, 0.6000,]

    ## Average Archean basalt (EarthChem data)
    #elements =    [ "SIO2", "TIO2", "AL2O3",   "FEO",  "MNO",   "MGO",  "CAO", "NA2O",  "K2O",  "H2O",  "CO2",]
    #composition = [49.2054, 0.8401, 12.0551, 11.4018, 0.2198, 12.3997, 9.3113, 1.6549, 0.4630, 1.8935, 0.5555,]

## --- # # # # # # # # # # # Some solution model options # # # # # # # # # # # #
    # Emphasis on phases from Green (2016) -- developed for metabasites, includes what is probably the best (and most expensive) amphibole model. Use with hp11ver.dat
    G_solution_phases = "Augite(G)\nOpx(JH)\ncAmph(G)\noAmph(DP)\nO(JH)\nSp(JH)\nGrt(JH)\nfeldspar_B\nMica(W)\nBio(TCC)\nChl(W)\nCtd(W)\nCrd(W)\nSa(WP)\nSt(W)\nIlm(WPH)\nAtg(PN)\nT\nB\nF\nDo(HP)\nScap\nChum\nNeph(FB)\n"
    G_excludes ="ged\nfanth\ngl\n"

    # Emphasis on phases from White (2014) -- developed for metapelites. Use with hp11ver.dat
    W_solution_phases = "Omph(HP)\nOpx(W)\ncAmph(DP)\noAmph(DP)\nO(JH)\nSp(JH)\nGt(W)\nfeldspar_B\nMica(W)\nBi(W)\nChl(W)\nCtd(W)\nCrd(W)\nSa(WP)\nSt(W) \nIlm(WPH)\nAtg(PN)\nT\nB\nF\nDo(HP)\nScap\nChum\nPu(M)\n"
    W_excludes = "andr\nts\nparg\ngl\nged\nfanth\n"

    # Emphasis on phases from Jennings and Holland (2015) -- developed for mantle melting. Use with hp11ver.dat
    JH_solution_phases = "Cpx(JH)\nOpx(JH)\ncAmph(DP)\noAmph(DP)\nO(JH)\nSp(JH)\nGrt(JH)\nfeldspar_B\nMica(W)\nBio(TCC)\nChl(W)\nCtd(W)\nCrd(W)\nSa(WP)\nSt(W)\nIlm(WPH)\nAtg(PN)\nT\nB\nF\nDo(HP)\nScap\nChum\nNeph(FB)\n"
    JH_excludes = "ts\nparg\ngl\nged\nfanth\n"

    # Emphasis on phases from Holland and Powell -- all phases can be used with hp02ver.dat.
    HP_solution_phases = "Omph(HP)\nOpx(HP)\nGlTrTsPg\nAnth\nO(HP)\nSp(HP)\nGt(HP)\nfeldspar_B\nMica(CF)\nBio(TCC)\nChl(HP)\nCtd(HP)\nSapp(HP)\nSt(HP)\nIlHm(A)\nDo(HP)\nT\nB\nF\n"
    HP_excludes = "";

## --- Prepare for plotting

    h0 = plot(xlabel="T (C)", ylabel="Melt percent")

## --- # # # # # # # # # # melt(G) + G_solution_phases # # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 1
    print("\nmelt(G) + G_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(G)\n"*G_solution_phases, excludes=G_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(G)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] .- (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(G) + G")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(G) + G_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_G.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(G) + G_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_G.pdf")

## --- # # # # # # # # # # melt(G) + W_solution_phases # # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 2
    print("\nmelt(G) + W_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(G)\n"*W_solution_phases, excludes=W_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_system(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(G)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(G) + W")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(G) + W_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_G_W.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(G) + W_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_G_W.pdf")

## --- # # # # # # # # # # melt(G) +JH_solution_phases # # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 3
    print("\nmelt(G) + JH_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(G)\n"*JH_solution_phases, excludes=JH_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(G)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(G) + JH")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(G) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_G_JH.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(G) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_G_JH.pdf")

## --- # # # # # # # # # # pMELTS(G) +HP_solution_phases # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 4
    print("\npMELTS(G) + JH_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp02ver.dat", solution_phases="pMELTS(G)\n"*JH_solution_phases, excludes=JH_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "pMELTS(G)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="pMELTS(G) + JH")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="pMELTS(G) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_pMELTS_JH.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="pMELTS(G) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_pMELTS_JH.pdf")

## --- # # # # # # # # # # # melt(W) + W_solution_phases # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 5
    print("\nmelt(W) + W_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(W)\n"*W_solution_phases, excludes=W_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(W)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(W) + W")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(W) + W_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_W.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(W) + W_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_W.pdf")

## --- # # # # # # # # # # melt(W) + G_solution_phases # # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 6
    print("\nmelt(W) + G_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(W)\n"*G_solution_phases, excludes=G_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(W)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(W) + G")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(W) + G_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_W_G.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(W) + G_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_W_G.pdf")

## --- # # # # # # # # # # # melt(W) +JH_solution_phases # # # # # # # # # # # #

    # Input parameters
    P = 10000 # bar
    T_range = [500+273.15, 1500+273.15]
    idx = 7
    print("\nmelt(W) + JH_solution_phases\n")
    @time perplex_configure_isobar(perplexdir, scratchdir, composition, elements, P, T_range, dataset="hp11ver.dat", solution_phases="melt(W)\n"*JH_solution_phases, excludes=JH_excludes, index=idx)

    # Query the full isobar -- results returned as elementified dictionary
    T_range_inc = [floor(Int,T_range[1])+1, ceil(Int,T_range[2])-1]
    npoints = T_range_inc[2] - T_range_inc[1] + 1
    bulk = perplex_query_system(perplexdir, scratchdir, index=idx)            # Get system data for all temperatures. Set include_fluid = "n" to get solid+melt only
    modes = perplex_query_modes(perplexdir, scratchdir, index=idx)            # || phase modes
    melt = perplex_query_phase(perplexdir, scratchdir, "melt(W)", index=idx)  # || melt data

    # Create dictionary to hold solid composition and fill it using what we know from system and melt
    solid = Dict()
    solid["wt_pct"] = 100 .- melt["wt_pct"]
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        solid[e] = (bulk[e] - (melt[e] .* melt["wt_pct"]/100)) ./ (solid["wt_pct"]/100)
    end

    # Add results to melt % vs temperature figure
    plot!(h0, melt["T(K)"] .- 273.15, melt["wt_pct"], label="melt(W) + JH")

    # Plot melt composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in melt", title="melt(W) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], melt[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box)
    savefig(h,"Perplex_MeltTest_W_JH.pdf")

    # Plot solid composition as a function of melt percent
    h = plot(xlabel="Percent melt", ylabel="Wt. % in solid", title="melt(W) + JH_solution_phases, $P bar")
    for e in ["SIO2","AL2O3","FEO","MGO","CAO","NA2O","K2O"]
        plot!(h, melt["wt_pct"], solid[e], label=e)
    end
    plot!(h,fg_color_legend=:white, framestyle=:box, legend=:topleft)
    savefig(h,"Perplex_SolidTest_W_JH.pdf")

## --- Format melt comparison

    plot!(h0,fg_color_legend=:white,legend=:topleft)
    display(h0)
    savefig(h0,"Perplex_T-F_comparison.pdf")

## --- End of File


function nextline(pf::IO, c::Char)
    eof(pf) && return "-1"
    s = "\0"
    while s[1] != c
        eof(pf) && return "-1"
        s = chomp(readline(pf))
    end
    return s
end

@doc """
    H, R = uwpf(pf[, v])

Read UW-format seismic pick file `pf` into SeisHdr object `H`, with seismic
source description (focal mechanism) returned in SeisSrc object `R`.

    uwpf!(W, pf[, v::Integer=KW.v])

Read UW-format seismic pick info from pickfile `f` into SeisEvent object `W`.
Overwrites W.source and W.hdr with pickfile information. Keyword `v` controls
verbosity.

!!! caution

    Reader has no safety check to guarantee that `pf` is from the same event.

""" uwpf
function uwpf(pickfile::String; v::Integer=KW.v)
  # Initialize variables that will fill SeisHdr structure
  D   = Dict{String, Any}()
  MAG = -5.0f0
  ID  = ""
  OT  = zero(Float64)
  loc = zeros(Float64, 12)
  sig = ""
  locflags = Array{Char, 1}(undef,8)
  R = SeisSrc()
  fill!(locflags, '0')

  # Read begins
  pf = open(pickfile, "r")

  # ========================================================================
  # Acard line
  A = nextline(pf, 'A')
  (v > 1)  && println(stdout, A)
  c = 0
  if length(A) == 75 || length(A) == 12
    y = zero(Int8)
    c = 1900
  else
    y = Int8(2)
  end
  D["type"] = getindex(A, 2)

  # ACard indices
  #
  # Crosson's notes:
  # Type, Year, Month,  Day,  Hour, Min,  Sec,  LatDeg, NS, Latmin*100, LongDeg,  EW, Lonmin*100, Depth, Fix, Magnitude, Numsta, numphase, Gap, Mindelta, RMS, ERR, Q1, Q2, Velmodel
  # ATYYYYMMDDHHMM SS.SS LLNMMMM LLLWMMMM DD.DD* M.M NN/0NN GGG DD R.RR EE.EQQ VV
  # AF200206291436  4.79 45N2009 121W4118  6.20* 4.5 41/041  37  9 0.27  0.1BB O0
  #
  #        Sec,Lat,Lon,Dep,Fix,Mag,Nst,Nph,Gap, d0,RMS,ERR, Q, mod
  si = Int8[13, 19, 27, 36, 42, 43, 47, 51, 54, 58, 61, 66, 71, 74] .+ y
  ei = Int8[18, 26, 35, 41, 42, 46, 49, 53, 57, 60, 65, 70, 72, 75] .+ y
  L = length(si)

  # Parse reset of Acard line
  ah = Array{String,1}(undef, L)
  for i = 1:L
    setindex!(ah, getindex(A, getindex(si, i):getindex(ei, i)), i)
  end
  v > 2 && println("ah = ", ah)

  # origin time, event depth, and magnitude
  OT            = d2u(DateTime(string(parse(Int64, A[3:4+y]) + c)*A[5+y:12+y],
                      "yyyymmddHHMM")) + parse(Float64, getindex(ah, 1))
  evla          = getindex(ah, 2)
  evlo          = getindex(ah, 3)
  loc[3]        = parse(Float64, getindex(ah, 4))       # depth           :dep
  locflags[3]   = (getindex(ah, 5) == "F") ? '1' : '0'
  MAG           = parse(Float32, getindex(ah, 6))
  nst           = parse(Int64, getindex(ah, 7))
  D["numpha"]   = parse(Int64, getindex(ah, 8))
  loc[10]       = parse(Float64, getindex(ah, 9))       # gap             :gap
  loc[11]       = parse(Float64, getindex(ah, 10))      # min distance    :dmin
  loc[9]        = parse(Float64, getindex(ah, 11))      # rms pick error  :rms
  loc[8]        = parse(Float64, getindex(ah, 12))      # standard error  :se
  D["qual"]     = getindex(ah, 13)
  D["vmod"]     = getindex(ah, 14)

  # Convert lat and lon to decimal degrees
  loc[1] = (parse(Float64, evla[1:3]) +
            parse(Float64, evla[5:6])/60.0 +
            parse(Float64, evla[7:8])/6000.0) * (evla[4] == 'S' ? -1.0 : 1.0)
  loc[2] = (parse(Float64, evlo[1:4]) +
            parse(Float64, evlo[6:7])/60.0 +
            parse(Float64, evlo[8:9])/6000.0) * (evlo[5] == 'W' ? -1.0 : 1.0)

  # ========================================================================
  # Error line
  seekstart(pf)
  eline = nextline(pf, 'E')
  if eline != "-1"
    # E O0  0.27 0.022 0.281 0.281  141.30  38   Z  0.05 0.05 0.11 0.01 4.50 0.000.03
    # Effectively: 10x   MeanRMS    SDabout0    SDaboutMean    SSWRES    NDFR    FIXXYZT    SDx    SDy    SDz    SDt    Mag  5x MeanUncert
    #              10x   f6.3       f6.3        f6.3           f8.2      i4      a4        f5.2   f5.2   f5.2   f5.2   f5.2  5x f4.2
    eline_keys = String["MeanRMS", "SDabout0", "SDaboutMean", "SSWRES", "NDFR", "FIXXYZT", "SDx", "SDy", "SDz", "SDt", "Mag", "MeanUncert"]
    si =           Int8[       11,         17,            23,       29,     37,        42,    46,     51,    56,   61,    66,           76]
    ei =           Int8[       16,         22,            28,       36,     40,        45,    50,     55,    60,   65,    70,           79]
    j = 0

    while j < length(eline_keys)
      j = j + 1
      a = getindex(si, j)
      b = getindex(ei, j)
      s = getindex(eline, a:b)
      if j == 6
        (s[1] == 'X') && (locflags[1] = '1')
        (s[2] == 'Y') && (locflags[2] = '1')
        (s[3] == 'Z') && (locflags[3] = '1')
        (s[4] == 'T') && (locflags[4] = '1')
      elseif j == 7
        loc[4] = parse(Float64, s)
      elseif j == 8
        loc[5] = parse(Float64, s)
      elseif j == 9
        loc[6] = parse(Float64, s)
      elseif j == 10
        if s != "*****"
          loc[7] = parse(Float64, s)
        end
      elseif !isempty(s)
        k = getindex(eline_keys, j)
        D[k] = parse(j == 5 ? Int32 : Float32, s)
      end
    end
    sig = "1σ"
  end
  LOC = EQLoc(loc..., nst, parse(UInt8, join(locflags), base=2), "", "hypocenter", "", "SPONG")

  # ========================================================================
  # Focal mechanism line(s)
  #= Note: planes F and G azimuth and an incidence are NOT in N°E. They're
    measured clockwise from the (N°E) azimuth of the dip vector, because R.
    Crosson wanted to be a unique special snowflake.

    The axes copied to Hdr.axes are therefore P, T, with the last field of
    the 3Tuple set to 0.0.
  =#
  seekstart(pf)
  mline = nextline(pf,'M')
  m = 0
  PAX = Array{Float64,2}(undef, 2 ,2)
  NP = Array{Float64,2}(undef, 2, 2)
  if mline != "-1"
    # Convert first mechanism line
    M = split(mline)

    setindex!(NP, parse(Float64, getindex(M, 3)), 1)
    setindex!(NP, parse(Float64, getindex(M, 4)), 2)
    setindex!(NP, parse(Float64, getindex(M, 6)), 3)
    setindex!(NP, parse(Float64, getindex(M, 7)), 4)

    # Order here is T, P
    setindex!(PAX, parse(Float64, getindex(M, 18)), 1)
    setindex!(PAX, parse(Float64, getindex(M, 19)), 2)
    setindex!(PAX, parse(Float64, getindex(M, 15)), 3)
    setindex!(PAX, parse(Float64, getindex(M, 16)), 4)

    setfield!(R, :pax, PAX)
    setfield!(R, :planes, NP)
    pf_str = abspath(pickfile)
    setfield!(R, :src, pf_str)
    note!(R, "+source ¦ " * pf_str)

    # Add rest to a dictionary
    mech_lines = Array{String, 1}(undef, 0)
    mline = nextline(pf,'M')
    while mline != "-1"
      m += 1
      push!(mech_lines, mline)
      mline = nextline(pf,'M')
    end
    R.gap = getindex(loc, 10)
    if !isempty(mech_lines)
      R.misc["mech_lines"] = mech_lines
    end
    v>0 && println(stdout, "Processed ", m, " focal mechanism lines.")
    note!(R, string("planes are arranged [θ₁ θ₂; ϕ₁ ϕ₂] but θ₁, θ₂ are NOT oriented N°E. ",
                    "They're measured clockwise from the N°E azimuth of the dip vector."))
    note!(R, string("gap is copied from the A-card line; this likely ",
                    "under-represents the true focal mechanism gap."))
  end

  # ========================================================================
  # Comment lines
  seekstart(pf)
  m = 0
  cline = nextline(pf,'C')
  if cline != "-1"
    D["comment"] = Array{String, 1}(undef, 0)
    while cline != "-1"
      m = m + 1
      L = lastindex(cline)
      if occursin("NEAR", cline)
        D["loc_name"] = getindex(cline, 8:L)
      elseif occursin("EVENT ID", cline)
        ID = getindex(cline, 13:L)
      elseif occursin("LOCATED BY", cline)
        setfield!(LOC, :src, getfield(LOC, :src) * "; " * getindex(cline, 3:L))
      else
        push!(D["comment"], getindex(cline, 3:L))
      end
      cline = nextline(pf,'C')
    end
    v > 0 && println(stdout, "Processed ", m, " comment lines.")
  end

  # ========================================================================
  # Done reading
  close(pf)
  H = SeisHdr()
  src_str = abspath(pickfile)
  setfield!(H, :loc, LOC)
  setfield!(H, :src, src_str)
  note!(H, "+source ¦ " * src_str)
  if MAG != -5.0f0
    setfield!(H, :mag, EQMag(val = MAG, scale = "Md", src = "SPONG"))
  end
  if OT != zero(Float64)
    setfield!(H, :ot, u2d(OT))
  end
  if isempty(ID) == false
    setfield!(H, :id, string(ID))
    setfield!(R, :eid, string(ID))
  end
  if isempty(D) == false
    setfield!(H, :misc, D)
  end

  return H, R
end

@doc (@doc uwpf)
function uwpf!(S::SeisEvent, pickfile::String; v::Integer=KW.v)
  (H, R) = uwpf(pickfile, v=v)

  N   = getfield(getfield(S, :data), :n)
  ID  = getfield(getfield(S, :data), :id)
  PHA = getfield(getfield(S, :data), :pha)
  cha = Array{String,1}(undef, N)
  for i = 1:N
    id = split(getindex(ID, i), ".", keepempty=true)
    setindex!(cha, string(".", getindex(id, 2), ".", getindex(id, 4)), i)
  end
  v > 2 && println("cha = ", cha)

  # Pick lines (requires reopening/rereading file)
  m = 0
  ndur = 0
  npol = 0
  pf = open(pickfile, "r")
  pick_line = nextline(pf, '.')

  while pick_line != "-1"
    v>1 && println(stdout, "pick_line = ", pick_line)
    m += 1
    pdat = split(pick_line, "(")
    pick_cha = getindex(pdat, 1)
    pcat = PhaseCat()
    dur = 0.0

    # Parse picks
    for j = 2:length(pdat)
      pha = split(getindex(pdat, j))
      if getindex(pha, 1) == "P"
        v > 2 && println(pha)
        pol = getindex(pha, 3)[1]
        if pol != '_'
          npol = npol + 1
        end
        pcat[getindex(pha,2)] = SeisPha(
          0.0,                              # amp
          0.0,                              # d
          0.0,                              # inc
          parse(Float64, pha[7][1:end-1]),  # res
          0.0,                              # rp
          0.0,                              # ta
          parse(Float64, pha[4]),           # tt --> relative to file begin; fixed below
          parse(Float64, pha[6]),           # unc
          pol,                              # polarity
          pha[5][1]                         # quality
          )
      elseif getindex(pha, 1) == "D"
        dur = parse(Float64, getindex(pha,2)[1:end-1])
      end
    end

    # Assign to the correct channel
    for i = 1:N
      if startswith(pick_cha, getindex(cha, i))
        for p in keys(pcat)
          PHA[i][p] = pcat[p]
        end
        if dur > 0.0
          ndur = ndur + 1
          S.data.misc[i]["dur"] = dur
        end
        break
      end
    end
    pick_line = nextline(pf, '.')
  end
  v>0 && println(stdout, "Processed ", m, " pick lines.")
  close(pf)

  # Set ndur, npol
  setfield!(getfield(H, :mag), :nst, ndur)
  setfield!(R, :npol, npol)

  # Place hdr, source
  setfield!(S, :hdr, H)
  setfield!(S, :source, R)

  # Done
  return S
end