<|start_filename|>tests/fortran/functional_curve.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module functional_curve

  use, intrinsic :: iso_c_binding, only: c_double
  use types, only: dp
  use functional_test_helpers, only: intersect_and_check
  implicit none
  private &
       case1, &
       case2, &
       case3, &
       case4, &
       case5, &
       case6, &
       case7, &
       case8, &
       case9, &
       case10, &
       case11, &
       case12, &
       case13, &
       case14, &
       case15, &
       case16, &
       case17, &
       case18, &
       case19, &
       case20, &
       case21, &
       case22, &
       case23, &
       case24, &
       case25, &
       case26, &
       case27, &
       case28, &
       case29, &
       case30, &
       case31, &
       case32, &
       case33, &
       case34, &
       case35, &
       case36, &
       case37, &
       case38, &
       case39, &
       case40, &
       case41, &
       case42, &
       case43, &
       case44, &
       case45, &
       case46, &
       case47, &
       case48, &
       case49, &
       case50
  public all_cases

contains

  subroutine case1()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes2(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes2(:, 1) = [1.125_dp, 0.5_dp]
    nodes2(:, 2) = [0.625_dp, -0.5_dp]
    nodes2(:, 3) = [0.125_dp, 0.5_dp]

    expected_params(1, :) = [0.21451472732312363_dp, 0.9104852726768764_dp]
    expected_params(2, :) = [0.9104852726768764_dp, 0.21451472732312363_dp]

    call intersect_and_check( &
         1, &
         3, nodes1, &
         3, nodes2, &
         2, expected_params)

  end subroutine case1

  subroutine case2()

    real(c_double) :: nodes3(2, 3)
    real(c_double) :: nodes4(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes3(:, 1) = [0.0_dp, 0.0_dp]
    nodes3(:, 2) = [1.5_dp, 3.0_dp]
    nodes3(:, 3) = [3.0_dp, 0.0_dp]

    nodes4(:, 1) = [3.0_dp, 1.5_dp]
    nodes4(:, 2) = [2.625_dp, -0.90625_dp]
    nodes4(:, 3) = [-0.75_dp, 2.4375_dp]

    expected_params(1, :) = [0.25_dp, 0.875_dp]
    expected_params(2, :) = [0.75_dp, 0.25_dp]

    call intersect_and_check( &
         2, &
         3, nodes3, &
         3, nodes4, &
         2, expected_params)

  end subroutine case2

  subroutine case3()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes5(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes5(:, 1) = [0.0_dp, 0.75_dp]
    nodes5(:, 2) = [0.5_dp, -0.25_dp]
    nodes5(:, 3) = [1.0_dp, 0.75_dp]

    expected_params(1, :) = [0.25_dp, 0.75_dp]
    expected_params(2, :) = [0.25_dp, 0.75_dp]

    call intersect_and_check( &
         3, &
         3, nodes1, &
         3, nodes5, &
         2, expected_params)

  end subroutine case3

  subroutine case4()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes6(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes6(:, 1) = [0.0_dp, 1.0_dp]
    nodes6(:, 2) = [0.5_dp, 0.0_dp]
    nodes6(:, 3) = [1.0_dp, 1.0_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         4, &
         3, nodes1, &
         3, nodes6, &
         1, expected_params)

  end subroutine case4

  subroutine case5()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes7(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes7(:, 1) = [0.0_dp, 0.265625_dp]
    nodes7(:, 2) = [0.5_dp, 0.234375_dp]
    nodes7(:, 3) = [1.0_dp, 0.265625_dp]

    expected_params(1, :) = [0.15184468808860432_dp, 0.8481553119113957_dp]
    expected_params(2, :) = [0.15184468808860432_dp, 0.8481553119113957_dp]

    call intersect_and_check( &
         5, &
         3, nodes1, &
         3, nodes7, &
         2, expected_params)

  end subroutine case5

  subroutine case6()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes8(2, 2)
    real(c_double) :: expected_params(2, 2)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes8(:, 1) = [0.0_dp, 0.375_dp]
    nodes8(:, 2) = [1.0_dp, 0.375_dp]

    expected_params(1, :) = [0.25_dp, 0.75_dp]
    expected_params(2, :) = [0.25_dp, 0.75_dp]

    call intersect_and_check( &
         6, &
         3, nodes1, &
         2, nodes8, &
         2, expected_params)

  end subroutine case6

  subroutine case7()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes9(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes9(:, 1) = [0.5_dp, 0.0_dp]
    nodes9(:, 2) = [0.5_dp, 0.75_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.6666666666666666_dp]

    call intersect_and_check( &
         7, &
         3, nodes1, &
         2, nodes9, &
         1, expected_params)

  end subroutine case7

  subroutine case8()

    real(c_double) :: nodes10(2, 3)
    real(c_double) :: nodes11(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes10(:, 1) = [0.0_dp, 0.0_dp]
    nodes10(:, 2) = [4.5_dp, 9.0_dp]
    nodes10(:, 3) = [9.0_dp, 0.0_dp]

    nodes11(:, 1) = [0.0_dp, 8.0_dp]
    nodes11(:, 2) = [6.0_dp, 0.0_dp]

    expected_params(1, :) = [0.3333333333333333_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         8, &
         3, nodes10, &
         2, nodes11, &
         1, expected_params)

  end subroutine case8

  subroutine case9()

    real(c_double) :: nodes8(2, 2)
    real(c_double) :: nodes9(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes8(:, 1) = [0.0_dp, 0.375_dp]
    nodes8(:, 2) = [1.0_dp, 0.375_dp]

    nodes9(:, 1) = [0.5_dp, 0.0_dp]
    nodes9(:, 2) = [0.5_dp, 0.75_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         9, &
         2, nodes8, &
         2, nodes9, &
         1, expected_params)

  end subroutine case9

  subroutine case10()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes13(2, 5)
    real(c_double) :: expected_params(2, 4)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes13(:, 1) = [0.0_dp, 0.0_dp]
    nodes13(:, 2) = [0.25_dp, 2.0_dp]
    nodes13(:, 3) = [0.5_dp, -2.0_dp]
    nodes13(:, 4) = [0.75_dp, 2.0_dp]
    nodes13(:, 5) = [1.0_dp, 0.0_dp]

    expected_params(1, :) = [ &
         0.0_dp, &
         0.3110177634953864_dp, &
         0.6889822365046137_dp, &
         1.0_dp]
    expected_params(2, :) = [ &
         0.0_dp, &
         0.3110177634953864_dp, &
         0.6889822365046137_dp, &
         1.0_dp]

    call intersect_and_check( &
         10, &
         3, nodes1, &
         5, nodes13, &
         4, expected_params)

  end subroutine case10

  subroutine case11()

    real(c_double) :: nodes14(2, 3)
    real(c_double) :: nodes15(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes14(:, 1) = [0.0_dp, 0.0_dp]
    nodes14(:, 2) = [0.375_dp, 0.75_dp]
    nodes14(:, 3) = [0.75_dp, 0.375_dp]

    nodes15(:, 1) = [0.25_dp, 0.625_dp]
    nodes15(:, 2) = [0.625_dp, 0.25_dp]
    nodes15(:, 3) = [1.0_dp, 1.0_dp]

    expected_params(1, :) = [0.6666666666666666_dp]
    expected_params(2, :) = [0.3333333333333333_dp]

    call intersect_and_check( &
         11, &
         3, nodes14, &
         3, nodes15, &
         1, expected_params)

  end subroutine case11

  subroutine case12()

    real(c_double) :: nodes14(2, 3)
    real(c_double) :: nodes16(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes14(:, 1) = [0.0_dp, 0.0_dp]
    nodes14(:, 2) = [0.375_dp, 0.75_dp]
    nodes14(:, 3) = [0.75_dp, 0.375_dp]

    nodes16(:, 1) = [0.25_dp, 0.5625_dp]
    nodes16(:, 2) = [0.625_dp, 0.1875_dp]
    nodes16(:, 3) = [1.0_dp, 0.9375_dp]

    expected_params(1, :) = [0.5_dp, 0.8333333333333334_dp]
    expected_params(2, :) = [0.16666666666666666_dp, 0.5_dp]

    call intersect_and_check( &
         12, &
         3, nodes14, &
         3, nodes16, &
         2, expected_params)

  end subroutine case12

  subroutine case13()

    real(c_double) :: nodes10(2, 3)
    real(c_double) :: nodes17(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes10(:, 1) = [0.0_dp, 0.0_dp]
    nodes10(:, 2) = [4.5_dp, 9.0_dp]
    nodes10(:, 3) = [9.0_dp, 0.0_dp]

    nodes17(:, 1) = [11.0_dp, 8.0_dp]
    nodes17(:, 2) = [7.0_dp, 10.0_dp]
    nodes17(:, 3) = [3.0_dp, 4.0_dp]

    expected_params(1, :) = [0.3333333333333333_dp]
    expected_params(2, :) = [1.0_dp]

    call intersect_and_check( &
         13, &
         3, nodes10, &
         3, nodes17, &
         1, expected_params)

  end subroutine case13

  subroutine case14()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes18(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes18(:, 1) = [1.0_dp, 0.0_dp]
    nodes18(:, 2) = [1.5_dp, -1.0_dp]
    nodes18(:, 3) = [2.0_dp, 0.0_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.0_dp]

    call intersect_and_check( &
         14, &
         3, nodes1, &
         3, nodes18, &
         1, expected_params)

  end subroutine case14

  subroutine case15()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes19(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes19(:, 1) = [2.0_dp, 0.0_dp]
    nodes19(:, 2) = [1.5_dp, 1.0_dp]
    nodes19(:, 3) = [1.0_dp, 0.0_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [1.0_dp]

    call intersect_and_check( &
         15, &
         3, nodes1, &
         3, nodes19, &
         1, expected_params)

  end subroutine case15

  subroutine case16()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes20(2, 3)
    real(c_double) :: expected_params(2, 4)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes20(:, 1) = [1.0_dp, 0.0_dp]
    nodes20(:, 2) = [-1.0_dp, 0.25_dp]
    nodes20(:, 3) = [1.0_dp, 0.5_dp]

    expected_params(1, :) = [ &
         0.09549150281252629_dp, &
         0.25_dp, &
         0.6545084971874737_dp, &
         1.0_dp]
    expected_params(2, :) = [ &
         0.3454915028125263_dp, &
         0.75_dp, &
         0.9045084971874737_dp, &
         0.0_dp]

    call intersect_and_check( &
         16, &
         3, nodes1, &
         3, nodes20, &
         4, expected_params)

  end subroutine case16

  subroutine case17()

    real(c_double) :: nodes20(2, 3)
    real(c_double) :: nodes21(2, 3)
    real(c_double) :: expected_params(2, 4)

    nodes20(:, 1) = [1.0_dp, 0.0_dp]
    nodes20(:, 2) = [-1.0_dp, 0.25_dp]
    nodes20(:, 3) = [1.0_dp, 0.5_dp]

    nodes21(:, 1) = [-0.125_dp, -0.28125_dp]
    nodes21(:, 2) = [0.5_dp, 1.28125_dp]
    nodes21(:, 3) = [1.125_dp, -0.28125_dp]

    expected_params(1, :) = [ &
         0.0_dp, &
         0.3454915028125263_dp, &
         0.75_dp, &
         0.9045084971874737_dp]
    expected_params(2, :) = [ &
         0.9_dp, &
         0.17639320225002103_dp, &
         0.3_dp, &
         0.623606797749979_dp]

    call intersect_and_check( &
         17, &
         3, nodes20, &
         3, nodes21, &
         4, expected_params)

  end subroutine case17

  subroutine case18()

    real(c_double) :: nodes21(2, 3)
    real(c_double) :: nodes22(2, 3)
    real(c_double) :: expected_params(2, 4)

    nodes21(:, 1) = [-0.125_dp, -0.28125_dp]
    nodes21(:, 2) = [0.5_dp, 1.28125_dp]
    nodes21(:, 3) = [1.125_dp, -0.28125_dp]

    nodes22(:, 1) = [1.5625_dp, -0.0625_dp]
    nodes22(:, 2) = [-1.5625_dp, 0.25_dp]
    nodes22(:, 3) = [1.5625_dp, 0.5625_dp]

    expected_params(1, :) = [ &
         0.17639320225002103_dp, &
         0.3_dp, &
         0.623606797749979_dp, &
         0.9_dp]
    expected_params(2, :) = [ &
         0.37639320225002104_dp, &
         0.7_dp, &
         0.823606797749979_dp, &
         0.1_dp]

    call intersect_and_check( &
         18, &
         3, nodes21, &
         3, nodes22, &
         4, expected_params)

  end subroutine case18

  subroutine case19()

    real(c_double) :: nodes10(2, 3)
    real(c_double) :: nodes23(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes10(:, 1) = [0.0_dp, 0.0_dp]
    nodes10(:, 2) = [4.5_dp, 9.0_dp]
    nodes10(:, 3) = [9.0_dp, 0.0_dp]

    nodes23(:, 1) = [3.0_dp, 4.5_dp]
    nodes23(:, 2) = [8.0_dp, 4.5_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.3_dp]

    call intersect_and_check( &
         19, &
         3, nodes10, &
         2, nodes23, &
         1, expected_params)

  end subroutine case19

  subroutine case20()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes24(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes24(:, 1) = [0.25_dp, 0.375_dp]
    nodes24(:, 2) = [0.75_dp, 0.875_dp]
    nodes24(:, 3) = [1.25_dp, -0.625_dp]

    expected_params(1, :) = [0.25_dp, 1.0_dp]
    expected_params(2, :) = [0.0_dp, 0.75_dp]

    call intersect_and_check( &
         20, &
         3, nodes1, &
         3, nodes24, &
         2, expected_params)

  end subroutine case20

  subroutine case21()

    real(c_double) :: nodes15(2, 3)
    real(c_double) :: nodes25(2, 4)
    real(c_double) :: expected_params(2, 1)

    nodes15(:, 1) = [0.25_dp, 0.625_dp]
    nodes15(:, 2) = [0.625_dp, 0.25_dp]
    nodes15(:, 3) = [1.0_dp, 1.0_dp]

    nodes25(:, 1) = [0.0_dp, 0.5_dp]
    nodes25(:, 2) = [0.25_dp, 1.0_dp]
    nodes25(:, 3) = [0.75_dp, 1.5_dp]
    nodes25(:, 4) = [1.0_dp, 0.5_dp]

    expected_params(1, :) = [0.8587897065534015_dp]
    expected_params(2, :) = [0.873452854150878_dp]

    call intersect_and_check( &
         21, &
         3, nodes15, &
         4, nodes25, &
         1, expected_params)

  end subroutine case21

  subroutine case22()

    real(c_double) :: nodes11(2, 2)
    real(c_double) :: nodes26(2, 4)
    real(c_double) :: expected_params(2, 3)

    nodes11(:, 1) = [0.0_dp, 8.0_dp]
    nodes11(:, 2) = [6.0_dp, 0.0_dp]

    nodes26(:, 1) = [0.375_dp, 7.0_dp]
    nodes26(:, 2) = [2.125_dp, 8.0_dp]
    nodes26(:, 3) = [3.875_dp, 0.0_dp]
    nodes26(:, 4) = [5.625_dp, 1.0_dp]

    expected_params(1, :) = [ &
         0.11416126713641388_dp, &
         0.5_dp, &
         0.8858387328635862_dp]
    expected_params(2, :) = [ &
         0.059041448155901566_dp, &
         0.5_dp, &
         0.9409585518440984_dp]

    call intersect_and_check( &
         22, &
         2, nodes11, &
         4, nodes26, &
         3, expected_params)

  end subroutine case22

  subroutine case23()

    real(c_double) :: nodes8(2, 2)
    real(c_double) :: nodes27(2, 4)
    real(c_double) :: expected_params(2, 2)

    nodes8(:, 1) = [0.0_dp, 0.375_dp]
    nodes8(:, 2) = [1.0_dp, 0.375_dp]

    nodes27(:, 1) = [0.125_dp, 0.25_dp]
    nodes27(:, 2) = [0.375_dp, 0.75_dp]
    nodes27(:, 3) = [0.625_dp, 0.0_dp]
    nodes27(:, 4) = [0.875_dp, 0.1875_dp]

    expected_params(1, :) = [0.20998193826534545_dp, 0.4482997212940395_dp]
    expected_params(2, :) = [0.11330925102046059_dp, 0.4310662950587193_dp]

    call intersect_and_check( &
         23, &
         2, nodes8, &
         4, nodes27, &
         2, expected_params)

  end subroutine case23

  subroutine case24()

    real(c_double) :: nodes28(2, 3)
    real(c_double) :: nodes29(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes28(:, 1) = [0.0_dp, 0.0_dp]
    nodes28(:, 2) = [-0.5_dp, 1.5_dp]
    nodes28(:, 3) = [1.0_dp, 1.0_dp]

    nodes29(:, 1) = [-1.0_dp, 1.0_dp]
    nodes29(:, 2) = [0.5_dp, 0.5_dp]
    nodes29(:, 3) = [0.0_dp, 2.0_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         24, &
         3, nodes28, &
         3, nodes29, &
         1, expected_params)

  end subroutine case24

  subroutine case25()

    real(c_double) :: nodes29(2, 3)
    real(c_double) :: nodes30(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes29(:, 1) = [-1.0_dp, 1.0_dp]
    nodes29(:, 2) = [0.5_dp, 0.5_dp]
    nodes29(:, 3) = [0.0_dp, 2.0_dp]

    nodes30(:, 1) = [0.5_dp, 0.5_dp]
    nodes30(:, 2) = [-0.25_dp, 1.25_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.6666666666666666_dp]

    call intersect_and_check( &
         25, &
         3, nodes29, &
         2, nodes30, &
         1, expected_params)

  end subroutine case25

  subroutine case26()

    real(c_double) :: nodes8(2, 2)
    real(c_double) :: nodes23(2, 2)
    real(c_double) :: expected_params(2, 0)

    nodes8(:, 1) = [0.0_dp, 0.375_dp]
    nodes8(:, 2) = [1.0_dp, 0.375_dp]

    nodes23(:, 1) = [3.0_dp, 4.5_dp]
    nodes23(:, 2) = [8.0_dp, 4.5_dp]

    call intersect_and_check( &
         26, &
         2, nodes8, &
         2, nodes23, &
         0, expected_params)

  end subroutine case26

  subroutine case27()

    real(c_double) :: nodes11(2, 2)
    real(c_double) :: nodes31(2, 2)
    real(c_double) :: expected_params(2, 0)

    nodes11(:, 1) = [0.0_dp, 8.0_dp]
    nodes11(:, 2) = [6.0_dp, 0.0_dp]

    nodes31(:, 1) = [0.25_dp, 16.75_dp]
    nodes31(:, 2) = [12.25_dp, 0.75_dp]

    call intersect_and_check( &
         27, &
         2, nodes11, &
         2, nodes31, &
         0, expected_params)

  end subroutine case27

  subroutine case28()

    real(c_double) :: nodes32(2, 3)
    real(c_double) :: nodes33(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes32(:, 1) = [-0.25_dp, -0.25_dp]
    nodes32(:, 2) = [0.1875_dp, -0.25_dp]
    nodes32(:, 3) = [0.625_dp, -0.25_dp]

    nodes33(:, 1) = [-0.125_dp, 0.0_dp]
    nodes33(:, 2) = [0.0625_dp, -0.5_dp]
    nodes33(:, 3) = [0.0_dp, -1.0_dp]

    expected_params(1, :) = [0.23214285714285715_dp]
    expected_params(2, :) = [0.25_dp]

    call intersect_and_check( &
         28, &
         3, nodes32, &
         3, nodes33, &
         1, expected_params)

  end subroutine case28

  subroutine case29()

    real(c_double) :: nodes34(2, 2)
    real(c_double) :: nodes35(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes34(:, 1) = [0.5_dp, 1.875_dp]
    nodes34(:, 2) = [0.5_dp, 2.625_dp]

    nodes35(:, 1) = [0.625_dp, 2.625_dp]
    nodes35(:, 2) = [-0.625_dp, 2.625_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.1_dp]

    call intersect_and_check( &
         29, &
         2, nodes34, &
         2, nodes35, &
         1, expected_params)

  end subroutine case29

  subroutine case30()

    real(c_double) :: nodes36(2, 2)
    real(c_double) :: nodes37(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes36(:, 1) = [0.5_dp, -0.375_dp]
    nodes36(:, 2) = [0.0_dp, -0.75_dp]

    nodes37(:, 1) = [-0.5_dp, -0.875_dp]
    nodes37(:, 2) = [1.25_dp, 0.0_dp]

    expected_params(1, :) = [0.0_dp]
    expected_params(2, :) = [0.5714285714285714_dp]

    call intersect_and_check( &
         30, &
         2, nodes36, &
         2, nodes37, &
         1, expected_params)

  end subroutine case30

  subroutine case31()

    real(c_double) :: nodes38(2, 3)
    real(c_double) :: nodes39(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes38(:, 1) = [0.5_dp, 0.125_dp]
    nodes38(:, 2) = [1.25_dp, -0.25_dp]
    nodes38(:, 3) = [2.0_dp, 0.5_dp]

    nodes39(:, 1) = [0.5_dp, -0.125_dp]
    nodes39(:, 2) = [1.0_dp, 0.125_dp]
    nodes39(:, 3) = [1.5_dp, -0.125_dp]

    expected_params(1, :) = [0.3333333333333333_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         31, &
         3, nodes38, &
         3, nodes39, &
         1, expected_params)

  end subroutine case31

  subroutine case32()

    real(c_double) :: nodes40(2, 2)
    real(c_double) :: nodes41(2, 2)
    real(c_double) :: expected_params(2, 0)

    nodes40(:, 1) = [-0.28040801468046_dp, -0.21145489702592957_dp]
    nodes40(:, 2) = [-0.30573520623357997_dp, -0.07183588647159315_dp]

    nodes41(:, 1) = [-0.2867761039288504_dp, -0.17635312979393736_dp]
    nodes41(:, 2) = [-0.3727388074986012_dp, -0.2689285277745333_dp]

    call intersect_and_check( &
         32, &
         2, nodes40, &
         2, nodes41, &
         0, expected_params)

  end subroutine case32

  subroutine case33()

    real(c_double) :: nodes42(2, 4)
    real(c_double) :: nodes43(2, 4)
    real(c_double) :: expected_params(2, 2)

    nodes42(:, 1) = [0.0_dp, 2.0_dp]
    nodes42(:, 2) = [-0.5_dp, 1.0_dp]
    nodes42(:, 3) = [-0.25_dp, 0.75_dp]
    nodes42(:, 4) = [-0.09375_dp, 0.828125_dp]

    nodes43(:, 1) = [-0.09375_dp, 0.828125_dp]
    nodes43(:, 2) = [0.0625_dp, 0.90625_dp]
    nodes43(:, 3) = [0.125_dp, 1.3125_dp]
    nodes43(:, 4) = [-0.75_dp, 1.625_dp]

    expected_params(1, :) = [0.2546440075000701_dp, 1.0_dp]
    expected_params(2, :) = [0.7453559924999299_dp, 0.0_dp]

    call intersect_and_check( &
         33, &
         4, nodes42, &
         4, nodes43, &
         2, expected_params)

  end subroutine case33

  subroutine case34()

    real(c_double) :: nodes44(2, 4)
    real(c_double) :: nodes45(2, 4)
    real(c_double) :: expected_params(2, 1)

    nodes44(:, 1) = [0.0_dp, 2.0_dp]
    nodes44(:, 2) = [-0.25_dp, 1.5_dp]
    nodes44(:, 3) = [-0.3125_dp, 1.1875_dp]
    nodes44(:, 4) = [-0.29296875_dp, 1.009765625_dp]

    nodes45(:, 1) = [-0.29296875_dp, 1.009765625_dp]
    nodes45(:, 2) = [-0.2734375_dp, 0.83203125_dp]
    nodes45(:, 3) = [-0.171875_dp, 0.7890625_dp]
    nodes45(:, 4) = [-0.09375_dp, 0.828125_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.0_dp]

    call intersect_and_check( &
         34, &
         4, nodes44, &
         4, nodes45, &
         1, expected_params)

  end subroutine case34

  subroutine case35()

    real(c_double) :: nodes46(2, 4)
    real(c_double) :: nodes47(2, 4)
    real(c_double) :: expected_params(2, 1)

    nodes46(:, 1) = [-0.09375_dp, 0.828125_dp]
    nodes46(:, 2) = [-0.015625_dp, 0.8671875_dp]
    nodes46(:, 3) = [0.0390625_dp, 0.98828125_dp]
    nodes46(:, 4) = [-0.03515625_dp, 1.138671875_dp]

    nodes47(:, 1) = [-0.03515625_dp, 1.138671875_dp]
    nodes47(:, 2) = [-0.109375_dp, 1.2890625_dp]
    nodes47(:, 3) = [-0.3125_dp, 1.46875_dp]
    nodes47(:, 4) = [-0.75_dp, 1.625_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.0_dp]

    call intersect_and_check( &
         35, &
         4, nodes46, &
         4, nodes47, &
         1, expected_params)

  end subroutine case35

  subroutine case36()

    real(c_double) :: nodes48(2, 2)
    real(c_double) :: nodes49(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes48(:, 1) = [1.0_dp, -3.0_dp]
    nodes48(:, 2) = [1.0_dp, 3.0_dp]

    nodes49(:, 1) = [10.0_dp, 0.0_dp]
    nodes49(:, 2) = [0.0_dp, 0.0_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.9_dp]

    call intersect_and_check( &
         36, &
         2, nodes48, &
         2, nodes49, &
         1, expected_params)

  end subroutine case36

  subroutine case37()

    real(c_double) :: nodes50(2, 2)
    real(c_double) :: nodes54(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes50(:, 1) = [2.25_dp, 3.03125_dp]
    nodes50(:, 2) = [2.125_dp, 2.875_dp]

    nodes54(:, 1) = [2.1015625_dp, 2.875_dp]
    nodes54(:, 2) = [2.16015625_dp, 2.875_dp]
    nodes54(:, 3) = [2.220703125_dp, 2.875_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.1993377410829988_dp]

    call intersect_and_check( &
         37, &
         2, nodes50, &
         3, nodes54, &
         1, expected_params)

  end subroutine case37

  subroutine case38()

    real(c_double) :: nodes51(2, 2)
    real(c_double) :: nodes54(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes51(:, 1) = [2.125_dp, 2.875_dp]
    nodes51(:, 2) = [2.3125_dp, 2.84375_dp]

    nodes54(:, 1) = [2.1015625_dp, 2.875_dp]
    nodes54(:, 2) = [2.16015625_dp, 2.875_dp]
    nodes54(:, 3) = [2.220703125_dp, 2.875_dp]

    expected_params(1, :) = [0.0_dp]
    expected_params(2, :) = [0.1993377410829988_dp]

    call intersect_and_check( &
         38, &
         2, nodes51, &
         3, nodes54, &
         1, expected_params)

  end subroutine case38

  subroutine case39()

    real(c_double) :: nodes52(2, 3)
    real(c_double) :: nodes54(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes52(:, 1) = [2.25_dp, 3.03125_dp]
    nodes52(:, 2) = [2.1875_dp, 2.953125_dp]
    nodes52(:, 3) = [2.125_dp, 2.875_dp]

    nodes54(:, 1) = [2.1015625_dp, 2.875_dp]
    nodes54(:, 2) = [2.16015625_dp, 2.875_dp]
    nodes54(:, 3) = [2.220703125_dp, 2.875_dp]

    expected_params(1, :) = [1.0_dp]
    expected_params(2, :) = [0.1993377410829988_dp]

    call intersect_and_check( &
         39, &
         3, nodes52, &
         3, nodes54, &
         1, expected_params)

  end subroutine case39

  subroutine case40()

    real(c_double) :: nodes53(2, 3)
    real(c_double) :: nodes54(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes53(:, 1) = [2.125_dp, 2.875_dp]
    nodes53(:, 2) = [2.21875_dp, 2.859375_dp]
    nodes53(:, 3) = [2.3125_dp, 2.84375_dp]

    nodes54(:, 1) = [2.1015625_dp, 2.875_dp]
    nodes54(:, 2) = [2.16015625_dp, 2.875_dp]
    nodes54(:, 3) = [2.220703125_dp, 2.875_dp]

    expected_params(1, :) = [0.0_dp]
    expected_params(2, :) = [0.1993377410829988_dp]

    call intersect_and_check( &
         40, &
         3, nodes53, &
         3, nodes54, &
         1, expected_params)

  end subroutine case40

  subroutine case41()

    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes55(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    nodes1(:, 3) = [1.0_dp, 0.0_dp]

    nodes55(:, 1) = [0.0_dp, 0.5_dp]
    nodes55(:, 2) = [1.0_dp, 0.5_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         41, &
         3, nodes1, &
         2, nodes55, &
         1, expected_params)

  end subroutine case41

  subroutine case42()

    real(c_double) :: nodes56(2, 3)
    real(c_double) :: nodes57(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes56(:, 1) = [12.0_dp, 4.0_dp]
    nodes56(:, 2) = [-4.0_dp, -4.0_dp]
    nodes56(:, 3) = [-4.0_dp, 4.0_dp]

    nodes57(:, 1) = [6.0_dp, 1.0_dp]
    nodes57(:, 2) = [-2.0_dp, -1.0_dp]
    nodes57(:, 3) = [-2.0_dp, 1.0_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         42, &
         3, nodes56, &
         3, nodes57, &
         1, expected_params)

  end subroutine case42

  subroutine case43()

    real(c_double) :: nodes58(2, 3)
    real(c_double) :: nodes59(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes58(:, 1) = [1.0_dp, 0.0_dp]
    nodes58(:, 2) = [1.0_dp, 1.0_dp]
    nodes58(:, 3) = [0.0_dp, 1.0_dp]

    nodes59(:, 1) = [1.0_dp, 0.0_dp]
    nodes59(:, 2) = [1.0_dp, 1.5_dp]
    nodes59(:, 3) = [-0.5_dp, 1.5_dp]

    expected_params(1, :) = [0.0_dp]
    expected_params(2, :) = [0.0_dp]

    call intersect_and_check( &
         43, &
         3, nodes58, &
         3, nodes59, &
         1, expected_params)

  end subroutine case43

  subroutine case44()

    real(c_double) :: nodes60(2, 3)
    real(c_double) :: nodes59(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes60(:, 1) = [0.9375_dp, -0.5625_dp]
    nodes60(:, 2) = [1.1875_dp, 0.6875_dp]
    nodes60(:, 3) = [0.4375_dp, 0.9375_dp]

    nodes59(:, 1) = [1.0_dp, 0.0_dp]
    nodes59(:, 2) = [1.0_dp, 1.5_dp]
    nodes59(:, 3) = [-0.5_dp, 1.5_dp]

    expected_params(1, :) = [0.25_dp]
    expected_params(2, :) = [0.0_dp]

    call intersect_and_check( &
         44, &
         3, nodes60, &
         3, nodes59, &
         1, expected_params)

  end subroutine case44

  subroutine case45()

    real(c_double) :: nodes61(2, 3)
    real(c_double) :: nodes62(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes61(:, 1) = [12.0_dp, 4.0_dp]
    nodes61(:, 2) = [-12.0_dp, -8.0_dp]
    nodes61(:, 3) = [0.0_dp, 16.0_dp]

    nodes62(:, 1) = [6.0_dp, 1.0_dp]
    nodes62(:, 2) = [-6.0_dp, -2.0_dp]
    nodes62(:, 3) = [0.0_dp, 4.0_dp]

    expected_params(1, :) = [0.3333333333333333_dp]
    expected_params(2, :) = [0.3333333333333333_dp]

    call intersect_and_check( &
         45, &
         3, nodes61, &
         3, nodes62, &
         1, expected_params)

  end subroutine case45

  subroutine case46()

    real(c_double) :: nodes63(2, 3)
    real(c_double) :: nodes64(2, 3)
    real(c_double) :: expected_params(2, 3)

    nodes63(:, 1) = [0.0_dp, 0.0_dp]
    nodes63(:, 2) = [0.5_dp, 2.0_dp]
    nodes63(:, 3) = [1.0_dp, 0.0_dp]

    nodes64(:, 1) = [1.0_dp, 0.1_dp]
    nodes64(:, 2) = [-0.6722503405359305_dp, 0.5_dp]
    nodes64(:, 3) = [1.0_dp, 1.0_dp]

    expected_params(1, :) = [ &
         0.17292378169294392_dp, &
         0.6666077520083393_dp, &
         0.9725947698747117_dp]
    expected_params(2, :) = [ &
         0.5520155861681976_dp, &
         0.8877064436020611_dp, &
         0.00826238406154377_dp]

    call intersect_and_check( &
         46, &
         3, nodes63, &
         3, nodes64, &
         3, expected_params)

  end subroutine case46

  subroutine case47()

    real(c_double) :: nodes65(2, 3)
    real(c_double) :: nodes66(2, 3)
    real(c_double) :: expected_params(2, 3)

    nodes65(:, 1) = [-0.5_dp, -3.0_dp]
    nodes65(:, 2) = [0.5_dp, 5.0_dp]
    nodes65(:, 3) = [1.5_dp, -3.0_dp]

    nodes66(:, 1) = [4.0_dp, -4.125_dp]
    nodes66(:, 2) = [-1.5_dp, 1.375_dp]
    nodes66(:, 3) = [1.0_dp, 0.875_dp]

    expected_params(1, :) = [ &
         0.375_dp, &
         0.5721745075055178_dp, &
         0.8653254924944822_dp]
    expected_params(2, :) = [ &
         0.75_dp, &
         0.9181509849889643_dp, &
         0.33184901501103564_dp]

    call intersect_and_check( &
         47, &
         3, nodes65, &
         3, nodes66, &
         3, expected_params)

  end subroutine case47

  subroutine case48()

    real(c_double) :: nodes67(2, 2)
    real(c_double) :: nodes68(2, 2)
    real(c_double) :: expected_params(2, 1)

    nodes67(:, 1) = [0.0_dp, 0.0_dp]
    nodes67(:, 2) = [1.0_dp, 1.0_dp]

    nodes68(:, 1) = [0.00390625_dp, -0.00390625_dp]
    nodes68(:, 2) = [0.99609375_dp, 1.00390625_dp]

    expected_params(1, :) = [0.5_dp]
    expected_params(2, :) = [0.5_dp]

    call intersect_and_check( &
         48, &
         2, nodes67, &
         2, nodes68, &
         1, expected_params)

  end subroutine case48

  subroutine case49()

    real(c_double) :: nodes69(2, 3)
    real(c_double) :: nodes70(2, 3)
    real(c_double) :: expected_params(2, 1)

    nodes69(:, 1) = [0.0_dp, 0.0_dp]
    nodes69(:, 2) = [1.0_dp, 0.0_dp]
    nodes69(:, 3) = [1.0_dp, 1.0_dp]

    nodes70(:, 1) = [0.00390625_dp, -0.00390625_dp]
    nodes70(:, 2) = [1.00390625_dp, -0.00390625_dp]
    nodes70(:, 3) = [0.99609375_dp, 1.00390625_dp]

    expected_params(1, :) = [0.7071067811865476_dp]
    expected_params(2, :) = [0.7071067811865476_dp]

    call intersect_and_check( &
         49, &
         3, nodes69, &
         3, nodes70, &
         1, expected_params)

  end subroutine case49

  subroutine case50()

    real(c_double) :: nodes71(2, 3)
    real(c_double) :: nodes72(2, 3)
    real(c_double) :: expected_params(2, 2)

    nodes71(:, 1) = [0.5003591034553179_dp, -0.5985224678695326_dp]
    nodes71(:, 2) = [0.4424702153048212_dp, -0.6835950191386464_dp]
    nodes71(:, 3) = [0.3838240936690618_dp, -0.7622137966405907_dp]

    nodes72(:, 1) = [0.4958221889917101_dp, -0.5983563350601222_dp]
    nodes72(:, 2) = [0.44414160334741726_dp, -0.6900255095833565_dp]
    nodes72(:, 3) = [0.38700163732483334_dp, -0.753067262372925_dp]

    expected_params(1, :) = [0.30862335873249314_dp, 0.7448360508660676_dp]
    expected_params(2, :) = [0.2978170326600928_dp, 0.7636785393899922_dp]

    call intersect_and_check( &
         50, &
         3, nodes71, &
         3, nodes72, &
         2, expected_params)

  end subroutine case50

  subroutine all_cases()

    call case1()
    call case2()
    call case3()
    call case4()
    call case5()
    call case6()
    call case7()
    call case8()
    call case9()
    call case10()
    call case11()
    call case12()
    call case13()
    call case14()
    call case15()
    call case16()
    call case17()
    call case18()
    call case19()
    call case20()
    call case21()
    call case22()
    call case23()
    call case24()
    call case25()
    call case26()
    call case27()
    call case28()
    call case29()
    call case30()
    call case31()
    call case32()
    call case33()
    call case34()
    call case35()
    call case36()
    call case37()
    call case38()
    call case39()
    call case40()
    call case41()
    call case42()
    call case43()
    call case44()
    call case45()
    call case46()
    call case47()
    call case48()
    call case49()
    call case50()

  end subroutine all_cases

end module functional_curve


<|start_filename|>docs/abi/example_locate_point_curve.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 4;
    int dimension = 2;
    double nodes[8] = { 0.0, 2.0, -1.0, 0.0, 1.0, 1.0, -0.75, 1.625 };
    double point1[2] = { -0.09375, 0.828125 };
    double point2[2] = { 0.0, 1.5 };
    double point3[2] = { -0.25, 1.375 };

    // Outputs.
    double s_approx;

    BEZ_locate_point_curve(&num_nodes, &dimension, nodes, point1, &s_approx);
    printf("When B(s) = [% f, %f]; s = % f\n", point1[0], point1[1], s_approx);
    BEZ_locate_point_curve(&num_nodes, &dimension, nodes, point2, &s_approx);
    printf("When B(s) = [% f, %f]; s = % f\n", point2[0], point2[1], s_approx);
    BEZ_locate_point_curve(&num_nodes, &dimension, nodes, point3, &s_approx);
    printf("When B(s) = [% f, %f]; s = % f\n", point3[0], point3[1], s_approx);

    return 0;
}


<|start_filename|>docs/abi/example_compute_length.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 2;
    int dimension = 2;
    double nodes[4] = { 0.0, 0.0, 3.0, 4.0 };

    // Outputs.
    double length;
    int error_val;

    BEZ_compute_length(&num_nodes, &dimension, nodes, &length, &error_val);
    printf("Length: %f\n", length);
    printf("Error value: %d\n", error_val);

    return 0;
}


<|start_filename|>docs/abi/example_subdivide_nodes_curve.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 3;
    int dimension = 2;
    double nodes[6] = { 0.0, 0.0, 1.25, 3.0, 2.0, 1.0 };

    // Outputs.
    double left_nodes[6];
    double right_nodes[6];

    BEZ_subdivide_nodes_curve(
        &num_nodes, &dimension, nodes, left_nodes, right_nodes);
    printf("Left Nodes:\n");
    printf("%f, %f, %f\n", left_nodes[0], left_nodes[2], left_nodes[4]);
    printf("%f, %f, %f\n", left_nodes[1], left_nodes[3], left_nodes[5]);
    printf("Right Nodes:\n");
    printf("%f, %f, %f\n", right_nodes[0], right_nodes[2], right_nodes[4]);
    printf("%f, %f, %f\n", right_nodes[1], right_nodes[3], right_nodes[5]);

    return 0;
}


<|start_filename|>src/fortran/include/bezier/triangle_intersection.h<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#ifndef BEZIER_TRIANGLE_INTERSECTION_H
#define BEZIER_TRIANGLE_INTERSECTION_H

#include "bezier/status.h"

#if defined(__cplusplus)
extern "C" {
#endif

typedef enum TriangleContained {
    NEITHER = 0,
    FIRST = 1,
    SECOND = 2,
} TriangleContained;

typedef struct CurvedPolygonSegment {
    double start;
    double end;
    int edge_index;
} CurvedPolygonSegment;

void BEZ_newton_refine_triangle(const int* num_nodes, const double* nodes,
    const int* degree, const double* x_val, const double* y_val,
    const double* s, const double* t, double* updated_s, double* updated_t);
void BEZ_locate_point_triangle(const int* num_nodes, const double* nodes,
    const int* degree, const double* x_val, const double* y_val, double* s_val,
    double* t_val);
void BEZ_triangle_intersections(const int* num_nodes1, const double* nodes1,
    const int* degree1, const int* num_nodes2, const double* nodes2,
    const int* degree2, const int* segment_ends_size, int* segment_ends,
    int* segments_size, CurvedPolygonSegment* segments, int* num_intersected,
    TriangleContained* contained, Status* status);
void BEZ_free_triangle_intersections_workspace(void);

#if defined(__cplusplus)
}
#endif

#endif /* BEZIER_TRIANGLE_INTERSECTION_H */


<|start_filename|>tests/fortran/test_triangle.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module test_triangle

  use, intrinsic :: iso_c_binding, only: c_bool, c_double, c_int, c_ptr, c_loc
  use triangle, only: &
       de_casteljau_one_round, evaluate_barycentric, &
       evaluate_barycentric_multi, evaluate_cartesian_multi, jacobian_both, &
       jacobian_det, specialize_triangle, subdivide_nodes, compute_edge_nodes, &
       shoelace_for_area, compute_area
  use types, only: dp
  use unit_test_helpers, only: &
       print_status, get_random_nodes, get_id_mat, ref_triangle_uniform_params
  implicit none
  private &
       test_de_casteljau_one_round, test_evaluate_barycentric, &
       test_evaluate_barycentric_multi, test_evaluate_cartesian_multi, &
       test_jacobian_both, test_jacobian_det, &
       test_specialize_triangle, test_subdivide_nodes, &
       subdivide_points_check, test_compute_edge_nodes, &
       test_shoelace_for_area, test_compute_area
  public triangle_all_tests

contains

  subroutine triangle_all_tests(success)
    logical(c_bool), intent(inout) :: success

    call test_de_casteljau_one_round(success)
    call test_evaluate_barycentric(success)
    call test_evaluate_barycentric_multi(success)
    call test_evaluate_cartesian_multi(success)
    call test_jacobian_both(success)
    call test_jacobian_det(success)
    call test_specialize_triangle(success)
    call test_subdivide_nodes(success)
    call test_compute_edge_nodes(success)
    call test_shoelace_for_area(success)
    call test_compute_area(success)

  end subroutine triangle_all_tests

  subroutine test_de_casteljau_one_round(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(2, 6), nodes3(2, 10)
    real(c_double) :: new_nodes1(2, 1), new_nodes2(2, 3), new_nodes3(2, 6)
    real(c_double) :: expected1(2, 1), expected2(2, 3), expected3(2, 6)
    real(c_double) :: lambda1, lambda2, lambda3
    integer :: case_id
    character(22) :: name

    case_id = 1
    name = "de_casteljau_one_round"

    ! CASE 1: Linear reference triangle (just goes to point).
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.5_dp
    lambda3 = 0.375_dp
    expected1(:, 1) = [lambda2, lambda3]
    call de_casteljau_one_round( &
         3, 2, nodes1, 1, &
         lambda1, lambda2, lambda3, new_nodes1)
    case_success = all(new_nodes1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    call get_random_nodes(nodes2, 790931, 1483, num_bits=8)
    ! NOTE: Use a fixed seed so the test is deterministic and round
    !       the nodes to 8 bits of precision to avoid round-off.
    lambda1 = 0.625_dp
    lambda2 = 0.25_dp
    lambda3 = 0.125_dp
    expected2(:, 1) = ( &
         lambda1 * nodes2(:, 1) + &  ! p200
         lambda2 * nodes2(:, 2) + &  ! p110
         lambda3 * nodes2(:, 4))  ! p101
    expected2(:, 2) = ( &
         lambda1 * nodes2(:, 2) + &  ! p110
         lambda2 * nodes2(:, 3) + &  ! p020
         lambda3 * nodes2(:, 5))  ! p011
    expected2(:, 3) = ( &
         lambda1 * nodes2(:, 4) + &  ! p101
         lambda2 * nodes2(:, 5) + &  ! p011
         lambda3 * nodes2(:, 6))  ! p002
    call de_casteljau_one_round( &
         6, 2, nodes2, 2, &
         lambda1, lambda2, lambda3, new_nodes2)
    case_success = all(new_nodes2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    nodes3(:, 1) = [0.0_dp, 0.0_dp]
    nodes3(:, 2) = [3.25_dp, 1.5_dp]
    nodes3(:, 3) = [6.5_dp, 1.5_dp]
    nodes3(:, 4) = [10.0_dp, 0.0_dp]
    nodes3(:, 5) = [1.5_dp, 3.25_dp]
    nodes3(:, 6) = [5.0_dp, 5.0_dp]
    nodes3(:, 7) = [10.0_dp, 5.25_dp]
    nodes3(:, 8) = [1.5_dp, 6.5_dp]
    nodes3(:, 9) = [5.25_dp, 10.0_dp]
    nodes3(:, 10) = [0.0_dp, 10.0_dp]
    lambda1 = 0.375_dp
    lambda2 = 0.25_dp
    lambda3 = 0.375_dp
    expected3(:, 1) = ( &
         lambda1 * nodes3(:, 1) + &  ! p300
         lambda2 * nodes3(:, 2) + &  ! p210
         lambda3 * nodes3(:, 5))  ! p201
    expected3(:, 2) = ( &
         lambda1 * nodes3(:, 2) + &  ! p210
         lambda2 * nodes3(:, 3) + &  ! p120
         lambda3 * nodes3(:, 6))  ! p111
    expected3(:, 3) = ( &
         lambda1 * nodes3(:, 3) + &  ! p120
         lambda2 * nodes3(:, 4) + &  ! p030
         lambda3 * nodes3(:, 7))  ! p021
    expected3(:, 4) = ( &
         lambda1 * nodes3(:, 5) + &  ! p201
         lambda2 * nodes3(:, 6) + &  ! p111
         lambda3 * nodes3(:, 8))  ! p102
    expected3(:, 5) = ( &
         lambda1 * nodes3(:, 6) + &  ! p111
         lambda2 * nodes3(:, 7) + &  ! p021
         lambda3 * nodes3(:, 9))  ! p012
    expected3(:, 6) = ( &
         lambda1 * nodes3(:, 8) + &  ! p102
         lambda2 * nodes3(:, 9) + &  ! p012
         lambda3 * nodes3(:, 10))  ! p003

    call de_casteljau_one_round( &
         10, 2, nodes3, 3, &
         lambda1, lambda2, lambda3, new_nodes3)
    case_success = all(new_nodes3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_de_casteljau_one_round

  subroutine test_evaluate_barycentric(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(2, 6), nodes3(3, 6)
    real(c_double) :: nodes4(2, 10), nodes5(2, 15)
    real(c_double) :: point1(2, 1), point2(3, 1)
    real(c_double) :: expected1(2, 1), expected2(3, 1)
    real(c_double) :: lambda1, lambda2, lambda3
    integer :: index_, i, j, k, trinomial
    integer :: case_id
    character(20) :: name

    case_id = 1
    name = "evaluate_barycentric"

    ! CASE 1: Linear triangle.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.5_dp]
    nodes1(:, 3) = [0.0_dp, 1.25_dp]
    lambda1 = 0.25_dp
    lambda2 = 0.5_dp
    lambda3 = 0.25_dp
    expected1(:, 1) = [0.5_dp, 0.5625_dp]
    call evaluate_barycentric( &
         3, 2, nodes1, 1, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    lambda1 = 0.0_dp
    lambda2 = 0.25_dp
    lambda3 = 0.75_dp
    nodes2(:, 1) = [0.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.5_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.5_dp]
    nodes2(:, 4) = [0.5_dp, 1.25_dp]
    nodes2(:, 5) = [0.0_dp, 1.25_dp]
    nodes2(:, 6) = [0.0_dp, 0.5_dp]
    expected1(:, 1) = [0.0625_dp, 0.78125_dp]
    call evaluate_barycentric( &
         6, 2, nodes2, 2, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Quadratic triangle in 3D.
    nodes3(:, 1) = [0.0_dp, 0.0_dp, 1.0_dp]
    nodes3(:, 2) = [0.5_dp, 0.0_dp, 0.25_dp]
    nodes3(:, 3) = [1.0_dp, 0.5_dp, 0.0_dp]
    nodes3(:, 4) = [0.5_dp, 1.25_dp, 1.25_dp]
    nodes3(:, 5) = [0.0_dp, 1.25_dp, 0.5_dp]
    nodes3(:, 6) = [0.0_dp, 0.5_dp, -1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.375_dp
    lambda3 = 0.5_dp
    expected2(:, 1) = [0.25_dp, 0.8203125_dp, 0.1328125_dp]
    call evaluate_barycentric( &
         6, 3, nodes3, 2, lambda1, lambda2, lambda3, point2)
    case_success = all(point2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Cubic triangle.
    nodes4(:, 1) = [0.0_dp, 0.0_dp]
    nodes4(:, 2) = [0.25_dp, 0.0_dp]
    nodes4(:, 3) = [0.75_dp, 0.25_dp]
    nodes4(:, 4) = [1.0_dp, 0.0_dp]
    nodes4(:, 5) = [0.0_dp, 0.25_dp]
    nodes4(:, 6) = [0.375_dp, 0.25_dp]
    nodes4(:, 7) = [0.5_dp, 0.25_dp]
    nodes4(:, 8) = [0.0_dp, 0.5_dp]
    nodes4(:, 9) = [0.25_dp, 0.75_dp]
    nodes4(:, 10) = [0.0_dp, 1.0_dp]
    lambda1 = 0.125_dp
    lambda2 = 0.5_dp
    lambda3 = 0.375_dp
    expected1(:, 1) = [0.447265625_dp, 0.37060546875_dp]
    call evaluate_barycentric( &
         10, 2, nodes4, 3, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Quartic (random) triangle.
    call get_random_nodes(nodes5, 64441, 222, num_bits=8)
    ! NOTE: Use a fixed seed so the test is deterministic and round
    !       the nodes to 8 bits of precision to avoid round-off.
    lambda1 = 0.125_dp
    lambda2 = 0.375_dp
    lambda3 = 0.5_dp
    ! We will manually compute the expected output.
    expected1 = 0
    index_ = 1
    do k = 0, 4
       do j = 0, 4 - k
          i = 4 - j - k
          if (maxval([i, j, k]) == 4) then
             trinomial = 1
          else if (maxval([i, j, k]) == 3) then
             trinomial = 4
          else if (minval([i, j, k]) == 0) then
             trinomial = 6
          else
             trinomial = 12
          end if
          expected1(:, 1) = ( &
               expected1(:, 1) + &
               ( &
               trinomial * lambda1**i * lambda2**j * lambda3**k * &
               nodes5(:, index_)))
          ! Update the index.
          index_ = index_ + 1
       end do
    end do
    call evaluate_barycentric( &
         15, 2, nodes5, 4, lambda1, lambda2, lambda3, point1)
    case_success = all(point1 == expected1)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_barycentric

  subroutine test_evaluate_barycentric_multi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes(2, 3), param_vals(3, 3)
    real(c_double) :: evaluated(2, 3), expected(2, 3)
    real(c_double) :: nodes_deg0(2, 1)
    integer :: i
    integer :: case_id
    character(26) :: name

    case_id = 1
    name = "evaluate_barycentric_multi"

    ! CASE 1: Basic evaluation.
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [2.0_dp, 1.0_dp]
    nodes(:, 3) = [-3.0_dp, 2.0_dp]
    param_vals(1, :) = [1.0_dp, 0.0_dp, 0.0_dp]
    param_vals(2, :) = [0.0_dp, 1.0_dp, 0.0_dp]
    param_vals(3, :) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 1) = [0.0_dp, 0.0_dp]
    expected(:, 2) = [2.0_dp, 1.0_dp]
    expected(:, 3) = [-0.5_dp, 1.5_dp]
    call evaluate_barycentric_multi( &
         3, 2, nodes, 1, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Values outside the domain.
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [3.0_dp, -1.0_dp]
    nodes(:, 3) = [1.0_dp, 0.0_dp]
    param_vals(1, :) = [0.25_dp, 0.25_dp, 0.25_dp]
    param_vals(2, :) = [-1.0_dp, -1.0_dp, 3.0_dp]
    param_vals(3, :) = [0.125_dp, 0.75_dp, 0.125_dp]
    expected(:, 1) = [1.0_dp, -0.25_dp]
    expected(:, 2) = [0.0_dp, 1.0_dp]
    expected(:, 3) = [2.375_dp, -0.75_dp]
    call evaluate_barycentric_multi( &
         3, 2, nodes, 1, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Degree zero "triangle"
    nodes_deg0(:, 1) = [1.5_dp, 7.75_dp]
    param_vals(1, :) = [0.5_dp, 0.25_dp, 0.25_dp]
    param_vals(2, :) = [0.25_dp, 0.125_dp, 0.625_dp]
    param_vals(3, :) = [0.75_dp, 0.25_dp, 0.0_dp]
    forall (i = 1:3)
       expected(:, i) = nodes_deg0(:, 1)
    end forall
    call evaluate_barycentric_multi( &
         1, 2, nodes_deg0, 0, 3, param_vals, evaluated)
    case_success = all(evaluated == expected)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_barycentric_multi

  subroutine test_evaluate_cartesian_multi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 6), param_vals1(4, 2)
    real(c_double) :: evaluated1(2, 4), expected1(2, 4)
    real(c_double) :: nodes2(2, 3), param_vals2(3, 2)
    real(c_double) :: evaluated2(2, 3), expected2(2, 3)
    real(c_double) :: nodes3(3, 1), param_vals3(16, 2)
    real(c_double) :: evaluated3(3, 16), expected3(3, 16)
    integer :: i
    integer :: case_id
    character(24) :: name

    case_id = 1
    name = "evaluate_cartesian_multi"

    ! CASE 1: Basic evaluation
    nodes1(:, 1) = [0.0_dp, 0.0_dp]
    nodes1(:, 2) = [1.0_dp, 0.75_dp]
    nodes1(:, 3) = [2.0_dp, 1.0_dp]
    nodes1(:, 4) = [-1.5_dp, 1.0_dp]
    nodes1(:, 5) = [-0.5_dp, 1.5_dp]
    nodes1(:, 6) = [-3.0_dp, 2.0_dp]
    param_vals1(1, :) = [0.25_dp, 0.75_dp]
    param_vals1(2, :) = [0.0_dp, 0.0_dp]
    param_vals1(3, :) = [0.5_dp, 0.25_dp]
    param_vals1(4, :) = [0.25_dp, 0.375_dp]
    expected1(:, 1) = [-1.75_dp, 1.75_dp]
    expected1(:, 2) = [0.0_dp, 0.0_dp]
    expected1(:, 3) = [0.25_dp, 1.0625_dp]
    expected1(:, 4) = [-0.625_dp, 1.046875_dp]
    call evaluate_cartesian_multi( &
         6, 2, nodes1, 2, 4, param_vals1, evaluated1)
    case_success = all(evaluated1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Values outside the domain.
    nodes2(:, 1) = [0.0_dp, 2.0_dp]
    nodes2(:, 2) = [1.0_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    param_vals2(1, :) = [0.25_dp, 0.25_dp]
    param_vals2(2, :) = [-1.0_dp, 3.0_dp]
    param_vals2(3, :) = [0.75_dp, 0.125_dp]
    expected2(:, 1) = [0.5_dp, 1.25_dp]
    expected2(:, 2) = [2.0_dp, -3.0_dp]
    expected2(:, 3) = [0.875_dp, 1.0_dp]
    call evaluate_cartesian_multi( &
         3, 2, nodes2, 1, 3, param_vals2, evaluated2)
    case_success = all(evaluated2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Degree zero "triangle"
    nodes3(:, 1) = [-1.5_dp, 0.75_dp, 5.0_dp]
    forall (i = 1:16)
       expected3(:, i) = nodes3(:, 1)
    end forall
    call evaluate_cartesian_multi( &
         1, 3, nodes3, 0, 16, param_vals3, evaluated3)
    case_success = all(evaluated3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_evaluate_cartesian_multi

  subroutine test_jacobian_both(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(1, 3), expected1(2, 1), new_nodes1(2, 1)
    real(c_double) :: nodes2(3, 6), expected2(6, 3), new_nodes2(6, 3)
    real(c_double) :: nodes3(2, 10), expected3(4, 6), new_nodes3(4, 6)
    integer :: case_id
    character(13) :: name

    case_id = 1
    name = "jacobian_both"

    ! CASE 1: Linear triangle.
    ! B(s, t) = -2s + 2t + 3
    nodes1(1, :) = [3.0_dp, 1.0_dp, 5.0_dp]
    ! B_s = -2
    ! B_t = 2
    expected1(:, 1) = [-2.0_dp, 2.0_dp]
    call jacobian_both( &
         3, 1, nodes1, 1, new_nodes1)
    case_success = all(new_nodes1 == expected1)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    ! B(s, t) = [
    !     4 s t - 2 s + 5 t^2 - 6 t + 3,
    !     -s (s - 2 t),
    !     8 s^2 - 10 s t - 2 s - 13 t^2 + 12 t + 1,
    ! ]
    !
    nodes2(:, 1) = [3.0_dp, 0.0_dp, 1.0_dp]
    nodes2(:, 2) = [2.0_dp, 0.0_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, -1.0_dp, 7.0_dp]
    nodes2(:, 4) = [0.0_dp, 0.0_dp, 7.0_dp]
    nodes2(:, 5) = [1.0_dp, 1.0_dp, 1.0_dp]
    nodes2(:, 6) = [2.0_dp, 0.0_dp, 0.0_dp]
    ! B_s = [
    !     4 t - 2,
    !     -2 s + 2 t,
    !     16 s - 10 t - 2,
    ! ]
    ! B_t = [
    !     4 s + 10 t - 6,
    !     2 s,
    !    -10 s - 26 t + 12,
    ! ]
    expected2(:, 1) = [-2.0_dp, 0.0_dp, -2.0_dp, -6.0_dp, 0.0_dp, 12.0_dp]
    expected2(:, 2) = [-2.0_dp, -2.0_dp, 14.0_dp, -2.0_dp, 2.0_dp, 2.0_dp]
    expected2(:, 3) = [2.0_dp, 2.0_dp, -12.0_dp, 4.0_dp, 0.0_dp, -14.0_dp]
    call jacobian_both( &
         6, 3, nodes2, 2, new_nodes2)
    case_success = all(new_nodes2 == expected2)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    ! B(s, t) = [
    !     -2s^3 + 9s^2t + 12st^2 - 12st + 3s - 2t^3 + 6t,
    !     (-10s^3 - 30s^2t + 30s^2 - 36st^2 + 42st -
    !          18s - 15t^3 + 30t^2 - 18t + 7),
    ! ]
    nodes3(:, 1) = [0.0_dp, 7.0_dp]
    nodes3(:, 2) = [1.0_dp, 1.0_dp]
    nodes3(:, 3) = [2.0_dp, 5.0_dp]
    nodes3(:, 4) = [1.0_dp, 9.0_dp]
    nodes3(:, 5) = [2.0_dp, 1.0_dp]
    nodes3(:, 6) = [1.0_dp, 2.0_dp]
    nodes3(:, 7) = [3.0_dp, 3.0_dp]
    nodes3(:, 8) = [4.0_dp, 5.0_dp]
    nodes3(:, 9) = [5.0_dp, 1.0_dp]
    nodes3(:, 10) = [4.0_dp, 4.0_dp]
    ! B_s = [
    !     -6s^2 + 18st + 12t^2 - 12t + 3,
    !     -30s^2 - 60st + 60s - 36t^2 + 42t - 18,
    ! ]
    ! B_t = [
    !     9s^2 + 24st - 12s - 6t^2 + 6,
    !     -30s^2 - 72st + 42s - 45t^2 + 60t - 18,
    ! ]
    expected3(:, 1) = [3.0_dp, -18.0_dp, 6.0_dp, -18.0_dp]
    expected3(:, 2) = [3.0_dp, 12.0_dp, 0.0_dp, 3.0_dp]
    expected3(:, 3) = [-3.0_dp, 12.0_dp, 3.0_dp, -6.0_dp]
    expected3(:, 4) = [-3.0_dp, 3.0_dp, 6.0_dp, 12.0_dp]
    expected3(:, 5) = [6.0_dp, 3.0_dp, 12.0_dp, -3.0_dp]
    expected3(:, 6) = [3.0_dp, -12.0_dp, 0.0_dp, -3.0_dp]
    call jacobian_both( &
         10, 2, nodes3, 3, new_nodes3)
    case_success = all(new_nodes3 == expected3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_jacobian_both

  subroutine test_jacobian_det(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), param_vals1(13, 2), evaluated1(13)
    real(c_double) :: nodes2(2, 6), param_vals2(4, 2)
    real(c_double) :: expected2(4), evaluated2(4)
    integer :: case_id
    character(12) :: name

    case_id = 1
    name = "jacobian_det"

    ! CASE 1: Linear triangle (determinant is area).
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 2.0_dp]
    call get_random_nodes(param_vals1, 308975611, 101301, num_bits=8)
    call jacobian_det( &
         3, nodes1, 1, 13, param_vals1, evaluated1)
    case_success = all(evaluated1 == 2.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic (i.e. non-linear) triangle.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [0.5_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    nodes2(:, 4) = [0.0_dp, 0.5_dp]
    nodes2(:, 5) = [1.0_dp, 1.0_dp]
    nodes2(:, 6) = [0.0_dp, 1.0_dp]
    ! B(s, t) = [s(t + 1), t(s + 1)]
    param_vals2(1, :) = [0.125_dp, 0.125_dp]
    param_vals2(2, :) = [0.5_dp, 0.375_dp]
    param_vals2(3, :) = [0.25_dp, 0.75_dp]
    param_vals2(4, :) = [1.0_dp, 0.0_dp]
    ! det(DB) = s + t + 1
    expected2 = param_vals2(:, 1) + param_vals2(:, 2) + 1.0_dp
    call jacobian_det( &
         6, nodes2, 2, 4, param_vals2, evaluated2)
    case_success = all(evaluated2 == expected2)
    call print_status(name, case_id, case_success, success)

  end subroutine test_jacobian_det

  subroutine test_specialize_triangle(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double), allocatable :: id_mat(:, :), specialized(:, :)
    real(c_double), allocatable :: expected(:, :)
    real(c_double) :: &
         weights0(3), weights1(3), weights2(3), weights3(3), &
         weights4(3), weights5(3)
    character(19) :: name

    case_id = 1
    name = "specialize_triangle"

    weights0 = [1.0_dp, 0.0_dp, 0.0_dp]
    weights1 = [0.5_dp, 0.5_dp, 0.0_dp]
    weights2 = [0.0_dp, 1.0_dp, 0.0_dp]
    weights3 = [0.5_dp, 0.0_dp, 0.5_dp]
    weights4 = [0.0_dp, 0.5_dp, 0.5_dp]
    weights5 = [0.0_dp, 0.0_dp, 1.0_dp]

    ! CASE 1: degree == 1, subdivision A
    allocate(id_mat(3, 3))
    id_mat = get_id_mat(3)
    allocate(specialized(3, 3))
    allocate(expected(3, 3))
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = [1.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.5_dp, 0.5_dp, 0.0_dp]
    expected(:, 3) = [0.5_dp, 0.0_dp, 0.5_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: degree == 1, subdivision B
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 2) = [0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 3) = [0.5_dp, 0.5_dp, 0.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: degree == 1, subdivision C
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = [0.5_dp, 0.5_dp, 0.0_dp]
    expected(:, 2) = [0.0_dp, 1.0_dp, 0.0_dp]
    expected(:, 3) = [0.0_dp, 0.5_dp, 0.5_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: degree == 1, subdivision D
    call specialize_triangle( &
         3, 3, id_mat, 1, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = [0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 2) = [0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 1.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 2
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 5: degree == 2, subdivision A
    id_mat = get_id_mat(6)
    allocate(specialized(6, 6))
    allocate(expected(6, 6))
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = [1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.5_dp, 0.5_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 3) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 4) = [0.5_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.0_dp]
    expected(:, 5) = [0.25_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 6) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: degree == 2, subdivision B
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    expected(:, 2) = [0.0_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp]
    expected(:, 3) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    expected(:, 4) = [0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 5) = [0.25_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 6) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: degree == 2, subdivision C
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = [0.25_dp, 0.5_dp, 0.25_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 2) = [0.0_dp, 0.5_dp, 0.5_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 1.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
    expected(:, 4) = [0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.25_dp, 0.0_dp]
    expected(:, 5) = [0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.5_dp, 0.0_dp]
    expected(:, 6) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: degree == 2, subdivision D
    call specialize_triangle( &
         6, 6, id_mat, 2, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = [0.25_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.25_dp]
    expected(:, 2) = [0.0_dp, 0.25_dp, 0.0_dp, 0.25_dp, 0.25_dp, 0.25_dp]
    expected(:, 3) = [0.0_dp, 0.0_dp, 0.25_dp, 0.0_dp, 0.5_dp, 0.25_dp]
    expected(:, 4) = [0.0_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.0_dp, 0.5_dp]
    expected(:, 5) = [0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.5_dp, 0.5_dp]
    expected(:, 6) = [0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 1.0_dp]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 3
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 9: degree == 3, subdivision A
    id_mat = get_id_mat(10)
    allocate(specialized(10, 10))
    allocate(expected(10, 10))
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = 0.125_dp * [8, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.125_dp * [4, 4, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.125_dp * [2, 4, 2, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.125_dp * [4, 0, 0, 0, 4, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.125_dp * [2, 2, 0, 0, 2, 2, 0, 0, 0, 0]
    expected(:, 7) = 0.125_dp * [1, 2, 1, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 8) = 0.125_dp * [2, 0, 0, 0, 4, 0, 0, 2, 0, 0]
    expected(:, 9) = 0.125_dp * [1, 1, 0, 0, 2, 2, 0, 1, 1, 0]
    expected(:, 10) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: degree == 3, subdivision B
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    expected(:, 2) = 0.125_dp * [0, 0, 1, 0, 0, 2, 1, 1, 2, 1]
    expected(:, 3) = 0.125_dp * [0, 1, 0, 0, 1, 2, 0, 2, 1, 1]
    expected(:, 4) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    expected(:, 5) = 0.125_dp * [0, 0, 1, 1, 0, 2, 2, 1, 1, 0]
    expected(:, 6) = 0.125_dp * [0, 1, 1, 0, 1, 2, 1, 1, 1, 0]
    expected(:, 7) = 0.125_dp * [1, 1, 0, 0, 2, 2, 0, 1, 1, 0]
    expected(:, 8) = 0.125_dp * [0, 1, 2, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 9) = 0.125_dp * [1, 2, 1, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 10) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: degree == 3, subdivision C
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = 0.125_dp * [1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.125_dp * [0, 2, 4, 2, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.125_dp * [0, 0, 4, 4, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.125_dp * [0, 0, 0, 8, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.125_dp * [0, 1, 2, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 6) = 0.125_dp * [0, 0, 2, 2, 0, 2, 2, 0, 0, 0]
    expected(:, 7) = 0.125_dp * [0, 0, 0, 4, 0, 0, 4, 0, 0, 0]
    expected(:, 8) = 0.125_dp * [0, 0, 1, 1, 0, 2, 2, 1, 1, 0]
    expected(:, 9) = 0.125_dp * [0, 0, 0, 2, 0, 0, 4, 0, 2, 0]
    expected(:, 10) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 12: degree == 3, subdivision D
    call specialize_triangle( &
         10, 10, id_mat, 3, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = 0.125_dp * [1, 0, 0, 0, 3, 0, 0, 3, 0, 1]
    expected(:, 2) = 0.125_dp * [0, 1, 0, 0, 1, 2, 0, 2, 1, 1]
    expected(:, 3) = 0.125_dp * [0, 0, 1, 0, 0, 2, 1, 1, 2, 1]
    expected(:, 4) = 0.125_dp * [0, 0, 0, 1, 0, 0, 3, 0, 3, 1]
    expected(:, 5) = 0.125_dp * [0, 0, 0, 0, 2, 0, 0, 4, 0, 2]
    expected(:, 6) = 0.125_dp * [0, 0, 0, 0, 0, 2, 0, 2, 2, 2]
    expected(:, 7) = 0.125_dp * [0, 0, 0, 0, 0, 0, 2, 0, 4, 2]
    expected(:, 8) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 4, 0, 4]
    expected(:, 9) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 0, 4, 4]
    expected(:, 10) = 0.125_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 8]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! De-allocate and prepare for degree == 4
    deallocate(id_mat)
    deallocate(specialized)
    deallocate(expected)

    ! CASE 13: degree == 4, subdivision A
    id_mat = get_id_mat(15)
    allocate(specialized(15, 15))
    allocate(expected(15, 15))
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights0, weights1, weights3, &
         specialized)
    expected(:, 1) = 0.0625_dp * [16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.0625_dp * [8, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.0625_dp * [4, 8, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.0625_dp * [2, 6, 6, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.0625_dp * [8, 0, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 7) = 0.0625_dp * [4, 4, 0, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 8) = 0.0625_dp * [2, 4, 2, 0, 0, 2, 4, 2, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 9) = 0.0625_dp * [1, 3, 3, 1, 0, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 10) = 0.0625_dp * [4, 0, 0, 0, 0, 8, 0, 0, 0, 4, 0, 0, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [2, 2, 0, 0, 0, 4, 4, 0, 0, 2, 2, 0, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [1, 2, 1, 0, 0, 2, 4, 2, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [2, 0, 0, 0, 0, 6, 0, 0, 0, 6, 0, 0, 2, 0, 0]
    expected(:, 14) = 0.0625_dp * [1, 1, 0, 0, 0, 3, 3, 0, 0, 3, 3, 0, 1, 1, 0]
    expected(:, 15) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 14: degree == 4, subdivision B
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights4, weights3, weights1, &
         specialized)
    expected(:, 1) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    expected(:, 2) = 0.0625_dp * [0, 0, 0, 1, 0, 0, 0, 3, 1, 0, 3, 3, 1, 3, 1]
    expected(:, 3) = 0.0625_dp * [0, 0, 1, 0, 0, 0, 2, 2, 0, 1, 4, 1, 2, 2, 1]
    expected(:, 4) = 0.0625_dp * [0, 1, 0, 0, 0, 1, 3, 0, 0, 3, 3, 0, 3, 1, 1]
    expected(:, 5) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    expected(:, 6) = 0.0625_dp * [0, 0, 0, 1, 1, 0, 0, 3, 3, 0, 3, 3, 1, 1, 0]
    expected(:, 7) = 0.0625_dp * [0, 0, 1, 1, 0, 0, 2, 3, 1, 1, 3, 2, 1, 1, 0]
    expected(:, 8) = 0.0625_dp * [0, 1, 1, 0, 0, 1, 3, 2, 0, 2, 3, 1, 1, 1, 0]
    expected(:, 9) = 0.0625_dp * [1, 1, 0, 0, 0, 3, 3, 0, 0, 3, 3, 0, 1, 1, 0]
    expected(:, 10) = 0.0625_dp * [0, 0, 1, 2, 1, 0, 2, 4, 2, 1, 2, 1, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [0, 1, 2, 1, 0, 1, 3, 3, 1, 1, 2, 1, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [1, 2, 1, 0, 0, 2, 4, 2, 0, 1, 2, 1, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [0, 1, 3, 3, 1, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 14) = 0.0625_dp * [1, 3, 3, 1, 0, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 15) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 15: degree == 4, subdivision C
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights1, weights2, weights4, &
         specialized)
    expected(:, 1) = 0.0625_dp * [1, 4, 6, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 2) = 0.0625_dp * [0, 2, 6, 6, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 3) = 0.0625_dp * [0, 0, 4, 8, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 4) = 0.0625_dp * [0, 0, 0, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 5) = 0.0625_dp * [0, 0, 0, 0, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
    expected(:, 6) = 0.0625_dp * [0, 1, 3, 3, 1, 1, 3, 3, 1, 0, 0, 0, 0, 0, 0]
    expected(:, 7) = 0.0625_dp * [0, 0, 2, 4, 2, 0, 2, 4, 2, 0, 0, 0, 0, 0, 0]
    expected(:, 8) = 0.0625_dp * [0, 0, 0, 4, 4, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0]
    expected(:, 9) = 0.0625_dp * [0, 0, 0, 0, 8, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0]
    expected(:, 10) = 0.0625_dp * [0, 0, 1, 2, 1, 0, 2, 4, 2, 1, 2, 1, 0, 0, 0]
    expected(:, 11) = 0.0625_dp * [0, 0, 0, 2, 2, 0, 0, 4, 4, 0, 2, 2, 0, 0, 0]
    expected(:, 12) = 0.0625_dp * [0, 0, 0, 0, 4, 0, 0, 0, 8, 0, 0, 4, 0, 0, 0]
    expected(:, 13) = 0.0625_dp * [0, 0, 0, 1, 1, 0, 0, 3, 3, 0, 3, 3, 1, 1, 0]
    expected(:, 14) = 0.0625_dp * [0, 0, 0, 0, 2, 0, 0, 0, 6, 0, 0, 6, 0, 2, 0]
    expected(:, 15) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 16: degree == 4, subdivision D
    call specialize_triangle( &
         15, 15, id_mat, 4, &
         weights3, weights4, weights5, &
         specialized)
    expected(:, 1) = 0.0625_dp * [1, 0, 0, 0, 0, 4, 0, 0, 0, 6, 0, 0, 4, 0, 1]
    expected(:, 2) = 0.0625_dp * [0, 1, 0, 0, 0, 1, 3, 0, 0, 3, 3, 0, 3, 1, 1]
    expected(:, 3) = 0.0625_dp * [0, 0, 1, 0, 0, 0, 2, 2, 0, 1, 4, 1, 2, 2, 1]
    expected(:, 4) = 0.0625_dp * [0, 0, 0, 1, 0, 0, 0, 3, 1, 0, 3, 3, 1, 3, 1]
    expected(:, 5) = 0.0625_dp * [0, 0, 0, 0, 1, 0, 0, 0, 4, 0, 0, 6, 0, 4, 1]
    expected(:, 6) = 0.0625_dp * [0, 0, 0, 0, 0, 2, 0, 0, 0, 6, 0, 0, 6, 0, 2]
    expected(:, 7) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 2, 0, 0, 2, 4, 0, 4, 2, 2]
    expected(:, 8) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 4, 2, 2, 4, 2]
    expected(:, 9) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 6, 0, 6, 2]
    expected(:, 10) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 8, 0, 4]
    expected(:, 11) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 4, 4, 4]
    expected(:, 12) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 8, 4]
    expected(:, 13) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0, 8]
    expected(:, 14) = 0.0625_dp * [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 8]
    expected(:, 15) = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]
    case_success = all(specialized == expected)
    call print_status(name, case_id, case_success, success)

  end subroutine test_specialize_triangle

  subroutine test_subdivide_nodes(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3)
    real(c_double) :: nodes_a1(2, 3), nodes_b1(2, 3)
    real(c_double) :: nodes_c1(2, 3), nodes_d1(2, 3)
    real(c_double) :: expected_a1(2, 3), expected_b1(2, 3)
    real(c_double) :: expected_c1(2, 3), expected_d1(2, 3)
    real(c_double) :: nodes2(2, 6)
    real(c_double) :: nodes_a2(2, 6), nodes_b2(2, 6)
    real(c_double) :: nodes_c2(2, 6), nodes_d2(2, 6)
    real(c_double) :: expected_a2(2, 6), expected_b2(2, 6)
    real(c_double) :: expected_c2(2, 6), expected_d2(2, 6)
    real(c_double) :: nodes3(2, 10)
    real(c_double) :: nodes_a3(2, 10), nodes_b3(2, 10)
    real(c_double) :: nodes_c3(2, 10), nodes_d3(2, 10)
    real(c_double) :: expected_a3(2, 10), expected_b3(2, 10)
    real(c_double) :: expected_c3(2, 10), expected_d3(2, 10)
    integer :: case_id
    character(26) :: name

    case_id = 1
    name = "subdivide_nodes (Triangle)"

    ! CASE 1: Linear triangle.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    expected_a1(:, 1) = 0
    expected_a1(:, 2) = [0.5_dp, 0.0_dp]
    expected_a1(:, 3) = [0.0_dp, 0.5_dp]
    expected_b1(:, 1) = 0.5_dp
    expected_b1(:, 2) = [0.0_dp, 0.5_dp]
    expected_b1(:, 3) = [0.5_dp, 0.0_dp]
    expected_c1(:, 1) = [0.5_dp, 0.0_dp]
    expected_c1(:, 2) = [1.0_dp, 0.0_dp]
    expected_c1(:, 3) = 0.5_dp
    expected_d1(:, 1) = [0.0_dp, 0.5_dp]
    expected_d1(:, 2) = 0.5_dp
    expected_d1(:, 3) = [0.0_dp, 1.0_dp]
    call subdivide_nodes( &
         3, 2, nodes1, 1, &
         nodes_a1, nodes_b1, nodes_c1, nodes_d1)
    case_success = ( &
         all(nodes_a1 == expected_a1) .AND. &
         all(nodes_b1 == expected_b1) .AND. &
         all(nodes_c1 == expected_c1) .AND. &
         all(nodes_d1 == expected_d1))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Evaluate subdivided parts of a linear triangle.
    call subdivide_points_check( &
         3, 2, 1, 290289, 111228, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Quadratic triangle.
    nodes2(:, 1) = [0.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.5_dp, 0.25_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    nodes2(:, 4) = [0.5_dp, 0.75_dp]
    nodes2(:, 5) = [0.0_dp, 1.0_dp]
    nodes2(:, 6) = [0.0_dp, 0.5_dp]
    expected_a2(:, 1) = [0.0_dp, 0.0_dp]
    expected_a2(:, 2) = [0.25_dp, 0.125_dp]
    expected_a2(:, 3) = [0.5_dp, 0.125_dp]
    expected_a2(:, 4) = [0.25_dp, 0.375_dp]
    expected_a2(:, 5) = [0.25_dp, 0.5_dp]
    expected_a2(:, 6) = [0.25_dp, 0.5_dp]
    expected_b2(:, 1) = [0.25_dp, 0.625_dp]
    expected_b2(:, 2) = [0.25_dp, 0.625_dp]
    expected_b2(:, 3) = [0.25_dp, 0.5_dp]
    expected_b2(:, 4) = [0.5_dp, 0.5_dp]
    expected_b2(:, 5) = [0.25_dp, 0.5_dp]
    expected_b2(:, 6) = [0.5_dp, 0.125_dp]
    expected_c2(:, 1) = [0.5_dp, 0.125_dp]
    expected_c2(:, 2) = [0.75_dp, 0.125_dp]
    expected_c2(:, 3) = [1.0_dp, 0.0_dp]
    expected_c2(:, 4) = [0.5_dp, 0.5_dp]
    expected_c2(:, 5) = [0.5_dp, 0.5_dp]
    expected_c2(:, 6) = [0.25_dp, 0.625_dp]
    expected_d2(:, 1) = [0.25_dp, 0.5_dp]
    expected_d2(:, 2) = [0.25_dp, 0.625_dp]
    expected_d2(:, 3) = [0.25_dp, 0.625_dp]
    expected_d2(:, 4) = [0.25_dp, 0.625_dp]
    expected_d2(:, 5) = [0.0_dp, 0.75_dp]
    expected_d2(:, 6) = [0.0_dp, 0.5_dp]
    call subdivide_nodes( &
         6, 2, nodes2, 2, &
         nodes_a2, nodes_b2, nodes_c2, nodes_d2)
    case_success = ( &
         all(nodes_a2 == expected_a2) .AND. &
         all(nodes_b2 == expected_b2) .AND. &
         all(nodes_c2 == expected_c2) .AND. &
         all(nodes_d2 == expected_d2))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Evaluate subdivided parts of a quadratic triangle.
    call subdivide_points_check( &
         6, 2, 2, 219803, 7086, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Cubic triangle.
    nodes3(:, 1) = [0.0_dp, 0.0_dp]
    nodes3(:, 2) = [3.25_dp, 1.5_dp]
    nodes3(:, 3) = [6.5_dp, 1.5_dp]
    nodes3(:, 4) = [10.0_dp, 0.0_dp]
    nodes3(:, 5) = [1.5_dp, 3.25_dp]
    nodes3(:, 6) = [5.0_dp, 5.0_dp]
    nodes3(:, 7) = [10.0_dp, 5.25_dp]
    nodes3(:, 8) = [1.5_dp, 6.5_dp]
    nodes3(:, 9) = [5.25_dp, 10.0_dp]
    nodes3(:, 10) = [0.0_dp, 10.0_dp]
    expected_a3(:, 1) = [0.0_dp, 0.0_dp]
    expected_a3(:, 2) = [1.625_dp, 0.75_dp]
    expected_a3(:, 3) = [3.25_dp, 1.125_dp]
    expected_a3(:, 4) = [4.90625_dp, 1.125_dp]
    expected_a3(:, 5) = [0.75_dp, 1.625_dp]
    expected_a3(:, 6) = [2.4375_dp, 2.4375_dp]
    expected_a3(:, 7) = [4.3125_dp, 2.875_dp]
    expected_a3(:, 8) = [1.125_dp, 3.25_dp]
    expected_a3(:, 9) = [2.875_dp, 4.3125_dp]
    expected_a3(:, 10) = [1.125_dp, 4.90625_dp]
    expected_b3(:, 1) = [6.96875_dp, 6.96875_dp]
    expected_b3(:, 2) = [4.8125_dp, 6.65625_dp]
    expected_b3(:, 3) = [2.875_dp, 5.96875_dp]
    expected_b3(:, 4) = [1.125_dp, 4.90625_dp]
    expected_b3(:, 5) = [6.65625_dp, 4.8125_dp]
    expected_b3(:, 6) = [4.75_dp, 4.75_dp]
    expected_b3(:, 7) = [2.875_dp, 4.3125_dp]
    expected_b3(:, 8) = [5.96875_dp, 2.875_dp]
    expected_b3(:, 9) = [4.3125_dp, 2.875_dp]
    expected_b3(:, 10) = [4.90625_dp, 1.125_dp]
    expected_c3(:, 1) = [4.90625_dp, 1.125_dp]
    expected_c3(:, 2) = [6.5625_dp, 1.125_dp]
    expected_c3(:, 3) = [8.25_dp, 0.75_dp]
    expected_c3(:, 4) = [10.0_dp, 0.0_dp]
    expected_c3(:, 5) = [5.96875_dp, 2.875_dp]
    expected_c3(:, 6) = [7.875_dp, 2.9375_dp]
    expected_c3(:, 7) = [10.0_dp, 2.625_dp]
    expected_c3(:, 8) = [6.65625_dp, 4.8125_dp]
    expected_c3(:, 9) = [8.8125_dp, 5.125_dp]
    expected_c3(:, 10) = [6.96875_dp, 6.96875_dp]
    expected_d3(:, 1) = [1.125_dp, 4.90625_dp]
    expected_d3(:, 2) = [2.875_dp, 5.96875_dp]
    expected_d3(:, 3) = [4.8125_dp, 6.65625_dp]
    expected_d3(:, 4) = [6.96875_dp, 6.96875_dp]
    expected_d3(:, 5) = [1.125_dp, 6.5625_dp]
    expected_d3(:, 6) = [2.9375_dp, 7.875_dp]
    expected_d3(:, 7) = [5.125_dp, 8.8125_dp]
    expected_d3(:, 8) = [0.75_dp, 8.25_dp]
    expected_d3(:, 9) = [2.625_dp, 10.0_dp]
    expected_d3(:, 10) = [0.0_dp, 10.0_dp]
    call subdivide_nodes( &
         10, 2, nodes3, 3, &
         nodes_a3, nodes_b3, nodes_c3, nodes_d3)
    case_success = ( &
         all(nodes_a3 == expected_a3) .AND. &
         all(nodes_b3 == expected_b3) .AND. &
         all(nodes_c3 == expected_c3) .AND. &
         all(nodes_d3 == expected_d3))
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Evaluate subdivided parts of a cubic triangle.
    call subdivide_points_check( &
         10, 2, 3, 439028340, 2184938, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Evaluate subdivided parts of a quartic triangle.
    call subdivide_points_check( &
         15, 2, 4, 1029038, 890012, case_success)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Evaluate subdivided parts of a quantic triangle. This
    !         will use ``specialize_triangle`` rather than a hard-coded
    !         process.
    call subdivide_points_check( &
         21, 2, 5, 91889, 1303497, case_success)
    call print_status(name, case_id, case_success, success)

  end subroutine test_subdivide_nodes

  subroutine subdivide_points_check( &
       num_nodes, dimension_, degree, multiplier, modulus, success)
    integer, intent(in) :: num_nodes, dimension_, degree
    integer, intent(in) :: multiplier, modulus
    logical, intent(out) :: success
    ! Variables outside of signature.
    real(c_double) :: nodes(dimension_, num_nodes)
    real(c_double) :: nodes_a(dimension_, num_nodes)
    real(c_double) :: nodes_b(dimension_, num_nodes)
    real(c_double) :: nodes_c(dimension_, num_nodes)
    real(c_double) :: nodes_d(dimension_, num_nodes)
    real(c_double) :: ref_triangle(561, 2), local_vals(561, 2)
    real(c_double) :: evaluated1(dimension_, 561)
    real(c_double) :: evaluated2(dimension_, 561)

    success = .TRUE.

    call get_random_nodes(nodes, multiplier, modulus, num_bits=8)
    call subdivide_nodes( &
         num_nodes, dimension_, nodes, degree, &
         nodes_a, nodes_b, nodes_c, nodes_d)

    ref_triangle = ref_triangle_uniform_params(5)

    ! Evaluate the **original** at ``local_vals`` and the subdivided version
    ! on the full unit triangle.
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_a, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_b, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp - 0.5_dp * ref_triangle
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_c, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    local_vals(:, 1) = local_vals(:, 1) + 0.5_dp
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes_d, degree, &
         561, ref_triangle, evaluated1)
    local_vals = 0.5_dp * ref_triangle
    local_vals(:, 2) = local_vals(:, 2) + 0.5_dp
    call evaluate_cartesian_multi( &
         num_nodes, dimension_, nodes, degree, &
         561, local_vals, evaluated2)
    success = ( &
         success .AND. &
         all(evaluated1 == evaluated2))

  end subroutine subdivide_points_check

  subroutine test_compute_edge_nodes(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(18) :: name
    real(c_double), allocatable :: nodes(:, :)
    real(c_double), allocatable :: nodes1(:, :), nodes2(:, :), nodes3(:, :)

    case_id = 1
    name = "compute_edge_nodes"

    ! CASE 1: Linear triangle.
    allocate(nodes(2, 3))
    allocate(nodes1(2, 2))
    allocate(nodes2(2, 2))
    allocate(nodes3(2, 2))
    nodes(:, 1) = [1.0_dp, 2.0_dp]
    nodes(:, 2) = [4.0_dp, 2.5_dp]
    nodes(:, 3) = [0.0_dp, 4.0_dp]

    call compute_edge_nodes( &
         3, 2, nodes, 1, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2])) .AND. &
         all(nodes2 == nodes(:, [2, 3])) .AND. &
         all(nodes3 == nodes(:, [3, 1])))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic triangle.
    deallocate(nodes)
    deallocate(nodes1)
    deallocate(nodes2)
    deallocate(nodes3)
    allocate(nodes(2, 6))
    allocate(nodes1(2, 3))
    allocate(nodes2(2, 3))
    allocate(nodes3(2, 3))
    nodes(:, 1) = 0
    nodes(:, 2) = [1.25_dp, 0.5_dp]
    nodes(:, 3) = [2.0_dp, 1.0_dp]
    nodes(:, 4) = [-1.5_dp, 0.75_dp]
    nodes(:, 5) = [0.0_dp, 2.0_dp]
    nodes(:, 6) = [-3.0_dp, 3.0_dp]

    call compute_edge_nodes( &
         6, 2, nodes, 2, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2, 3])) .AND. &
         all(nodes2 == nodes(:, [3, 5, 6])) .AND. &
         all(nodes3 == nodes(:, [6, 4, 1])))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic triangle.
    deallocate(nodes)
    deallocate(nodes1)
    deallocate(nodes2)
    deallocate(nodes3)
    allocate(nodes(2, 10))
    allocate(nodes1(2, 4))
    allocate(nodes2(2, 4))
    allocate(nodes3(2, 4))
    nodes(:, 1) = [0.0_dp, 0.0_dp]
    nodes(:, 2) = [0.328125_dp, 0.1484375_dp]
    nodes(:, 3) = [0.65625_dp, 0.1484375_dp]
    nodes(:, 4) = [1.0_dp, 0.0_dp]
    nodes(:, 5) = [0.1484375_dp, 0.328125_dp]
    nodes(:, 6) = [0.5_dp, 0.5_dp]
    nodes(:, 7) = [1.0_dp, 0.53125_dp]
    nodes(:, 8) = [0.1484375_dp, 0.65625_dp]
    nodes(:, 9) = [0.53125_dp, 1.0_dp]
    nodes(:, 10) = [0.0_dp, 1.0_dp]

    call compute_edge_nodes( &
         10, 2, nodes, 3, nodes1, nodes2, nodes3)
    case_success = ( &
         all(nodes1 == nodes(:, [1, 2, 3, 4])) .AND. &
         all(nodes2 == nodes(:, [4, 7, 9, 10])) .AND. &
         all(nodes3 == nodes(:, [10, 8, 5, 1])))
    call print_status(name, case_id, case_success, success)

  end subroutine test_compute_edge_nodes

  subroutine test_shoelace_for_area(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(17) :: name
    real(c_double) :: nodes1(2, 2), nodes2(2, 3), nodes3(2, 4)
    real(c_double) :: nodes4(2, 5), nodes5(2, 6)
    real(c_double) :: shoelace
    logical(c_bool) :: not_implemented

    case_id = 1
    name = "shoelace_for_area"

    ! CASE 1: Linear edge.
    nodes1(:, 1) = 1
    nodes1(:, 2) = [2.0_dp, 4.0_dp]
    call shoelace_for_area(2, nodes1, shoelace, not_implemented)
    case_success = ( &
         shoelace == 1.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Quadratic edge.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [1.0_dp, 3.0_dp]
    nodes2(:, 3) = [4.0_dp, 3.0_dp]
    call shoelace_for_area(3, nodes2, shoelace, not_implemented)
    case_success = ( &
         shoelace == -3.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Cubic edge.
    nodes3(:, 1) = 0
    nodes3(:, 2) = [1.0_dp, 9.0_dp]
    nodes3(:, 3) = [2.0_dp, -6.0_dp]
    nodes3(:, 4) = [3.0_dp, 3.0_dp]
    call shoelace_for_area(4, nodes3, shoelace, not_implemented)
    case_success = ( &
         shoelace == 0.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Quartic edge.
    nodes4(:, 1) = 0
    nodes4(:, 2) = [1.0_dp, -4.0_dp]
    nodes4(:, 3) = [2.0_dp, 3.0_dp]
    nodes4(:, 4) = [3.0_dp, -4.0_dp]
    nodes4(:, 5) = [4.0_dp, 0.0_dp]
    call shoelace_for_area(5, nodes4, shoelace, not_implemented)
    case_success = ( &
         shoelace == 4.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Unsupported degree.
    nodes5 = 1
    call shoelace_for_area(6, nodes5, shoelace, not_implemented)
    case_success = not_implemented
    call print_status(name, case_id, case_success, success)

  end subroutine test_shoelace_for_area

  subroutine test_compute_area(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(12) :: name
    type(c_ptr) :: nodes_pointers(4)
    real(c_double) :: area
    logical(c_bool) :: not_implemented
    real(c_double), target :: linear1(2, 2), linear2(2, 2), linear3(2, 2)
    real(c_double), target :: &
         quadratic1(2, 3), quadratic2(2, 3), quadratic3(2, 3)
    real(c_double), target :: quintic1(2, 6)

    case_id = 1
    name = "compute_area"

    ! CASE 1: Curved clam shell (edges are mixed degree).
    linear1(:, 1) = 0
    linear1(:, 2) = [2.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(linear1)
    quadratic1(:, 1) = [2.0_dp, 0.0_dp]
    quadratic1(:, 2) = [1.0_dp, 3.0_dp]
    quadratic1(:, 3) = 0
    nodes_pointers(2) = c_loc(quadratic1)
    call compute_area( &
         2, [2, 3], nodes_pointers(:2), area, not_implemented)
    case_success = ( &
         area == 2.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Curved triangle (all edges quadratic).
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [1.0_dp, -1.0_dp]
    quadratic1(:, 3) = [2.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(quadratic1)
    quadratic2(:, 1) = [2.0_dp, 0.0_dp]
    quadratic2(:, 2) = [1.5_dp, 1.5_dp]
    quadratic2(:, 3) = [0.0_dp, 2.0_dp]
    nodes_pointers(2) = c_loc(quadratic2)
    quadratic3(:, 1) = [0.0_dp, 2.0_dp]
    quadratic3(:, 2) = 1
    quadratic3(:, 3) = 0
    nodes_pointers(3) = c_loc(quadratic3)
    call compute_area( &
         3, [3, 3, 3], nodes_pointers(:3), area, not_implemented)
    case_success = ( &
         3.0_dp * area == 8.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Curved quadrilateral (edges are mixed degree).
    linear1(:, 1) = 0
    linear1(:, 2) = [1.0_dp, 0.0_dp]
    nodes_pointers(1) = c_loc(linear1)
    linear2(:, 1) = [1.0_dp, 0.0_dp]
    linear2(:, 2) = 1
    nodes_pointers(2) = c_loc(linear2)
    quadratic1(:, 1) = 1
    quadratic1(:, 2) = [0.5_dp, 2.0_dp]
    quadratic1(:, 3) = [0.0_dp, 1.0_dp]
    nodes_pointers(3) = c_loc(quadratic1)
    linear3(:, 1) = [0.0_dp, 1.0_dp]
    linear3(:, 2) = 0
    nodes_pointers(4) = c_loc(linear3)
    call compute_area( &
         4, [2, 2, 3, 2], nodes_pointers, area, not_implemented)
    case_success = ( &
         3.0_dp * area == 4.0_dp .AND. &
         .NOT. not_implemented)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Unsupported degree.
    quintic1 = 1
    nodes_pointers(1) = c_loc(quintic1)
    call compute_area( &
         1, [6], nodes_pointers(:1), area, not_implemented)
    case_success = not_implemented
    call print_status(name, case_id, case_success, success)

  end subroutine test_compute_area

end module test_triangle


<|start_filename|>src/fortran/include/bezier/status.h<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#ifndef BEZIER_STATUS_H
#define BEZIER_STATUS_H

#if defined(__cplusplus)
extern "C" {
#endif

typedef enum Status {
    SUCCESS = 0,
    BAD_MULTIPLICITY = 1,
    NO_CONVERGE = 2,
    INSUFFICIENT_SPACE = 3,
    SAME_CURVATURE = 4,
    BAD_INTERIOR = 5,
    EDGE_END = 6,
    SINGULAR = 7,
    UNKNOWN = 999,
} Status;

#if defined(__cplusplus)
}
#endif

#endif /* BEZIER_STATUS_H */


<|start_filename|>tests/fortran/test_curve_intersection.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module test_curve_intersection

  use, intrinsic :: iso_c_binding, only: c_bool, c_double, c_int
  use status, only: &
       Status_SUCCESS, Status_BAD_MULTIPLICITY, Status_NO_CONVERGE, &
       Status_INSUFFICIENT_SPACE, Status_SINGULAR
  use helpers, only: WIGGLE
  use curve, only: &
       CurveData, evaluate_multi, specialize_curve, subdivide_nodes, &
       curves_equal, subdivide_curve
  use curve_intersection, only: &
       BoxIntersectionType_INTERSECTION, BoxIntersectionType_TANGENT, &
       BoxIntersectionType_DISJOINT, &
       Subdivide_FIRST, Subdivide_SECOND, &
       Subdivide_BOTH, Subdivide_NEITHER, &
       linearization_error, segment_intersection, &
       newton_refine_intersect, bbox_intersect, parallel_lines_parameters, &
       line_line_collide, convex_hull_collide, newton_simple_root, &
       newton_double_root, newton_iterate, full_newton_nonzero, full_newton, &
       from_linearized, &
       bbox_line_intersect, check_lines, add_intersection, &
       add_from_linearized, endpoint_check, tangent_bbox_intersection, &
       add_candidates, intersect_one_round, make_same_degree, &
       add_coincident_parameters, all_intersections, all_intersections_abi
  use types, only: dp
  use unit_test_helpers, only: print_status
  implicit none
  private &
       test_linearization_error, test_segment_intersection, &
       test_newton_refine_intersect, test_bbox_intersect, &
       test_parallel_lines_parameters, test_line_line_collide, &
       test_convex_hull_collide, test_newton_simple_root, &
       test_newton_double_root, check_closer, test_newton_iterate, &
       test_full_newton_nonzero, test_full_newton, test_from_linearized, &
       test_bbox_line_intersect, test_check_lines, test_add_intersection, &
       test_add_from_linearized, test_endpoint_check, &
       test_tangent_bbox_intersection, test_add_candidates, &
       test_intersect_one_round, test_make_same_degree, &
       test_add_coincident_parameters, test_all_intersections, &
       test_all_intersections_abi
  public curve_intersection_all_tests

contains

  subroutine curve_intersection_all_tests(success)
    logical(c_bool), intent(inout) :: success

    call test_linearization_error(success)
    call test_segment_intersection(success)
    call test_newton_refine_intersect(success)
    call test_bbox_intersect(success)
    call test_parallel_lines_parameters(success)
    call test_line_line_collide(success)
    call test_convex_hull_collide(success)
    call test_newton_simple_root(success)
    call test_newton_double_root(success)
    call test_newton_iterate(success)
    call test_full_newton_nonzero(success)
    call test_full_newton(success)
    call test_from_linearized(success)
    call test_bbox_line_intersect(success)
    call test_check_lines(success)
    call test_add_intersection(success)
    call test_add_from_linearized(success)
    call test_endpoint_check(success)
    call test_tangent_bbox_intersection(success)
    call test_add_candidates(success)
    call test_intersect_one_round(success)
    call test_make_same_degree(success)
    call test_add_coincident_parameters(success)
    call test_all_intersections(success)
    call test_all_intersections_abi(success)

  end subroutine curve_intersection_all_tests

  subroutine test_linearization_error(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 2), nodes2(2, 3), nodes3(2, 5)
    real(c_double) :: nodes4(3, 3), nodes5(2, 4), nodes6(2, 6)
    real(c_double) :: left_nodes2(2, 3), right_nodes2(2, 3)
    real(c_double) :: error1, error2, expected
    integer :: case_id
    character(19) :: name

    case_id = 1
    name = "linearization_error"

    ! CASE 1: Linear curve (i.e. no error).
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 2.0_dp]
    call linearization_error( &
         2, 2, nodes1, error1)
    case_success = (error1 == 0.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Degree-elevated line (i.e. no error) as quadratic.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [0.5_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 2.0_dp]
    call linearization_error( &
         3, 2, nodes2, error1)
    case_success = (error1 == 0.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Degree-elevated line (i.e. no error) as quartic.
    nodes3(:, 1) = 0
    nodes3(:, 2) = [0.25_dp, 0.5_dp]
    nodes3(:, 3) = [0.5_dp, 1.0_dp]
    nodes3(:, 4) = [0.75_dp, 1.5_dp]
    nodes3(:, 5) = [1.0_dp, 2.0_dp]
    call linearization_error( &
         5, 2, nodes3, error1)
    case_success = (error1 == 0.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Line with bad parameterization.
    ! NOTE: This is the line 3 y = 4 x, but with the parameterization
    !       x(s) = 3 s (4 - 3 s).
    nodes2(:, 1) = 0
    nodes2(:, 2) = [6.0_dp, 8.0_dp]
    nodes2(:, 3) = [3.0_dp, 4.0_dp]
    call linearization_error( &
         3, 2, nodes2, error1)
    ! D^2 v = [-9, -12]
    expected = 0.125_dp * 2 * 1 * 15.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Quadratic curve.
    nodes2(:, 1) = 0
    nodes2(:, 2) = 1
    nodes2(:, 3) = [5.0_dp, 6.0_dp]
    call linearization_error( &
         3, 2, nodes2, error1)
    ! NOTE: This is hand picked so that
    !             d Nodes = [1, 1], [4, 5]
    !           d^2 Nodes = [3, 4]
    !       so that sqrt(3^2 + 4^2) = 5.0
    expected = 0.125_dp * 2 * 1 * 5.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Subdivided curves (left and right) from CASE 5.
    call subdivide_nodes( &
         3, 2, nodes2, left_nodes2, right_nodes2)
    call linearization_error( &
         3, 2, left_nodes2, error1)
    call linearization_error( &
         3, 2, right_nodes2, error2)
    ! For a degree two curve, the 2nd derivative is constant
    ! so by subdividing, our error should drop by a factor
    ! of (1/2)^2 = 4.
    expected = 0.25_dp * expected
    case_success = (error1 == expected .AND. error2 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Quadratic curve in 3D.
    nodes4(:, 1) = [1.5_dp, 0.0_dp, 6.25_dp]
    nodes4(:, 2) = [3.5_dp, -5.0_dp, 10.25_dp]
    nodes4(:, 3) = [8.5_dp, 2.0_dp, 10.25_dp]
    call linearization_error( &
         3, 3, nodes4, error1)
    ! NOTE: This is hand picked so that
    !             d Nodes = [2, -5, 4], [5, 7, 0]
    !           d^2 Nodes = [3, 12, -4]
    !       so that sqrt(3^2 + 12^2 + 4^2) = 13.0
    expected = 0.125_dp * 2 * 1 * 13.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Quadratic with bad parameterization.
    ! NOTE: This is the quadratic y = 1 + x^2 / 4, but with the
    !       parameterization x(s) = (3 s - 1)^2.
    nodes3(:, 1) = [1.0_dp, 1.25_dp]
    nodes3(:, 2) = [-0.5_dp, 0.5_dp]
    nodes3(:, 3) = [-0.5_dp, 2.0_dp]
    nodes3(:, 4) = [1.0_dp, -1.0_dp]
    nodes3(:, 5) = [4.0_dp, 5.0_dp]
    call linearization_error( &
         5, 2, nodes3, error1)
    ! D^2 v = [1.5, 2.25], [1.5, -4.5], [1.5, 9]
    expected = 0.125_dp * 4 * 3 * sqrt(1.5_dp**2 + 9.0_dp**2)
    case_success = (abs(error1 - expected) <= spacing(expected))
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Cubic curve.
    nodes5(:, 1) = 0
    nodes5(:, 2) = 1
    nodes5(:, 3) = [5.0_dp, 6.0_dp]
    nodes5(:, 4) = [6.0_dp, 7.0_dp]
    call linearization_error( &
         4, 2, nodes5, error1)
    ! NOTE: This is hand picked so that
    !             d Nodes = [1, 1], [4, 5], [1, 1]
    !           d^2 Nodes = [3, 4], [-3, -4]
    !       so that sqrt(3^2 + 4^2) = 5.0
    expected = 0.125_dp * 3 * 2 * 5.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Quartic curve.
    nodes3(:, 1) = 0
    nodes3(:, 2) = 1
    nodes3(:, 3) = [5.0_dp, 6.0_dp]
    nodes3(:, 4) = [6.0_dp, 7.0_dp]
    nodes3(:, 5) = [4.0_dp, 7.0_dp]
    call linearization_error( &
         5, 2, nodes3, error1)
    ! NOTE: This is hand picked so that
    !             d Nodes = [1, 1], [4, 5], [1, 1], [-2, 0]
    !           d^2 Nodes = [3, 4], [-3, -4], [-3, -1]
    !       so that sqrt(3^2 + 4^2) = 5.0
    expected = 0.125_dp * 4 * 3 * 5.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: Quintic curve (i.e. degree 5).
    nodes6(:, 1) = 0
    nodes6(:, 2) = 1
    nodes6(:, 3) = [7.0_dp, 3.0_dp]
    nodes6(:, 4) = [11.0_dp, 8.0_dp]
    nodes6(:, 5) = [15.0_dp, 1.0_dp]
    nodes6(:, 6) = [16.0_dp, -3.0_dp]
    call linearization_error( &
         6, 2, nodes6, error1)
    ! NOTE: This is hand picked so that
    !             d Nodes = [1, 1], [6, 2], [4, 5], [4, -7], [1, -4]
    !           d^2 Nodes = [5, 1], [-2, 3], [0, -12], [-3, 3]
    !       so that sqrt(5^2 + 12^2) = 13.0
    expected = 0.125_dp * 5 * 4 * 13.0_dp
    case_success = (error1 == expected)
    call print_status(name, case_id, case_success, success)

  end subroutine test_linearization_error

  subroutine test_segment_intersection(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: start0(2), end0(2)
    real(c_double) :: start1(2), end1(2)
    real(c_double) :: s, t
    logical(c_bool) :: si_success
    integer :: case_id
    character(20) :: name

    case_id = 1
    name = "segment_intersection"

    ! CASE 1: Segments that intersect.
    start0 = [1.75_dp, 2.125_dp]
    end0 = [-1.25_dp, 1.625_dp]
    start1 = [-0.25_dp, 2.625_dp]
    end1 = [1.75_dp, 1.625_dp]
    ! D0 x D1 == 4.0, so there will be no round-off in answer.
    call segment_intersection( &
         start0, end0, start1, end1, s, t, si_success)
    case_success = (si_success .AND. s == 0.25_dp .AND. t == 0.625_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Parallel segments.
    start0 = [0.0_dp, 0.5_dp]
    end0 = [0.0_dp, -0.5_dp]
    start1 = [0.0_dp, 1.0_dp]
    end1 = [0.0_dp, -1.0_dp]
    call segment_intersection( &
         start0, end0, start1, end1, s, t, si_success)
    case_success = (.NOT. si_success)
    call print_status(name, case_id, case_success, success)

  end subroutine test_segment_intersection

  subroutine test_newton_refine_intersect(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 2), nodes2(2, 2)
    real(c_double) :: nodes3(2, 3), nodes4(2, 3), nodes5(2, 5)
    real(c_double) :: known_s, known_t
    real(c_double) :: wrong_s, wrong_t
    real(c_double) :: new_s, new_t
    integer(c_int) :: status
    integer :: i
    integer :: case_id
    character(23) :: name

    case_id = 1
    name = "newton_refine_intersect"

    ! CASE 1: Intersection of two lines.
    ! Newton's method is exact on linear problems so will
    ! always converge after one step.
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    known_s = 0.75_dp
    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.0_dp, 3.0_dp]
    known_t = 0.25_dp
    ! NOTE: By construction, the Jacobian matrix will be
    !           [1, 1], [1, -3]
    !       which has determinant -4.0, hence there will
    !       be no round-off when solving.
    wrong_s = known_s - 0.125_dp
    wrong_t = known_t + 0.125_dp
    call newton_refine_intersect( &
         wrong_s, 2, nodes1, wrong_t, 2, nodes2, new_s, new_t, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         new_s == known_s .AND. &
         new_t == known_t .AND. &
         curves_intersect(nodes1, known_s, nodes2, known_t))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Mixed degree (line and quadratic).
    nodes3(:, 1) = 0
    nodes3(:, 2) = [0.5_dp, 1.0_dp]
    nodes3(:, 3) = [1.0_dp, 0.0_dp]
    known_s = 0.5_dp
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, 1.0_dp]
    known_t = 0.5_dp
    ! NOTE: By construction, the Jacobian matrix will be
    !           [1, 1], [1, -1]
    !       which has determinant -2.0, hence there will
    !       be no round-off when solving.
    wrong_s = 0.25_dp
    wrong_t = 0.25_dp
    call newton_refine_intersect( &
         wrong_s, 3, nodes3, wrong_t, 2, nodes1, new_s, new_t, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         new_s == 0.4375_dp .AND. &
         abs(known_s - new_s) < abs(known_s - wrong_s) .AND. &
         new_t == 0.5625_dp .AND. &
         abs(known_t - new_t) < abs(known_t - wrong_t) .AND. &
         curves_intersect(nodes3, known_s, nodes1, known_t))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Early exit (i.e. already an intersection).
    nodes3(:, 1) = 0
    nodes3(:, 2) = [0.5_dp, 1.0_dp]
    nodes3(:, 3) = [1.0_dp, 0.0_dp]
    known_s = 0.25_dp
    nodes4(:, 1) = [1.0_dp, 0.75_dp]
    nodes4(:, 2) = [0.5_dp, -0.25_dp]
    nodes4(:, 3) = [0.0_dp, 0.75_dp]
    known_t = 0.75_dp
    call newton_refine_intersect( &
         known_s, 3, nodes3, known_t, 3, nodes4, new_s, new_t, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         new_s == known_s .AND. &
         new_t == known_t .AND. &
         curves_intersect(nodes3, known_s, nodes4, known_t))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Intersect quadratics.
    nodes3(:, 1) = 0
    nodes3(:, 2) = [0.5_dp, 1.0_dp]
    nodes3(:, 3) = [1.0_dp, 0.0_dp]
    known_s = 0.25_dp
    nodes4(:, 1) = [1.0_dp, 0.75_dp]
    nodes4(:, 2) = [0.5_dp, -0.25_dp]
    nodes4(:, 3) = [0.0_dp, 0.75_dp]
    known_t = 0.75_dp
    ! NOTE: By construction, the Jacobian matrix will be
    !           [1, 3/4], [1, -5/4]
    !       which has determinant -2.0, hence there will
    !       be no round-off when solving.
    wrong_s = known_s + 0.0625_dp
    wrong_t = known_t + 0.0625_dp
    call newton_refine_intersect( &
         wrong_s, 3, nodes3, wrong_t, 3, nodes4, new_s, new_t, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         new_s == 0.2421875_dp .AND. &
         abs(known_s - new_s) < abs(known_s - wrong_s) .AND. &
         new_t == 0.7578125_dp .AND. &
         abs(known_t - new_t) < abs(known_t - wrong_t) .AND. &
         curves_intersect(nodes3, known_s, nodes4, known_t))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Convergence test.
    nodes5(:, 1) = 0
    nodes5(:, 2) = [0.25_dp, 1.0_dp]
    nodes5(:, 3) = [0.5_dp, -0.75_dp]
    nodes5(:, 4) = [0.75_dp, 1.0_dp]
    nodes5(:, 5) = [1.0_dp, 0.0_dp]
    known_s = 0.5_dp
    nodes1(:, 1) = [0.5_dp, 0.0_dp]
    nodes1(:, 2) = [0.5_dp, 1.0_dp]
    known_t = 0.21875_dp
    ! We start with a very wrong guess and update it three times.
    wrong_s = 0.0_dp
    wrong_t = 0.0_dp
    case_success = .TRUE.
    do i = 1, 3
       call newton_refine_intersect( &
            wrong_s, 5, nodes5, wrong_t, 2, nodes1, new_s, new_t, status)
       wrong_s = new_s
       wrong_t = new_t
       if (i == 1) then
          case_success = ( &
               case_success .AND. &
               status == Status_SUCCESS .AND. &
               new_s == known_s .AND. &
               new_t == 2.0_dp)
       else
          case_success = ( &
               case_success .AND. &
               status == Status_SUCCESS .AND. &
               new_s == known_s .AND. &
               new_t == known_t)
       end if
    end do

    case_success = ( &
         case_success .AND. &
         curves_intersect(nodes5, known_s, nodes1, known_t))
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Singular Jacobian.
    nodes3(:, 1) = [0.5_dp, 0.0_dp]
    nodes3(:, 2) = 1
    nodes3(:, 3) = [1.5_dp, 0.0_dp]
    known_s = 0.5_dp
    nodes1(:, 1) = [0.0_dp, 0.5_dp]
    nodes1(:, 2) = [1.0_dp, 0.5_dp]
    known_t = 0.5_dp
    ! NOTE: By construction, the Jacobian matrix
    !           [1, -1], [2(1 - 2s), 0]
    !       will evaluate at ``1/2, 1/2`` to
    !           [1, -1], [0, 0]
    !       which has determinant 0.0 exactly.
    call newton_refine_intersect( &
         known_s, 3, nodes3, known_t, 2, nodes1, new_s, new_t, status)
    case_success = (status == Status_SINGULAR)
    call print_status(name, case_id, case_success, success)

  end subroutine test_newton_refine_intersect

  function curves_intersect(nodes1, s, nodes2, t) result(predicate)
    real(c_double), intent(in) :: nodes1(:, :), nodes2(:, :)
    real(c_double), intent(in) :: s, t
    logical(c_bool) :: predicate
    ! Variables outside of signature.
    real(c_double) :: point1(1, 2), point2(1, 2)

    call evaluate_multi( &
         size(nodes1, 2), size(nodes1, 1), nodes1, 1, [s], point1)
    call evaluate_multi( &
         size(nodes2, 2), size(nodes2, 1), nodes2, 1, [t], point2)
    predicate = all(point1 == point2)

  end function curves_intersect

  subroutine test_bbox_intersect(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: unit_square(2, 4), other(2, 4), delta
    integer(c_int) :: enum_, i
    integer :: case_id
    character(14) :: name

    case_id = 1
    name = "bbox_intersect"
    unit_square(:, 1) = 0
    unit_square(:, 2) = [1.0_dp, 0.0_dp]
    unit_square(:, 3) = 1
    unit_square(:, 4) = [0.0_dp, 1.0_dp]

    ! CASE 1: Intersecting bbox-es.
    forall (i = 1:4)
       other(:, i) = unit_square(:, i) + 0.5_dp
    end forall
    call bbox_intersect( &
         4, unit_square, 4, other, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Far apart bbox-es.
    forall (i = 1:4)
       other(:, i) = unit_square(:, i) + 100.0_dp
    end forall
    call bbox_intersect( &
         4, unit_square, 4, other, enum_)
    case_success = (enum_ == BoxIntersectionType_DISJOINT)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Disjoint bbox-es that have an "aligned" edge.
    forall (i = 1:4)
       other(:, i) = unit_square(:, i) + [1.0_dp, 2.0_dp]
    end forall
    call bbox_intersect( &
         4, unit_square, 4, other, enum_)
    case_success = (enum_ == BoxIntersectionType_DISJOINT)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Tangent bbox-es.
    forall (i = 1:4)
       other(:, i) = unit_square(:, i) + [1.0_dp, 0.0_dp]
    end forall
    call bbox_intersect( &
         4, unit_square, 4, other, enum_)
    case_success = (enum_ == BoxIntersectionType_TANGENT)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Almost tangent bbox-es.
    delta = 1.0_dp + spacing(1.0_dp)
    forall (i = 1:4)
       other(:, i) = unit_square(:, i) + [delta, 0.0_dp]
    end forall
    call bbox_intersect( &
         4, unit_square, 4, other, enum_)
    case_success = (enum_ == BoxIntersectionType_DISJOINT)
    call print_status(name, case_id, case_success, success)

  end subroutine test_bbox_intersect

  subroutine test_parallel_lines_parameters(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    logical(c_bool) :: disjoint
    real(c_double) :: start0(2), end0(2)
    real(c_double) :: start1(2), end1(2)
    real(c_double) :: parameters(2, 2)
    integer :: case_id
    character(25) :: name

    case_id = 1
    name = "parallel_lines_parameters"

    ! CASE 1: Same line, but segments don't overlap.
    start0 = 0
    end0 = [3.0_dp, 4.0_dp]
    start1 = [6.0_dp, 8.0_dp]
    end1 = [9.0_dp, 12.0_dp]
    call parallel_lines_parameters( &
         start0, end0, start1, end1, disjoint, parameters)
    case_success = (disjoint)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Same as CASE 1, but reverse the direction of line 1.
    call parallel_lines_parameters( &
         start0, end0, end1, start1, disjoint, parameters)
    case_success = (disjoint)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Same as CASE 1, but swap the lines.
    call parallel_lines_parameters( &
         start1, end1, start0, end0, disjoint, parameters)
    case_success = (disjoint)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Same as CASE 1, but reverse the direction of line 0.
    call parallel_lines_parameters( &
         end0, start0, start1, end1, disjoint, parameters)
    case_success = (disjoint)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Same line, ``start1`` contained in segment "0".
    start0 = [6.0_dp, -3.0_dp]
    end0 = [-7.0_dp, 1.0_dp]
    start1 = [1.125_dp, -1.5_dp]
    end1 = [-5.375_dp, 0.5_dp]
    call parallel_lines_parameters( &
         start0, end0, start1, end1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.375_dp, 0.0_dp]) .AND. &
         all(parameters(:, 2) == [0.875_dp, 1.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Same as CASE 5, but reverse the direction of line 1.
    call parallel_lines_parameters( &
         start0, end0, end1, start1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.875_dp, 0.0_dp]) .AND. &
         all(parameters(:, 2) == [0.375_dp, 1.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Same as CASE 5, but swap the lines.
    call parallel_lines_parameters( &
         start1, end1, start0, end0, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.0_dp, 0.375_dp]) .AND. &
         all(parameters(:, 2) == [1.0_dp, 0.875_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Same line, ``end1`` contained in segment "0".
    start0 = [1.0_dp, 2.0_dp]
    end0 = [3.0_dp, 5.0_dp]
    start1 = [-2.0_dp, -2.5_dp]
    end1 = [2.0_dp, 3.5_dp]
    call parallel_lines_parameters( &
         start0, end0, start1, end1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.0_dp, 0.75_dp]) .AND. &
         all(parameters(:, 2) == [0.5_dp, 1.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Same as CASE 8, but reverse the direction of line 1.
    call parallel_lines_parameters( &
         start0, end0, end1, start1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.5_dp, 0.0_dp]) .AND. &
         all(parameters(:, 2) == [0.0_dp, 0.25_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Same as CASE 8, but swap the lines.
    call parallel_lines_parameters( &
         start1, end1, start0, end0, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.75_dp, 0.0_dp]) .AND. &
         all(parameters(:, 2) == [1.0_dp, 0.5_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 11: Same line, segment "0" fully contained in segment "1".
    start0 = [-9.0_dp, 0.0_dp]
    end0 = [4.0_dp, 5.0_dp]
    start1 = [23.5_dp, 12.5_dp]
    end1 = [-28.5_dp, -7.5_dp]
    call parallel_lines_parameters( &
         start0, end0, start1, end1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [1.0_dp, 0.375_dp]) .AND. &
         all(parameters(:, 2) == [0.0_dp, 0.625_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 12: Same as CASE 11, but reverse the direction of line 1.
    call parallel_lines_parameters( &
         start0, end0, end1, start1, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.0_dp, 0.375_dp]) .AND. &
         all(parameters(:, 2) == [1.0_dp, 0.625_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 13: Same as CASE 11, but swap the lines.
    call parallel_lines_parameters( &
         start1, end1, start0, end0, disjoint, parameters)
    case_success = ( &
         .NOT. disjoint .AND. &
         all(parameters(:, 1) == [0.625_dp, 0.0_dp]) .AND. &
         all(parameters(:, 2) == [0.375_dp, 1.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 14: Parallel, but different lines.
    start0 = [3.0_dp, 2.0_dp]
    end0 = [3.0_dp, 0.75_dp]
    start1 = 0
    end1 = [0.0_dp, 2.0_dp]
    call parallel_lines_parameters( &
         start0, end0, start1, end1, disjoint, parameters)
    case_success = (disjoint)
    call print_status(name, case_id, case_success, success)

  end subroutine test_parallel_lines_parameters

  subroutine test_line_line_collide(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: line1(2, 2), line2(2, 2)
    logical(c_bool) :: collision
    integer :: case_id
    character(17) :: name

    case_id = 1
    name = "line_line_collide"

    ! Will hold throughout.
    line1(:, 1) = 0
    line1(:, 2) = 1

    ! CASE 1: Lines in general position (i.e. not parallel) that collide.
    line2(:, 1) = [0.0_dp, 1.0_dp]
    line2(:, 2) = [1.0_dp, 0.0_dp]
    call line_line_collide(line1, line2, collision)
    case_success = (collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Lines in general position (i.e. not parallel) that don't collide.
    line2(:, 1) = [3.0_dp, 4.0_dp]
    line2(:, 2) = [3.0_dp, 5.0_dp]
    call line_line_collide(line1, line2, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Segments that lie on parallel (but distinct) lines.
    line2(:, 1) = [0.0_dp, 1.0_dp]
    line2(:, 2) = [1.0_dp, 2.0_dp]
    call line_line_collide(line1, line2, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Segments that lie on the same line, but are disjoint.
    line2(:, 1) = 2
    line2(:, 2) = 3
    call line_line_collide(line1, line2, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Segments that lie on the same line and overlap.
    line2(:, 1) = 0.5_dp
    line2(:, 2) = 1.5_dp
    call line_line_collide(line1, line2, collision)
    case_success = (collision)
    call print_status(name, case_id, case_success, success)

  end subroutine test_line_line_collide

  subroutine test_convex_hull_collide(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 2), nodes2(2, 3)
    real(c_double), allocatable :: polygon1(:, :), polygon2(:, :)
    logical(c_bool) :: collision
    integer :: case_id
    character(19) :: name

    case_id = 1
    name = "convex_hull_collide"

    ! CASE 1: Convex hulls are both lines (Also, both ``polygon1`` and
    !         ``polygon2`` need to be allocated.)
    nodes2(:, 1) = 0
    nodes2(:, 2) = 1
    nodes2(:, 3) = 2
    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = [0.0_dp, 2.0_dp]
    call convex_hull_collide( &
         3, nodes2, polygon1, 2, nodes1, polygon2, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: At least one of the convex hulls is not a line (Also,
    !         ``polygon1`` does not need to be resized but ``polygon2``
    !         does.)
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    nodes2(:, 1) = [0.0_dp, 0.5_dp]
    nodes2(:, 2) = 1
    nodes2(:, 3) = [2.0_dp, 0.5_dp]
    call convex_hull_collide( &
         2, nodes1, polygon1, 3, nodes2, polygon2, collision)
    case_success = (collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Same as CASE 2 with inputs swapped (Also, ``polygon2`` does not
    !         need to be resized but ``polygon1`` does.)
    deallocate(polygon1)
    allocate(polygon1(2, 2))
    call convex_hull_collide( &
         3, nodes2, polygon1, 2, nodes1, polygon2, collision)
    case_success = (collision)
    call print_status(name, case_id, case_success, success)

  end subroutine test_convex_hull_collide

  subroutine test_newton_simple_root(success)

    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(18) :: name
    real(c_double) :: nodes1(2, 3), nodes2(2, 2)
    real(c_double) :: first_deriv1(2, 2), first_deriv2(2, 1)
    real(c_double) :: jacobian(2, 2)
    real(c_double) :: func_val(2, 1)

    case_id = 1
    name = "newton_simple_root"

    ! CASE 1: F(s, t) != [0, 0].
    !           B1(s) = [s(s + 2) ]
    !                   [4s(1 - s)]
    !           B2(t) = [1 + 3t]
    !                   [4 - 4t]
    !           DF    = [2 + 2s, -3]
    !                   [4 - 8s,  4]
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 2.0_dp]
    nodes1(:, 3) = [3.0_dp, 0.0_dp]
    first_deriv1(:, 1) = [2.0_dp, 4.0_dp]
    first_deriv1(:, 2) = [4.0_dp, -4.0_dp]
    nodes2(:, 1) = [1.0_dp, 4.0_dp]
    nodes2(:, 2) = [4.0_dp, 0.0_dp]
    first_deriv2(:, 1) = [3.0_dp, -4.0_dp]
    call newton_simple_root( &
         0.5_dp, 3, nodes1, first_deriv1, &
         0.25_dp, 2, nodes2, first_deriv2, jacobian, func_val)
    case_success = ( &
         all(jacobian(:, 1) == [3.0_dp, 0.0_dp]) .AND. &
         all(jacobian(:, 2) == [-3.0_dp, 4.0_dp]) .AND. &
         all(func_val(:, 1) == [-0.5_dp, -2.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: F(s, t) == [0, 0].
    !           B1(s) = [2s(1 + s)]
    !                   [6s(1 - s)]
    !           B2(t) = [21t]
    !                   [ 9t]
    !           DF    = [2 +  4s, -21]
    !                   [6 - 12s,  -9]
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 3.0_dp]
    nodes1(:, 3) = [4.0_dp, 0.0_dp]
    first_deriv1(:, 1) = [2.0_dp, 6.0_dp]
    first_deriv1(:, 2) = [6.0_dp, -6.0_dp]
    nodes2(:, 1) = 0
    nodes2(:, 2) = [21.0_dp, 9.0_dp]
    first_deriv2(:, 1) = [21.0_dp, 9.0_dp]
    call newton_simple_root( &
         0.75_dp, 3, nodes1, first_deriv1, &
         0.125_dp, 2, nodes2, first_deriv2, jacobian, func_val)
    case_success = ( &
         all(func_val == 0.0_dp))
    call print_status(name, case_id, case_success, success)

  end subroutine test_newton_simple_root

  subroutine test_newton_double_root(success)

    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(18) :: name
    real(c_double) :: nodes1(2, 3), nodes2(2, 3)
    real(c_double) :: first_deriv1(2, 2), first_deriv2(2, 2)
    real(c_double) :: second_deriv1(2, 1), second_deriv2(2, 1)
    real(c_double) :: modified_lhs(2, 2)
    real(c_double) :: modified_rhs(2, 1)

    case_id = 1
    name = "newton_double_root"

    ! Same for both.
    !           B1(s) = [s(s + 2) ]
    !                   [4s(1 - s)]
    !           B2(t) = [1 + 3t]
    !                   [4 - 4t]
    !           DF    = [2 + 2s, -3]
    !                   [4 - 8s,  4]
    !           B1(s) = [4s(1 - s)]
    !                   [       2s]
    !           B2(t) = [2(2t^2 - 2t + 1)]
    !                   [              2t]
    !           B1'(s) x B2'(s) = -16(s + t - 1)
    !           DG    = [4 - 8s, 4 - 8t]
    !                   [     2,     -2]
    !                   [   -16,    -16]
    !           DG^T DG = [   4(16s^2 - 16s + 69), 4(16st - 8s - 8t + 67)]
    !                     [4(16st - 8s - 8t + 67),    4(16t^2 - 16t + 69)]
    !           DG^T G  =
    !     [4(8s^3 - 12s^2 + 8st^2 - 8st + 73s - 4t^2 + 67t - 66)]
    !     [4(8s^2t - 4s^2 - 8st + 67s + 8t^3 - 12t^2 + 73t - 66)]
    nodes1(:, 1) = 0
    nodes1(:, 2) = [2.0_dp, 1.0_dp]
    nodes1(:, 3) = [0.0_dp, 2.0_dp]
    first_deriv1(:, 1) = [4.0_dp, 2.0_dp]
    first_deriv1(:, 2) = [-4.0_dp, 2.0_dp]
    second_deriv1(:, 1) = [-8.0_dp, 0.0_dp]
    nodes2(:, 1) = [2.0_dp, 0.0_dp]
    nodes2(:, 2) = [0.0_dp, 1.0_dp]
    nodes2(:, 3) = [2.0_dp, 2.0_dp]
    first_deriv2(:, 1) = [-4.0_dp, 2.0_dp]
    first_deriv2(:, 2) = [4.0_dp, 2.0_dp]
    second_deriv2(:, 1) = [8.0_dp, 0.0_dp]

    ! CASE 1: G(s, t) != [0, 0, 0].
    call newton_double_root( &
         0.75_dp, 3, nodes1, first_deriv1, second_deriv1, &
         0.25_dp, 3, nodes2, first_deriv2, second_deriv2, &
         modified_lhs, modified_rhs)
    case_success = ( &
         all(modified_lhs(:, 1) == [264.0_dp, 248.0_dp]) .AND. &
         all(modified_lhs(:, 2) == [248.0_dp, 264.0_dp]) .AND. &
         all(modified_rhs(:, 1) == [3.0_dp, -3.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: G(s, t) == [0, 0, 0].
    call newton_double_root( &
         0.5_dp, 3, nodes1, first_deriv1, second_deriv1, &
         0.5_dp, 3, nodes2, first_deriv2, second_deriv2, &
         modified_lhs, modified_rhs)
    case_success = ( &
         all(modified_rhs(:, 1) == 0.0_dp))
    call print_status(name, case_id, case_success, success)

  end subroutine test_newton_double_root

  subroutine check_closer( &
       s, current_s, expected_s, t, current_t, expected_t, success)

    ! Checks if ``current_s`` is closer to ``expected_s`` than ``s`` was
    ! but also makes sure it is not as close as ``sqrt(machine precision)``
    ! in relative error.

    real(c_double), intent(in) :: s
    real(c_double), intent(in) :: current_s
    real(c_double), intent(in) :: expected_s
    real(c_double), intent(in) :: t
    real(c_double), intent(in) :: current_t
    real(c_double), intent(in) :: expected_t
    logical, intent(out) :: success
    ! Variables outside of signature.
    real(c_double) :: err_s, err_t

    err_s = abs(expected_s - current_s)
    err_t = abs(expected_t - current_t)

    success = ( &
         err_s < abs(expected_s - s) .AND. &
         err_t < abs(expected_t - t) .AND. &
         err_s > 0.5_dp**26 * expected_s .AND. &
         err_t > 0.5_dp**26 * expected_t)

  end subroutine check_closer

  subroutine test_newton_iterate(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(14) :: name
    real(c_double) :: s, t, new_s, new_t
    logical(c_bool) :: converged
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3)
    real(c_double) :: first_deriv1(2, 2), first_deriv2(2, 2)
    real(c_double) :: line(2, 2), line_first_deriv(2, 1)
    real(c_double) :: second_deriv1(2, 1), second_deriv2(2, 1)
    real(c_double) :: expected_s, expected_t

    case_id = 1
    name = "newton_iterate"

    ! CASE 1: RHS is exactly zero during "Newton simple" iteration.
    !         B1([10922/32768, 10923/32768]) and B2([16383/16384, 1]) are
    !         linearized and when the segments intersect they produce
    !         t = 109217/109216 > 1.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [4.5_dp, 9.0_dp]
    quadratic1(:, 3) = [9.0_dp, 0.0_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    s = 671023103.0_dp / 2013069312.0_dp

    quadratic2(:, 1) = [11.0_dp, 8.0_dp]
    quadratic2(:, 2) = [7.0_dp, 10.0_dp]
    quadratic2(:, 3) = [3.0_dp, 4.0_dp]
    first_deriv2 = 2 * (quadratic2(:, 2:) - quadratic2(:, :2))
    t = 1789394945.0_dp / 1789394944.0_dp

    call newton_iterate(f_simple, s, t, new_s, new_t, converged)
    case_success = ( &
         3 * new_s == 1.0_dp .AND. &
         new_t == 1.0_dp .AND. &
         converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Jacobian becomes singular during "Newton simple" iteration.
    !         B1([5461/8192, 5462/8192]) and B2([2730/8192, 2731/8192]) are
    !         linearized and the segments are parallel. The curves intersect
    !         at the point B1(2/3) = [1/2, 1/2] = B2(1/3) and they have
    !         parallel tangent vectors B1'(2/3) = [3/4, 0] = B2'(1/3).
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.375_dp, 0.75_dp]
    quadratic1(:, 3) = [0.75_dp, 0.375_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    s = 10923.0_dp / 16384.0_dp

    quadratic2(:, 1) = [0.25_dp, 0.625_dp]
    quadratic2(:, 2) = [0.625_dp, 0.25_dp]
    quadratic2(:, 3) = 1
    first_deriv2 = 2 * (quadratic2(:, 2:) - quadratic2(:, :2))
    t = 5461.0_dp / 16384.0_dp

    call newton_iterate(f_simple, s, t, new_s, new_t, converged)
    case_success = ( &
         3 * new_s == 2.0_dp + 0.5_dp**14 .AND. &
         3 * new_t == 1.0_dp - 0.5_dp**14 .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: The method converges linearly (rather than quadratically)
    !         during "Newton simple" iteration.
    !         B1([2730/8192, 2731/8192]) and B2([1/2, 2049/4096]) are
    !         linearized and when the segments intersect they produce
    !         t = -1/6 < 0.
    quadratic1(:, 1) = [0.5_dp, 0.125_dp]
    quadratic1(:, 2) = [1.25_dp, -0.25_dp]
    quadratic1(:, 3) = [2.0_dp, 0.5_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    s = 12287.0_dp / 36864.0_dp

    quadratic2(:, 1) = [0.5_dp, -0.125_dp]
    quadratic2(:, 2) = [1.0_dp, 0.125_dp]
    quadratic2(:, 3) = [1.5_dp, -0.125_dp]
    first_deriv2 = 2 * (quadratic2(:, 2:) - quadratic2(:, :2))
    t = 12287.0_dp / 24576.0_dp

    call newton_iterate(f_simple, s, t, new_s, new_t, converged)
    call check_closer( &
         s, new_s, 1.0_dp / 3.0_dp, t, new_t, 0.5_dp, case_success)
    case_success = ( &
         case_success .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: The method converges because relative error is below threshold
    !         during "Newton double" iteration.
    !         B1([2730/8192, 2731/8192]) and B2([2047/4096, 1/2]) are
    !         linearized and when the segments intersect they produce
    !         t = 11/10 > 1.
    !         This re-uses the nodes from CASE 3.

    second_deriv1 = (first_deriv1(:, 2:) - first_deriv1(:, :1))
    second_deriv2 = (first_deriv2(:, 2:) - first_deriv2(:, :1))

    ! NOTE: These ``s-t`` values come after the simple root case exits
    !       due to linear convergence, having started from
    !       s = 6827 / 20480 and t = 20481 / 40960 and updating 4 times.
    s = 109227.0_dp / 327680.0_dp
    t = 327681.0_dp / 655360.0_dp

    call newton_iterate(f_double, s, t, new_s, new_t, converged)
    expected_s = 1.0_dp / 3.0_dp
    case_success = ( &
         expected_s - new_s == spacing(expected_s) .AND. &
         new_t == 0.5_dp .AND. &
         converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: The method converges because relative error is below threshold
    !         during "Newton simple" iteration.
    !         B1([12287/16384, 3/4]) and B2([2457/8192, 2458/8192]) are
    !         linearized and when the segments intersect they produce
    !         s = 33555797/33551701 > 1.
    quadratic1(:, 1) = [1.0_dp, 0.0_dp]
    quadratic1(:, 2) = [-1.0_dp, 0.25_dp]
    quadratic1(:, 3) = [1.0_dp, 0.5_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    s = 25163776.0_dp / 33551701.0_dp

    quadratic2(:, 1) = [-0.125_dp, -0.28125_dp]
    quadratic2(:, 2) = [0.5_dp, 1.28125_dp]
    quadratic2(:, 3) = [1.125_dp, -0.28125_dp]
    first_deriv2 = 2 * (quadratic2(:, 2:) - quadratic2(:, :2))
    t = 41228331827.0_dp / 137427767296.0_dp

    call newton_iterate(f_simple, s, t, new_s, new_t, converged)
    expected_t = 3.0_dp / 10.0_dp
    case_success = ( &
         new_s == 0.75_dp .AND. &
         new_t - expected_t == spacing(expected_t) .AND. &
         converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Jacobian becomes singular during "Newton double" iteration.
    !         The curves are tangent and have the same curvature (i.e.
    !         triple root).
    quadratic1(:, 1) = [12.0_dp, 4.0_dp]
    quadratic1(:, 2) = -4
    quadratic1(:, 3) = [-4.0_dp, 4.0_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    second_deriv1 = (first_deriv1(:, 2:) - first_deriv1(:, :1))
    s = 1125899532873825.0_dp * 0.5_dp**51

    quadratic2(:, 1) = [6.0_dp, 1.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -1.0_dp]
    quadratic2(:, 3) = [-2.0_dp, 1.0_dp]
    first_deriv2 = 2 * (quadratic2(:, 2:) - quadratic2(:, :2))
    second_deriv2 = (first_deriv2(:, 2:) - first_deriv2(:, :1))
    t = 4503596635588511.0_dp * 0.5_dp**53

    call newton_iterate(f_double, s, t, new_s, new_t, converged)
    call check_closer( &
         s, new_s, 0.5_dp, t, new_t, 0.5_dp, case_success)
    case_success = ( &
         case_success .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: The method converges linearly (rather than quadratically)
    !         during "Newton simple" iteration.
    !         B1([16387/32768, 16388/32768]) and B2([8195/16384, 8196/16384])
    !         are linearized and when the segments intersect they produce
    !         s = t = -9/7 < 0.
    !         This re-uses the nodes from CASE 6.

    ! NOTE: These ``s-t`` values come after the simple root case exits
    !       due to linear convergence, having started from
    !       s = 28675 / 57344 and t = 14339 / 28672.
    s = 4503629435419537.0_dp * 0.5_dp**53
    t = 2251829621738309.0_dp * 0.5_dp**52

    call newton_iterate(f_double, s, t, new_s, new_t, converged)
    call check_closer( &
         s, new_s, 0.5_dp, t, new_t, 0.5_dp, case_success)
    case_success = ( &
         case_success .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: A sequence of ``s-t`` parameters converges linearly via
    !         ``sn = tn = 0.5 - k`` ==> ``s{n+1} = t{n+1} = 0.5 - 0.5 k``.
    !         This will be used to show an "early" exit when the root gets
    !         within ``sqrt(machine precision)`` of the actual root
    !         ``s = t = 0.5``.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.5_dp, 1.0_dp]
    quadratic1(:, 3) = [1.0_dp, 0.0_dp]
    first_deriv1 = 2 * (quadratic1(:, 2:) - quadratic1(:, :2))
    s = -0.5_dp

    line(:, 1) = [0.0_dp, 0.5_dp]
    line(:, 2) = [1.0_dp, 0.5_dp]
    line_first_deriv = line(:, 2:) - line(:, :1)
    t = -0.5_dp

    call newton_iterate(f_curve_line, s, t, new_s, new_t, converged)
    case_success = ( &
         new_s == 0.5_dp - 0.5_dp**4 .AND. &
         new_t == 0.5_dp - 0.5_dp**4 .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Same as CASE 8, but closer to the solution (but still not close
    !         enough to "converge" prematurely).
    s = 0.5_dp - 0.5_dp**20
    t = 0.5_dp - 0.5_dp**20
    call newton_iterate(f_curve_line, s, t, new_s, new_t, converged)
    case_success = ( &
         new_s == 0.5_dp - 0.5_dp**24 .AND. &
         new_t == 0.5_dp - 0.5_dp**24 .AND. &
         .NOT. converged)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Same as CASE 8 and 9 and "converges" prematurely, i.e.
    !          ``F(s, t)`` evaluates to zero earlier than it should.
    s = 0.5_dp - 0.5_dp**26
    t = 0.5_dp - 0.5_dp**26
    call newton_iterate(f_curve_line, s, t, new_s, new_t, converged)
    case_success = ( &
         new_s == 0.5_dp - 0.5_dp**28 .AND. &
         new_t == 0.5_dp - 0.5_dp**28 .AND. &
         converged)
    call print_status(name, case_id, case_success, success)

  contains

    ! NOTE: This is a closure around several variables in the
    !       scope above which may change:
    !       * ``quadratic1``
    !       * ``first_deriv1``
    !       * ``quadratic2``
    !       * ``first_deriv2``
    subroutine f_simple(s, t, jacobian, func_val)
      real(c_double), intent(in) :: s
      real(c_double), intent(in) :: t
      real(c_double), intent(out) :: jacobian(2, 2)
      real(c_double), intent(out) :: func_val(2, 1)

      call newton_simple_root( &
           s, 3, quadratic1, first_deriv1, &
           t, 3, quadratic2, first_deriv2, jacobian, func_val)

    end subroutine f_simple

    ! NOTE: This is a closure around several variables in the
    !       scope above which may change:
    !       * ``quadratic1``
    !       * ``first_deriv1``
    !       * ``second_deriv1``
    !       * ``quadratic2``
    !       * ``first_deriv2``
    !       * ``second_deriv2``
    subroutine f_double(s, t, jacobian, func_val)
      real(c_double), intent(in) :: s
      real(c_double), intent(in) :: t
      real(c_double), intent(out) :: jacobian(2, 2)
      real(c_double), intent(out) :: func_val(2, 1)

      call newton_double_root( &
           s, 3, quadratic1, first_deriv1, second_deriv1, &
           t, 3, quadratic2, first_deriv2, second_deriv2, &
           jacobian, func_val)

    end subroutine f_double

    ! NOTE: This is a closure around several variables in the
    !       scope above which may change:
    !       * ``quadratic1``
    !       * ``first_deriv1``
    !       * ``line``
    !       * ``line_first_deriv``
    subroutine f_curve_line(s, t, jacobian, func_val)
      real(c_double), intent(in) :: s
      real(c_double), intent(in) :: t
      real(c_double), intent(out) :: jacobian(2, 2)
      real(c_double), intent(out) :: func_val(2, 1)

      call newton_simple_root( &
           s, 3, quadratic1, first_deriv1, &
           t, 2, line, line_first_deriv, jacobian, func_val)

    end subroutine f_curve_line

  end subroutine test_newton_iterate

  subroutine test_full_newton_nonzero(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(19) :: name
    real(c_double) :: s, t, new_s, new_t
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3), line(2, 2)
    integer(c_int) :: status
    real(c_double) :: expected_s, expected_t

    case_id = 1
    name = "full_newton_nonzero"

    ! CASE 1: Simple root, converges.
    !         B1([4095/8192, 1/2]) and B2([1365/8192, 1366/8192]) are
    !         linearized and when the segments intersect they produce
    !         s = 24580/24579 > 1.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.375_dp, 0.75_dp]
    quadratic1(:, 3) = [0.75_dp, 0.375_dp]
    s = 100675585.0_dp / 201351168.0_dp

    quadratic2(:, 1) = [0.25_dp, 0.5625_dp]
    quadratic2(:, 2) = [0.625_dp, 0.1875_dp]
    quadratic2(:, 3) = [1.0_dp, 0.9375_dp]
    t = 33558529.0_dp / 201351168.0_dp

    call full_newton_nonzero( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    expected_s = 0.5_dp
    expected_t = 1.0_dp / 6.0_dp
    case_success = ( &
         new_s - expected_s == spacing(expected_s) .AND. &
         new_t - expected_t == 3 * spacing(expected_t) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Double root, converges.
    !         B1([5461/8192, 5462/8192]) and B2([2730/8192, 2731/8192]) are
    !         linearized and the segments are parallel. The curves intersect
    !         at the point B1(2/3) = [1/2, 1/2] = B2(1/3) and they have
    !         parallel tangent vectors B1'(2/3) = [3/4, 0] = B2'(1/3).
    !         This re-uses the ``quadratic1`` from CASE 1.

    s = 10923.0_dp / 16384.0_dp

    quadratic2(:, 1) = [0.25_dp, 0.625_dp]
    quadratic2(:, 2) = [0.625_dp, 0.25_dp]
    quadratic2(:, 3) = 1
    t = 5461.0_dp / 16384.0_dp

    call full_newton_nonzero( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    expected_s = 2.0_dp / 3.0_dp
    expected_t = 1.0_dp / 3.0_dp
    case_success = ( &
         new_s - expected_s == spacing(expected_s) .AND. &
         new_t == expected_t .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Triple root, does not converge.
    !         B1([16382/32768, 16383/32768]) and B2([8190/16384, 8191/16384])
    !         are linearized and when the segments intersect they produce
    !         s = t = 4/3 > 1.
    quadratic1(:, 1) = [12.0_dp, 4.0_dp]
    quadratic1(:, 2) = -4
    quadratic1(:, 3) = [-4.0_dp, 4.0_dp]
    s = 24575.0_dp / 49152.0_dp

    quadratic2(:, 1) = [6.0_dp, 1.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -1.0_dp]
    quadratic2(:, 3) = [-2.0_dp, 1.0_dp]
    t = 12287.0_dp / 24576.0_dp

    call full_newton_nonzero( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    call check_closer( &
         s, new_s, 0.5_dp, t, new_t, 0.5_dp, case_success)
    case_success = ( &
         case_success .AND. &
         status == Status_BAD_MULTIPLICITY)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Intersect a line and a curve (and line has special handling
    !         for the second derivative).
    !         B1([5461/16384, 5462/16384]) and B2([0, 1]) are linearized
    !         and when the segments intersect they produce s = -1/3 < 0.
    quadratic1(:, 1) = [0.0_dp, 2.25_dp]
    quadratic1(:, 2) = [1.5_dp, -2.25_dp]
    quadratic1(:, 3) = [3.0_dp, 2.25_dp]
    s = 8191.0_dp / 24576.0_dp

    line(:, 1) = [-0.5_dp, 1.75_dp]
    line(:, 2) = [4.0_dp, -2.75_dp]
    t = 12287.0_dp / 36864.0_dp

    call full_newton_nonzero( &
         s, 3, quadratic1, t, 2, line, new_s, new_t, status)
    expected_s = 1.0_dp / 3.0_dp
    expected_t = 1.0_dp / 3.0_dp
    case_success = ( &
         new_s - expected_s == spacing(expected_s) .AND. &
         new_t == expected_t .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Two simple roots are nearby each other and cause issues
    !         with convergence of Newton's method. The intersection
    !         parameters come from intersecting the linearized segments
    !         B1([158/512, 159/512]) and B2([304/1024, 305/1024]).
    quadratic1(1, 1) = 2253417071872805.0_dp * 0.5_dp**52
    quadratic1(2, 1) = -5391011126540193.0_dp * 0.5_dp**53
    quadratic1(1, 2) = 249088587096167.0_dp * 0.5_dp**49
    quadratic1(2, 2) = -3078638273465135.0_dp * 0.5_dp**52
    quadratic1(1, 3) = 1728590045223805.0_dp * 0.5_dp**52
    quadratic1(2, 3) = -6865411541054431.0_dp * 0.5_dp**53
    s = 1389916272532583.0_dp * 0.5_dp**52

    quadratic2(1, 1) = 8931938502340357.0_dp * 0.5_dp**54
    quadratic2(2, 1) = -1347378683805771.0_dp * 0.5_dp**51
    quadratic2(1, 2) = 2000235959335163.0_dp * 0.5_dp**52
    quadratic2(2, 2) = -3107598627835741.0_dp * 0.5_dp**52
    quadratic2(1, 3) = 6971601718591565.0_dp * 0.5_dp**54
    quadratic2(2, 3) = -6783026884415249.0_dp * 0.5_dp**53
    t = 5364995685988593.0_dp * 0.5_dp**54

    call full_newton_nonzero( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    expected_s = 1389916043385487.0_dp * 0.5_dp**52
    expected_t = 5364994709250323.0_dp * 0.5_dp**54
    case_success = ( &
         new_s - expected_s == 447 * spacing(expected_s) .AND. &
         new_t - expected_t == 474 * spacing(expected_t) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_full_newton_nonzero

  subroutine test_full_newton(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(11) :: name
    real(c_double) :: s, t, new_s, new_t
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3)
    integer(c_int) :: status
    real(c_double) :: expected_s, expected_t

    case_id = 1
    name = "full_newton"

    ! CASE 1: Both parameters near zero.
    !         B1([0, 1/8192]) and B2([0, 1/8192]) are linearized and the
    !         segments are parallel, and the root is a double root.
    quadratic1(:, 1) = [1.0_dp, 0.0_dp]
    quadratic1(:, 2) = 1
    quadratic1(:, 3) = [0.0_dp, 1.0_dp]
    s = 1.0_dp / 16384.0_dp

    quadratic2(:, 1) = [1.0_dp, 0.0_dp]
    quadratic2(:, 2) = [1.0_dp, 1.5_dp]
    quadratic2(:, 3) = [-0.5_dp, 1.5_dp]
    t = 1.0_dp / 16384.0_dp

    call full_newton( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    case_success = ( &
         new_s == 0.0_dp .AND. &
         new_t == 0.0_dp .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``s`` near zero, ``t`` not.
    !         B1([0, 1/8192]) and B2([1/4, 2049/8192]) are linearized and the
    !         segments are parallel, and the root is a double root.
    quadratic1(:, 1) = [1.0_dp, 0.0_dp]
    quadratic1(:, 2) = [1.0_dp, 1.5_dp]
    quadratic1(:, 3) = [-0.5_dp, 1.5_dp]
    s = 1.0_dp / 16384.0_dp

    quadratic2(:, 1) = [0.9375_dp, -0.5625_dp]
    quadratic2(:, 2) = [1.1875_dp, 0.6875_dp]
    quadratic2(:, 3) = [0.4375_dp, 0.9375_dp]
    t = 4097.0_dp / 16384.0_dp

    call full_newton( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    case_success = ( &
         new_s == 0.0_dp .AND. &
         new_t == 0.25_dp .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``t`` near zero, ``s`` not. We re-use the nodes and parameters
    !         from CASE 2 and just swap the order.
    call full_newton( &
         t, 3, quadratic2, s, 3, quadratic1, new_s, new_t, status)
    case_success = ( &
         new_s == 0.25_dp .AND. &
         new_t == 0.0_dp .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Neither parameter near zero.
    !         B1([6826/8192, 6827/8192]) and B2([1/2, 4097/8192]) are
    !         linearized and when the segments intersect they produce
    !         t = -1/24579 < 0. The root is a simple root.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.375_dp, 0.75_dp]
    quadratic1(:, 3) = [0.75_dp, 0.375_dp]
    s = 167792639.0_dp / 201351168.0_dp

    quadratic2(:, 1) = [0.25_dp, 0.5625_dp]
    quadratic2(:, 2) = [0.625_dp, 0.1875_dp]
    quadratic2(:, 3) = [1.0_dp, 0.9375_dp]
    t = 100675583.0_dp / 201351168.0_dp

    expected_s = 5.0_dp / 6.0_dp
    expected_t = 0.5_dp
    call full_newton( &
         s, 3, quadratic1, t, 3, quadratic2, new_s, new_t, status)
    case_success = ( &
         expected_s - new_s == 2 * spacing(expected_s) .AND. &
         expected_t - new_t == 0.5_dp * spacing(expected_t) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_full_newton

  subroutine test_from_linearized(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    type(CurveData) :: curve1, curve2, curve3, curve4
    real(c_double) :: root_nodes1(2, 3), root_nodes2(2, 3)
    real(c_double) :: refined_s, refined_t
    logical(c_bool) :: does_intersect
    integer(c_int) :: status
    real(c_double) :: expected_s, expected_t
    integer :: case_id
    character(15) :: name

    case_id = 1
    name = "from_linearized"

    ! Will hold throughout.
    curve1%start = 0.0_dp
    curve1%end_ = 1.0_dp
    curve2%start = 0.0_dp
    curve2%end_ = 1.0_dp

    ! CASE 1: Basic test of not-very-linearized quadratics that do intersect.
    allocate(curve1%nodes(2, 3))
    curve1%nodes(:, 1) = 0
    curve1%nodes(:, 2) = [0.5_dp, 1.0_dp]
    curve1%nodes(:, 3) = 1

    allocate(curve2%nodes(2, 3))
    curve2%nodes(:, 1) = [0.0_dp, 1.0_dp]
    curve2%nodes(:, 2) = [0.5_dp, 1.0_dp]
    curve2%nodes(:, 3) = [1.0_dp, 0.0_dp]

    call from_linearized( &
         curve1, 3, curve1%nodes, &
         curve2, 3, curve2%nodes, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         does_intersect .AND. &
         refined_s == 0.5_dp .AND. &
         refined_t == 0.5_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Curves have overlapping bounding boxes, but do not intersect. The
    !         linearized intersection has ``s = 0.5, t == 1.25``, i.e. it is
    !         outside the unit interval. In this case, we fall back to the
    !         convex hulls (which are disjoint).
    curve1%nodes(:, 1) = 0
    curve1%nodes(:, 2) = [0.5_dp, 0.0_dp]
    curve1%nodes(:, 3) = 1

    deallocate(curve2%nodes)
    allocate(curve2%nodes(2, 3))
    curve2%nodes(:, 1) = [1.75_dp, -0.75_dp]
    curve2%nodes(:, 2) = [1.25_dp, -0.75_dp]
    curve2%nodes(:, 3) = [0.75_dp, 0.25_dp]

    call from_linearized( &
         curve1, 3, curve1%nodes, &
         curve2, 3, curve2%nodes, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Linearized segments are parallel, so we fall back to the convex
    !         hulls (which are disjoint).
    deallocate(curve1%nodes)
    allocate(curve1%nodes(2, 2))
    curve1%nodes(:, 1) = 0
    curve1%nodes(:, 2) = 1

    ! NOTE: This is a "bad" parameterization of ``y == x``.
    curve2%nodes(:, 1) = 2
    curve2%nodes(:, 2) = 2.5009765625_dp
    curve2%nodes(:, 3) = 3

    call from_linearized( &
         curve1, 2, curve1%nodes, &
         curve2, 3, curve2%nodes, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Similar to CASE 2, this is just the linearized segments as lines.
    curve1%nodes(:, 1) = 0
    curve1%nodes(:, 2) = 1

    deallocate(curve2%nodes)
    allocate(curve2%nodes(2, 2))
    curve2%nodes(:, 1) = [1.75_dp, -0.75_dp]
    curve2%nodes(:, 2) = [0.75_dp, 0.25_dp]

    call from_linearized( &
         curve1, 2, curve1%nodes, &
         curve2, 2, curve2%nodes, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Parallel lines (should have been handled already by
    !         ``check_lines``).
    curve1%nodes(:, 1) = 0
    curve1%nodes(:, 2) = 1

    curve2%nodes(:, 1) = [0.0_dp, 1.0_dp]
    curve2%nodes(:, 2) = [1.0_dp, 2.0_dp]

    call from_linearized( &
         curve1, 2, curve1%nodes, &
         curve2, 2, curve2%nodes, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Curves have parallel linearized segments caused by a tangent
    !         intersection.
    curve3%start = 5461.0_dp / 8192
    curve3%end_ = 5462.0_dp / 8192
    allocate(curve3%nodes(2, 3))
    root_nodes1(:, 1) = 0
    root_nodes1(:, 2) = [0.375_dp, 0.75_dp]
    root_nodes1(:, 3) = [0.75_dp, 0.375_dp]
    call specialize_curve( &
         3, 2, root_nodes1, curve3%start, curve3%end_, curve3%nodes)

    curve4%start = 2730.0_dp / 8192
    curve4%end_ = 2731.0_dp / 8192
    allocate(curve4%nodes(2, 3))
    root_nodes2(:, 1) = [0.25_dp, 0.625_dp]
    root_nodes2(:, 2) = [0.625_dp, 0.25_dp]
    root_nodes2(:, 3) = 1
    call specialize_curve( &
         3, 2, root_nodes2, curve4%start, curve4%end_, curve4%nodes)

    call from_linearized( &
         curve3, 3, root_nodes1, &
         curve4, 3, root_nodes2, &
         refined_s, refined_t, does_intersect, status)
    expected_s = 2.0_dp / 3.0_dp
    expected_t = 1.0_dp / 3.0_dp
    case_success = ( &
         status == Status_SUCCESS .AND. &
         does_intersect .AND. &
         refined_s - expected_s == spacing(expected_s) .AND. &
         refined_t == expected_t)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Curves intersect just outside of the "wiggled" unit interval
    !         ``[-2^{-44}, 1 + 2^{-44}]``.
    curve3%start = 127.0_dp / 128
    curve3%end_ = 1
    root_nodes1(:, 1) = [-0.8558466524001767_dp, -0.9648818559703933_dp]
    root_nodes1(:, 2) = [-0.8384755863215392_dp, -0.9825154456957814_dp]
    root_nodes1(:, 3) = [-0.8214285714285716_dp, -1.0_dp]
    call specialize_curve( &
         3, 2, root_nodes1, curve3%start, curve3%end_, curve3%nodes)

    curve4%start = 0
    curve4%end_ = 1
    root_nodes2(:, 1) = [-0.8348214285714286_dp, -0.986607142857143_dp]
    root_nodes2(:, 2) = [-0.8158482142857144_dp, -1.0055803571428572_dp]
    root_nodes2(:, 3) = [-0.7968750000000001_dp, -1.0245535714285714_dp]
    curve4%nodes = root_nodes2

    call from_linearized( &
         curve3, 3, root_nodes1, &
         curve4, 3, root_nodes2, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect .AND. &
         refined_s > 1.0_dp + WIGGLE)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Same as CASE 7, with arguments reversed.
    call from_linearized( &
         curve4, 3, root_nodes2, &
         curve3, 3, root_nodes1, &
         refined_s, refined_t, does_intersect, status)
    case_success = ( &
         status == Status_SUCCESS .AND. &
         .NOT. does_intersect .AND. &
         refined_t > 1.0_dp + WIGGLE)
    call print_status(name, case_id, case_success, success)

  end subroutine test_from_linearized

  subroutine test_bbox_line_intersect(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: unit_square(2, 4)
    real(c_double) :: line_start(2), line_end(2)
    integer(c_int) :: enum_
    integer :: case_id
    character(19) :: name

    case_id = 1
    name = "bbox_line_intersect"
    unit_square(:, 1) = 0
    unit_square(:, 2) = [1.0_dp, 0.0_dp]
    unit_square(:, 3) = 1
    unit_square(:, 4) = [0.0_dp, 1.0_dp]

    ! CASE 1: Line starts inside bounding box.
    line_start = 0.5_dp
    line_end = [0.5_dp, 1.5_dp]
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Line ends (but does not start) in bounding box.
    line_start = [-1.0_dp, 0.5_dp]
    line_end = 0.5_dp
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Line segment "pierces" bbox from the bottom.
    line_start = [0.5_dp, -0.5_dp]
    line_end = [0.5_dp, 1.5_dp]
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Line segment "pierces" bbox from the right.
    line_start = [-0.5_dp, 0.5_dp]
    line_end = [1.5_dp, 0.5_dp]
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Line segment "pierces" bbox from the top.
    line_start = [-0.25_dp, 0.5_dp]
    line_end = [0.5_dp, 1.25_dp]
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_INTERSECTION)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Line segment is disjoint from bbox.
    line_start = 2
    line_end = [2.0_dp, 5.0_dp]
    call bbox_line_intersect( &
         4, unit_square, line_start, line_end, enum_)
    case_success = (enum_ == BoxIntersectionType_DISJOINT)
    call print_status(name, case_id, case_success, success)

  end subroutine test_bbox_line_intersect

  subroutine test_check_lines(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(2, 3), nodes3(2, 2), nodes4(2, 2)
    logical(c_bool) :: both_linear
    logical(c_bool) :: coincident
    real(c_double), allocatable :: intersections(:, :)
    integer(c_int) :: num_intersections
    integer :: case_id
    character(11) :: name

    case_id = 1
    name = "check_lines"

    ! CASE 1: Test first curve not linearized.
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    nodes1(:, 3) = [2.0_dp, 0.0_dp]
    nodes2(:, 1) = [0.0_dp, 1.0_dp]
    nodes2(:, 2) = [1.0_dp, 0.0_dp]
    nodes2(:, 3) = [2.0_dp, 1.0_dp]

    call check_lines( &
         3, nodes1, 3, nodes2, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         .NOT. both_linear .AND. &
         .NOT. coincident .AND. &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Test second curve not linearized.
    nodes3(:, 1) = 0
    nodes3(:, 2) = 1

    call check_lines( &
         2, nodes3, 3, nodes2, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         .NOT. both_linear .AND. &
         .NOT. coincident .AND. &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Lines aren't parallel, but do not intersect in their parameter
    !         ranges.
    nodes4(:, 1) = [2.0_dp, 3.0_dp]
    nodes4(:, 2) = [3.0_dp, 2.0_dp]

    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         both_linear .AND. &
         .NOT. coincident .AND. &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Lines do intersect (aren't parallel). Also, ``intersections``
    !         gets allocated.
    nodes4(:, 1) = [0.0_dp, 1.0_dp]
    nodes4(:, 2) = [1.0_dp, 0.0_dp]

    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         both_linear .AND. &
         .NOT. coincident .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         all(intersections(:, 1) == 0.5_dp))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Lines do intersect (aren't parallel), but ``intersections``
    !         is already allocated.
    nodes4(:, 1) = [0.0_dp, 1.0_dp]
    nodes4(:, 2) = [2.0_dp, -1.0_dp]

    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]))
    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         case_success .AND. &
         both_linear .AND. &
         .NOT. coincident .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         all(intersections(:, 1) == [0.5_dp, 0.25_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Lines are parallel, but do not shared a coincident segment.
    !         This also checks that even in the "failure" case (i.e. not
    !         coincident), ``intersections`` will get allocated. It **also**
    !         shows that it increases the size when too small.
    nodes4(:, 1) = [0.0_dp, 1.0_dp]
    nodes4(:, 2) = [1.0_dp, 2.0_dp]

    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]))
    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         case_success .AND. &
         both_linear .AND. &
         .NOT. coincident .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Lines are parallel and do share a coincident segment (and
    !         ``intersections`` is "big enough").
    nodes4(:, 1) = [0.5_dp, 0.5_dp]
    nodes4(:, 2) = [4.5_dp, 4.5_dp]

    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]))
    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         case_success .AND. &
         both_linear .AND. &
         coincident .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2 .AND. &
         all(intersections(:, 1) == [0.5_dp, 0.0_dp]) .AND. &
         all(intersections(:, 2) == [1.0_dp, 0.125_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Same as CASE 8, but ``intersections`` does not start
    !         out allocated.
    deallocate(intersections)
    call check_lines( &
         2, nodes3, 2, nodes4, &
         both_linear, coincident, intersections, num_intersections)
    case_success = ( &
         case_success .AND. &
         both_linear .AND. &
         coincident .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2 .AND. &
         all(intersections(:, 1) == [0.5_dp, 0.0_dp]) .AND. &
         all(intersections(:, 2) == [1.0_dp, 0.125_dp]))
    call print_status(name, case_id, case_success, success)

  end subroutine test_check_lines

  subroutine test_add_intersection(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    real(c_double) :: s_val, t_val
    integer :: case_id
    character(16) :: name

    case_id = 1
    name = "add_intersection"
    num_intersections = 0

    ! CASE 1: Intersections is **not allocated**.
    case_success = .NOT. allocated(intersections)
    call add_intersection( &
         0.25_dp, 0.5_dp, num_intersections, intersections)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 0.25_dp .AND. &
         intersections(2, 1) == 0.5_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Intersections is allocated, but not big enough.
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1)
    call add_intersection( &
         0.375_dp, 0.125_dp, num_intersections, intersections)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2 .AND. &
         intersections(1, 2) == 0.375_dp .AND. &
         intersections(2, 2) == 0.125_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Intersections is allocated and has enough space for
    !         another intersection.
    deallocate(intersections)
    allocate(intersections(2, 2))
    num_intersections = 0
    call add_intersection( &
         0.75_dp, 1.0_dp, &
         num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 0.75_dp .AND. &
         intersections(2, 1) == 1.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Proposed intersection is a duplicate, matches first.
    intersections(1, 1) = 0.125_dp
    intersections(2, 1) = 0.75_dp
    intersections(1, 2) = 1.0_dp
    intersections(2, 2) = 0.25_dp
    num_intersections = 2

    call add_intersection( &
         0.125_dp, 0.75_dp, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Proposed intersection is a duplicate, matches second.
    call add_intersection( &
         1.0_dp, 0.25_dp, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: ``s``-value is below the ``ZERO_THRESHOLD``.
    intersections(1, 1) = 0.0_dp
    intersections(2, 1) = 0.75_dp
    num_intersections = 1

    s_val = 0.5_dp**44
    call add_intersection( &
         s_val, 0.75_dp, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 1)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: ``s``-value is below the ``ZERO_THRESHOLD``.
    intersections(1, 1) = 0.125_dp
    intersections(2, 1) = 0.0_dp
    num_intersections = 1

    t_val = 0.5_dp**42
    call add_intersection( &
         0.125_dp, t_val, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 1)
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_intersection

  subroutine test_add_from_linearized(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer(c_int) :: status
    real(c_double) :: nodes1(2, 2), nodes2(2, 3)
    real(c_double) :: root_nodes1(2, 3), root_nodes2(2, 3)
    type(CurveData) :: first, second
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    integer :: case_id
    character(19) :: name

    case_id = 1
    name = "add_from_linearized"
    num_intersections = 0

    ! CASE 1: Lines that intersect. Since lines, there are 0 subdivisions.
    first%start = 0.0_dp
    first%end_ = 1.0_dp
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    first%nodes = nodes1

    second%start = 0.0_dp
    second%end_ = 1.0_dp
    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    second%nodes = nodes1

    call add_from_linearized( &
         first, first%nodes, second, second%nodes, &
         num_intersections, intersections, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         status == Status_SUCCESS .AND. &
         intersections(1, 1) == 0.5_dp .AND. &
         intersections(2, 1) == 0.5_dp)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 2: Lines that **do not** intersect.
    first%start = 0.0_dp
    first%end_ = 1.0_dp
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    first%nodes = nodes1

    second%start = 0.0_dp
    second%end_ = 1.0_dp
    nodes1(:, 1) = [3.0_dp, 0.0_dp]
    nodes1(:, 2) = [2.0_dp, 1.0_dp]
    second%nodes = nodes1

    call add_from_linearized( &
         first, first%nodes, second, second%nodes, &
         num_intersections, intersections, status)
    case_success = ( &
         num_intersections == 0 .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Quadratic curves that intersect after many (12) subdivisions.
    root_nodes1(:, 1) = [0.25_dp, 0.4375_dp]
    root_nodes1(:, 2) = [0.625_dp, 1.0_dp]
    root_nodes1(:, 3) = 1
    first%start = 1365.0_dp / 4096.0_dp
    first%end_ = 1366.0_dp / 4096.0_dp
    ! NOTE: This is the result of
    !       call specialize_curve( &
    !            3, 2, root_nodes1, first%start, first%end_, ...)
    nodes2(:, 1) = [134201344.0_dp, 201310207.0_dp]
    nodes2(:, 2) = [134225920.0_dp, 201334786.0_dp]
    nodes2(:, 3) = [134250496.0_dp, 201359356.0_dp]
    first%nodes = 0.5_dp**28 * nodes2

    root_nodes2(:, 1) = [0.0_dp, 1.0_dp]
    root_nodes2(:, 2) = [0.375_dp, 1.0_dp]
    root_nodes2(:, 3) = [0.75_dp, 0.4375_dp]
    second%start = 2730.0_dp / 4096.0_dp
    second%end_ = 2731.0_dp / 4096.0_dp
    ! NOTE: This is the result of
    !       call specialize_curve( &
    !            3, 2, root_nodes2, second%start, second%end_, ...)
    nodes2(:, 1) = [134184960.0_dp, 201359356.0_dp]
    nodes2(:, 2) = [134209536.0_dp, 201334786.0_dp]
    nodes2(:, 3) = [134234112.0_dp, 201310207.0_dp]
    second%nodes = 0.5_dp**28 * nodes2

    call add_from_linearized( &
         first, root_nodes1, second, root_nodes2, &
         num_intersections, intersections, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         status == Status_SUCCESS .AND. &
         3.0_dp * intersections(1, 1) == 1.0_dp .AND. &
         3.0_dp * intersections(2, 1) == 2.0_dp)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 4: A line that is tangent to a curve, which requires a "full"
    !         Newton iteration.
    first%start = 5461.0_dp / 16384.0_dp
    first%end_ = 5462.0_dp / 16384.0_dp
    root_nodes1(:, 1) = [0.0_dp, 2.25_dp]
    root_nodes1(:, 2) = [1.5_dp, -2.25_dp]
    root_nodes1(:, 3) = [3.0_dp, 2.25_dp]
    call specialize_curve( &
         3, 2, root_nodes1, first%start, first%end_, first%nodes)

    second%start = 0.0_dp
    second%end_ = 1.0_dp
    nodes1(:, 1) = [-0.5_dp, 1.75_dp]
    nodes1(:, 2) = [4.0_dp, -2.75_dp]
    second%nodes = nodes1

    call add_from_linearized( &
         first, root_nodes1, second, second%nodes, &
         num_intersections, intersections, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         status == Status_SUCCESS .AND. &
         3.0_dp * intersections(1, 1) == 1.0_dp .AND. &
         3.0_dp * intersections(2, 1) == 1.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Same as CASE 4, with arguments swapped.
    call add_from_linearized( &
         second, second%nodes, first, root_nodes1, &
         num_intersections, intersections, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         status == Status_SUCCESS .AND. &
         3.0_dp * intersections(1, 1) == 1.0_dp .AND. &
         3.0_dp * intersections(2, 1) == 1.0_dp)
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_from_linearized

  subroutine test_endpoint_check(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    type(CurveData) :: first, second
    real(c_double) :: node_first(2), node_second(2)
    real(c_double) :: s, t
    real(c_double) :: nodes1(2, 2), nodes2(2, 3)
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    integer :: case_id
    character(14) :: name

    case_id = 1
    name = "endpoint_check"
    num_intersections = 0

    ! CASE 1: Endpoints that are not close to one another.
    node_first = 0
    s = 0.0_dp

    node_second = 1
    t = 0.0_dp

    ! NOTE: We use ``first`` and ``second`` without any actual info,
    !       but it won't matter because ``node_first`` and ``node_second``
    !       are not close.
    call endpoint_check( &
         first, node_first, 0.0_dp, &
         second, node_second, 0.0_dp, &
         num_intersections, intersections)
    case_success = ( &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: The endpoints are actually the same.
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    first%nodes = nodes1
    s = 1.0_dp
    node_first = first%nodes(:, 2)

    nodes1(:, 1) = 1
    nodes1(:, 2) = [2.0_dp, 1.0_dp]
    second%nodes = nodes1
    t = 0.0_dp
    node_second = second%nodes(:, 1)

    call endpoint_check( &
         first, node_first, s, &
         second, node_second, t, &
         num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == s .AND. &
         intersections(2, 1) == t)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 3: An intersection after one subdivision.
    first%start = 0.0_dp
    first%end_ = 0.5_dp
    nodes2(:, 1) = 0
    nodes2(:, 2) = [0.25_dp, 0.5_dp]
    nodes2(:, 3) = 0.5_dp
    first%nodes = nodes2
    node_first = first%nodes(:, 3)

    second%start = 0.5_dp
    second%end_ = 1.0_dp
    nodes2(:, 1) = 0.5_dp
    nodes2(:, 2) = [0.5_dp, 0.0_dp]
    nodes2(:, 3) = [1.0_dp, -0.5_dp]
    second%nodes = nodes2
    node_second = second%nodes(:, 1)

    call endpoint_check( &
         first, node_first, s, &
         second, node_second, t, &
         num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 0.5_dp .AND. &
         intersections(2, 1) == 0.5_dp)
    call print_status(name, case_id, case_success, success)

  end subroutine test_endpoint_check

  subroutine test_tangent_bbox_intersection(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    type(CurveData) :: first, second
    real(c_double) :: nodes1(2, 3), nodes2(2, 2)
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    integer :: case_id
    character(25) :: name

    case_id = 1
    name = "tangent_bbox_intersection"
    num_intersections = 0

    ! CASE 1: Standard case of two quadratics that touch at a single endpoint.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 2.0_dp]
    nodes1(:, 3) = [2.0_dp, 0.0_dp]
    first%nodes = nodes1

    nodes1(:, 1) = [2.0_dp, 0.0_dp]
    nodes1(:, 2) = [3.0_dp, 2.0_dp]
    nodes1(:, 3) = [4.0_dp, 0.0_dp]
    second%nodes = nodes1

    call tangent_bbox_intersection( &
         first, second, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 1.0_dp .AND. &
         intersections(2, 1) == 0.0_dp)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 2: Two quadratics that touch at both endpoints.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [-1.0_dp, 0.5_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    first%nodes = nodes1

    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.5_dp]
    nodes1(:, 3) = [0.0_dp, 1.0_dp]
    second%nodes = nodes1

    call tangent_bbox_intersection( &
         first, second, num_intersections, intersections)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2 .AND. &
         intersections(1, 1) == 0.0_dp .AND. &
         intersections(2, 1) == 0.0_dp .AND. &
         intersections(2, 2) == 1.0_dp .AND. &
         intersections(2, 2) == 1.0_dp)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 3: Two lines that don't touch at endpoints, but have
    !         tangent bounding boxes.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [2.0_dp, 1.0_dp]
    first%nodes = nodes2

    nodes2(:, 1) = [0.5_dp, 1.0_dp]
    nodes2(:, 2) = [2.5_dp, 2.0_dp]
    second%nodes = nodes2

    call tangent_bbox_intersection( &
         first, second, num_intersections, intersections)
    case_success = (num_intersections == 0)
    call print_status(name, case_id, case_success, success)

  end subroutine test_tangent_bbox_intersection

  subroutine test_add_candidates(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    type(CurveData), allocatable :: candidates(:, :)
    type(CurveData) :: curve1, curve2, curve3
    type(CurveData) :: right1, left3, right3
    integer(c_int) :: num_candidates
    integer :: case_id
    character(14) :: name

    case_id = 1
    name = "add_candidates"

    ! Pre-populate the curves.
    allocate(curve1%nodes(2, 3))
    curve1%nodes(:, 1) = [0.0_dp, 1.0_dp]
    curve1%nodes(:, 2) = [1.0_dp, 2.0_dp]
    curve1%nodes(:, 3) = [2.0_dp, 1.0_dp]
    allocate(curve2%nodes(2, 2))
    curve2%nodes(:, 1) = [0.0_dp, 1.25_dp]
    curve2%nodes(:, 2) = [2.0_dp, 1.25_dp]
    call subdivide_curve(curve1, curve3, right1)
    call subdivide_curve(curve3, left3, right3)

    ! CASE 1: Add when ``candidates`` is un-allocated. (Also ``enum_`` is
    !         ``Subdivide_FIRST``.)
    num_candidates = 0
    case_success = .NOT. allocated(candidates)
    call add_candidates( &
         candidates, num_candidates, curve1, curve2, Subdivide_FIRST)
    case_success = ( &
         case_success .AND. &
         num_candidates == 2 .AND. &
         all(shape(candidates) == [2, 2]) .AND. &
         curves_equal(candidates(1, 1), curve3) .AND. &
         curves_equal(candidates(2, 1), curve2) .AND. &
         curves_equal(candidates(1, 2), right1) .AND. &
         curves_equal(candidates(2, 2), curve2))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Add when ``candidates`` is allocated but too small. (Also
    !         ``enum_`` is ``Subdivide_BOTH``.)
    case_success = ( &
         num_candidates == 2 .AND. &
         allocated(candidates) .AND. &
         all(shape(candidates) == [2, 2]))
    call add_candidates( &
         candidates, num_candidates, curve3, curve1, Subdivide_BOTH)
    case_success = ( &
         case_success .AND. &
         num_candidates == 6 .AND. &
         all(shape(candidates) == [2, 6]) .AND. &
         curves_equal(candidates(1, 3), left3) .AND. &
         curves_equal(candidates(2, 3), curve3) .AND. &
         curves_equal(candidates(1, 4), left3) .AND. &
         curves_equal(candidates(2, 4), right1) .AND. &
         curves_equal(candidates(1, 5), right3) .AND. &
         curves_equal(candidates(2, 5), curve3) .AND. &
         curves_equal(candidates(1, 6), right3) .AND. &
         curves_equal(candidates(2, 6), right1))
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)

    ! CASE 3: Add when ``candidates`` is bigger than necessary. (Also
    !         ``enum_`` is ``Subdivide_SECOND``.)
    num_candidates = 2
    allocate(candidates(2, 5))

    case_success = ( &
         num_candidates == 2 .AND. &
         allocated(candidates) .AND. &
         all(shape(candidates) == [2, 5]))
    call add_candidates( &
         candidates, num_candidates, curve2, curve3, Subdivide_SECOND)
    case_success = ( &
         case_success .AND. &
         num_candidates == 4 .AND. &
         all(shape(candidates) == [2, 5]) .AND. &
         curves_equal(candidates(1, 3), curve2) .AND. &
         curves_equal(candidates(2, 3), left3) .AND. &
         curves_equal(candidates(1, 4), curve2) .AND. &
         curves_equal(candidates(2, 4), right3))
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)

    ! CASE 4: ``enum_`` does not require subdivision, ``candidates`` is
    !         **not** allocated.
    num_candidates = -6  ! This is a nonsense value.
    case_success = .NOT. allocated(candidates)
    call add_candidates( &
         candidates, num_candidates, curve1, curve2, Subdivide_NEITHER)
    case_success = ( &
         case_success .AND. &
         num_candidates == -6 .AND. &
         .NOT. allocated(candidates))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: ``enum_`` does not require subdivision, ``candidates`` is
    !         allocated.
    num_candidates = 13  ! This does not reflect the size.
    allocate(candidates(2, 1))

    call add_candidates( &
         candidates, num_candidates, curve1, curve2, Subdivide_NEITHER)
    case_success = ( &
         case_success .AND. &
         num_candidates == 13 .AND. &
         all(shape(candidates) == [2, 1]))
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_candidates

  subroutine test_intersect_one_round(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: fixed_quadratic1(2, 3), fixed_quadratic2(2, 3)
    real(c_double) :: fixed_line1(2, 2), fixed_line2(2, 2)
    integer(c_int) :: num_candidates
    type(CurveData), allocatable :: candidates(:, :)
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    type(CurveData), allocatable :: next_candidates(:, :)
    integer(c_int) :: num_next_candidates
    integer(c_int) :: status
    type(CurveData) :: left1, right1, left2, right2
    integer :: case_id
    character(19) :: name

    case_id = 1
    name = "intersect_one_round"
    num_intersections = 0

    ! NOTE: ``fixed_quadratic1`` is a specialization of
    !       [0, 0], [1/2, 1], [1, 1] onto the interval [1/4, 1].
    fixed_quadratic1(:, 1) = [0.25_dp, 0.4375_dp]
    fixed_quadratic1(:, 2) = [0.625_dp, 1.0_dp]
    fixed_quadratic1(:, 3) = 1
    ! NOTE: ``fixed_quadratic2`` is a specialization of
    !       [0, 1], [1/2, 1], [1, 0] onto the interval [0, 3/4].
    fixed_quadratic2(:, 1) = [0.0_dp, 1.0_dp]
    fixed_quadratic2(:, 2) = [0.375_dp, 1.0_dp]
    fixed_quadratic2(:, 3) = [0.75_dp, 0.4375_dp]

    fixed_line1(:, 1) = 0
    fixed_line1(:, 2) = 1

    fixed_line2(:, 1) = [0.0_dp, 1.0_dp]
    fixed_line2(:, 2) = [1.0_dp, 0.0_dp]

    ! CASE 1: Simple test, non-linearized quadratics.
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve.
    candidates(1, 1)%nodes = fixed_quadratic1
    call subdivide_curve(candidates(1, 1), left1, right1)
    ! Populate the "second" curve.
    candidates(2, 1)%nodes = fixed_quadratic2
    call subdivide_curve(candidates(2, 1), left2, right2)

    call intersect_one_round( &
         fixed_quadratic1, fixed_quadratic2, num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0 .AND. &
         num_next_candidates == 4 .AND. &
         curves_equal(next_candidates(1, 1), left1) .AND. &
         curves_equal(next_candidates(2, 1), left2) .AND. &
         curves_equal(next_candidates(1, 2), left1) .AND. &
         curves_equal(next_candidates(2, 2), right2) .AND. &
         curves_equal(next_candidates(1, 3), right1) .AND. &
         curves_equal(next_candidates(2, 3), left2) .AND. &
         curves_equal(next_candidates(1, 4), right1) .AND. &
         curves_equal(next_candidates(2, 4), right2) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)
    deallocate(next_candidates)

    ! CASE 2: First curve is linearized, second is not.
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve with a line.
    candidates(1, 1)%nodes = fixed_line1
    ! Populate the "second" curve.
    candidates(2, 1)%nodes = fixed_quadratic2
    call subdivide_curve(candidates(2, 1), left2, right2)

    call intersect_one_round( &
         fixed_line1, fixed_quadratic2, num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0 .AND. &
         num_next_candidates == 2 .AND. &
         curves_equal(next_candidates(1, 1), candidates(1, 1)) .AND. &
         curves_equal(next_candidates(2, 1), left2) .AND. &
         curves_equal(next_candidates(1, 2), candidates(1, 1)) .AND. &
         curves_equal(next_candidates(2, 2), right2) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)
    deallocate(next_candidates)

    ! CASE 3: Second curve is linearized, first is not.
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve.
    candidates(1, 1)%nodes = fixed_quadratic1
    call subdivide_curve(candidates(1, 1), left1, right1)
    ! Populate the "second" curve with a line.
    candidates(2, 1)%nodes = fixed_line2

    call intersect_one_round( &
         fixed_quadratic1, fixed_line2, num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0 .AND. &
         num_next_candidates == 2 .AND. &
         curves_equal(next_candidates(1, 1), left1) .AND. &
         curves_equal(next_candidates(2, 1), candidates(2, 1)) .AND. &
         curves_equal(next_candidates(1, 2), right1) .AND. &
         curves_equal(next_candidates(2, 2), candidates(2, 1)) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)
    deallocate(next_candidates)

    ! CASE 4: Both curves are linearized.
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve with a line.
    candidates(1, 1)%nodes = fixed_line1
    ! Populate the "second" curve with a line.
    candidates(2, 1)%nodes = fixed_line2

    call intersect_one_round( &
         fixed_line1, fixed_line2, num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 0.5_dp .AND. &
         intersections(2, 1) == 0.5_dp .AND. &
         num_next_candidates == 0 .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)
    num_intersections = 0

    ! CASE 5: Disjoint bounding boxes.
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve with a line.
    candidates(1, 1)%nodes = fixed_quadratic1
    ! Populate the "second" curve with a line.
    allocate(candidates(2, 1)%nodes(2, 2))
    candidates(2, 1)%nodes(:, 1) = [1.0_dp, 1.25_dp]
    candidates(2, 1)%nodes(:, 2) = [0.0_dp, 2.0_dp]

    call intersect_one_round( &
         fixed_quadratic1, candidates(2, 1)%nodes, &
         num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         num_intersections == 0 .AND. &
         num_next_candidates == 0 .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)
    deallocate(candidates)

    ! CASE 6: Tangent bounding boxes (**with** an intersection), noting
    !         that tangency is only allowed for a pair with both curves
    !         can't be linearized (since tangency can be resolved in the
    !         linearized case by checking endpoints).
    num_candidates = 1
    allocate(candidates(2, num_candidates))
    ! Populate the "first" curve.
    allocate(candidates(1, 1)%nodes(2, 3))
    candidates(1, 1)%nodes(:, 1) = 0
    candidates(1, 1)%nodes(:, 2) = [0.5_dp, 1.0_dp]
    candidates(1, 1)%nodes(:, 3) = [1.0_dp, 0.0_dp]
    ! [0 <= x <= 1.0], [0.0 <= y <= 1.0]
    ! Populate the "second" curve.
    allocate(candidates(2, 1)%nodes(2, 3))
    candidates(2, 1)%nodes(:, 1) = [1.0_dp, 0.0_dp]
    candidates(2, 1)%nodes(:, 2) = [1.5_dp, 0.5_dp]
    candidates(2, 1)%nodes(:, 3) = [2.0_dp, -0.25_dp]
    ! [1.0 <= x <= 2.0], [-0.25 <= y <= 0.5]

    call intersect_one_round( &
         candidates(1, 1)%nodes, candidates(2, 1)%nodes, &
         num_candidates, candidates, &
         num_intersections, intersections, &
         next_candidates, num_next_candidates, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) == 1.0_dp .AND. &
         intersections(2, 1) == 0.0_dp .AND. &
         num_next_candidates == 0 .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_intersect_one_round

  subroutine test_make_same_degree(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double) :: nodes1(2, 3), nodes2(2, 3), nodes3(2, 2), nodes4(2, 4)
    integer(c_int) :: num_nodes
    real(c_double), allocatable :: elevated1(:, :)
    real(c_double), allocatable :: elevated2(:, :)
    character(16) :: name

    case_id = 1
    name = "make_same_degree"

    ! CASE 1: Same degree.
    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = [1.0_dp, 2.0_dp]
    nodes1(:, 3) = [2.0_dp, 1.0_dp]
    nodes2(:, 1) = [1.0_dp, 2.0_dp]
    nodes2(:, 2) = [2.0_dp, 1.0_dp]
    nodes2(:, 3) = [4.0_dp, 2.0_dp]
    call make_same_degree( &
         3, nodes1, 3, nodes2, num_nodes, elevated1, elevated2)
    case_success = ( &
         num_nodes == 3 .AND. &
         allocated(elevated1) .AND. &
         all(shape(elevated1) == [2, 3]) .AND. &
         all(elevated1 == nodes1) .AND. &
         allocated(elevated2) .AND. &
         all(shape(elevated2) == [2, 3]) .AND. &
         all(elevated2 == nodes2))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Elevate once (first argument).
    nodes3(:, 1) = 0
    nodes3(:, 2) = 1
    nodes1(:, 1) = [1.0_dp, 2.0_dp]
    nodes1(:, 2) = 2
    nodes1(:, 3) = 0
    call make_same_degree( &
         2, nodes3, 3, nodes1, num_nodes, elevated1, elevated2)
    case_success = ( &
         num_nodes == 3 .AND. &
         allocated(elevated1) .AND. &
         all(shape(elevated1) == [2, 3]) .AND. &
         all(elevated1(:, 1) == 0) .AND. &
         all(elevated1(:, 2) == 0.5_dp) .AND. &
         all(elevated1(:, 3) == 1) .AND. &
         allocated(elevated2) .AND. &
         all(shape(elevated2) == [2, 3]) .AND. &
         all(elevated2 == nodes1))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Same as CASE 2, but swap arguments.
    call make_same_degree( &
         3, nodes1, 2, nodes3, num_nodes, elevated1, elevated2)
    case_success = ( &
         num_nodes == 3 .AND. &
         allocated(elevated1) .AND. &
         all(shape(elevated1) == [2, 3]) .AND. &
         all(elevated1 == nodes1) .AND. &
         allocated(elevated2) .AND. &
         all(shape(elevated2) == [2, 3]) .AND. &
         all(elevated2(:, 1) == 0) .AND. &
         all(elevated2(:, 2) == 0.5_dp) .AND. &
         all(elevated2(:, 3) == 1))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Elevate twice (first argument).
    nodes3(:, 1) = 0
    nodes3(:, 2) = 3
    nodes4(:, 1) = [0.0_dp, 1.0_dp]
    nodes4(:, 2) = [1.0_dp, 2.0_dp]
    nodes4(:, 3) = [3.0_dp, 2.0_dp]
    nodes4(:, 4) = [4.0_dp, 2.0_dp]
    call make_same_degree( &
         2, nodes3, 4, nodes4, num_nodes, elevated1, elevated2)
    case_success = ( &
         num_nodes == 4 .AND. &
         allocated(elevated1) .AND. &
         all(shape(elevated1) == [2, 4]) .AND. &
         all(elevated1(:, 1) == 0) .AND. &
         all(elevated1(:, 2) == 1) .AND. &
         all(elevated1(:, 3) == 2) .AND. &
         all(elevated1(:, 4) == 3) .AND. &
         allocated(elevated2) .AND. &
         all(shape(elevated2) == [2, 4]) .AND. &
         all(elevated2 == nodes4))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Same as CASE 4, but swap arguments.
    call make_same_degree( &
         4, nodes4, 2, nodes3, num_nodes, elevated1, elevated2)
    case_success = ( &
         num_nodes == 4 .AND. &
         allocated(elevated1) .AND. &
         all(shape(elevated1) == [2, 4]) .AND. &
         all(elevated1 == nodes4) .AND. &
         allocated(elevated2) .AND. &
         all(shape(elevated2) == [2, 4]) .AND. &
         all(elevated2(:, 1) == 0) .AND. &
         all(elevated2(:, 2) == 1) .AND. &
         all(elevated2(:, 3) == 2) .AND. &
         all(elevated2(:, 4) == 3))
    call print_status(name, case_id, case_success, success)

  end subroutine test_make_same_degree

  subroutine test_add_coincident_parameters(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: linear1(2, 2)
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3)
    real(c_double) :: cubic1(2, 4), cubic2(2, 4)
    real(c_double) :: params(2, 8), start, end_
    real(c_double) :: expected(2, 2)
    integer(c_int) :: num_intersections
    real(c_double), allocatable :: intersections(:, :)
    logical(c_bool) :: coincident
    integer(c_int) :: i
    integer :: case_id
    character(25) :: name

    case_id = 1
    name = "add_coincident_parameters"
    num_intersections = 0
    allocate(intersections(2, 2))

    ! CASE 1: Actual curve degrees differ (i.e. one is a line, the other is
    !         a quadratic).
    linear1(:, 1) = 0
    linear1(:, 2) = 1
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = 1
    quadratic1(:, 3) = [2.0_dp, 0.0_dp]

    call add_coincident_parameters( &
         2, linear1, 3, quadratic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Actual curve degrees are the same, but one is elevated (and is
    !         the same curve segment).
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = 3
    quadratic1(:, 3) = [6.0_dp, 0.0_dp]
    cubic1(:, 1) = 0
    cubic1(:, 2) = 2
    cubic1(:, 3) = [4.0_dp, 2.0_dp]
    cubic1(:, 4) = [6.0_dp, 0.0_dp]

    call add_coincident_parameters( &
         3, quadratic1, 4, cubic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         all(shape(intersections) == [2, 2]) .AND. &
         all(intersections(:, 1) == 0) .AND. &
         all(intersections(:, 2) == 1) .AND. &
         num_intersections == 2 .AND. &
         coincident)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 3: Fail due to invalid point (i.e curve has a self-crossing).
    cubic1(:, 1) = [0.0_dp, 16.0_dp]
    cubic1(:, 2) = [-8.0_dp, 0.0_dp]
    cubic1(:, 3) = [8.0_dp, 8.0_dp]
    cubic1(:, 4) = [-6.0_dp, 13.0_dp]
    linear1(:, 1) = [-2.0_dp, 11.0_dp]
    linear1(:, 2) = [-2.0_dp, 16.0_dp]
    call add_coincident_parameters( &
         4, cubic1, 2, linear1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Same as CASE 3, with arguments swapped.
    call add_coincident_parameters( &
         2, linear1, 4, cubic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Segments are part of the same algebraic curve, but the segments
    !         only touch at endpoints (i.e. they don't overlap).
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [1.0_dp, 2.0_dp]
    quadratic1(:, 3) = [3.0_dp, 2.0_dp]
    params(1, :4) = [1.0_dp, 2.0_dp, -1.0_dp, 0.0_dp]
    params(2, :4) = [2.0_dp, 1.0_dp, 0.0_dp, -1.0_dp]

    case_success = .TRUE.
    do i = 1, 4
       call specialize_curve( &
            3, 2, quadratic1, params(1, i), params(2, i), quadratic2)
       call add_coincident_parameters( &
            3, quadratic1, 3, quadratic2, &
            num_intersections, intersections, coincident)
       case_success = ( &
            case_success .AND. &
            num_intersections == 0 .AND. &
            .NOT. coincident)
    end do
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Segments are part of the same algebraic curve, but the segments
    !         are totally disjoint.
    cubic1(:, 1) = [1.0_dp, 0.0_dp]
    cubic1(:, 2) = [1.0_dp, 2.0_dp]
    cubic1(:, 3) = [3.0_dp, 2.0_dp]
    cubic1(:, 4) = [4.0_dp, 0.0_dp]
    params(1, :4) = [1.5_dp, 2.0_dp, -1.0_dp, -0.5_dp]
    params(2, :4) = [2.0_dp, 1.5_dp, -0.5_dp, -1.0_dp]

    case_success = .TRUE.
    do i = 1, 4
       call specialize_curve( &
            4, 2, cubic1, params(1, i), params(2, i), cubic2)
       call add_coincident_parameters( &
            4, cubic1, 4, cubic2, &
            num_intersections, intersections, coincident)
       case_success = ( &
            case_success .AND. &
            num_intersections == 0 .AND. &
            .NOT. coincident)
    end do
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Curve endpoints touch, but curves are not coincident.
    quadratic1(:, 1) = [1.0_dp, 8.0_dp]
    quadratic1(:, 2) = [3.0_dp, 6.0_dp]
    quadratic1(:, 3) = [3.0_dp, 5.0_dp]
    quadratic2(:, 1) = [3.0_dp, 5.0_dp]
    quadratic2(:, 2) = [3.0_dp, -1.0_dp]
    quadratic2(:, 3) = [4.0_dp, -4.0_dp]
    call add_coincident_parameters( &
         3, quadratic1, 3, quadratic2, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Identical curves.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [2.0_dp, 3.0_dp]
    quadratic1(:, 3) = 5
    call add_coincident_parameters( &
         3, quadratic1, 3, quadratic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         all(shape(intersections) == [2, 2]) .AND. &
         all(intersections(:, 1) == 0) .AND. &
         all(intersections(:, 2) == 1) .AND. &
         num_intersections == 2 .AND. &
         coincident)
    call print_status(name, case_id, case_success, success)
    num_intersections = 0

    ! CASE 9: Segments are part of the same algebraic curve, one segment
    !         is interior to the other **AND** they touch at endpoints.
    quadratic1(:, 1) = [4.0_dp, 1.0_dp]
    quadratic1(:, 2) = [6.0_dp, 3.0_dp]
    quadratic1(:, 3) = [2.0_dp, 1.0_dp]
    params(1, :) = [ &
         0.0_dp, 0.5_dp, 0.5_dp, 1.0_dp, 0.0_dp, 2.0_dp, -1.0_dp, 1.0_dp]
    params(2, :) = [ &
         0.5_dp, 0.0_dp, 1.0_dp, 0.5_dp, 2.0_dp, 0.0_dp, 1.0_dp, -1.0_dp]
    case_success = .TRUE.
    do i = 1, 8
       start = params(1, i)
       end_ = params(2, i)
       call specialize_curve( &
            3, 2, quadratic1, start, end_, quadratic2)
       call add_coincident_parameters( &
            3, quadratic1, 3, quadratic2, &
            num_intersections, intersections, coincident)
       if (start == 2.0_dp .OR. end_ == 2.0_dp) then
          expected(:, 1) = [0.0_dp, -start / (end_ - start)]
          expected(:, 2) = [1.0_dp, (end_ - 1.0_dp) / (end_ - start)]
       else if (start == -1.0_dp .OR. end_ == -1.0_dp) then
          expected(:, 1) = [0.0_dp, -start / (end_ - start)]
          expected(:, 2) = [1.0_dp, (1.0_dp - start) / (end_ - start)]
       else
          expected(:, 1) = [start, 0.0_dp]
          expected(:, 2) = [end_, 1.0_dp]
       end if
       case_success = ( &
            case_success .AND. &
            all(shape(intersections) == [2, 2]) .AND. &
            all(intersections == expected) .AND. &
            num_intersections == 2 .AND. &
            coincident)
       num_intersections = 0
    end do
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Segments are part of the same algebraic curve, one segment
    !          is fully interior to the other (i.e. same as CASE 9 but with
    !          no endpoint contact).
    quadratic1(:, 1) = -1
    quadratic1(:, 2) = [0.0_dp, 2.0_dp]
    quadratic1(:, 3) = [2.0_dp, 0.0_dp]
    params(1, :4) = [0.25_dp, 0.75_dp, -0.5_dp, 1.5_dp]
    params(2, :4) = [0.75_dp, 0.25_dp, 1.5_dp, -0.5_dp]
    case_success = .TRUE.
    do i = 1, 4
       start = params(1, i)
       end_ = params(2, i)
       call specialize_curve( &
            3, 2, quadratic1, start, end_, quadratic2)
       call add_coincident_parameters( &
            3, quadratic1, 3, quadratic2, &
            num_intersections, intersections, coincident)
       if (start == -0.5_dp .OR. end_ == -0.5_dp) then
          expected(:, 1) = [0.0_dp, (end_ - 1.0_dp) / (end_ - start)]
          expected(:, 2) = [1.0_dp, end_ / (end_ - start)]
       else
          expected(:, 1) = [start, 0.0_dp]
          expected(:, 2) = [end_, 1.0_dp]
       end if
       case_success = ( &
            case_success .AND. &
            all(shape(intersections) == [2, 2]) .AND. &
            all(intersections == expected) .AND. &
            num_intersections == 2 .AND. &
            coincident)
       num_intersections = 0
    end do
    call print_status(name, case_id, case_success, success)

    ! CASE 11: Segments are part of the same algebraic curve and they overlap
    !          in a staggered fashion. I.e curve A starts somewhere in the
    !          middle of curve B and curve B ends somewhere in the middle of
    !          curve A.
    cubic1(:, 1) = [0.0_dp, -1.0_dp]
    cubic1(:, 2) = [1.0_dp, 2.0_dp]
    cubic1(:, 3) = [1.0_dp, 0.0_dp]
    cubic1(:, 4) = [3.0_dp, 2.0_dp]
    params(1, :4) = [0.5_dp, 1.5_dp, -0.5_dp, 0.5_dp]
    params(2, :4) = [1.5_dp, 0.5_dp, 0.5_dp, -0.5_dp]
    case_success = .TRUE.
    do i = 1, 4
       start = params(1, i)
       end_ = params(2, i)
       call specialize_curve( &
            4, 2, cubic1, start, end_, cubic2)
       call add_coincident_parameters( &
            4, cubic1, 4, cubic2, &
            num_intersections, intersections, coincident)
       if (start == 1.5_dp .OR. end_ == 1.5_dp) then
          expected(:, 1) = [0.5_dp, start - 0.5_dp]
          expected(:, 2) = [1.0_dp, 0.5_dp]
       else
          expected(:, 1) = [0.0_dp, 0.5_dp]
          expected(:, 2) = [0.5_dp, end_ + 0.5_dp]
       end if
       case_success = ( &
            case_success .AND. &
            all(shape(intersections) == [2, 2]) .AND. &
            all(intersections == expected) .AND. &
            num_intersections == 2 .AND. &
            coincident)
       num_intersections = 0
    end do
    call print_status(name, case_id, case_success, success)

    ! CASE 12: Exactly one endpoint from each curve lies on the other curve,
    !          but the curves are not coincident.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [16.0_dp, 0.0_dp]
    quadratic1(:, 3) = 16
    quadratic2(:, 1) = [7.0_dp, 1.0_dp]
    quadratic2(:, 2) = [7.0_dp, 17.0_dp]
    quadratic2(:, 3) = [23.0_dp, 17.0_dp]
    call add_coincident_parameters( &
         3, quadratic1, 3, quadratic2, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 13: Both endpoints from one curve lie on the other curve,
    !          but the curves are not coincident.
    cubic1(:, 1) = 0
    cubic1(:, 2) = 32
    cubic1(:, 3) = [96.0_dp, 32.0_dp]
    cubic1(:, 4) = [128.0_dp, 0.0_dp]
    cubic2(:, 1) = [29.0_dp, 18.0_dp]
    cubic2(:, 2) = [49.0_dp, 38.0_dp]
    cubic2(:, 3) = [79.0_dp, 38.0_dp]
    cubic2(:, 4) = [99.0_dp, 18.0_dp]
    call add_coincident_parameters( &
         4, cubic1, 4, cubic2, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 14: Same as CASE 13, with arguments swapped.
    call add_coincident_parameters( &
         4, cubic2, 4, cubic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 15: Exactly one endpoint from curve A lies on curve B, but not at
    !          one of the endpoints of curve B.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = 2
    quadratic1(:, 3) = [4.0_dp, 0.0_dp]
    quadratic2(:, 1) = [2.0_dp, 1.0_dp]
    quadratic2(:, 2) = [4.0_dp, 3.0_dp]
    quadratic2(:, 3) = [6.0_dp, 2.0_dp]
    call add_coincident_parameters( &
         3, quadratic1, 3, quadratic2, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

    ! CASE 16: Same as CASE 15, with arguments swapped.
    call add_coincident_parameters( &
         3, quadratic2, 3, quadratic1, &
         num_intersections, intersections, coincident)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident)
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_coincident_parameters

  subroutine test_all_intersections(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double), allocatable :: intersections(:, :)
    real(c_double) :: linear1(2, 2), linear2(2, 2)
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3)
    real(c_double) :: cubic1(2, 4), cubic2(2, 4)
    integer(c_int) :: num_intersections
    logical(c_bool) :: coincident
    real(c_double) :: expected_s, expected_t
    integer(c_int) :: status
    integer :: case_id
    character(17) :: name

    case_id = 1
    name = "all_intersections"

    ! CASE 1: No intersections.
    linear1(:, 1) = 0
    linear1(:, 2) = 1
    linear2(:, 1) = 3
    linear2(:, 2) = [4.0_dp, 3.0_dp]

    call all_intersections( &
         2, linear1, 2, linear2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         .NOT. allocated(intersections) .AND. &
         num_intersections == 0 .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Intersection of two quadratic curves.
    ! NOTE: The first candidate is a specialization of [0, 0], [1/2, 1], [1, 1]
    !       onto the interval [1/4, 1] and the second candidate is
    !       specialization of [0, 1], [1/2, 1], [1, 0] onto the interval
    !       [0, 3/4]. We expect them to intersect at s = 1/3, t = 2/3, which is
    !       the point [1/2, 3/4].
    quadratic1(:, 1) = [0.25_dp, 0.4375_dp]
    quadratic1(:, 2) = [0.625_dp, 1.0_dp]
    quadratic1(:, 3) = 1
    quadratic2(:, 1) = [0.0_dp, 1.0_dp]
    quadratic2(:, 2) = [0.375_dp, 1.0_dp]
    quadratic2(:, 3) = [0.75_dp, 0.4375_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         3 * intersections(1, 1) == 1.0_dp .AND. &
         3 * intersections(2, 1) == 2.0_dp .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Tangent curves which have to do a "full" Newton iteration.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.375_dp, 0.75_dp]
    quadratic1(:, 3) = [0.75_dp, 0.375_dp]
    quadratic2(:, 1) = [0.25_dp, 0.625_dp]
    quadratic2(:, 2) = [0.625_dp, 0.25_dp]
    quadratic2(:, 3) = 1
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    expected_s = 2.0_dp / 3.0_dp
    expected_t = 1.0_dp / 3.0_dp
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         intersections(1, 1) - expected_s == spacing(expected_s) .AND. &
         intersections(2, 1) == expected_t .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Tangent curves, which cause the number of candidate pairs
    !         to become too high and will trigger a "prune" step.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [-0.5_dp, 1.5_dp]
    quadratic1(:, 3) = 1
    quadratic2(:, 1) = [-1.0_dp, 1.0_dp]
    quadratic2(:, 2) = 0.5_dp
    quadratic2(:, 3) = [0.0_dp, 2.0_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 1]) .AND. &
         num_intersections == 1 .AND. &
         all(intersections(:, 1) == 0.5_dp) .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Badly scaled curves, which cause the subdivision process to
    !         take too many iterations before being "almost linear".
    ! NOTE: This is just the quadratic given by [0, 0], [4.5, 9], [9, 0] and
    !       the line given by [0, 8], [6, 0], but scaled up by a factor of
    !       2**14 == 16384. This makes the linearization error large.
    !       This definitely points out a flaw in using absolute vs. relative
    !       linearization error. However, there is an upside in not using
    !       relative error: it is faster to compute without normalization.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [73728.0_dp, 147456.0_dp]
    quadratic1(:, 3) = [147456.0_dp, 0.0_dp]
    linear1(:, 1) = [0.0_dp, 131072.0_dp]
    linear1(:, 2) = [98304.0_dp, 0.0_dp]
    call all_intersections( &
         3, quadratic1, 2, linear1, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident .AND. &
         status == Status_NO_CONVERGE)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Curves where there are duplicate intersections caused by
    !         bounding boxes touching at corners.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.5_dp, 1.0_dp]
    quadratic1(:, 3) = [1.0_dp, 0.0_dp]
    quadratic2(:, 1) = [0.0_dp, 0.75_dp]
    quadratic2(:, 2) = [0.5_dp, -0.25_dp]
    quadratic2(:, 3) = [1.0_dp, 0.75_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 2 .AND. &
         intersections(1, 1) == 0.25_dp .AND. &
         intersections(2, 1) == 0.25_dp .AND. &
         intersections(1, 2) == 0.75_dp .AND. &
         intersections(2, 2) == 0.75_dp .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Curves that **almost** touch at their endpoints, but don't
    !         actually cross. This results in no intersections because
    !         ``from_linearized()`` exits since the convex hulls are disjoint.
    cubic1(:, 1) = [-0.7838204403623438_dp, -0.25519640597397464_dp]
    cubic1(:, 2) = [-0.7894577677825452_dp, -0.24259531488131633_dp]
    cubic1(:, 3) = [-0.7946421067207265_dp, -0.22976394420044136_dp]
    cubic1(:, 4) = [-0.799367666650849_dp, -0.21671303774854855_dp]
    cubic2(:, 1) = [-0.7993236103108717_dp, -0.21683567278362156_dp]
    cubic2(:, 2) = [-0.8072986524226636_dp, -0.21898490744674426_dp]
    cubic2(:, 3) = [-0.8152736945344552_dp, -0.2211341421098668_dp]
    cubic2(:, 4) = [-0.8232487366462472_dp, -0.2232833767729893_dp]

    call all_intersections( &
         4, cubic1, 4, cubic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         num_intersections == 0 .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Same as CASE 4, except the nodes have been re-specialized to
    !         [0, 2] and [-1, 1], respectively. This way, the first round
    !         reduces to CASE 4, so the "prune" stage happens at an odd
    !         iteration rather than en even iteration.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [-1.0_dp, 3.0_dp]
    quadratic1(:, 3) = [6.0_dp, -2.0_dp]
    quadratic2(:, 1) = [-6.0_dp, 4.0_dp]
    quadratic2(:, 2) = [1.0_dp, -1.0_dp]
    quadratic2(:, 3) = [0.0_dp, 2.0_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 2]) .AND. &
         num_intersections == 1 .AND. &
         all(intersections(:, 1) == [0.25_dp, 0.75_dp]) .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Coincident curves (i.e. segments on a common curve). In this
    !         case, the second curve is just the first curve specialized to
    !         [1/2, 1]. In this case, "convex hull pruning" is of no use
    !         because at a certain point the subdivided curve segments will
    !         be identical.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [0.5_dp, 0.25_dp]
    quadratic1(:, 3) = [1.0_dp, 0.0_dp]
    quadratic2(:, 1) = [0.5_dp, 0.125_dp]
    quadratic2(:, 2) = [0.75_dp, 0.125_dp]
    quadratic2(:, 3) = [1.0_dp, 0.0_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 16]) .AND. &
         num_intersections == 2 .AND. &
         all(intersections(:, 1) == [0.5_dp, 0.0_dp]) .AND. &
         all(intersections(:, 2) == 1) .AND. &
         coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Curve are tangent and have the same curvature, but
    !          there are more than ``MAX_CANDIDATES`` candidates
    !          that can't be pruned.
    quadratic1(:, 1) = [12.0_dp, 4.0_dp]
    quadratic1(:, 2) = [-12.0_dp, -8.0_dp]
    quadratic1(:, 3) = [0.0_dp, 16.0_dp]
    quadratic2(:, 1) = [6.0_dp, 1.0_dp]
    quadratic2(:, 2) = [-6.0_dp, -2.0_dp]
    quadratic2(:, 3) = [0.0_dp, 4.0_dp]
    call all_intersections( &
         3, quadratic1, 3, quadratic2, intersections, &
         num_intersections, coincident, status)
    case_success = ( &
         allocated(intersections) .AND. &
         all(shape(intersections) == [2, 16]) .AND. &
         num_intersections == 0 .AND. &
         .NOT. coincident .AND. &
         status == 74)
    call print_status(name, case_id, case_success, success)

  end subroutine test_all_intersections

  subroutine test_all_intersections_abi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: linear1(2, 2)
    real(c_double) :: quadratic1(2, 3), quadratic2(2, 3)
    real(c_double) :: cubic1(2, 4)
    integer(c_int) :: num_intersections
    logical(c_bool) :: coincident
    real(c_double) :: intersections1(2, 2), intersections2(2, 3)
    integer(c_int) :: status
    integer :: case_id
    character(21) :: name

    case_id = 1
    name = "all_intersections_abi"

    ! CASE 1: **Other** failure (tangent curves with the same curvature).
    quadratic1(:, 1) = [12.0_dp, 4.0_dp]
    quadratic1(:, 2) = -4
    quadratic1(:, 3) = [-4.0_dp, 4.0_dp]
    quadratic2(:, 1) = [6.0_dp, 1.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -1.0_dp]
    quadratic2(:, 3) = [-2.0_dp, 1.0_dp]

    call all_intersections_abi( &
         3, quadratic1, 3, quadratic2, 2, intersections1, &
         num_intersections, coincident, status)
    case_success = ( &
         num_intersections == 1 .AND. &
         .NOT. coincident .AND. &
         status == Status_BAD_MULTIPLICITY)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``intersections`` is not large enough.
    linear1(:, 1) = [-3.0_dp, 0.0_dp]
    linear1(:, 2) = [5.0_dp, 0.0_dp]
    cubic1(:, 1) = [-7.0_dp, -9.0_dp]
    cubic1(:, 2) = [9.0_dp, 13.0_dp]
    cubic1(:, 3) = [-7.0_dp, -13.0_dp]
    cubic1(:, 4) = [9.0_dp, 9.0_dp]

    call all_intersections_abi( &
         2, linear1, 4, cubic1, 2, intersections1, &
         num_intersections, coincident, status)
    case_success = ( &
         num_intersections == 3 .AND. &
         .NOT. coincident .AND. &
         status == Status_INSUFFICIENT_SPACE)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Just case 7, but with large enough ``intersections``.
    call all_intersections_abi( &
         2, linear1, 4, cubic1, 3, intersections2, &
         num_intersections, coincident, status)
    case_success = ( &
         num_intersections == 3 .AND. &
         intersections2(1, 1) == 0.5_dp .AND. &
         intersections2(2, 1) == 0.5_dp .AND. &
         intersections2(1, 2) == 0.375_dp .AND. &
         intersections2(2, 2) == 0.25_dp .AND. &
         intersections2(1, 3) == 0.625_dp .AND. &
         intersections2(2, 3) == 0.75_dp .AND. &
         .NOT. coincident .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_all_intersections_abi

end module test_curve_intersection


<|start_filename|>docs/abi/example_elevate_nodes_curve.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 3;
    int dimension = 2;
    double nodes[6] = { 0.0, 0.0, 1.5, 1.5, 3.0, 0.0 };

    // Outputs.
    double elevated[8];

    BEZ_elevate_nodes_curve(&num_nodes, &dimension, nodes, elevated);
    printf("Elevated:\n");
    printf("%f, %f, %f, %f\n", elevated[0], elevated[2], elevated[4],
        elevated[6]);
    printf("%f, %f, %f, %f\n", elevated[1], elevated[3], elevated[5],
        elevated[7]);

    return 0;
}


<|start_filename|>src/fortran/include/bezier/triangle.h<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#ifndef BEZIER_TRIANGLE_H
#define BEZIER_TRIANGLE_H

#include <stdbool.h>

#if defined(__cplusplus)
extern "C" {
#endif

void BEZ_de_casteljau_one_round(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, const double* lambda1,
    const double* lambda2, const double* lambda3, double* new_nodes);
void BEZ_evaluate_barycentric(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, const double* lambda1,
    const double* lambda2, const double* lambda3, double* point);
void BEZ_evaluate_barycentric_multi(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, const int* num_vals,
    const double* param_vals, double* evaluated);
void BEZ_evaluate_cartesian_multi(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, const int* num_vals,
    const double* param_vals, double* evaluated);
void BEZ_jacobian_both(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, double* new_nodes);
void BEZ_jacobian_det(const int* num_nodes, const double* nodes,
    const int* degree, const int* num_vals, const double* param_vals,
    double* evaluated);
void BEZ_specialize_triangle(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, const double* weights_a,
    const double* weights_b, const double* weights_c, double* specialized);
void BEZ_subdivide_nodes_triangle(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, double* nodes_a, double* nodes_b,
    double* nodes_c, double* nodes_d);
void BEZ_compute_edge_nodes(const int* num_nodes, const int* dimension,
    const double* nodes, const int* degree, double* nodes1, double* nodes2,
    double* nodes3);
void BEZ_compute_area(int* num_edges, int* sizes,
    const double* const* nodes_pointers, double* area, bool* not_implemented);

#if defined(__cplusplus)
}
#endif

#endif /* BEZIER_TRIANGLE_H */


<|start_filename|>tests/fortran/functional.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

program functional

  use functional_test_helpers, only: clean_up
  use functional_curve, only: all_cases

  call all_cases()
  call clean_up()

end program functional


<|start_filename|>tests/fortran/test_triangle_intersection.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module test_triangle_intersection

  use, intrinsic :: iso_c_binding, only: c_bool, c_double, c_int
  use status, only: &
       Status_SUCCESS, Status_BAD_MULTIPLICITY, Status_NO_CONVERGE, &
       Status_INSUFFICIENT_SPACE, Status_SAME_CURVATURE, Status_BAD_INTERIOR, &
       Status_EDGE_END, Status_UNKNOWN
  use curve, only: CurveData, LOCATE_MISS
  use triangle_intersection, only: &
       Intersection, CurvedPolygonSegment, IntersectionClassification_UNSET, &
       IntersectionClassification_FIRST, IntersectionClassification_SECOND, &
       IntersectionClassification_OPPOSED, &
       IntersectionClassification_TANGENT_FIRST, &
       IntersectionClassification_TANGENT_SECOND, &
       IntersectionClassification_IGNORED_CORNER, &
       IntersectionClassification_TANGENT_BOTH, &
       IntersectionClassification_COINCIDENT, &
       IntersectionClassification_COINCIDENT_UNUSED, &
       TriangleContained_NEITHER, &
       TriangleContained_FIRST, TriangleContained_SECOND, newton_refine, &
       locate_point, classify_intersection, update_edge_end_unused, &
       find_corner_unused, add_st_vals, should_keep, &
       triangles_intersection_points, is_first, is_second, &
       get_next, to_front, add_segment, &
       interior_combine, triangles_intersect, triangles_intersect_abi
  use types, only: dp
  use unit_test_helpers, only: print_status
  implicit none
  private &
       test_newton_refine, test_locate_point, test_classify_intersection, &
       test_update_edge_end_unused, test_find_corner_unused, &
       test_add_st_vals, test_should_keep, test_triangles_intersection_points, &
       test_is_first, test_is_second, &
       intersection_check, intersection_equal, test_get_next, test_to_front, &
       test_add_segment, test_interior_combine, segment_check, &
       test_triangles_intersect, test_triangles_intersect_abi
  public triangle_intersection_all_tests

contains

  subroutine triangle_intersection_all_tests(success)
    logical(c_bool), intent(inout) :: success

    call test_newton_refine(success)
    call test_locate_point(success)
    call test_classify_intersection(success)
    call test_update_edge_end_unused(success)
    call test_find_corner_unused(success)
    call test_add_st_vals(success)
    call test_should_keep(success)
    call test_triangles_intersection_points(success)
    call test_is_first(success)
    call test_is_second(success)
    call test_get_next(success)
    call test_to_front(success)
    call test_add_segment(success)
    call test_interior_combine(success)
    call test_triangles_intersect(success)
    call test_triangles_intersect_abi(success)

  end subroutine triangle_intersection_all_tests

  subroutine test_newton_refine(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(24) :: name
    real(c_double) :: nodes(2, 6)
    real(c_double) :: updated_s, updated_t

    case_id = 1
    name = "newton_refine (Triangle)"

    ! CASE 1: Quadratic triangle.
    ! NOTE: This triangle is given by
    !       [(4 s - t^2) / 4, (4 s^2 + 4 s t - t^2 - 4 s + 8 t) / 8]
    nodes(:, 1) = 0
    nodes(:, 2) = [0.5_dp, -0.25_dp]
    nodes(:, 3) = [1.0_dp, 0.0_dp]
    nodes(:, 4) = [0.0_dp, 0.5_dp]
    nodes(:, 5) = 0.5_dp
    nodes(:, 6) = [-0.25_dp, 0.875_dp]
    ! At our point (s, t) = (1/4, 1/2), the Jacobian is
    !     [1, -1/4]
    !     [0,  1  ]
    ! hence there will be no round-off when applying the inverse.
    call newton_refine( &
         6, nodes, 2, 0.484375_dp, 0.1796875_dp, &
         0.25_dp, 0.5_dp, updated_s, updated_t)
    case_success = ( &
         updated_s == 247.0_dp / 512 .AND. &
         updated_t == 31.0_dp / 128)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Solution is **exact**.
    ! NOTE: This triangle is given by [s, t]
    nodes(:, 1) = 0
    nodes(:, 2) = [0.5_dp, 0.0_dp]
    nodes(:, 3) = [1.0_dp, 0.0_dp]
    nodes(:, 4) = [0.0_dp, 0.5_dp]
    nodes(:, 5) = 0.5_dp
    nodes(:, 6) = [0.0_dp, 1.0_dp]
    ! Since x(s) = s and y(t) = t, we simply use the same x/y and s/t.
    call newton_refine( &
         6, nodes, 2, 0.375_dp, 0.75_dp, &
         0.375_dp, 0.75_dp, updated_s, updated_t)
    case_success = ( &
         updated_s == 0.375_dp .AND. &
         updated_t == 0.75_dp)
    call print_status(name, case_id, case_success, success)

  end subroutine test_newton_refine

  subroutine test_locate_point(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double), allocatable :: nodes(:, :)
    real(c_double) :: x_val, y_val, s_val, t_val
    real(c_double) :: expected_s, expected_t
    character(24) :: name

    case_id = 1
    name = "newton_refine (Triangle)"

    ! CASE 1: B(s, t) = (s, t), match.
    allocate(nodes(2, 3))
    nodes(:, 1) = 0
    nodes(:, 2) = [1.0_dp, 0.0_dp]
    nodes(:, 3) = [0.0_dp, 1.0_dp]
    x_val = 0.25_dp
    y_val = 0.625_dp
    call locate_point( &
         3, nodes, 1, x_val, y_val, s_val, t_val)
    case_success = (x_val == s_val .AND. y_val == t_val)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: B(s, t) = (s, t), no match.
    x_val = -0.125_dp
    y_val = 0.25_dp
    call locate_point( &
         3, nodes, 1, x_val, y_val, s_val, t_val)
    case_success = (s_val == LOCATE_MISS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: B(s, t) = (-2 (s + 2 t) (t - 1), 2 (s + 1) t), one extra
    !         Newton refinement required (verified by hand).
    deallocate(nodes)
    allocate(nodes(2, 6))
    nodes(:, 1) = 0
    nodes(:, 2) = [1.0_dp, 0.0_dp]
    nodes(:, 3) = [2.0_dp, 0.0_dp]
    nodes(:, 4) = [2.0_dp, 1.0_dp]
    nodes(:, 5) = 2
    nodes(:, 6) = [0.0_dp, 2.0_dp]
    x_val = 0.59375_dp
    y_val = 0.25_dp
    call locate_point( &
         6, nodes, 2, x_val, y_val, s_val, t_val)
    ! NOTE: We can use the resultant to find that the **true** answers
    !       are roots of the following polynomials.
    !           64 s^3 + 101 s^2 + 34 s - 5 = 0
    !           128 t^3 - 192 t^2 + 91 t - 8 = 0
    !       Using extended precision, we can find these values to more
    !       digits than what is supported by IEEE-754.
    expected_s = 0.109190958136897160638_dp
    expected_t = 0.11269475204698919699_dp
    case_success = ( &
         abs(s_val - expected_s) <= 5 * spacing(expected_s) .AND. &
         abs(t_val - expected_t) <= spacing(expected_t))
    call print_status(name, case_id, case_success, success)

  end subroutine test_locate_point

  subroutine test_classify_intersection(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(21) :: name
    type(Intersection) :: intersection_
    type(CurveData) :: edges_first(3), edges_second(3)
    real(c_double) :: nodes1(2, 2), nodes2(2, 3)
    integer(c_int) :: enum_, status

    case_id = 1
    name = "classify_intersection"

    ! CASE 1: Intersection is on "the end" of the first edge.
    intersection_%s = 1.0_dp
    intersection_%t = 0.5_dp
    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = (status == Status_EDGE_END)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Intersection is on "the end" of the second edge.
    intersection_%s = 0.5_dp
    intersection_%t = 1.0_dp
    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = (status == Status_EDGE_END)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Intersection is on interior, "SECOND".
    nodes1(:, 1) = 0
    nodes1(:, 2) = 1
    edges_first(1)%nodes = nodes1

    nodes1(:, 1) = [0.25_dp, 0.0_dp]
    nodes1(:, 2) = [0.75_dp, 1.0_dp]
    edges_second(1)%nodes = nodes1

    intersection_ = Intersection(0.5_dp, 0.5_dp, 1, 1)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Intersection is on interior, "FIRST".
    call classify_intersection( &
         edges_second, edges_first, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Intersection is tangent, "FIRST".
    nodes2(:, 1) = 0
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [3.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes2

    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [2.0_dp, 0.0_dp]
    edges_second(1)%nodes = nodes2

    intersection_ = Intersection(0.5_dp, 0.5_dp, 1, 1)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Intersection is tangent, "SECOND".
    call classify_intersection( &
         edges_second, edges_first, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Intersection is tangent, but only to machine precision. The
    !         cross product of the tangent vectors is ``-2^{-53}``, rather
    !         than ``0.0``.
    nodes2(:, 1) = 0
    nodes2(:, 2) = [0.5_dp, -1.0_dp / 5.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes2

    nodes2(:, 1) = [0.5_dp, -0.125_dp]
    nodes2(:, 2) = [2.0625_dp, 0.1875_dp]
    nodes2(:, 3) = [3.625_dp, 0.5_dp]
    edges_second(1)%nodes = nodes2

    intersection_ = Intersection(0.75_dp, 2.0_dp / 25.0_dp - 0.5_dp**56, 1, 1)
    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Intersection is an ignored corner.
    ! NOTE: The curves in ``edges_first`` are the edges of the
    !       "unit simplex" ...
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, 1.0_dp]
    edges_first(2)%nodes = nodes1
    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = 0
    edges_first(3)%nodes = nodes1
    ! ... and those in ``edges_second`` are the edges in the triangle given by
    !           [ 0,  0]
    !           [-1,  0]
    !           [ 0, -1]
    nodes1(:, 1) = [-1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, -1.0_dp]
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = [0.0_dp, -1.0_dp]
    nodes1(:, 2) = 0
    edges_second(2)%nodes = nodes1
    nodes1(:, 1) = 0
    nodes1(:, 2) = [-1.0_dp, 0.0_dp]
    edges_second(3)%nodes = nodes1

    intersection_ = Intersection(0.0_dp, 0.0_dp, 1, 3)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_IGNORED_CORNER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Intersection is a corner.
    nodes1(:, 1) = [0.0_dp, 0.5_dp]
    nodes1(:, 2) = 1
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = 1
    nodes1(:, 2) = 0
    edges_first(2)%nodes = nodes1
    deallocate(edges_first(3)%nodes)  ! Unset.

    deallocate(edges_second(1)%nodes)  ! Unset.
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [1.0_dp, 2.0_dp]
    edges_second(2)%nodes = nodes1
    deallocate(edges_second(3)%nodes)  ! Unset.

    intersection_ = Intersection(0.0_dp, 0.5_dp, 2, 2)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Intersection is tangent, use curvature of "FIRST".
    deallocate(edges_first(1)%nodes)  ! Unset.
    nodes2(:, 1) = [2.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = [3.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = 0
    edges_second(2)%nodes = nodes2

    intersection_ = Intersection(0.5_dp, 0.5_dp, 2, 2)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: Intersection is tangent, use curvature of "SECOND".
    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [2.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = 0
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [3.0_dp, 0.0_dp]
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 12: Intersection is tangent, same curvature and direction.
    nodes2(:, 1) = [1.0_dp, 0.25_dp]
    nodes2(:, 2) = [-0.5_dp, -0.25_dp]
    nodes2(:, 3) = [0.0_dp, 0.25_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = [0.75_dp, 0.25_dp]
    nodes2(:, 2) = -0.25_dp
    nodes2(:, 3) = [-0.25_dp, 0.25_dp]
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = (status == Status_SAME_CURVATURE)
    call print_status(name, case_id, case_success, success)

    ! CASE 13: Intersection is tangent, same curvature, opposite direction.
    nodes2(:, 1) = [0.0_dp, 0.25_dp]
    nodes2(:, 2) = [-0.5_dp, -0.25_dp]
    nodes2(:, 3) = [1.0_dp, 0.25_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = [0.75_dp, 0.25_dp]
    nodes2(:, 2) = -0.25_dp
    nodes2(:, 3) = [-0.25_dp, 0.25_dp]
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = (status == Status_SAME_CURVATURE)
    call print_status(name, case_id, case_success, success)

    ! CASE 14: Intersection is tangent, opposite direction, curvatures have
    !          same sign and there is no overlap.
    nodes2(:, 1) = [2.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = 1
    nodes2(:, 2) = [1.5_dp, 0.0_dp]
    nodes2(:, 3) = [2.0_dp, 1.0_dp]
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_OPPOSED .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 15: Intersection is tangent, opposite direction, curvatures have
    !          same sign and there **is** overlap.
    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [2.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = [2.0_dp, 1.0_dp]
    nodes2(:, 2) = [1.5_dp, 0.0_dp]
    nodes2(:, 3) = 1
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_BOTH .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 16: Intersection is tangent, opposite direction, curvatures have
    !          opposite sign and there is no overlap.
    nodes2(:, 1) = [2.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [1.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = 0
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [3.0_dp, 0.0_dp]
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_OPPOSED .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 17: Intersection is tangent, opposite direction, curvatures have
    !          opposite sign and there **is** overlap.
    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = [2.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes2

    nodes2(:, 1) = [3.0_dp, 0.0_dp]
    nodes2(:, 2) = [1.5_dp, 1.0_dp]
    nodes2(:, 3) = 0
    edges_second(2)%nodes = nodes2

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_TANGENT_BOTH .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 18: Intersection at corner, but the corner "staddles" an edge.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_first(2)%nodes = nodes1

    nodes1(:, 1) = 1
    nodes1(:, 2) = [0.5_dp, 0.0_dp]
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = [0.5_dp, 0.0_dp]
    nodes1(:, 2) = [1.5_dp, -1.0_dp]
    edges_second(2)%nodes = nodes1

    intersection_ = Intersection(0.5_dp, 0.0_dp, 2, 2)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 19: Intersection at corner of **both** edges, the corners just
    !          "kiss", hence are ignored.
    nodes1(:, 1) = [0.5_dp, 1.0_dp]
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [1.5_dp, 0.25_dp]
    edges_first(2)%nodes = nodes1

    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, 1.0_dp]
    edges_second(2)%nodes = nodes1

    intersection_ = Intersection(0.0_dp, 0.0_dp, 2, 2)

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_IGNORED_CORNER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 20: Intersection at corner of **both** edges, "FIRST" is interior.
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, 1.0_dp]
    edges_first(2)%nodes = nodes1

    nodes1(:, 1) = [0.5_dp, 0.25_dp]
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = 1
    edges_second(2)%nodes = nodes1

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 21: Intersection at corner of **both** edges, "SECOND" is interior.
    nodes1(:, 1) = [0.5_dp, 0.25_dp]
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = 1
    edges_first(2)%nodes = nodes1

    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = [1.0_dp, 0.0_dp]
    nodes1(:, 2) = [0.0_dp, 1.0_dp]
    edges_second(2)%nodes = nodes1

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 22: Intersection at corner of **both** edges, one corner is
    !          completely contained in the area of the other corner.
    nodes1(:, 1) = [0.5_dp, 1.0_dp]
    nodes1(:, 2) = 0
    edges_first(1)%nodes = nodes1
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.5_dp]
    edges_first(2)%nodes = nodes1

    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = 0
    edges_second(1)%nodes = nodes1
    nodes1(:, 1) = 0
    nodes1(:, 2) = [1.0_dp, 0.0_dp]
    edges_second(2)%nodes = nodes1

    call classify_intersection( &
         edges_first, edges_second, intersection_, enum_, status)
    case_success = ( &
         enum_ == IntersectionClassification_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_classify_intersection

  subroutine test_update_edge_end_unused(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(22) :: name
    type(Intersection) :: intersections(1)
    integer(c_int) :: num_intersections, unused

    case_id = 1
    name = "update_edge_end_unused"

    unused = IntersectionClassification_COINCIDENT_UNUSED

    ! CASE 1: ``s`` is the corner, no matching intersection.
    num_intersections = 0
    call update_edge_end_unused( &
         1.0_dp, 1, 0.5_dp, 1, intersections, num_intersections)
    case_success = ( &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.0_dp, 0.5_dp, 2, 1, unused))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``s`` is the corner, matching intersection.
    num_intersections = 1
    intersections(1)%s = 0.0_dp
    intersections(1)%t = 0.25_dp
    intersections(1)%index_first = 3
    intersections(1)%index_second = 2
    call update_edge_end_unused( &
         1.0_dp, 2, 0.25_dp, 2, intersections, num_intersections)
    case_success = ( &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.0_dp, 0.25_dp, 3, 2, unused))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``t`` is the corner, no matching intersection.
    num_intersections = 0
    call update_edge_end_unused( &
         0.5_dp, 1, 1.0_dp, 1, intersections, num_intersections)
    case_success = ( &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.5_dp, 0.0_dp, 1, 2, unused))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: ``t`` is the corner, matching intersection.
    num_intersections = 1
    intersections(1)%s = 0.25_dp
    intersections(1)%t = 0.0_dp
    intersections(1)%index_first = 2
    intersections(1)%index_second = 3
    call update_edge_end_unused( &
         0.25_dp, 2, 1.0_dp, 2, intersections, num_intersections)
    case_success = ( &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.25_dp, 0.0_dp, 2, 3, unused))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Both ``s`` and ``t`` are corners, no matching intersection.
    num_intersections = 0
    call update_edge_end_unused( &
         1.0_dp, 3, 1.0_dp, 3, intersections, num_intersections)
    case_success = ( &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.0_dp, 0.0_dp, 1, 1, unused))
    call print_status(name, case_id, case_success, success)

  end subroutine test_update_edge_end_unused

  subroutine test_find_corner_unused(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(18) :: name
    type(Intersection) :: intersections(1)
    logical(c_bool) :: found

    case_id = 1
    name = "find_corner_unused"

    ! CASE 1: ``s == 0``, not found.
    intersections(1)%index_first = 2
    call find_corner_unused( &
         0.0_dp, 1, 1, intersections, 1, found)
    case_success = (.NOT. found)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``s == 0``, found.
    intersections(1)%s = 0.0_dp
    intersections(1)%t = 0.5_dp
    intersections(1)%index_first = 2
    intersections(1)%index_second = 3
    intersections(1)%interior_curve = ( &
         IntersectionClassification_COINCIDENT_UNUSED)
    call find_corner_unused( &
         0.0_dp, 2, 3, intersections, 1, found)
    case_success = found
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``t == 0`` (i.e. ``s /= 0``), not found.
    intersections(1)%index_second = 2
    call find_corner_unused( &
         0.5_dp, 1, 1, intersections, 1, found)
    case_success = (.NOT. found)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: ``t == 0`` (i.e. ``s /= 0``), found.
    intersections(1)%s = 0.5_dp
    intersections(1)%t = 0.0_dp
    intersections(1)%index_first = 2
    intersections(1)%index_second = 3
    intersections(1)%interior_curve = ( &
         IntersectionClassification_COINCIDENT_UNUSED)
    call find_corner_unused( &
         0.5_dp, 2, 3, intersections, 1, found)
    case_success = found
    call print_status(name, case_id, case_success, success)

  end subroutine test_find_corner_unused

  subroutine test_add_st_vals(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(11) :: name
    real(c_double), allocatable :: st_vals(:, :)
    type(Intersection), allocatable :: intersections(:)
    integer(c_int) :: num_intersections
    type(CurveData) :: edges_first(3), edges_second(3)
    integer(c_int) :: first, second, coincident, known_enum
    integer(c_int) :: status

    case_id = 1
    name = "add_st_vals"

    first = IntersectionClassification_FIRST
    second = IntersectionClassification_SECOND
    coincident = IntersectionClassification_COINCIDENT
    known_enum = IntersectionClassification_UNSET

    ! CASE 1: ``intersections`` must be allocated.
    num_intersections = 0
    allocate(st_vals(2, 1))
    st_vals(:, 1) = [0.25_dp, 0.75_dp]
    case_success = .NOT. allocated(intersections)
    ! Set the relevant edges as lines.
    allocate(edges_first(2)%nodes(2, 2))
    allocate(edges_second(3)%nodes(2, 2))
    edges_first(2)%nodes(:, 1) = 0
    edges_first(2)%nodes(:, 2) = 1
    edges_second(3)%nodes(:, 1) = [1.0_dp, -0.5_dp]
    edges_second(3)%nodes(:, 2) = [0.0_dp, 0.5_dp]
    call add_st_vals( &
         edges_first, edges_second, 1, st_vals, known_enum, &
         2, 3, intersections, num_intersections, status)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         size(intersections) == 1 .AND. &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.25_dp, 0.75_dp, 2, 3, second) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``intersections`` must be re-allocated.
    st_vals(:, 1) = [0.0_dp, 0.5_dp]
    ! Set the relevant edges as lines.
    allocate(edges_first(3)%nodes(2, 2))
    allocate(edges_second(1)%nodes(2, 2))
    edges_first(3)%nodes(:, 1) = 0
    edges_first(3)%nodes(:, 2) = 1
    edges_second(1)%nodes(:, 1) = [1.0_dp, -1.0_dp]
    edges_second(1)%nodes(:, 2) = [-1.0_dp, 1.0_dp]
    case_success = ( &
         allocated(intersections) .AND. &
         num_intersections == 1)
    call add_st_vals( &
         edges_first, edges_second, 1, st_vals, known_enum, &
         3, 1, intersections, num_intersections, status)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         size(intersections) == 2 .AND. &
         num_intersections == 2 .AND. &
         intersection_check( &
         intersections(2), 0.0_dp, 0.5_dp, 3, 1, second) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``intersections`` is large enough.
    num_intersections = 0
    st_vals(:, 1) = [0.875_dp, 0.125_dp]
    ! Set the relevant edges as lines.
    allocate(edges_second(2)%nodes(2, 2))
    edges_first(2)%nodes(:, 1) = 0
    edges_first(2)%nodes(:, 2) = 1
    edges_second(2)%nodes(:, 1) = [0.75_dp, 0.625_dp]
    edges_second(2)%nodes(:, 2) = [1.75_dp, 2.625_dp]
    case_success = allocated(intersections)
    call add_st_vals( &
         edges_first, edges_second, 1, st_vals, known_enum, &
         2, 2, intersections, num_intersections, status)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         size(intersections) == 2 .AND. &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.875_dp, 0.125_dp, 2, 2, second) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Intersection causes error.
    st_vals(:, 1) = 0.5_dp
    deallocate(edges_first(2)%nodes)
    allocate(edges_first(2)%nodes(2, 3))
    edges_first(2)%nodes(:, 1) = [1.0_dp, 0.25_dp]
    edges_first(2)%nodes(:, 2) = [-0.5_dp, -0.25_dp]
    edges_first(2)%nodes(:, 3) = [0.0_dp, 0.25_dp]
    deallocate(edges_second(2)%nodes)
    allocate(edges_second(2)%nodes(2, 3))
    edges_second(2)%nodes(:, 1) = [0.75_dp, 0.25_dp]
    edges_second(2)%nodes(:, 2) = -0.25_dp
    edges_second(2)%nodes(:, 3) = [-0.25_dp, 0.25_dp]
    call add_st_vals( &
         edges_first, edges_second, 1, st_vals, known_enum, &
         2, 2, intersections, num_intersections, status)
    case_success = (status == Status_SAME_CURVATURE)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: ``intersections`` has edge ends, gets "over-allocated".
    deallocate(intersections)
    deallocate(st_vals)
    allocate(st_vals(2, 2))
    num_intersections = 0
    st_vals(:, 1) = [1.0_dp, 0.125_dp]
    st_vals(:, 2) = 0.5_dp
    ! Set the relevant edges as lines.
    allocate(edges_first(1)%nodes(2, 2))
    edges_first(1)%nodes(:, 1) = 0
    edges_first(1)%nodes(:, 2) = 1
    edges_second(1)%nodes(:, 1) = [0.0_dp, 1.0_dp]
    edges_second(1)%nodes(:, 2) = [1.0_dp, 0.0_dp]
    call add_st_vals( &
         edges_first, edges_second, 2, st_vals, known_enum, &
         1, 1, intersections, num_intersections, status)
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 2 .AND. &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.5_dp, 0.5_dp, 1, 1, first) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Intersection is coincident.
    known_enum = IntersectionClassification_COINCIDENT
    num_intersections = 0
    st_vals(:, 1) = [0.5_dp, 0.5_dp]
    ! Set the relevant edges as lines.
    edges_first(1)%nodes(:, 1) = 0
    edges_first(1)%nodes(:, 2) = 1
    edges_second(1)%nodes(:, 1) = [1.0_dp, 0.0_dp]
    edges_second(1)%nodes(:, 2) = [0.0_dp, 1.0_dp]
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 2)
    call add_st_vals( &
         edges_first, edges_second, 1, st_vals, known_enum, &
         1, 1, intersections, num_intersections, status)
    case_success = ( &
         case_success .AND. &
         allocated(intersections) .AND. &
         size(intersections) == 2 .AND. &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), 0.5_dp, 0.5_dp, 1, 1, coincident) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_st_vals

  subroutine test_should_keep(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(11) :: name
    type(Intersection) :: intersection_
    logical(c_bool) :: predicate

    case_id = 1
    name = "should_keep"

    ! CASE 1: Classified as an "acceptable" value.
    intersection_%interior_curve = IntersectionClassification_FIRST
    predicate = should_keep(intersection_)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Classified as tangent, in a corner.
    intersection_%s = 0.0_dp
    intersection_%t = 0.5_dp
    intersection_%interior_curve = IntersectionClassification_TANGENT_SECOND
    predicate = should_keep(intersection_)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 3: In a corner, not classified as tangent.
    intersection_%s = 0.0_dp
    intersection_%t = 0.5_dp
    intersection_%interior_curve = IntersectionClassification_IGNORED_CORNER
    predicate = should_keep(intersection_)
    case_success = .NOT. predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Classified as tangent, not in a corner.
    intersection_%s = 0.25_dp
    intersection_%t = 0.25_dp
    intersection_%interior_curve = IntersectionClassification_TANGENT_FIRST
    predicate = should_keep(intersection_)
    case_success = .NOT. predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 5: "Always unused" classification type.
    intersection_%interior_curve = IntersectionClassification_OPPOSED
    predicate = should_keep(intersection_)
    case_success = .NOT. predicate
    call print_status(name, case_id, case_success, success)

  end subroutine test_should_keep

  subroutine test_triangles_intersection_points(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(29) :: name
    real(c_double) :: linear1(2, 3), linear2(2, 3)
    real(c_double) :: quadratic1(2, 6), quadratic2(2, 6)
    type(Intersection), allocatable :: intersections(:)
    integer(c_int) :: num_intersections
    integer(c_int) :: all_types, status
    integer(c_int) :: first, second, coincident
    real(c_double) :: expected_s, expected_t

    case_id = 1
    name = "triangles_intersection_points"

    first = IntersectionClassification_FIRST
    second = IntersectionClassification_SECOND
    coincident = IntersectionClassification_COINCIDENT

    ! CASE 1: Overlapping triangles (i.e. degree 1 triangles).
    linear1(:, 1) = 0
    linear1(:, 2) = [2.0_dp, 0.0_dp]
    linear1(:, 3) = [1.0_dp, 2.0_dp]
    linear2(:, 1) = [0.0_dp, 1.0_dp]
    linear2(:, 2) = [2.0_dp, 1.0_dp]
    linear2(:, 3) = [1.0_dp, -1.0_dp]
    call triangles_intersection_points( &
         3, linear1, 1, 3, linear2, 1, &
         intersections, num_intersections, all_types, status)
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 6 .AND. &
         num_intersections == 6 .AND. &
         intersection_check( &
         intersections(1), 0.75_dp, 0.5_dp, 1, 2, first) .AND. &
         intersection_check( &
         intersections(2), 0.25_dp, 0.5_dp, 1, 3, second) .AND. &
         intersection_check( &
         intersections(3), 0.5_dp, 0.75_dp, 2, 1, first) .AND. &
         intersection_check( &
         intersections(4), 0.25_dp, 0.25_dp, 2, 2, second) .AND. &
         intersection_check( &
         intersections(5), 0.5_dp, 0.25_dp, 3, 1, second) .AND. &
         intersection_check( &
         intersections(6), 0.75_dp, 0.75_dp, 3, 3, first) .AND. &
         all_types == 2**first + 2**second .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Tangent intersection, which requires a "full" Newton iteration.
    quadratic1(:, 1) = 0
    quadratic1(:, 2) = [6.0_dp, 12.0_dp]
    quadratic1(:, 3) = [12.0_dp, 6.0_dp]
    quadratic1(:, 4) = [4.0_dp, -8.0_dp]
    quadratic1(:, 5) = [10.0_dp, -5.0_dp]
    quadratic1(:, 6) = [8.0_dp, -16.0_dp]
    quadratic2(:, 1) = [4.0_dp, 10.0_dp]
    quadratic2(:, 2) = [10.0_dp, 4.0_dp]
    quadratic2(:, 3) = [16.0_dp, 16.0_dp]
    quadratic2(:, 4) = [6.0_dp, 21.0_dp]
    quadratic2(:, 5) = [12.0_dp, 24.0_dp]
    quadratic2(:, 6) = [8.0_dp, 32.0_dp]
    call triangles_intersection_points( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         intersections, num_intersections, all_types, status)
    expected_s = 2.0_dp / 3.0_dp
    expected_t = 1.0_dp / 3.0_dp
    ! Account for an error of 1 ULP in computed ``s``.
    expected_s = expected_s + spacing(expected_s)
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 6 .AND. &
         num_intersections == 1 .AND. &
         intersection_check( &
         intersections(1), expected_s, expected_t, 1, 1, second) .AND. &
         all_types == 2**second .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Tangent intersection with the same curvature.
    num_intersections = 0
    quadratic1(:, 1) = [0.0_dp, 2.0_dp]
    quadratic1(:, 2) = [-4.0_dp, -2.0_dp]
    quadratic1(:, 3) = [8.0_dp, 2.0_dp]
    quadratic1(:, 4) = [4.0_dp, 4.0_dp]
    quadratic1(:, 5) = [8.0_dp, 4.0_dp]
    quadratic1(:, 6) = [8.0_dp, 6.0_dp]
    quadratic2(:, 1) = [-2.0_dp, 2.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -2.0_dp]
    quadratic2(:, 3) = [6.0_dp, 2.0_dp]
    quadratic2(:, 4) = [1.0_dp, 5.0_dp]
    quadratic2(:, 5) = [5.0_dp, 5.0_dp]
    quadratic2(:, 6) = [4.0_dp, 8.0_dp]
    call triangles_intersection_points( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         intersections, num_intersections, all_types, status)
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 6 .AND. &
         num_intersections == 0 .AND. &
         all_types == 0 .AND. &
         status == Status_BAD_MULTIPLICITY)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Coincident intersection with shared interior, which sets
    !         ``known_enum`` to ``COINCIDENT``.
    num_intersections = 0
    quadratic1(:, 1) = [1.0_dp, 0.0_dp]
    quadratic1(:, 2) = [0.5_dp, 0.25_dp]
    quadratic1(:, 3) = 0
    quadratic1(:, 4) = [0.75_dp, -0.375_dp]
    quadratic1(:, 5) = [0.25_dp, -0.375_dp]
    quadratic1(:, 6) = [0.5_dp, -0.75_dp]
    quadratic2(:, 1) = [0.75_dp, 0.09375_dp]
    quadratic2(:, 2) = [0.25_dp, 0.21875_dp]
    quadratic2(:, 3) = [-0.25_dp, -0.15625_dp]
    quadratic2(:, 4) = [0.625_dp, -0.328125_dp]
    quadratic2(:, 5) = [0.125_dp, -0.453125_dp]
    quadratic2(:, 6) = [0.5_dp, -0.75_dp]
    call triangles_intersection_points( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         intersections, num_intersections, all_types, status)
    case_success = ( &
         allocated(intersections) .AND. &
         size(intersections) == 6 .AND. &
         num_intersections == 3 .AND. &
         intersection_check( &
         intersections(1), 0.25_dp, 0.0_dp, 1, 1, coincident) .AND. &
         intersection_check( &
         intersections(2), 0.0_dp, 0.75_dp, 2, 1, first) .AND. &
         intersection_check( &
         intersections(3), 0.0_dp, 0.0_dp, 3, 3, second) .AND. &
         all_types == (2**first + 2**second + 2**coincident) .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_triangles_intersection_points

  subroutine test_is_first(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(8) :: name
    logical(c_bool) :: predicate

    case_id = 1
    name = "is_first"

    ! CASE 1: Success.
    predicate = is_first(IntersectionClassification_FIRST)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Failure.
    predicate = is_first(IntersectionClassification_COINCIDENT)
    case_success = .NOT. predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Success, and tangent.
    predicate = is_first(IntersectionClassification_TANGENT_FIRST)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

  end subroutine test_is_first

  subroutine test_is_second(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(9) :: name
    logical(c_bool) :: predicate

    case_id = 1
    name = "is_second"

    ! CASE 1: Success.
    predicate = is_second(IntersectionClassification_SECOND)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Failure.
    predicate = is_second(IntersectionClassification_TANGENT_BOTH)
    case_success = .NOT. predicate
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Success, and tangent.
    predicate = is_second(IntersectionClassification_TANGENT_SECOND)
    case_success = predicate
    call print_status(name, case_id, case_success, success)

  end subroutine test_is_second

  function intersection_check( &
       intersection_, s, t, index_first, index_second, &
       interior_curve) result(same)

    type(Intersection), intent(in) :: intersection_
    real(c_double), intent(in) :: s, t
    integer(c_int), intent(in) :: index_first, index_second
    integer(c_int), intent(in) :: interior_curve
    logical(c_bool) :: same

    same = ( &
         intersection_%s == s .AND. &
         intersection_%t == t .AND. &
         intersection_%index_first == index_first .AND. &
         intersection_%index_second == index_second .AND. &
         intersection_%interior_curve == interior_curve)

  end function intersection_check

  function intersection_equal(intersection1, intersection2) result(same)

    type(Intersection), intent(in) :: intersection1, intersection2
    logical(c_bool) :: same

    same = intersection_check( &
         intersection2, &
         intersection1%s, &
         intersection1%t, &
         intersection1%index_first, &
         intersection1%index_second, &
         intersection1%interior_curve)

  end function intersection_equal

  subroutine test_get_next(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(8) :: name
    integer(c_int) :: first, second, coincident
    type(Intersection) :: intersections(5)
    type(Intersection) :: curr_node, next_node
    logical(c_bool) :: at_start
    integer(c_int) :: unused(4)
    integer(c_int) :: remaining

    case_id = 1
    name = "get_next"

    first = IntersectionClassification_FIRST
    second = IntersectionClassification_SECOND
    coincident = IntersectionClassification_COINCIDENT

    ! CASE 1: On an edge of first triangle, no other intersections on that edge.
    curr_node = Intersection(0.125_dp, -1.0_dp, 2, -1, first)
    intersections(1) = Intersection(0.5_dp, -1.0_dp, 3, -1, first)
    remaining = 4
    call get_next( &
         1, intersections(:1), unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, 1.0_dp, -1.0_dp, 2, -1, first) .AND. &
         remaining == 4 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: On an edge of first triangle, **multiple** other intersections
    !         on same edge.
    curr_node = Intersection(0.25_dp, -1.0_dp, 3, -1, first)
    ! An "acceptable" intersection that will be overtaken by the
    ! next since 0.25 < 0.5 < 0.875.
    intersections(1) = Intersection(0.875_dp, -1.0_dp, 3, -1, second)
    ! Closer to ``curr_node`` then previous.
    intersections(2) = Intersection(0.5_dp, -1.0_dp, 3, -1, first)
    ! On a different edge.
    intersections(3) = Intersection(-1.0_dp, -1.0_dp, 2, -1)
    ! Same edge, but parameter comes **before** ``curr_node``.
    intersections(4) = Intersection(0.125_dp, -1.0_dp, 3, -1, first)
    ! Past the already accepted intersection: 0.25 < 0.5 < 0.625
    intersections(5) = Intersection(0.625_dp, -1.0_dp, 3, -1, first)
    ! Populate the list of indices to be removed.
    unused = [1, 2, 3, 5]
    remaining = 4
    call get_next( &
         5, intersections, unused, remaining, &
         2, curr_node, next_node, at_start)
    case_success = ( &
         intersection_equal(next_node, intersections(2)) .AND. &
         remaining == 3 .AND. &
         all(unused == [1, 3, 5, 5]) .AND. &
         at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: On an edge of second triangle, no other intersections on
    !         that edge.
    curr_node = Intersection(-1.0_dp, 0.625_dp, -1, 3, second)
    intersections(1) = Intersection(-1.0_dp, 0.5_dp, -1, 1, first)
    remaining = 2
    call get_next( &
         1, intersections(:1), unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, -1.0_dp, 1.0_dp, -1, 3, second) .AND. &
         remaining == 2 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: On an edge of second triangle, **multiple** other intersections
    !         on same edge.
    curr_node = Intersection(-1.0_dp, 0.125_dp, -1, 2, second)
    ! An "acceptable" intersection that will be overtaken by the
    ! next since 0.125 < 0.625 < 0.75.
    intersections(1) = Intersection(-1.0_dp, 0.75_dp, -1, 2, first)
    ! On a different edge.
    intersections(2) = Intersection(-1.0_dp, -1.0_dp, -1, 3)
    ! Closer to ``curr_node`` then previous accepted.
    intersections(3) = Intersection(-1.0_dp, 0.625_dp, -1, 2, second)
    ! Same edge, but parameter comes **before** ``curr_node``.
    intersections(4) = Intersection(-1.0_dp, 0.0625_dp, -1, 2, first)
    ! Past the already accepted intersection: 0.125 < 0.625 < 0.6875
    intersections(5) = Intersection(-1.0_dp, 0.6875_dp, -1, 2, second)
    ! Populate the list of indices to be removed, missing 3.
    unused(:3) = [1, 2, 4]
    remaining = 3
    call get_next( &
         5, intersections, unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_equal(next_node, intersections(3)) .AND. &
         remaining == 3 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: On an edge of both triangles (i.e. along a ``COINCIDENT``
    !         segment). Next node found along edge of first triangle.
    curr_node = Intersection(0.25_dp, 0.0_dp, 1, 3, coincident)
    ! NOTE: ``intersections(1)`` is "nonsense". A coincident edge should
    !       only have one other intesection along it, the "nonsense"
    !       intesection is just there to hit a "just in case" code path
    !       that checks the smallest ``s`` value after ``curr_node``.
    intersections(1) = Intersection(0.875_dp, -1.0_dp, 1, 2, first)
    intersections(2) = Intersection(0.75_dp, 0.0_dp, 1, 1, second)
    unused(:2) = [2, 3]
    remaining = 2
    call get_next( &
         2, intersections(:2), unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, 0.75_dp, 0.0_dp, 1, 1, second) .AND. &
         remaining == 1 .AND. &
         all(unused(:2) == [3, 3]) .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: On an edge of both triangles (i.e. along a ``COINCIDENT``
    !         segment). Next node found along edge of second triangle.
    curr_node = Intersection(0.625_dp, 0.0_dp, 2, 2, coincident)
    ! NOTE: ``intersections(1)`` is "nonsense". A coincident edge should
    !       only have one other intesection along it, the "nonsense"
    !       intesection is just there to hit a "just in case" code path
    !       that checks the smallest ``t`` value after ``curr_node``.
    intersections(1) = Intersection(-1.0_dp, 0.75_dp, 1, 2, first)
    intersections(2) = Intersection(0.0_dp, 0.5_dp, 3, 2, second)
    unused(:2) = [2, 5]
    remaining = 2
    call get_next( &
         2, intersections(:2), unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, 0.0_dp, 0.5_dp, 3, 2, second) .AND. &
         remaining == 1 .AND. &
         all(unused(:2) == [5, 5]) .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: On an edge of both triangles (i.e. along a ``COINCIDENT``
    !         segment). Next node found at corner of edges.
    curr_node = Intersection(0.625_dp, 0.5_dp, 1, 3, coincident)
    intersections(1) = Intersection(0.0_dp, 0.0_dp, 2, 1, first)
    unused(:2) = [1, 5]
    remaining = 2
    call get_next( &
         1, intersections(:1), unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check( &
         next_node, 1.0_dp, 1.0_dp, 1, 3, coincident) .AND. &
         remaining == 2 .AND. &
         .NOT. at_start)

  end subroutine test_get_next

  subroutine test_to_front(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(8) :: name
    integer(c_int) :: first, second
    type(Intersection) :: intersections(1)
    type(Intersection) :: curr_node, next_node
    logical(c_bool) :: at_start
    integer(c_int) :: unused(4)
    integer(c_int) :: remaining

    case_id = 1
    name = "to_front"

    first = IntersectionClassification_FIRST
    second = IntersectionClassification_SECOND

    ! CASE 1: Unchanged node (i.e. not at the end).
    curr_node = Intersection(0.5_dp, -1.0_dp, 3, -1, first)
    remaining = 4
    call to_front( &
         0, intersections(:0), unused, remaining, &
         -1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_equal(curr_node, next_node) .AND. &
         remaining == 4 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Change the ``s`` parameter, no corresponding node.
    curr_node = Intersection(1.0_dp, -1.0_dp, 3, -1, first)
    remaining = 3
    call to_front( &
         0, intersections(:0), unused, remaining, &
         -1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, 0.0_dp, -1.0_dp, 1, -1, first) .AND. &
         remaining == 3 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Change the ``s`` parameter, new corner node exists.
    curr_node = Intersection(1.0_dp, -1.0_dp, 2, -1, first)
    intersections(1) = Intersection( &
         0.0_dp, 0.5_dp, 3, 1, IntersectionClassification_TANGENT_FIRST)
    unused = [1, 3, 4, 6]
    remaining = 4
    call to_front( &
         1, intersections, unused, remaining, &
         -1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_equal(next_node, intersections(1)) .AND. &
         remaining == 3 .AND. &
         all(unused == [3, 4, 6, 6]) .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Change the ``t`` parameter, no corresponding node.
    curr_node = Intersection(-1.0_dp, 1.0_dp, -1, 2, second)
    remaining = 4
    call to_front( &
         0, intersections(:0), unused, remaining, &
         -1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_check(next_node, -1.0_dp, 0.0_dp, -1, 3, second) .AND. &
         remaining == 4 .AND. &
         .NOT. at_start)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Change the ``t`` parameter, new corner node exists.
    curr_node = Intersection(-1.0_dp, 1.0_dp, -1, 1, second)
    intersections(1) = Intersection( &
         0.5_dp, 0.0_dp, 3, 2, IntersectionClassification_TANGENT_SECOND)
    remaining = 0
    call to_front( &
         1, intersections, unused, remaining, &
         1, curr_node, next_node, at_start)
    case_success = ( &
         intersection_equal(next_node, intersections(1)) .AND. &
         remaining == 0 .AND. &
         at_start)
    call print_status(name, case_id, case_success, success)

  end subroutine test_to_front

  subroutine test_add_segment(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(11) :: name
    type(Intersection) :: curr_node, next_node
    type(CurvedPolygonSegment), allocatable :: segments(:)
    integer(c_int) :: count

    case_id = 1
    name = "add_segment"

    ! CASE 1: ``segments`` is not allocated; intersection is classified as
    !         SECOND.
    count = 0
    curr_node = Intersection( &
         -1.0_dp, 0.25_dp, -1, 1, IntersectionClassification_SECOND)
    next_node = Intersection(t=0.5_dp)
    case_success = .NOT. allocated(segments)
    call add_segment(curr_node, next_node, count, segments)
    case_success = ( &
         case_success .AND. &
         count == 1 .AND. &
         allocated(segments) .AND. &
         size(segments) == 1 .AND. &
         segments(1)%start == curr_node%t .AND. &
         segments(1)%end_ == next_node%t .AND. &
         segments(1)%edge_index == curr_node%index_second + 3)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``segments`` is allocated, but not large enough; intersection
    !         is classified as FIRST.
    count = 1
    curr_node = Intersection( &
         0.5_dp, -1.0_dp, 2, -1, IntersectionClassification_FIRST)
    next_node = Intersection(s=1.0_dp)
    case_success = ( &
         allocated(segments) .AND. &
         size(segments) == 1)
    call add_segment(curr_node, next_node, count, segments)
    case_success = ( &
         case_success .AND. &
         count == 2 .AND. &
         allocated(segments) .AND. &
         size(segments) == 2 .AND. &
         segments(2)%start == curr_node%s .AND. &
         segments(2)%end_ == next_node%s .AND. &
         segments(2)%edge_index == curr_node%index_first)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``segments`` is allocated and does not need to be resized;
    !         intersection is classified as FIRST.
    count = 1
    curr_node = Intersection( &
         0.125_dp, -1.0_dp, 3, -1, IntersectionClassification_FIRST)
    next_node = Intersection(s=0.75_dp)
    case_success = ( &
         allocated(segments) .AND. &
         size(segments) == 2)
    call add_segment(curr_node, next_node, count, segments)
    case_success = ( &
         case_success .AND. &
         count == 2 .AND. &
         allocated(segments) .AND. &
         size(segments) == 2 .AND. &
         segments(2)%start == curr_node%s .AND. &
         segments(2)%end_ == next_node%s .AND. &
         segments(2)%edge_index == curr_node%index_first)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Intersection is classified as COINCIDENT, nodes match
    !         on first edge.
    count = 0
    curr_node = Intersection( &
         0.125_dp, -1.0_dp, 3, -1, IntersectionClassification_COINCIDENT)
    next_node = Intersection(s=0.625_dp, index_first=3)
    case_success = ( &
         allocated(segments) .AND. &
         size(segments) == 2)
    call add_segment(curr_node, next_node, count, segments)
    case_success = ( &
         case_success .AND. &
         count == 1 .AND. &
         allocated(segments) .AND. &
         size(segments) == 2 .AND. &
         segments(1)%start == curr_node%s .AND. &
         segments(1)%end_ == next_node%s .AND. &
         segments(1)%edge_index == curr_node%index_first)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Intersection is classified as COINCIDENT, nodes match
    !         on second edge.
    count = 0
    curr_node = Intersection( &
         -1.0_dp, 0.25_dp, -1, 1, IntersectionClassification_COINCIDENT)
    next_node = Intersection(-1.0_dp, 1.0_dp, -2, 1)
    case_success = ( &
         allocated(segments) .AND. &
         size(segments) == 2)
    call add_segment(curr_node, next_node, count, segments)
    case_success = ( &
         case_success .AND. &
         count == 1 .AND. &
         allocated(segments) .AND. &
         size(segments) == 2 .AND. &
         segments(1)%start == curr_node%t .AND. &
         segments(1)%end_ == next_node%t .AND. &
         segments(1)%edge_index == curr_node%index_second + 3)
    call print_status(name, case_id, case_success, success)

  end subroutine test_add_segment

  subroutine test_interior_combine(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(16) :: name
    integer(c_int) :: first, second
    type(Intersection) :: intersections(4)
    integer(c_int), allocatable :: segment_ends(:)
    type(CurvedPolygonSegment), allocatable :: segments(:)
    integer(c_int) :: num_intersected, contained, status

    case_id = 1
    name = "interior_combine"

    first = IntersectionClassification_FIRST
    second = IntersectionClassification_SECOND

    ! CASE 1: ``segments`` and ``segment_ends`` are not allocated,
    !         from 1L-6L (ID: 23).
    intersections(1) = Intersection(0.25_dp, 0.75_dp, 1, 3, second)
    intersections(2) = Intersection(0.75_dp, 0.25_dp, 3, 1, first)

    case_success = ( &
         .NOT. allocated(segments) .AND. &
         .NOT. allocated(segment_ends))
    call interior_combine( &
         2, intersections(:2), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         case_success .AND. &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         all(segment_ends == [4]) .AND. &
         allocated(segments) .AND. &
         size(segments) == 4 .AND. &
         segment_check(segments(1), 0.75_dp, 1.0_dp, 3) .AND. &
         segment_check(segments(2), 0.0_dp, 0.25_dp, 1) .AND. &
         segment_check(segments(3), 0.75_dp, 1.0_dp, 6) .AND. &
         segment_check(segments(4), 0.0_dp, 0.25_dp, 4) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``segments`` and ``segment_ends`` must be re-allocated
    !         (``segment_ends`` is re-allocated in ``finalize_segment()``);
    !         two disjoint intersections, from 13L-38Q (ID: 39).
    intersections(1) = Intersection(0.625_dp, 0.25_dp, 1, 1, first)
    intersections(2) = Intersection(0.375_dp, 0.75_dp, 1, 1, second)
    intersections(3) = Intersection(0.3125_dp, 0.25_dp, 1, 2, first)
    intersections(4) = Intersection(0.6875_dp, 0.75_dp, 1, 3, second)

    case_success = ( &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 1 .AND. &
         allocated(segments) .AND. &
         size(segments) == 4)
    call interior_combine( &
         4, intersections, &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         case_success .AND. &
         num_intersected == 2 .AND. &
         allocated(segment_ends) .AND. &
         all(segment_ends == [3, 6]) .AND. &
         allocated(segments) .AND. &
         size(segments) == 6 .AND. &
         segment_check(segments(1), 0.75_dp, 1.0_dp, 6) .AND. &
         segment_check(segments(2), 0.0_dp, 0.25_dp, 4) .AND. &
         segment_check(segments(3), 0.625_dp, 0.6875_dp, 1) .AND. &
         segment_check(segments(4), 0.3125_dp, 0.375_dp, 1) .AND. &
         segment_check(segments(5), 0.75_dp, 1.0_dp, 4) .AND. &
         segment_check(segments(6), 0.0_dp, 0.25_dp, 5) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``segments`` has been allocated but is not large enough (at the
    !         outset of the subroutine ``segments`` is resized based on the
    !         size of ``intersections``); intersection terminates after node
    !         is "rotated" via ``to_front()``, from 1L-28Q (ID: 25) with
    !         rounded parameters from ``s = 0.40587727318528016`` and
    !         ``t == 0.59412272681471978``.
    intersections(1) = Intersection(0.375_dp, 0.5625_dp, 2, 2, second)
    intersections(2) = Intersection(0.1875_dp, 0.0_dp, 1, 3, first)
    ! Note that the corner is the last intersection, which will be used
    ! as ``start``.
    deallocate(segments)
    allocate(segments(1))  ! Too small.
    case_success = ( &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 2 .AND. &
         allocated(segments) .AND. &
         size(segments) == 1)
    call interior_combine( &
         2, intersections(:2), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         case_success .AND. &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 2 .AND. &  ! Unchanged
         segment_ends(1) == 3 .AND. &
         allocated(segments) .AND. &
         size(segments) == 3 .AND. &
         segment_check(segments(1), 0.1875_dp, 1.0_dp, 1) .AND. &
         segment_check(segments(2), 0.0_dp, 0.375_dp, 2) .AND. &
         segment_check(segments(3), 0.5625_dp, 1.0_dp, 5) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: ``segments`` is larger than needed; inspired by 11Q-12Q (ID: 16)
    !         with rounded parameters from ``0.14644660940672624`` and
    !         ``0.8535533905932737``.
    intersections(1) = Intersection(0.140625_dp, 0.84375_dp, 1, 1, first)
    intersections(2) = Intersection(0.84375_dp, 0.140625_dp, 1, 1, second)
    case_success = ( &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 2 .AND. &
         allocated(segments) .AND. &
         size(segments) == 3)
    call interior_combine( &
         2, intersections(:2), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         case_success .AND. &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 2 .AND. &  ! Unchanged
         segment_ends(1) == 2 .AND. &
         allocated(segments) .AND. &
         size(segments) == 3 .AND. &  ! Unchanged
         segment_check(segments(1), 0.140625_dp, 0.84375_dp, 4) .AND. &
         segment_check(segments(2), 0.140625_dp, 0.84375_dp, 1) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: First triangle is completely contained in the other; from
    !         13Q-35Q (ID: 37).
    intersections(1) = Intersection(0.0_dp, 0.5_dp, 3, 3, first)
    call interior_combine( &
         1, intersections(:1), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Second triangle is completely contained in the other; from
    !         1L-9L (ID: 30).
    intersections(1) = Intersection(0.875_dp, 0.0_dp, 1, 2, second)
    intersections(2) = Intersection(0.75_dp, 0.0_dp, 2, 3, second)
    intersections(3) = Intersection(0.875_dp, 0.0_dp, 3, 1, second)
    call interior_combine( &
         3, intersections(:3), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Intersection only contains "whole" edges of each triangle, but
    !         is not either one of the triangle; from 1L-39Q (ID: 40).
    intersections(1) = Intersection(0.0_dp, 0.0_dp, 2, 1, second)
    intersections(2) = Intersection(0.0_dp, 0.0_dp, 3, 2, first)
    call interior_combine( &
         2, intersections(:2), &
         num_intersected, segment_ends, segments, &
         contained, status)
    case_success = ( &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         size(segment_ends) == 2 .AND. &
         segment_ends(1) == 3 .AND. &
         allocated(segments) .AND. &
         size(segments) == 3 .AND. &
         segment_check(segments(1), 0.0_dp, 1.0_dp, 3) .AND. &
         segment_check(segments(2), 0.0_dp, 1.0_dp, 1) .AND. &
         segment_check(segments(3), 0.0_dp, 1.0_dp, 4) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_interior_combine

  function segment_check(segment, start, end_, edge_index) result(same)

    type(CurvedPolygonSegment), intent(in) :: segment
    real(c_double), intent(in) :: start, end_
    integer(c_int), intent(in) :: edge_index
    logical(c_bool) :: same

    same = ( &
         segment%start == start .AND. &
         segment%end_ == end_ .AND. &
         segment%edge_index == edge_index)

  end function segment_check

  subroutine test_triangles_intersect(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(19) :: name
    integer(c_int) :: num_intersected, contained, status
    real(c_double) :: linear1(2, 3), linear2(2, 3)
    real(c_double) :: quadratic1(2, 6), quadratic2(2, 6)
    real(c_double) :: cubic1(2, 10), cubic2(2, 10)
    integer(c_int), allocatable :: segment_ends(:)
    type(CurvedPolygonSegment), allocatable :: segments(:)
    real(c_double) :: start, end_

    case_id = 1
    name = "triangles_intersect"

    ! CASE 1: Disjoint bounding boxes.
    linear1(:, 1) = 0
    linear1(:, 2) = [1.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 1.0_dp]
    linear2(:, 1) = 10
    linear2(:, 2) = [11.0_dp, 10.0_dp]
    linear2(:, 3) = [10.0_dp, 11.0_dp]

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         .NOT. allocated(segment_ends) .AND. &
         .NOT. allocated(segments) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Intersecting edges results in error.
    quadratic1(:, 1) = [0.0_dp, 2.0_dp]
    quadratic1(:, 2) = [-4.0_dp, -2.0_dp]
    quadratic1(:, 3) = [8.0_dp, 2.0_dp]
    quadratic1(:, 4) = [4.0_dp, 4.0_dp]
    quadratic1(:, 5) = [8.0_dp, 4.0_dp]
    quadratic1(:, 6) = [8.0_dp, 6.0_dp]
    quadratic2(:, 1) = [-2.0_dp, 2.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -2.0_dp]
    quadratic2(:, 3) = [6.0_dp, 2.0_dp]
    quadratic2(:, 4) = [1.0_dp, 5.0_dp]
    quadratic2(:, 5) = [5.0_dp, 5.0_dp]
    quadratic2(:, 6) = [4.0_dp, 8.0_dp]

    call triangles_intersect( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         .NOT. allocated(segments) .AND. &
         .NOT. allocated(segment_ends) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_BAD_MULTIPLICITY)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Triangle 2 contained in triangle 1.
    linear1(:, 1) = 0
    linear1(:, 2) = [5.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 5.0_dp]
    linear2(:, 1) = [2.0_dp, 1.0_dp]
    linear2(:, 2) = [3.0_dp, 1.0_dp]
    linear2(:, 3) = 2

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         .NOT. allocated(segment_ends) .AND. &
         .NOT. allocated(segments) .AND. &
         contained == TriangleContained_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Triangle 1 contained in triangle 2 (re-uses all data from CASE 3).
    call triangles_intersect( &
         3, linear2, 1, 3, linear1, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         .NOT. allocated(segment_ends) .AND. &
         .NOT. allocated(segments) .AND. &
         contained == TriangleContained_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Triangles disjoint with overlapping bounding boxes (re-uses
    !         ``linear1`` from previous cases).
    linear2(:, 1) = [7.0_dp, 2.0_dp]
    linear2(:, 2) = [7.0_dp, 3.0_dp]
    linear2(:, 3) = [6.0_dp, 3.0_dp]

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         .NOT. allocated(segment_ends) .AND. &
         .NOT. allocated(segments) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Triangles intersect.
    linear1(:, 1) = 0
    linear1(:, 2) = [8.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 8.0_dp]
    linear2(:, 1) = [4.0_dp, 5.0_dp]
    linear2(:, 2) = [-4.0_dp, 5.0_dp]
    linear2(:, 3) = [4.0_dp, -3.0_dp]

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         all(segment_ends == [6]) .AND. &
         allocated(segments) .AND. &
         size(segments) == 6 .AND. &
         segment_check(segments(1), 0.5_dp, 0.625_dp, 5) .AND. &
         segment_check(segments(2), 0.125_dp, 0.5_dp, 1) .AND. &
         segment_check(segments(3), 0.375_dp, 0.875_dp, 6) .AND. &
         segment_check(segments(4), 0.5_dp, 0.625_dp, 2) .AND. &
         segment_check(segments(5), 0.125_dp, 0.5_dp, 4) .AND. &
         segment_check(segments(6), 0.375_dp, 0.875_dp, 3) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: The only intersection(s) are ``OPPOSED``.
    quadratic1(:, 1) = [4.0_dp, 0.0_dp]
    quadratic1(:, 2) = [2.0_dp, 4.0_dp]
    quadratic1(:, 3) = 0
    quadratic1(:, 4) = [3.0_dp, -2.0_dp]
    quadratic1(:, 5) = [1.0_dp, -2.0_dp]
    quadratic1(:, 6) = [2.0_dp, -4.0_dp]
    quadratic2(:, 1) = [0.0_dp, 4.0_dp]
    quadratic2(:, 2) = [2.0_dp, 0.0_dp]
    quadratic2(:, 3) = 4
    quadratic2(:, 4) = [1.0_dp, 6.0_dp]
    quadratic2(:, 5) = [3.0_dp, 6.0_dp]
    quadratic2(:, 6) = [2.0_dp, 8.0_dp]

    call triangles_intersect( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         allocated(segment_ends) .AND. &  ! Though unused, not de-allocated.
         allocated(segments) .AND. &  ! Though unused, not de-allocated.
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: The only intersection(s) are ``IGNORED_CORNER``.
    linear1(:, 1) = 0
    linear1(:, 2) = [1.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 1.0_dp]
    linear2(:, 1) = 0
    linear2(:, 2) = [-2.0_dp, 3.0_dp]
    linear2(:, 3) = [1.0_dp, -3.0_dp]

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         allocated(segment_ends) .AND. &  ! Though unused, not de-allocated.
         allocated(segments) .AND. &  ! Though unused, not de-allocated.
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 9: The only intersection(s) are ``TANGENT_FIRST``.
    quadratic1(:, 1) = [2.0_dp, 1.25_dp]
    quadratic1(:, 2) = [4.0_dp, 0.75_dp]
    quadratic1(:, 3) = [6.0_dp, 1.25_dp]
    quadratic1(:, 4) = 3
    quadratic1(:, 5) = [5.0_dp, 3.0_dp]
    quadratic1(:, 6) = [4.0_dp, 5.0_dp]
    quadratic2(:, 1) = 0
    quadratic2(:, 2) = [4.0_dp, 2.0_dp]
    quadratic2(:, 3) = [8.0_dp, 0.0_dp]
    quadratic2(:, 4) = [1.5_dp, 7.5_dp]
    quadratic2(:, 5) = [11.0_dp, 6.0_dp]
    quadratic2(:, 6) = 8

    call triangles_intersect( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         allocated(segment_ends) .AND. &  ! Though unused, not de-allocated.
         allocated(segments) .AND. &  ! Though unused, not de-allocated.
         contained == TriangleContained_FIRST .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: The only intersection(s) are ``TANGENT_SECOND`` (re-uses
    !          **all** data from CASE 9).
    call triangles_intersect( &
         6, quadratic2, 2, 6, quadratic1, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         allocated(segment_ends) .AND. &  ! Though unused, not de-allocated.
         allocated(segments) .AND. &  ! Though unused, not de-allocated.
         contained == TriangleContained_SECOND .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: In a previous implementation, round-off issues in
    !          ``curve_intersection.f90::add_intersection()`` caused a
    !          "phantom" extra intersection point caused issues in
    !          ``interior_combine()``. This case is kept around to guard
    !          against regression.
    cubic1(:, 1) = [-0.519247936646441_dp, 0.008196262233806585_dp]
    cubic1(:, 2) = [-0.5206153113582636_dp, 0.01587839530234961_dp]
    cubic1(:, 3) = [-0.5220361984817866_dp, 0.023564120023660037_dp]
    cubic1(:, 4) = [-0.5234919947680754_dp, 0.03126920999203689_dp]
    cubic1(:, 5) = [-0.5306013153328831_dp, 0.010994185722894958_dp]
    cubic1(:, 6) = [-0.5320185860555878_dp, 0.018720567953255777_dp]
    cubic1(:, 7) = [-0.533471521483344_dp, 0.026443532602826243_dp]
    cubic1(:, 8) = [-0.5418564772120571_dp, 0.013842126833196683_dp]
    cubic1(:, 9) = [-0.5433055706504355_dp, 0.02160135650021924_dp]
    cubic1(:, 10) = [-0.5530139922771271_dp, 0.016726767154940626_dp]
    cubic2(:, 1) = [-0.5492475273303934_dp, 0.004806678750684627_dp]
    cubic2(:, 2) = [-0.5507539103531026_dp, 0.011215423321262663_dp]
    cubic2(:, 3) = [-0.552283211157318_dp, 0.017577411042302475_dp]
    cubic2(:, 4) = [-0.553868947686436_dp, 0.023906392050982415_dp]
    cubic2(:, 5) = [-0.5543287770635862_dp, 0.0032189095236835417_dp]
    cubic2(:, 6) = [-0.5558905319225977_dp, 0.00960140358887212_dp]
    cubic2(:, 7) = [-0.5574932750785362_dp, 0.015938552164569394_dp]
    cubic2(:, 8) = [-0.5596130517429451_dp, 0.0014977481523963628_dp]
    cubic2(:, 9) = [-0.5612419767391262_dp, 0.007849282849502192_dp]
    cubic2(:, 10) = [-0.5650788564504334_dp, -0.0003406439314109452_dp]

    call triangles_intersect( &
         10, cubic1, 3, 10, cubic2, 3, &
         segment_ends, segments, &
         num_intersected, contained, status)
    start = 0.60937510406326056_dp
    end_ = 0.64417397312262270_dp
    case_success = ( &
         num_intersected == 1 .AND. &
         allocated(segment_ends) .AND. &
         all(segment_ends == [3]) .AND. &
         allocated(segments) .AND. &
         segment_check(segments(1), start, end_, 4) .AND. &
         segment_check(segments(2), 0.97192953004411586_dp, 1.0_dp, 2) .AND. &
         segment_check(segments(3), 0.0_dp, 0.029255079571205871_dp, 3) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 12: Two triangles share an edge but no interior, will result in
    !          ``COINCIDENT_UNUSED``. This is 29Q-42Q (ID: 43).
    quadratic1(:, 1) = -0.5_dp
    quadratic1(:, 2) = [0.3125_dp, -0.25_dp]
    quadratic1(:, 3) = [1.25_dp, 0.0_dp]
    quadratic1(:, 4) = [-0.25_dp, 0.3125_dp]
    quadratic1(:, 5) = 0.125_dp
    quadratic1(:, 6) = [0.0_dp, 1.25_dp]
    quadratic2(:, 1) = [0.0_dp, 1.25_dp]
    quadratic2(:, 2) = 0.125_dp
    quadratic2(:, 3) = [1.25_dp, 0.0_dp]
    quadratic2(:, 4) = [0.625_dp, 1.25_dp]
    quadratic2(:, 5) = [1.25_dp, 0.625_dp]
    quadratic2(:, 6) = 1.25_dp
    call triangles_intersect( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 13: Same as CASE 12, with arguments swapped.
    call triangles_intersect( &
         6, quadratic2, 2, 6, quadratic1, 2, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 14: Triangles are disjoint, but bounding boxes are not.
    linear1(:, 1) = 0
    linear1(:, 2) = [8.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 8.0_dp]
    linear2(:, 1) = [6.0_dp, 3.0_dp]
    linear2(:, 2) = 6
    linear2(:, 3) = [3.0_dp, 6.0_dp]

    call triangles_intersect( &
         3, linear1, 1, 3, linear2, 1, &
         segment_ends, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_triangles_intersect

  subroutine test_triangles_intersect_abi(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    character(23) :: name
    real(c_double) :: linear1(2, 3), linear2(2, 3)
    real(c_double) :: quadratic1(2, 6), quadratic2(2, 6)
    integer(c_int) :: num_intersected, contained, status
    integer(c_int) :: segment_ends(2)
    type(CurvedPolygonSegment) :: segments(6)

    case_id = 1
    name = "triangles_intersect_abi"

    ! CASE 1: Intersection results in error.
    quadratic1(:, 1) = [0.0_dp, 2.0_dp]
    quadratic1(:, 2) = [-4.0_dp, -2.0_dp]
    quadratic1(:, 3) = [8.0_dp, 2.0_dp]
    quadratic1(:, 4) = [4.0_dp, 4.0_dp]
    quadratic1(:, 5) = [8.0_dp, 4.0_dp]
    quadratic1(:, 6) = [8.0_dp, 6.0_dp]
    quadratic2(:, 1) = [-2.0_dp, 2.0_dp]
    quadratic2(:, 2) = [-2.0_dp, -2.0_dp]
    quadratic2(:, 3) = [6.0_dp, 2.0_dp]
    quadratic2(:, 4) = [1.0_dp, 5.0_dp]
    quadratic2(:, 5) = [5.0_dp, 5.0_dp]
    quadratic2(:, 6) = [4.0_dp, 8.0_dp]
    call triangles_intersect_abi( &
         6, quadratic1, 2, 6, quadratic2, 2, &
         2, segment_ends, 6, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_BAD_MULTIPLICITY)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: ``segment_ends`` is not large enough; two disjoint intersections
    !         from 13L-38Q (ID: 39).
    linear1(:, 1) = [-8.0_dp, 0.0_dp]
    linear1(:, 2) = [8.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 8.0_dp]
    quadratic1(:, 1) = [4.0_dp, 3.0_dp]
    quadratic1(:, 2) = [0.0_dp, -5.0_dp]
    quadratic1(:, 3) = [-4.0_dp, 3.0_dp]
    quadratic1(:, 4) = [2.0_dp, -3.0_dp]
    quadratic1(:, 5) = [-2.0_dp, -3.0_dp]
    quadratic1(:, 6) = [0.0_dp, -9.0_dp]
    segment_ends(:2) = [-1337, -42]
    call triangles_intersect_abi( &
         3, linear1, 1, 6, quadratic1, 2, &
         1, segment_ends, 3, segments(:3), &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 2 .AND. &
         all(segment_ends(:2) == [-1337, -42]) .AND. &  ! Unchanged.
         contained == TriangleContained_NEITHER .AND. &
         status == Status_INSUFFICIENT_SPACE)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: ``segments`` is not large enough; two disjoint intersections
    !         from 13L-38Q (ID: 39).
    call triangles_intersect_abi( &
         3, linear1, 1, 6, quadratic1, 2, &
         2, segment_ends, 3, segments(:3), &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 2 .AND. &
         all(segment_ends(:2) == [3, 6]) .AND. &  ! Changed.
         contained == TriangleContained_NEITHER .AND. &
         status == Status_INSUFFICIENT_SPACE)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Successful intersection; two disjoint intersections
    !         from 13L-38Q (ID: 39).
    call triangles_intersect_abi( &
         3, linear1, 1, 6, quadratic1, 2, &
         2, segment_ends, 6, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 2 .AND. &
         all(segment_ends(:2) == [3, 6]) .AND. &
         segment_check(segments(1), 0.75_dp, 1.0_dp, 6) .AND. &
         segment_check(segments(2), 0.0_dp, 0.25_dp, 4) .AND. &
         segment_check(segments(3), 0.625_dp, 0.6875_dp, 1) .AND. &
         segment_check(segments(4), 0.3125_dp, 0.375_dp, 1) .AND. &
         segment_check(segments(5), 0.75_dp, 1.0_dp, 4) .AND. &
         segment_check(segments(6), 0.0_dp, 0.25_dp, 5) .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: No intersections.
    linear1(:, 1) = 0
    linear1(:, 2) = [1.0_dp, 0.0_dp]
    linear1(:, 3) = [0.0_dp, 1.0_dp]
    linear2(:, 1) = 3
    linear2(:, 2) = [4.0_dp, 3.0_dp]
    linear2(:, 3) = [3.0_dp, 4.0_dp]
    call triangles_intersect_abi( &
         3, linear1, 1, 3, linear2, 1, &
         2, segment_ends, 6, segments, &
         num_intersected, contained, status)
    case_success = ( &
         num_intersected == 0 .AND. &
         contained == TriangleContained_NEITHER .AND. &
         status == Status_SUCCESS)
    call print_status(name, case_id, case_success, success)

  end subroutine test_triangles_intersect_abi

end module test_triangle_intersection


<|start_filename|>src/fortran/triangle.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module triangle

  use, intrinsic :: iso_c_binding, only: &
       c_double, c_int, c_bool, c_ptr, c_f_pointer
  use types, only: dp
  use curve, only: evaluate_curve_barycentric
  implicit none
  private specialize_workspace_sizes, specialize_triangle_one_round
  public &
       de_casteljau_one_round, evaluate_barycentric, &
       evaluate_barycentric_multi, evaluate_cartesian_multi, jacobian_both, &
       jacobian_det, specialize_triangle, subdivide_nodes, compute_edge_nodes, &
       shoelace_for_area, compute_area

contains

  subroutine de_casteljau_one_round( &
       num_nodes, dimension_, nodes, degree, &
       lambda1, lambda2, lambda3, new_nodes) &
       bind(c, name='BEZ_de_casteljau_one_round')

    ! NOTE: This is de Casteljau on a Bezier triangle / triangle.

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(in) :: lambda1
    real(c_double), intent(in) :: lambda2
    real(c_double), intent(in) :: lambda3
    real(c_double), intent(out) :: &
         new_nodes(dimension_, num_nodes - degree - 1)
    ! Variables outside of signature.
    integer(c_int) :: index_
    integer(c_int) :: parent_i1, parent_i2, parent_i3
    integer(c_int) :: k, j

    index_ = 1
    parent_i1 = 1
    parent_i2 = 2
    parent_i3 = degree + 2
    ! NOTE: Throughout for index_ <--> (i, j, k) in the (degree - 1)
    !       triangle, we have parent_i1 = index_ + k <--> (i + 1, j, k),
    !       parent_i2 = index_ + k + 1 <--> (i, j + 1, k) and
    !       parent_i3 = index_ + degree + 1 <--> (i, j, k + 1).
    do k = 0, degree - 1
       do j = 0, degree - k - 1
          ! NOTE: i = (degree - 1) - j - k
          new_nodes(:, index_) = ( &
               lambda1 * nodes(:, parent_i1) + &
               lambda2 * nodes(:, parent_i2) + &
               lambda3 * nodes(:, parent_i3))
          ! Update all the indices.
          parent_i1 = parent_i1 + 1
          parent_i2 = parent_i2 + 1
          parent_i3 = parent_i3 + 1
          index_ = index_ + 1
       end do
       ! Update the indices that depend on k.
       parent_i1 = parent_i1 + 1
       parent_i2 = parent_i2 + 1
    end do

  end subroutine de_casteljau_one_round

  subroutine evaluate_barycentric( &
       num_nodes, dimension_, nodes, degree, &
       lambda1, lambda2, lambda3, point) &
       bind(c, name='BEZ_evaluate_barycentric')

    ! NOTE: This evaluation is on a Bezier triangle / triangle.
    ! NOTE: This assumes degree >= 1.

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(in) :: lambda1
    real(c_double), intent(in) :: lambda2
    real(c_double), intent(in) :: lambda3
    real(c_double), intent(out) :: point(dimension_, 1)
    ! Variables outside of signature.
    real(c_double) :: param_vals(3, 1)

    param_vals(1, 1) = lambda1
    param_vals(2, 1) = lambda2
    param_vals(3, 1) = lambda3
    call evaluate_barycentric_multi( &
         num_nodes, dimension_, nodes, degree, 1, param_vals, point)

  end subroutine evaluate_barycentric

  subroutine evaluate_barycentric_multi( &
       num_nodes, dimension_, nodes, degree, num_vals, param_vals, evaluated) &
       bind(c, name='BEZ_evaluate_barycentric_multi')

    ! NOTE: This evaluation is on a Bezier triangle / triangle.
    ! NOTE: This assumes degree >= 1.

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree, num_vals
    real(c_double), intent(in) :: param_vals(num_vals, 3)
    real(c_double), intent(out) :: evaluated(dimension_, num_vals)
    ! Variables outside of signature.
    integer(c_int) :: k, binom_val, index_, new_index
    real(c_double) :: row_result(dimension_, num_vals)

    index_ = num_nodes
    forall (new_index = 1:num_vals)  ! Borrow new_index for this loop.
       evaluated(:, new_index) = nodes(:, index_)
    end forall

    if (degree == 0) then
       return
    end if

    binom_val = 1
    do k = degree - 1, 0, -1
       ! We want to go from (d C (k + 1)) to (d C k).
       binom_val = (binom_val * (k + 1)) / (degree - k)
       index_ = index_ - 1  ! Step to last element in row.
       !     k = d - 1, d - 2, ...
       ! d - k =     1,     2, ...
       ! We know row k has (d - k + 1) elements.
       new_index = index_ - degree + k  ! First element in row.

       ! lambda1 = param_vals(:, 1)
       ! lambda2 = param_vals(:, 2)
       call evaluate_curve_barycentric( &
            degree - k + 1, dimension_, nodes(:, new_index:index_), &
            num_vals, param_vals(:, 1), param_vals(:, 2), row_result)

       ! Update index for next iteration.
       index_ = new_index

       ! lambda3 = param_vals(:, 3)
       forall (new_index = 1:num_vals)  ! Borrow new_index for this loop.
          evaluated(:, new_index) = ( &
               param_vals(new_index, 3) * evaluated(:, new_index) + &
               binom_val * row_result(:, new_index))
       end forall
    end do

  end subroutine evaluate_barycentric_multi

  subroutine evaluate_cartesian_multi( &
       num_nodes, dimension_, nodes, degree, num_vals, param_vals, evaluated) &
       bind(c, name='BEZ_evaluate_cartesian_multi')

    ! NOTE: This evaluation is on a Bezier triangle / triangle.
    ! NOTE: This mostly copies evaluate_barycentric_multi but does not just
    !       call it directly. This is to avoid copying param_vals.

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree, num_vals
    real(c_double), intent(in) :: param_vals(num_vals, 2)
    real(c_double), intent(out) :: evaluated(dimension_, num_vals)
    ! Variables outside of signature.
    integer(c_int) :: k, binom_val, index_, new_index
    real(c_double) :: row_result(dimension_, num_vals)
    real(c_double) :: lambda1_vals(num_vals)

    index_ = num_nodes
    forall (new_index = 1:num_vals)  ! Borrow new_index for this loop.
       evaluated(:, new_index) = nodes(:, index_)
    end forall

    if (degree == 0) then
       return
    end if

    lambda1_vals = 1.0_dp - param_vals(:, 1) - param_vals(:, 2)

    binom_val = 1
    do k = degree - 1, 0, -1
       ! We want to go from (d C (k + 1)) to (d C k).
       binom_val = (binom_val * (k + 1)) / (degree - k)
       index_ = index_ - 1  ! Step to last element in row.
       !     k = d - 1, d - 2, ...
       ! d - k =     1,     2, ...
       ! We know row k has (d - k + 1) elements.
       new_index = index_ - degree + k  ! First element in row.

       ! lambda1 = param_vals(:, 1)
       ! lambda2 = param_vals(:, 1)
       call evaluate_curve_barycentric( &
            degree - k + 1, dimension_, nodes(:, new_index:index_), &
            num_vals, lambda1_vals, param_vals(:, 1), row_result)

       ! Update index for next iteration.
       index_ = new_index

       ! lambda3 = param_vals(:, 2)
       forall (new_index = 1:num_vals)  ! Borrow new_index for this loop.
          evaluated(:, new_index) = ( &
               param_vals(new_index, 2) * evaluated(:, new_index) + &
               binom_val * row_result(:, new_index))
       end forall
    end do

  end subroutine evaluate_cartesian_multi

  subroutine jacobian_both( &
       num_nodes, dimension_, nodes, degree, new_nodes) &
       bind(c, name='BEZ_jacobian_both')

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(out) :: &
         new_nodes(2 * dimension_, num_nodes - degree - 1)
    ! Variables outside of signature.
    integer(c_int) :: index_, i, j, k, num_vals

    index_ = 1
    i = 1
    j = degree + 2
    do num_vals = degree, 1, -1
       do k = 0, num_vals - 1
          ! jacobian_s
          new_nodes(:dimension_, index_) = nodes(:, i + 1) - nodes(:, i)
          ! jacobian_t
          new_nodes(dimension_ + 1:, index_) = nodes(:, j) - nodes(:, i)
          ! Update the indices
          index_ = index_ + 1
          i = i + 1
          j = j + 1
       end do
       ! In between each row, the index_ gains an extra value.
       i = i + 1
    end do

    new_nodes = degree * new_nodes

  end subroutine jacobian_both

  subroutine jacobian_det( &
       num_nodes, nodes, degree, num_vals, param_vals, evaluated) &
       bind(c, name='BEZ_jacobian_det')

    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: nodes(2, num_nodes)
    integer(c_int), intent(in) :: degree, num_vals
    real(c_double), intent(in) :: param_vals(num_vals, 2)
    real(c_double), intent(out) :: evaluated(num_vals)
    ! Variables outside of signature.
    real(c_double) :: jac_nodes(4, num_nodes - degree - 1)
    real(c_double) :: Bs_Bt_vals(4, num_vals)
    real(c_double) :: determinant

    call jacobian_both( &
         num_nodes, 2, nodes, degree, jac_nodes)
    if (degree == 1) then
       determinant = ( &
            jac_nodes(1, 1) * jac_nodes(4, 1) - &
            jac_nodes(2, 1) * jac_nodes(3, 1))
       evaluated = determinant
    else
       call evaluate_cartesian_multi( &
            num_nodes - degree - 1, 4, jac_nodes, degree - 1, &
            num_vals, param_vals, Bs_Bt_vals)
       evaluated = ( &
            Bs_Bt_vals(1, :) * Bs_Bt_vals(4, :) - &
            Bs_Bt_vals(2, :) * Bs_Bt_vals(3, :))
    end if

  end subroutine jacobian_det

  subroutine specialize_workspace_sizes(degree, size_odd, size_even)

    ! NOTE: This is a helper for ``specialize_triangle()``.

    integer(c_int), intent(in) :: degree
    integer(c_int), intent(out) :: size_odd, size_even

    if (mod(degree, 2) == 1) then
       size_odd = ((degree + 1) * (degree + 3)**2 * (degree + 5)) / 64
       size_even = size_odd
    else if (mod(degree, 4) == 0) then
       size_odd = (degree * (degree + 2) * (degree + 4) * (degree + 6)) / 64
       size_even = (((degree + 2) * (degree + 4)) / 8)**2
    else
       size_odd = (((degree + 2) * (degree + 4)) / 8)**2
       size_even = (degree * (degree + 2) * (degree + 4) * (degree + 6)) / 64
    end if

  end subroutine specialize_workspace_sizes

  subroutine specialize_triangle_one_round( &
       dimension_, num_read, read_nodes, num_write, write_nodes, &
       size_read, size_write, step, local_degree, &
       weights_a, weights_b, weights_c)

    ! INVARIANT: `step + local_degree == (total) degree + 1`
    ! INVARIANT: `size_write == size_read - local_degree - 1`

    integer(c_int), intent(in) :: dimension_
    integer(c_int), intent(in) :: num_read
    real(c_double), intent(in) :: read_nodes(dimension_, num_read)
    integer(c_int), intent(in) :: num_write
    real(c_double), intent(inout) :: write_nodes(dimension_, num_write)
    integer(c_int), intent(in) :: size_read, size_write
    integer(c_int), intent(in) :: step, local_degree
    real(c_double), intent(in) :: weights_a(3), weights_b(3), weights_c(3)
    ! Variables outside of signature.
    integer(c_int) :: write_index, new_write, read_index, new_read, i

    ! First: (step, 0, 0)
    call de_casteljau_one_round( &
         size_read, dimension_, read_nodes(:, 1:size_read), &
         local_degree, weights_a(1), weights_a(2), weights_a(3), &
         write_nodes(:, 1:size_write))

    ! Second: (i, j, 0) for j > 0, i + j = step
    write_index = size_write + 1
    read_index = 1
    do i = 1, step
       new_write = write_index + size_write - 1
       new_read = read_index + size_read - 1
       call de_casteljau_one_round( &
            size_read, dimension_, read_nodes(:, read_index:new_read), &
            local_degree, weights_b(1), weights_b(2), weights_b(3), &
            write_nodes(:, write_index:new_write))
       ! Update the indices.
       write_index = new_write + 1
       read_index = new_read + 1
    end do

    ! Third:  (i, j, k) for k > 0, i + j + k = step
    read_index = 1
    do i = 1, ((step + 1) * step) / 2
       new_write = write_index + size_write - 1
       new_read = read_index + size_read - 1
       call de_casteljau_one_round( &
            size_read, dimension_, read_nodes(:, read_index:new_read), &
            local_degree, weights_c(1), weights_c(2), weights_c(3), &
            write_nodes(:, write_index:new_write))
       ! Update the indices.
       write_index = new_write + 1
       read_index = new_read + 1
    end do

  end subroutine specialize_triangle_one_round

  subroutine specialize_triangle( &
       num_nodes, dimension_, nodes, degree, &
       weights_a, weights_b, weights_c, specialized) &
       bind(c, name='BEZ_specialize_triangle')

    ! This re-parameterizes by "specializing" to a subregion of the unit
    ! triangle. This happens in waves by applying one round of de Casteljau
    ! with the given sets of barycentric weights. For example, in the degree
    ! 1 case, we transform
    !     [n0]          [dC(n0(1:3), a)]
    !     [  ] --> n1 = [dC(n0(1:3), b)]
    !     [  ]          [dC(n0(1:3), c)]
    ! where `n` on the LHS is 3xDIM and each of the transformed sets of
    ! nodes are 1xDIM (since de Casteljau drops the degree by 1). (NOTE:
    ! here I'm using `dC` as a shorthand for "de Casteljau" and `a` as a
    ! shorthand `weights_a`.) In the degree 2 case:
    !     [n0]          [dC(n0(1:6), a)]          [dC(n1(1:3), a)]
    !     [  ]          [              ]          [dC(n1(1:3), b)]
    !     [  ]          [              ] --> n2 = [dC(n1(4:6), b)]
    !     [  ] --> n1 = [dC(n0(1:6), b)]          [dC(n1(1:3), c)]
    !     [  ]          [              ]          [dC(n1(4:6), c)]
    !     [  ]          [              ]          [dC(n1(7:9), c)]
    !                   [dC(n0(1:6), c)]
    !                   [              ]
    !                   [              ]
    ! In the degree 3 case:
    !     [n0]          [dC(n0(1:10), a)]          [dC(n1( 1:6 ), a)]
    !     [  ]          [               ]          [                ]
    !     [  ]          [               ]          [                ]
    !     [  ]          [               ]          [dC(n1( 1:6 ), b)]
    !     [  ]          [               ]          [                ]
    !     [  ] --> n1 = [               ]          [                ]
    !     [  ]          [dC(n0(1:10), b)]          [dC(n1( 7:12), b)]
    !     [  ]          [               ]          [                ]
    !     [  ]          [               ]          [                ]
    !     [  ]          [               ] --> n2 = [dC(n1( 1:6 ), c)]
    !                   [               ]          [                ]
    !                   [               ]          [                ]
    !                   [dC(n0(1:10), c)]          [dC(n1( 7:12), c)]
    !                   [               ]          [                ]
    !                   [               ]          [                ]
    !                   [               ]          [dC(n1(13:18), c)]
    !                   [               ]          [                ]
    !                   [               ]          [                ]
    ! ... CONTINUING TO DEGREE 3 ...
    !                 [dC(n2( 1:3 ), a)]
    !                 [dC(n2( 1:3 ), b)]
    !                 [dC(n2( 4:6 ), b)]
    !                 [dC(n2( 7:9 ), b)]
    !                 [dC(n2( 1:3 ), c)]
    !     n2 --> n3 = [dC(n2( 4:6 ), c)]
    !                 [dC(n2( 7:9 ), c)]
    !                 [dC(n2(10:12), c)]
    !                 [dC(n2(13:15), c)]
    !                 [dC(n2(16:18), c)]
    ! For **all** cases, we are tracking applications of weights at
    ! each step:
    !     STEP 1: {a}, {b}, {c}
    !     STEP 2: {aa}, {ab}, {bb}, {ac}, {bc}, {cc}
    !     STEP 3: {aaa}, {aab}, {abb}, {bbb}, {aac}, ...
    ! and each of these quantities can be computed using the ones computed
    ! at the previous step. So in STEP 2, we compute {aa} by applying
    ! the `a` weights to {a}, we compute {ab} and {bb} by applying the
    ! `b` weights to {a} and {b} and we compute {ac}, {bc}, {cc} by
    ! applying the `c` weights to the whole set.
    !
    ! For a "general" step, we can treat the triple (#a, #b, #c) just like
    ! we treat an index triple (i, j, k), which we know has linear index
    ! (1-based) `1 + j + (k/2) (2(i + j) + k + 3)`. This is very useful because
    ! we can find the **previous** quantity by using this index. For example,
    ! to compute {aabccc} by applying `c` to {aabcc}, we know the index
    ! of the {aabcc} is 13 and the index of {aabccc} is 20. In fact, one can
    ! show that when dropping from (i, j, k) to (i, j, k - 1) the index will
    ! always drop by `(i + j + k) + 1 = step + 1`. Unfortunately, some values
    ! have no `c` weights at all, i.e. `k = 0`. For these special cases we
    ! also use the formula to show `(step, 0, 0) --> (step - 1, 0, 0)` has
    ! no change in index (both are the first index). From `(i, j, 0)` to
    ! `(i, j - 1, 0)` drops the index by `1`.
    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(in) :: weights_a(3), weights_b(3), weights_c(3)
    real(c_double), intent(out) :: specialized(dimension_, num_nodes)
    ! Variables outside of signature.
    integer(c_int) :: num_curves, size, size_odd, size_even
    real(c_double), allocatable :: workspace_odd(:, :), workspace_even(:, :)
    integer(c_int) :: delta_nc, delta_size, size_new, step
    logical(c_bool) :: is_even

    num_curves = 1
    size = ((degree + 1) * (degree + 2)) / 2
    call specialize_workspace_sizes(degree, size_odd, size_even)
    allocate(workspace_odd(dimension_, size_odd))
    allocate(workspace_even(dimension_, size_even))

    ! `num_curves` and `delta_size` are triangular numbers going in
    ! the opposite direction. `num_curves` will go from 1, 3, 6, 10, ...
    ! and `delta_size` will go (d + 2 C 2), (d + 1 C 2), ...
    ! Since the delta between consecutive terms grows linearly, we track
    ! them as well to avoid multiplications.
    delta_nc = 2
    delta_size = -degree - 1
    is_even = .FALSE.  ! At `step == 1`.

    do step = 1, degree
       num_curves = num_curves + delta_nc
       size_new = size + delta_size
       if (step == 1) then
          ! Read from `nodes`, write to `workspace_odd`.
          call specialize_triangle_one_round( &
               dimension_, num_nodes, nodes, size_odd, workspace_odd, &
               size, size_new, step, degree + 1 - step, &
               weights_a, weights_b, weights_c)
       else if (is_even) then
          ! Read from `workspace_odd`, write to `workspace_even`.
          call specialize_triangle_one_round( &
               dimension_, size_odd, workspace_odd, &
               size_even, workspace_even, &
               size, size_new, step, degree + 1 - step, &
               weights_a, weights_b, weights_c)
       else
          ! Read from `workspace_even`, write to `workspace_odd`.
          call specialize_triangle_one_round( &
               dimension_, size_even, workspace_even, &
               size_odd, workspace_odd, &
               size, size_new, step, degree + 1 - step, &
               weights_a, weights_b, weights_c)
       end if

       ! Update our index values.
       size = size_new
       delta_nc = delta_nc + 1
       delta_size = delta_size + 1
       is_even = .NOT. is_even  ! Switch parity.
    end do

    ! Read from the last workspace that was written to.
    if (is_even) then
       specialized = workspace_odd(:, 1:num_nodes)
    else
       specialized = workspace_even(:, 1:num_nodes)
    end if

  end subroutine specialize_triangle

  subroutine subdivide_nodes( &
       num_nodes, dimension_, nodes, degree, &
       nodes_a, nodes_b, nodes_c, nodes_d) &
       bind(c, name='BEZ_subdivide_nodes_triangle')

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(out) :: nodes_a(dimension_, num_nodes)
    real(c_double), intent(out) :: nodes_b(dimension_, num_nodes)
    real(c_double), intent(out) :: nodes_c(dimension_, num_nodes)
    real(c_double), intent(out) :: nodes_d(dimension_, num_nodes)

    if (degree == 1) then
       nodes_a(:, 1) = nodes(:, 1)
       nodes_a(:, 2) = 0.5_dp * (nodes(:, 1) + nodes(:, 2))
       nodes_a(:, 3) = 0.5_dp * (nodes(:, 1) + nodes(:, 3))
       nodes_b(:, 1) = 0.5_dp * (nodes(:, 2) + nodes(:, 3))
       nodes_b(:, 2) = nodes_a(:, 3)
       nodes_b(:, 3) = nodes_a(:, 2)
       nodes_c(:, 1) = nodes_a(:, 2)
       nodes_c(:, 2) = nodes(:, 2)
       nodes_c(:, 3) = nodes_b(:, 1)
       nodes_d(:, 1) = nodes_a(:, 3)
       nodes_d(:, 2) = nodes_b(:, 1)
       nodes_d(:, 3) = nodes(:, 3)
    else if (degree == 2) then
       nodes_a(:, 1) = nodes(:, 1)
       nodes_a(:, 2) = 0.5_dp * (nodes(:, 1) + nodes(:, 2))
       nodes_a(:, 3) = 0.25_dp * (nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3))
       nodes_a(:, 4) = 0.5_dp * (nodes(:, 1) + nodes(:, 4))
       nodes_a(:, 5) = 0.25_dp * ( &
            nodes(:, 1) + nodes(:, 2) + nodes(:, 4) + nodes(:, 5))
       nodes_a(:, 6) = 0.25_dp * (nodes(:, 1) + 2 * nodes(:, 4) + nodes(:, 6))
       nodes_b(:, 1) = 0.25_dp * (nodes(:, 3) + 2 * nodes(:, 5) + nodes(:, 6))
       nodes_b(:, 2) = 0.25_dp * ( &
            nodes(:, 2) + nodes(:, 4) + nodes(:, 5) + nodes(:, 6))
       nodes_b(:, 3) = nodes_a(:, 6)
       nodes_b(:, 4) = 0.25_dp * ( &
            nodes(:, 2) + nodes(:, 3) + nodes(:, 4) + nodes(:, 5))
       nodes_b(:, 5) = nodes_a(:, 5)
       nodes_b(:, 6) = nodes_a(:, 3)
       nodes_c(:, 1) = nodes_a(:, 3)
       nodes_c(:, 2) = 0.5_dp * (nodes(:, 2) + nodes(:, 3))
       nodes_c(:, 3) = nodes(:, 3)
       nodes_c(:, 4) = nodes_b(:, 4)
       nodes_c(:, 5) = 0.5_dp * (nodes(:, 3) + nodes(:, 5))
       nodes_c(:, 6) = nodes_b(:, 1)
       nodes_d(:, 1) = nodes_a(:, 6)
       nodes_d(:, 2) = nodes_b(:, 2)
       nodes_d(:, 3) = nodes_b(:, 1)
       nodes_d(:, 4) = 0.5_dp * (nodes(:, 4) + nodes(:, 6))
       nodes_d(:, 5) = 0.5_dp * (nodes(:, 5) + nodes(:, 6))
       nodes_d(:, 6) = nodes(:, 6)
    else if (degree == 3) then
       nodes_a(:, 1) = nodes(:, 1)
       nodes_a(:, 2) = 0.5_dp * (nodes(:, 1) + nodes(:, 2))
       nodes_a(:, 3) = 0.25_dp * (nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3))
       nodes_a(:, 4) = 0.125_dp * ( &
            nodes(:, 1) + 3 * nodes(:, 2) + 3 * nodes(:, 3) + nodes(:, 4))
       nodes_a(:, 5) = 0.5_dp * (nodes(:, 1) + nodes(:, 5))
       nodes_a(:, 6) = 0.25_dp * ( &
            nodes(:, 1) + nodes(:, 2) + nodes(:, 5) + nodes(:, 6))
       nodes_a(:, 7) = 0.125_dp * ( &
            nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3) + nodes(:, 5) + &
            2 * nodes(:, 6) + nodes(:, 7))
       nodes_a(:, 8) = 0.25_dp * (nodes(:, 1) + 2 * nodes(:, 5) + nodes(:, 8))
       nodes_a(:, 9) = 0.125_dp * ( &
            nodes(:, 1) + nodes(:, 2) + 2 * nodes(:, 5) + 2 * nodes(:, 6) + &
            nodes(:, 8) + nodes(:, 9))
       nodes_a(:, 10) = 0.125_dp * ( &
            nodes(:, 1) + 3 * nodes(:, 5) + 3 * nodes(:, 8) + nodes(:, 10))
       nodes_b(:, 1) = 0.125_dp * ( &
            nodes(:, 4) + 3 * nodes(:, 7) + 3 * nodes(:, 9) + nodes(:, 10))
       nodes_b(:, 2) = 0.125_dp * ( &
            nodes(:, 3) + 2 * nodes(:, 6) + nodes(:, 7) + nodes(:, 8) + &
            2 * nodes(:, 9) + nodes(:, 10))
       nodes_b(:, 3) = 0.125_dp * ( &
            nodes(:, 2) + nodes(:, 5) + 2 * nodes(:, 6) + 2 * nodes(:, 8) + &
            nodes(:, 9) + nodes(:, 10))
       nodes_b(:, 4) = nodes_a(:, 10)
       nodes_b(:, 5) = 0.125_dp * ( &
            nodes(:, 3) + nodes(:, 4) + 2 * nodes(:, 6) + 2 * nodes(:, 7) + &
            nodes(:, 8) + nodes(:, 9))
       nodes_b(:, 6) = 0.125_dp * ( &
            nodes(:, 2) + nodes(:, 3) + nodes(:, 5) + 2 * nodes(:, 6) + &
            nodes(:, 7) + nodes(:, 8) + nodes(:, 9))
       nodes_b(:, 7) = nodes_a(:, 9)
       nodes_b(:, 8) = 0.125_dp * ( &
            nodes(:, 2) + 2 * nodes(:, 3) + nodes(:, 4) + nodes(:, 5) + &
            2 * nodes(:, 6) + nodes(:, 7))
       nodes_b(:, 9) = nodes_a(:, 7)
       nodes_b(:, 10) = nodes_a(:, 4)
       nodes_c(:, 1) = nodes_a(:, 4)
       nodes_c(:, 2) = 0.25_dp * (nodes(:, 2) + 2 * nodes(:, 3) + nodes(:, 4))
       nodes_c(:, 3) = 0.5_dp * (nodes(:, 3) + nodes(:, 4))
       nodes_c(:, 4) = nodes(:, 4)
       nodes_c(:, 5) = nodes_b(:, 8)
       nodes_c(:, 6) = 0.25_dp * ( &
            nodes(:, 3) + nodes(:, 4) + nodes(:, 6) + nodes(:, 7))
       nodes_c(:, 7) = 0.5_dp * (nodes(:, 4) + nodes(:, 7))
       nodes_c(:, 8) = nodes_b(:, 5)
       nodes_c(:, 9) = 0.25_dp * (nodes(:, 4) + 2 * nodes(:, 7) + nodes(:, 9))
       nodes_c(:, 10) = nodes_b(:, 1)
       nodes_d(:, 1) = nodes_a(:, 10)
       nodes_d(:, 2) = nodes_b(:, 3)
       nodes_d(:, 3) = nodes_b(:, 2)
       nodes_d(:, 4) = nodes_b(:, 1)
       nodes_d(:, 5) = 0.25_dp * (nodes(:, 5) + 2 * nodes(:, 8) + nodes(:, 10))
       nodes_d(:, 6) = 0.25_dp * ( &
            nodes(:, 6) + nodes(:, 8) + nodes(:, 9) + nodes(:, 10))
       nodes_d(:, 7) = 0.25_dp * (nodes(:, 7) + 2 * nodes(:, 9) + nodes(:, 10))
       nodes_d(:, 8) = 0.5_dp * (nodes(:, 8) + nodes(:, 10))
       nodes_d(:, 9) = 0.5_dp * (nodes(:, 9) + nodes(:, 10))
       nodes_d(:, 10) = nodes(:, 10)
    else if (degree == 4) then
       nodes_a(:, 1) = nodes(:, 1)
       nodes_a(:, 2) = 0.5_dp * (nodes(:, 1) + nodes(:, 2))
       nodes_a(:, 3) = 0.25_dp * (nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3))
       nodes_a(:, 4) = 0.125_dp * ( &
            nodes(:, 1) + 3 * nodes(:, 2) + 3 * nodes(:, 3) + nodes(:, 4))
       nodes_a(:, 5) = 0.0625_dp * ( &
            nodes(:, 1) + 4 * nodes(:, 2) + 6 * nodes(:, 3) + &
            4 * nodes(:, 4) + nodes(:, 5))
       nodes_a(:, 6) = 0.5_dp * (nodes(:, 1) + nodes(:, 6))
       nodes_a(:, 7) = 0.25_dp * ( &
            nodes(:, 1) + nodes(:, 2) + nodes(:, 6) + nodes(:, 7))
       nodes_a(:, 8) = 0.125_dp * ( &
            nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3) + nodes(:, 6) + &
            2 * nodes(:, 7) + nodes(:, 8))
       nodes_a(:, 9) = 0.0625_dp * ( &
            nodes(:, 1) + 3 * nodes(:, 2) + 3 * nodes(:, 3) + nodes(:, 4) + &
            nodes(:, 6) + 3 * nodes(:, 7) + 3 * nodes(:, 8) + nodes(:, 9))
       nodes_a(:, 10) = 0.25_dp * ( &
            nodes(:, 1) + 2 * nodes(:, 6) + nodes(:, 10))
       nodes_a(:, 11) = 0.125_dp * ( &
            nodes(:, 1) + nodes(:, 2) + 2 * nodes(:, 6) + 2 * nodes(:, 7) + &
            nodes(:, 10) + nodes(:, 11))
       nodes_a(:, 12) = 0.0625_dp * ( &
            nodes(:, 1) + 2 * nodes(:, 2) + nodes(:, 3) + 2 * nodes(:, 6) + &
            4 * nodes(:, 7) + 2 * nodes(:, 8) + nodes(:, 10) + &
            2 * nodes(:, 11) + nodes(:, 12))
       nodes_a(:, 13) = 0.125_dp * ( &
            nodes(:, 1) + 3 * nodes(:, 6) + 3 * nodes(:, 10) + nodes(:, 13))
       nodes_a(:, 14) = 0.0625_dp * ( &
            nodes(:, 1) + nodes(:, 2) + 3 * nodes(:, 6) + 3 * nodes(:, 7) + &
            3 * nodes(:, 10) + 3 * nodes(:, 11) + nodes(:, 13) + nodes(:, 14))
       nodes_a(:, 15) = 0.0625_dp * ( &
            nodes(:, 1) + 4 * nodes(:, 6) + 6 * nodes(:, 10) + &
            4 * nodes(:, 13) + nodes(:, 15))
       nodes_b(:, 1) = 0.0625_dp * ( &
            nodes(:, 5) + 4 * nodes(:, 9) + 6 * nodes(:, 12) + &
            4 * nodes(:, 14) + nodes(:, 15))
       nodes_b(:, 2) = 0.0625_dp * ( &
            nodes(:, 4) + 3 * nodes(:, 8) + nodes(:, 9) + 3 * nodes(:, 11) + &
            3 * nodes(:, 12) + nodes(:, 13) + 3 * nodes(:, 14) + nodes(:, 15))
       nodes_b(:, 3) = 0.0625_dp * ( &
            nodes(:, 3) + 2 * nodes(:, 7) + 2 * nodes(:, 8) + nodes(:, 10) + &
            4 * nodes(:, 11) + nodes(:, 12) + 2 * nodes(:, 13) + &
            2 * nodes(:, 14) + nodes(:, 15))
       nodes_b(:, 4) = 0.0625_dp * ( &
            nodes(:, 2) + nodes(:, 6) + 3 * nodes(:, 7) + 3 * nodes(:, 10) + &
            3 * nodes(:, 11) + 3 * nodes(:, 13) + nodes(:, 14) + nodes(:, 15))
       nodes_b(:, 5) = nodes_a(:, 15)
       nodes_b(:, 6) = 0.0625_dp * ( &
            nodes(:, 4) + nodes(:, 5) + 3 * nodes(:, 8) + 3 * nodes(:, 9) + &
            3 * nodes(:, 11) + 3 * nodes(:, 12) + nodes(:, 13) + nodes(:, 14))
       nodes_b(:, 7) = 0.0625_dp * ( &
            nodes(:, 3) + nodes(:, 4) + 2 * nodes(:, 7) + 3 * nodes(:, 8) + &
            nodes(:, 9) + nodes(:, 10) + 3 * nodes(:, 11) + &
            2 * nodes(:, 12) + nodes(:, 13) + nodes(:, 14))
       nodes_b(:, 8) = 0.0625_dp * ( &
            nodes(:, 2) + nodes(:, 3) + nodes(:, 6) + 3 * nodes(:, 7) + &
            2 * nodes(:, 8) + 2 * nodes(:, 10) + 3 * nodes(:, 11) + &
            nodes(:, 12) + nodes(:, 13) + nodes(:, 14))
       nodes_b(:, 9) = nodes_a(:, 14)
       nodes_b(:, 10) = 0.0625_dp * ( &
            nodes(:, 3) + 2 * nodes(:, 4) + nodes(:, 5) + 2 * nodes(:, 7) + &
            4 * nodes(:, 8) + 2 * nodes(:, 9) + nodes(:, 10) + &
            2 * nodes(:, 11) + nodes(:, 12))
       nodes_b(:, 11) = 0.0625_dp * ( &
            nodes(:, 2) + 2 * nodes(:, 3) + nodes(:, 4) + nodes(:, 6) + &
            3 * nodes(:, 7) + 3 * nodes(:, 8) + nodes(:, 9) + nodes(:, 10) + &
            2 * nodes(:, 11) + nodes(:, 12))
       nodes_b(:, 12) = nodes_a(:, 12)
       nodes_b(:, 13) = 0.0625_dp * ( &
            nodes(:, 2) + 3 * nodes(:, 3) + 3 * nodes(:, 4) + nodes(:, 5) + &
            nodes(:, 6) + 3 * nodes(:, 7) + 3 * nodes(:, 8) + nodes(:, 9))
       nodes_b(:, 14) = nodes_a(:, 9)
       nodes_b(:, 15) = nodes_a(:, 5)
       nodes_c(:, 1) = nodes_a(:, 5)
       nodes_c(:, 2) = 0.125_dp * ( &
            nodes(:, 2) + 3 * nodes(:, 3) + 3 * nodes(:, 4) + nodes(:, 5))
       nodes_c(:, 3) = 0.25_dp * ( &
            nodes(:, 3) + 2 * nodes(:, 4) + nodes(:, 5))
       nodes_c(:, 4) = 0.5_dp * ( &
            nodes(:, 4) + nodes(:, 5))
       nodes_c(:, 5) = nodes(:, 5)
       nodes_c(:, 6) = nodes_b(:, 13)
       nodes_c(:, 7) = 0.125_dp * ( &
            nodes(:, 3) + 2 * nodes(:, 4) + nodes(:, 5) + nodes(:, 7) + &
            2 * nodes(:, 8) + nodes(:, 9))
       nodes_c(:, 8) = 0.25_dp * ( &
            nodes(:, 4) + nodes(:, 5) + nodes(:, 8) + nodes(:, 9))
       nodes_c(:, 9) = 0.5_dp * (nodes(:, 5) + nodes(:, 9))
       nodes_c(:, 10) = nodes_b(:, 10)
       nodes_c(:, 11) = 0.125_dp * ( &
            nodes(:, 4) + nodes(:, 5) + 2 * nodes(:, 8) + 2 * nodes(:, 9) + &
            nodes(:, 11) + nodes(:, 12))
       nodes_c(:, 12) = 0.25_dp * ( &
            nodes(:, 5) + 2 * nodes(:, 9) + nodes(:, 12))
       nodes_c(:, 13) = nodes_b(:, 6)
       nodes_c(:, 14) = 0.125_dp * ( &
            nodes(:, 5) + 3 * nodes(:, 9) + 3 * nodes(:, 12) + nodes(:, 14))
       nodes_c(:, 15) = nodes_b(:, 1)
       nodes_d(:, 1) = nodes_a(:, 15)
       nodes_d(:, 2) = nodes_b(:, 4)
       nodes_d(:, 3) = nodes_b(:, 3)
       nodes_d(:, 4) = nodes_b(:, 2)
       nodes_d(:, 5) = nodes_b(:, 1)
       nodes_d(:, 6) = 0.125_dp * ( &
            nodes(:, 6) + 3 * nodes(:, 10) + 3 * nodes(:, 13) + nodes(:, 15))
       nodes_d(:, 7) = 0.125_dp * ( &
            nodes(:, 7) + nodes(:, 10) + 2 * nodes(:, 11) + &
            2 * nodes(:, 13) + nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 8) = 0.125_dp * ( &
            nodes(:, 8) + 2 * nodes(:, 11) + nodes(:, 12) + nodes(:, 13) + &
            2 * nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 9) = 0.125_dp * ( &
            nodes(:, 9) + 3 * nodes(:, 12) + 3 * nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 10) = 0.25_dp * ( &
            nodes(:, 10) + 2 * nodes(:, 13) + nodes(:, 15))
       nodes_d(:, 11) = 0.25_dp * ( &
            nodes(:, 11) + nodes(:, 13) + nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 12) = 0.25_dp * ( &
            nodes(:, 12) + 2 * nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 13) = 0.5_dp * (nodes(:, 13) + nodes(:, 15))
       nodes_d(:, 14) = 0.5_dp * (nodes(:, 14) + nodes(:, 15))
       nodes_d(:, 15) = nodes(:, 15)
    else
       call specialize_triangle( &
            num_nodes, dimension_, nodes, degree, &
            [1.0_dp, 0.0_dp, 0.0_dp], &
            [0.5_dp, 0.5_dp, 0.0_dp], &
            [0.5_dp, 0.0_dp, 0.5_dp], &
            nodes_a)
       call specialize_triangle( &
            num_nodes, dimension_, nodes, degree, &
            [0.0_dp, 0.5_dp, 0.5_dp], &
            [0.5_dp, 0.0_dp, 0.5_dp], &
            [0.5_dp, 0.5_dp, 0.0_dp], &
            nodes_b)
       call specialize_triangle( &
            num_nodes, dimension_, nodes, degree, &
            [0.5_dp, 0.5_dp, 0.0_dp], &
            [0.0_dp, 1.0_dp, 0.0_dp], &
            [0.0_dp, 0.5_dp, 0.5_dp], &
            nodes_c)
       call specialize_triangle( &
            num_nodes, dimension_, nodes, degree, &
            [0.5_dp, 0.0_dp, 0.5_dp], &
            [0.0_dp, 0.5_dp, 0.5_dp], &
            [0.0_dp, 0.0_dp, 1.0_dp], &
            nodes_d)
    end if

  end subroutine subdivide_nodes

  subroutine compute_edge_nodes( &
       num_nodes, dimension_, nodes, degree, nodes1, nodes2, nodes3) &
       bind(c, name='BEZ_compute_edge_nodes')

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(out) :: nodes1(dimension_, degree + 1)
    real(c_double), intent(out) :: nodes2(dimension_, degree + 1)
    real(c_double), intent(out) :: nodes3(dimension_, degree + 1)
    ! Variables outside of signature.
    integer(c_int) :: index1, index2, index3

    index2 = degree + 1
    index3 = num_nodes
    do index1 = 1, degree + 1
       nodes1(:, index1) = nodes(:, index1)
       nodes2(:, index1) = nodes(:, index2)
       nodes3(:, index1) = nodes(:, index3)
       ! Update the indices.
       index2 = index2 - index1 + degree + 1
       index3 = index3 - index1 - 1
    end do

  end subroutine compute_edge_nodes

  subroutine shoelace_for_area(num_nodes, nodes, shoelace, not_implemented)

    ! NOTE: This is a helper for ``compute_area()``.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: nodes(2, num_nodes)
    real(c_double), intent(out) :: shoelace
    logical(c_bool), intent(out) :: not_implemented

    not_implemented = .FALSE.
    if (num_nodes == 2) then
       shoelace = ( &
            nodes(1, 1) * nodes(2, 2) - nodes(2, 1) * nodes(1, 2))
       shoelace = shoelace / 2
    else if (num_nodes == 3) then
       shoelace = ( &
            2 * (nodes(1, 1) * nodes(2, 2) - nodes(2, 1) * nodes(1, 2)) + &
            (nodes(1, 1) * nodes(2, 3) - nodes(2, 1) * nodes(1, 3)) + &
            2 * (nodes(1, 2) * nodes(2, 3) - nodes(2, 2) * nodes(1, 3)))
       shoelace = shoelace / 6
    else if (num_nodes == 4) then
       shoelace = ( &
            6 * (nodes(1, 1) * nodes(2, 2) - nodes(2, 1) * nodes(1, 2)) + &
            3 * (nodes(1, 1) * nodes(2, 3) - nodes(2, 1) * nodes(1, 3)) + &
            (nodes(1, 1) * nodes(2, 4) - nodes(2, 1) * nodes(1, 4)) + &
            3 * (nodes(1, 2) * nodes(2, 3) - nodes(2, 2) * nodes(1, 3)) + &
            3 * (nodes(1, 2) * nodes(2, 4) - nodes(2, 2) * nodes(1, 4)) + &
            6 * (nodes(1, 3) * nodes(2, 4) - nodes(2, 3) * nodes(1, 4)))
       shoelace = shoelace / 20
    else if (num_nodes == 5) then
       shoelace = ( &
            20 * (nodes(1, 1) * nodes(2, 2) - nodes(2, 1) * nodes(1, 2)) + &
            10 * (nodes(1, 1) * nodes(2, 3) - nodes(2, 1) * nodes(1, 3)) + &
            4 * (nodes(1, 1) * nodes(2, 4) - nodes(2, 1) * nodes(1, 4)) + &
            (nodes(1, 1) * nodes(2, 5) - nodes(2, 1) * nodes(1, 5)) + &
            8 * (nodes(1, 2) * nodes(2, 3) - nodes(2, 2) * nodes(1, 3)) + &
            8 * (nodes(1, 2) * nodes(2, 4) - nodes(2, 2) * nodes(1, 4)) + &
            4 * (nodes(1, 2) * nodes(2, 5) - nodes(2, 2) * nodes(1, 5)) + &
            8 * (nodes(1, 3) * nodes(2, 4) - nodes(2, 3) * nodes(1, 4)) + &
            10 * (nodes(1, 3) * nodes(2, 5) - nodes(2, 3) * nodes(1, 5)) + &
            20 * (nodes(1, 4) * nodes(2, 5) - nodes(2, 4) * nodes(1, 5)))
       shoelace = shoelace / 70
    else
       shoelace = 0.0_dp
       not_implemented = .TRUE.
    end if

  end subroutine shoelace_for_area

  subroutine compute_area( &
       num_edges, sizes, nodes_pointers, area, not_implemented) &
       bind(c, name='BEZ_compute_area')

    integer(c_int), intent(in) :: num_edges
    integer(c_int), intent(in) :: sizes(num_edges)
    type(c_ptr), intent(in) :: nodes_pointers(num_edges)
    real(c_double), intent(out) :: area
    logical(c_bool), intent(out) :: not_implemented
    ! Variables outside of signature.
    integer(c_int) :: i
    real(c_double), pointer :: nodes(:, :)
    real(c_double) :: shoelace

    area = 0.0_dp
    do i = 1, num_edges
       call c_f_pointer(nodes_pointers(i), nodes, [2, sizes(i)])
       call shoelace_for_area(sizes(i), nodes, shoelace, not_implemented)
       if (not_implemented) then
          return
       else
          area = area + shoelace
       end if
    end do

  end subroutine compute_area

end module triangle


<|start_filename|>docs/abi/example_full_reduce.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 5;
    int dimension = 2;
    double nodes[10] = { 1.0, 3.0, 1.25, 3.5, 1.5, 4.0, 1.75, 4.5, 2.0, 5.0 };

    // Outputs.
    int num_reduced_nodes;
    double reduced[10];
    bool not_implemented;

    BEZ_full_reduce(&num_nodes, &dimension, nodes, &num_reduced_nodes, reduced,
        &not_implemented);
    printf("Number of reduced nodes: %d\n", num_reduced_nodes);
    printf("Reduced:\n");
    printf("%f, %f\n", reduced[0], reduced[2]);
    printf("%f, %f\n", reduced[1], reduced[3]);
    printf("Not implemented: %s\n", not_implemented ? "TRUE" : "FALSE");

    return 0;
}


<|start_filename|>src/fortran/include/bezier/curve_intersection.h<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#ifndef BEZIER_CURVE_INTERSECTION_H
#define BEZIER_CURVE_INTERSECTION_H

#include "bezier/status.h"
#include <stdbool.h>

#if defined(__cplusplus)
extern "C" {
#endif

typedef enum BoxIntersectionType {
    INTERSECTION = 0,
    TANGENT = 1,
    DISJOINT = 2,
} BoxIntersectionType;

void BEZ_newton_refine_curve_intersect(const double* s, const int* num_nodes1,
    const double* nodes1, const double* t, const int* num_nodes2,
    const double* nodes2, double* new_s, double* new_t, Status* status);
void BEZ_bbox_intersect(const int* num_nodes1, const double* nodes1,
    const int* num_nodes2, const double* nodes2, BoxIntersectionType* enum_);
void BEZ_curve_intersections(const int* num_nodes_first,
    const double* nodes_first, const int* num_nodes_second,
    const double* nodes_second, const int* intersections_size,
    double* intersections, const int* num_intersections, bool* coincident,
    Status* status);
void BEZ_free_curve_intersections_workspace(void);

#if defined(__cplusplus)
}
#endif

#endif /* BEZIER_CURVE_INTERSECTION_H */


<|start_filename|>tests/fortran/test_helpers.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module test_helpers

  use, intrinsic :: iso_c_binding, only: c_double, c_int, c_bool
  use helpers, only: &
       WIGGLE, cross_product, bbox, wiggle_interval, contains_nd, &
       vector_close, in_interval, in_sorted, convex_hull, polygon_collide, &
       solve2x2
  use types, only: dp
  use unit_test_helpers, only: MACHINE_EPS, print_status
  implicit none
  private &
       test_cross_product, test_bbox, test_wiggle_interval, &
       test_contains_nd, test_vector_close, test_in_interval, &
       test_in_sorted, test_convex_hull, test_polygon_collide, test_solve2x2
  public helpers_all_tests

contains

  subroutine helpers_all_tests(success)
    logical(c_bool), intent(inout) :: success

    call test_cross_product(success)
    call test_bbox(success)
    call test_wiggle_interval(success)
    call test_contains_nd(success)
    call test_vector_close(success)
    call test_in_interval(success)
    call test_in_sorted(success)
    call test_convex_hull(success)
    call test_polygon_collide(success)
    call test_solve2x2(success)

  end subroutine helpers_all_tests

  subroutine test_cross_product(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: vec0(2)
    real(c_double) :: vec1(2)
    real(c_double) :: result_
    integer :: case_id
    character(13) :: name

    case_id = 1
    name = "cross_product"

    ! CASE 1: Identical vector.
    vec0 = [1.0_dp, 7.0_dp] / 8
    vec1 = [-11.0_dp, 24.0_dp] / 32
    call cross_product(vec0, vec1, result_)
    case_success = (result_ == 101.0_dp / 256)
    call print_status(name, case_id, case_success, success)

  end subroutine test_cross_product

  subroutine test_bbox(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 2), nodes2(2, 6)
    real(c_double) :: left, right, bottom, top
    integer :: case_id
    character(4) :: name

    case_id = 1
    name = "bbox"

    ! CASE 1: Simple case (just two nodes).
    nodes1(:, 1) = [0.0_dp, 5.0_dp]
    nodes1(:, 2) = [1.0_dp, 3.0_dp]
    call bbox(2, nodes1, left, right, bottom, top)
    case_success = ( &
         left == 0.0_dp .AND. right == 1.0_dp &
         .AND. bottom == 3.0_dp .AND. top == 5.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: "Many" nodes.
    nodes2(:, 1) = [1.0_dp, 0.0_dp]
    nodes2(:, 2) = [2.0_dp, 1.0_dp]
    nodes2(:, 3) = [-1.0_dp, 2.0_dp]
    nodes2(:, 4) = [5.0_dp, -3.0_dp]
    nodes2(:, 5) = [4.0_dp, 4.0_dp]
    nodes2(:, 6) = [0.0_dp, 0.0_dp]
    call bbox(6, nodes2, left, right, bottom, top)
    case_success = ( &
         left == -1.0_dp .AND. right == 5.0_dp &
         .AND. bottom == -3.0_dp .AND. top == 4.0_dp)
    call print_status(name, case_id, case_success, success)

  end subroutine test_bbox

  subroutine test_wiggle_interval(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: value1, value2, value3, value4, value5
    real(c_double) :: result1, result2, result3, result4, result5
    logical(c_bool) :: &
         wiggle_success1, wiggle_success2, wiggle_success3, &
         wiggle_success4, wiggle_success5
    integer :: case_id
    character(15) :: name

    case_id = 1
    name = "wiggle_interval"

    ! CASE 1: **Exactly** at endpoint.
    value1 = 0.0_dp
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (wiggle_success1 .AND. result1 == 0.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Near endpoint.
    value1 = 1.0_dp + 0.5_dp**20
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (.NOT. wiggle_success1)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: "Below" the interval.
    value1 = -0.25_dp
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (.NOT. wiggle_success1)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: "Above" the interval.
    value1 = 1.5_dp
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (.NOT. wiggle_success1)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Inside the interval.
    value1 = 0.25_dp
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (wiggle_success1 .AND. result1 == value1)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Wiggle "below" the interval.
    value1 = -0.5_dp**60
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (wiggle_success1 .AND. result1 == 0.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Wiggle "above" the interval.
    value1 = 1.0_dp + MACHINE_EPS
    call wiggle_interval(value1, result1, wiggle_success1)
    case_success = (wiggle_success1 .AND. result1 == 1.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 8: Test "lower outer" boundary, i.e. values in (-epsilon, 0).
    value1 = -WIGGLE + MACHINE_EPS * WIGGLE
    value2 = -WIGGLE + MACHINE_EPS * WIGGLE / 2
    value3 = -WIGGLE
    value4 = -WIGGLE - MACHINE_EPS * WIGGLE
    call wiggle_interval(value1, result1, wiggle_success1)
    call wiggle_interval(value2, result2, wiggle_success2)
    call wiggle_interval(value3, result3, wiggle_success3)
    call wiggle_interval(value4, result4, wiggle_success4)
    case_success = ( &
         wiggle_success1 .AND. result1 == 0.0_dp .AND. &
         wiggle_success2 .AND. result2 == 0.0_dp .AND. &
         .NOT. wiggle_success3 .AND. .NOT. wiggle_success4)
    call print_status(name, case_id, case_success, success)

    ! CASE 9: Test "upper outer" boundary, i.e. values in (1, 1 + epsilon).
    value1 = 1.0_dp + WIGGLE - 2 * MACHINE_EPS
    value2 = 1.0_dp + WIGGLE - MACHINE_EPS
    value3 = 1.0_dp + WIGGLE
    value4 = 1.0_dp + WIGGLE + MACHINE_EPS
    call wiggle_interval(value1, result1, wiggle_success1)
    call wiggle_interval(value2, result2, wiggle_success2)
    call wiggle_interval(value3, result3, wiggle_success3)
    call wiggle_interval(value4, result4, wiggle_success4)
    case_success = ( &
         wiggle_success1 .AND. result1 == 1.0_dp .AND. &
         wiggle_success2 .AND. result2 == 1.0_dp .AND. &
         .NOT. wiggle_success3 .AND. .NOT. wiggle_success4)
    call print_status(name, case_id, case_success, success)

    ! CASE 10: Test "lower inner" boundary, i.e. values in (0, epsilon).
    value1 = WIGGLE - WIGGLE * MACHINE_EPS
    value2 = WIGGLE - WIGGLE * MACHINE_EPS / 2
    value3 = WIGGLE
    value4 = WIGGLE + WIGGLE * MACHINE_EPS
    call wiggle_interval(value1, result1, wiggle_success1)
    call wiggle_interval(value2, result2, wiggle_success2)
    call wiggle_interval(value3, result3, wiggle_success3)
    call wiggle_interval(value4, result4, wiggle_success4)
    case_success = ( &
         wiggle_success1 .AND. result1 == 0.0_dp .AND. &
         wiggle_success2 .AND. result2 == 0.0_dp .AND. &
         wiggle_success3 .AND. result3 == value3 .AND. &
         wiggle_success4 .AND. result4 == value4)
    call print_status(name, case_id, case_success, success)

    ! CASE 11: Test "uper inner" boundary, i.e. values in (1 - epsilon, 1).
    value1 = 1.0_dp - WIGGLE - MACHINE_EPS
    value2 = 1.0_dp - WIGGLE - MACHINE_EPS / 2
    value3 = 1.0_dp - WIGGLE
    value4 = 1.0_dp - WIGGLE + MACHINE_EPS / 2
    value5 = 1.0_dp - WIGGLE + MACHINE_EPS
    call wiggle_interval(value1, result1, wiggle_success1)
    call wiggle_interval(value2, result2, wiggle_success2)
    call wiggle_interval(value3, result3, wiggle_success3)
    call wiggle_interval(value4, result4, wiggle_success4)
    call wiggle_interval(value5, result5, wiggle_success5)
    case_success = ( &
         wiggle_success1 .AND. result1 == value1 .AND. &
         wiggle_success2 .AND. result2 == value2 .AND. &
         wiggle_success3 .AND. result3 == value3 .AND. &
         wiggle_success4 .AND. result4 == 1.0_dp .AND. &
         wiggle_success5 .AND. result5 == 1.0_dp)
    call print_status(name, case_id, case_success, success)

  end subroutine test_wiggle_interval

  subroutine test_contains_nd(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: nodes1(2, 3), nodes2(3, 2), nodes3(4, 2)
    real(c_double) :: point1(2), point2(3), point3(4)
    logical(c_bool) :: is_contained
    integer :: case_id
    character(11) :: name

    case_id = 1
    name = "contains_nd"

    ! CASE 1: Below bounding box.
    nodes1(:, 1) = [0.0_dp, 1.0_dp]
    nodes1(:, 2) = [0.5_dp, 0.0_dp]
    nodes1(:, 3) = [1.0_dp, 2.0_dp]
    point1 = [-0.5_dp, 1.0_dp]
    call contains_nd(3, 2, nodes1, point1, is_contained)
    case_success = (.NOT. is_contained)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Above bounding box.
    nodes2(:, 1) = [0.0_dp, -4.0_dp, 2.0_dp]
    nodes2(:, 2) = [-1.0_dp, 1.0_dp, 3.0_dp]
    point2 = [-0.5_dp, 2.0_dp, 2.5_dp]
    call contains_nd(2, 3, nodes2, point2, is_contained)
    case_success = (.NOT. is_contained)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Inside bounding box.
    nodes3(:, 1) = [0.0_dp, 1.0_dp, 2.0_dp, 3.0_dp]
    nodes3(:, 2) = [1.0_dp, -2.0_dp, -4.0_dp, 1.0_dp]
    point3 = [0.5_dp, 0.0_dp, 0.0_dp, 2.0_dp]
    call contains_nd(2, 4, nodes3, point3, is_contained)
    case_success = (is_contained)
    call print_status(name, case_id, case_success, success)

  end subroutine test_contains_nd

  subroutine test_vector_close(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    real(c_double) :: eps
    real(c_double) :: vec1(2)
    real(c_double) :: vec2(2)
    logical(c_bool) :: is_close
    integer :: case_id
    character(12) :: name

    eps = 0.5_dp**40
    case_id = 1
    name = "vector_close"

    ! CASE 1: Identical vector.
    vec1 = [0.5_dp, 4.0_dp]
    is_close = vector_close(2, vec1, vec1, eps)
    case_success = (is_close)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Far apart vectors.
    vec1 = [0.0_dp, 6.0_dp]
    vec2 = [1.0_dp, -4.0_dp]
    is_close = vector_close(2, vec1, vec2, eps)
    case_success = (.NOT. is_close)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Close but different.
    vec1 = [2.25_dp, -3.5_dp]
    vec2 = vec1 + 0.5_dp**43 * [-5.0_dp, 12.0_dp]
    is_close = vector_close(2, vec1, vec2, eps)
    case_success = (is_close)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Custom epsilon.
    vec1 = [3.0_dp, 4.0_dp]
    vec2 = [2.0_dp, 5.0_dp]
    is_close = vector_close(2, vec1, vec2, 0.5_dp)
    case_success = (is_close .AND. .NOT. vector_close(2, vec1, vec2, eps))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Near zero.
    vec1 = [0.0_dp, 0.0_dp]
    vec2 = 0.5_dp**45 * [3.0_dp, 4.0_dp]
    is_close = vector_close(2, vec1, vec2, eps)
    case_success = (is_close)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: Near zero failure (i.e. not near enough).
    vec1 = 0.5_dp**20 * [1.0_dp, 0.0_dp]
    vec2 = [0.0_dp, 0.0_dp]
    is_close = vector_close(2, vec1, vec2, eps)
    case_success = (.NOT. is_close)
    call print_status(name, case_id, case_success, success)

  end subroutine test_vector_close

  subroutine test_in_interval(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    logical(c_bool) :: is_inside
    integer :: case_id
    character(11) :: name

    case_id = 1
    name = "in_interval"

    ! CASE 1: Interior value.
    is_inside = in_interval(1.5_dp, 1.0_dp, 2.0_dp)
    case_success = (is_inside)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Barely inside.
    is_inside = in_interval(1.0_dp + MACHINE_EPS, 1.0_dp, 2.0_dp)
    case_success = (is_inside)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Barely outside.
    is_inside = in_interval(1.0_dp - MACHINE_EPS / 2, 1.0_dp, 2.0_dp)
    case_success = (.NOT. is_inside)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Exterior value.
    is_inside = in_interval(-1.0_dp, 1.0_dp, 2.0_dp)
    case_success = (.NOT. is_inside)
    call print_status(name, case_id, case_success, success)

  end subroutine test_in_interval

  subroutine test_in_sorted(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer(c_int) :: values(5)
    integer :: case_id
    character(9) :: name

    case_id = 1
    name = "in_sorted"

    ! CASE 1: Inside the interval.
    values = [0, 5, 8, 12, 17]
    case_success = ( &
         .NOT. in_sorted(5, values, 4) .AND. &
         in_sorted(5, values, 5) .AND. &
         .NOT. in_sorted(5, values, 6) .AND. &
         .NOT. in_sorted(5, values, 7) .AND. &
         in_sorted(5, values, 8) .AND. &
         .NOT. in_sorted(5, values, 9) .AND. &
         .NOT. in_sorted(5, values, 10) .AND. &
         .NOT. in_sorted(5, values, 11) .AND. &
         in_sorted(5, values, 12) .AND. &
         .NOT. in_sorted(5, values, 13))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Near the left endpoint.
    values(:3) = [9, 11, 220]
    case_success = ( &
         .NOT. in_sorted(3, values(:3), 7) .AND. &
         .NOT. in_sorted(3, values(:3), 8) .AND. &
         in_sorted(3, values(:3), 9) .AND. &
         .NOT. in_sorted(3, values(:3), 10))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Near the right endpoint.
    values(:3) = [16, 18, 20]
    case_success = ( &
         .NOT. in_sorted(3, values(:3), 19) .AND. &
         in_sorted(3, values(:3), 20) .AND. &
         .NOT. in_sorted(3, values(:3), 21) .AND. &
         .NOT. in_sorted(3, values(:3), 22))
    call print_status(name, case_id, case_success, success)

  end subroutine test_in_sorted

  subroutine test_convex_hull(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double) :: points1(2, 5), points2(2, 2), points3(2, 100)
    integer(c_int) :: polygon_size, i, j
    real(c_double) :: polygon(2, 100)
    character(11) :: name

    case_id = 1
    name = "convex_hull"

    ! CASE 1: Triangle with centroid (i.e. inside) and a repeated corner.
    points1(1, :) = [0.0_dp, 0.0_dp, 1.0_dp, 3.0_dp, 0.0_dp]
    points1(2, :) = [0.0_dp, 3.0_dp, 1.0_dp, 0.0_dp, 3.0_dp]
    call convex_hull(5, points1, polygon_size, polygon(:, :5))
    case_success = ( &
         polygon_size == 3 .AND. &
         all(polygon(1, :3) == [0.0_dp, 3.0_dp, 0.0_dp]) .AND. &
         all(polygon(2, :3) == [0.0_dp, 0.0_dp, 3.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Degenerate case (2 points, i.e. the "polygon" is just a line).
    points2(1, :) = [0.0_dp, 1.0_dp]
    points2(2, :) = [0.0_dp, 0.0_dp]
    call convex_hull(2, points2, polygon_size, polygon(:, :2))
    case_success = ( &
         polygon_size == 2 .AND. &
         all(polygon(1, :2) == [0.0_dp, 1.0_dp]) .AND. &
         all(polygon(2, :2) == [0.0_dp, 0.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Same as CASE 2, but points are in reverse order.
    points2(1, :) = [1.0_dp, 0.0_dp]
    points2(2, :) = [0.0_dp, 0.0_dp]
    call convex_hull(2, points2, polygon_size, polygon(:, :2))
    case_success = ( &
         polygon_size == 2 .AND. &
         all(polygon(1, :2) == [0.0_dp, 1.0_dp]) .AND. &
         all(polygon(2, :2) == [0.0_dp, 0.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 4: 10-by-10 grid of points. Also covers case where ``polygon`` is
    !         allocated but not large enough.
    do i = 1, 10
       do j = 1, 10
          points3(1, 10 * (i - 1) + j) = j
          points3(2, 10 * (i - 1) + j) = i
       end do
    end do
    call convex_hull(100, points3, polygon_size, polygon)
    case_success = ( &
         polygon_size == 4 .AND. &
         all(polygon(1, :4) == [1.0_dp, 10.0_dp, 10.0_dp, 1.0_dp]) .AND. &
         all(polygon(2, :4) == [1.0_dp, 1.0_dp, 10.0_dp, 10.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 5: No points (degenerate case).
    call convex_hull(0, points1(:, :0), polygon_size, polygon(:, :0))
    case_success = (polygon_size == 0)
    call print_status(name, case_id, case_success, success)

    ! CASE 6: One point (degenerate case).
    points1(:, 1) = [2.0_dp, 3.0_dp]
    call convex_hull(1, points1(:, :1), polygon_size, polygon(:, :1))
    case_success = ( &
         polygon_size == 1 .AND. &
         all(polygon(1, :1) == [2.0_dp]) .AND. &
         all(polygon(2, :1) == [3.0_dp]))
    call print_status(name, case_id, case_success, success)

    ! CASE 7: Almost linear. In a previous implementation, this caused
    !         an illegal memory access because the middle point of the
    !         "line" was placed in both the upper and lower hull (which used
    !         4 points for the hull when only 3 were allocated).
    points1(1, 1) = -2320058418903481.0_dp * 0.5_dp**54
    points1(1, 2) = -6216142699324449.0_dp * 0.5_dp**56
    points1(1, 3) = -6304103446069947.0_dp * 0.5_dp**57
    points1(2, 1) = -1911920978562235.0_dp * 0.5_dp**55
    points1(2, 2) = -461442255594807.0_dp * 0.5_dp**57
    points1(2, 3) = 6724799403059327.0_dp * 0.5_dp**57

    call convex_hull(3, points1(:, :3), polygon_size, polygon(:, :3))
    case_success = ( &
         polygon_size == 3 .AND. &
         all(polygon(:, :3) == points1(:, :3)))
    call print_status(name, case_id, case_success, success)

  end subroutine test_convex_hull

  subroutine test_polygon_collide(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double) :: polygon1(2, 3), polygon2(2, 4), polygon3(2, 4)
    logical(c_bool) :: collision
    character(15) :: name

    case_id = 1
    name = "polygon_collide"

    ! CASE 1: Triangle and square that do not collide.
    polygon1(1, :) = [1.0_dp, 3.0_dp, -2.0_dp]
    polygon1(2, :) = [1.0_dp, 4.0_dp, 2.0_dp]
    polygon2(1, :) = [3.5_dp, 6.5_dp, 6.5_dp, 3.5_dp]
    polygon2(2, :) = [3.0_dp, 3.0_dp, 7.0_dp, 7.0_dp]
    call polygon_collide(3, polygon1, 4, polygon2, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Same as CASE 1 but with polygons swapped.
    call polygon_collide(4, polygon2, 3, polygon1, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Triangles that do collide.
    polygon1(1, :) = [0.0_dp, 3.0_dp, 0.0_dp]
    polygon1(2, :) = [0.0_dp, 0.0_dp, 3.0_dp]
    polygon2(1, :3) = [1.0_dp, 4.0_dp, 1.0_dp]
    polygon2(2, :3) = [1.0_dp, 1.0_dp, 4.0_dp]
    call polygon_collide(3, polygon1, 3, polygon2(:, :3), collision)
    case_success = (collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Two squares where an edge other than edge 1 in polygon 1 is
    !         the separating line.
    polygon2(1, :) = [1.0_dp, 1.0_dp, 0.0_dp, 0.0_dp]
    polygon2(2, :) = [0.0_dp, 1.0_dp, 1.0_dp, 0.0_dp]
    polygon3(1, :) = [2.0_dp, 3.0_dp, 3.0_dp, 2.0_dp]
    polygon3(2, :) = [0.0_dp, 0.0_dp, 1.0_dp, 1.0_dp]
    call polygon_collide(4, polygon2, 4, polygon3, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Square and triangle where none of the edges in polygon 1 are
    !         separating lines and an edge other than edge 1 in polygon 2
    !         **is** the separating line.
    polygon2(1, :) = [0.0_dp, 2.0_dp, 2.0_dp, 0.0_dp]
    polygon2(2, :) = [0.0_dp, 0.0_dp, 2.0_dp, 2.0_dp]
    polygon1(1, :) = [1.0_dp, 4.0_dp, 4.0_dp]
    polygon1(2, :) = [4.0_dp, 1.0_dp, 4.0_dp]
    call polygon_collide(4, polygon2, 3, polygon1, collision)
    case_success = (.NOT. collision)
    call print_status(name, case_id, case_success, success)

  end subroutine test_polygon_collide

  subroutine test_solve2x2(success)
    logical(c_bool), intent(inout) :: success
    ! Variables outside of signature.
    logical :: case_success
    integer :: case_id
    real(c_double) :: lhs(2, 2), rhs(2), x_val, y_val
    logical(c_bool) :: singular
    character(8) :: name

    case_id = 1
    name = "solve2x2"

    ! CASE 1: Solve without a row-swap.
    lhs(:, 1) = [2.0_dp, 1.0_dp]
    lhs(:, 2) = [3.0_dp, 2.0_dp]
    rhs = [31.0_dp, 19.0_dp]
    call solve2x2(lhs, rhs, singular, x_val, y_val)
    case_success = ( &
         .NOT. singular .AND. &
         x_val == 5.0_dp .AND. &
         y_val == 7.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 2: Solve with a row-swap.
    lhs(:, 1) = [1.0_dp, 4.0_dp]
    lhs(:, 2) = [0.0_dp, 1.0_dp]
    rhs = [3.0_dp, 13.0_dp]
    call solve2x2(lhs, rhs, singular, x_val, y_val)
    case_success = ( &
         .NOT. singular .AND. &
         x_val == 3.0_dp .AND. &
         y_val == 1.0_dp)
    call print_status(name, case_id, case_success, success)

    ! CASE 3: Singular due to first column all zero.
    lhs(:, 1) = 0
    call solve2x2(lhs, rhs, singular, x_val, y_val)
    case_success = singular
    call print_status(name, case_id, case_success, success)

    ! CASE 4: Singular without a row-swap.
    lhs(:, 1) = [2.0_dp, 1.0_dp]
    lhs(:, 2) = [4.0_dp, 2.0_dp]
    call solve2x2(lhs, rhs, singular, x_val, y_val)
    case_success = singular
    call print_status(name, case_id, case_success, success)

    ! CASE 5: Singular with a row-swap.
    lhs(:, 1) = [3.0_dp, 12.0_dp]
    lhs(:, 2) = [1.0_dp, 4.0_dp]
    call solve2x2(lhs, rhs, singular, x_val, y_val)
    case_success = singular
    call print_status(name, case_id, case_success, success)

  end subroutine test_solve2x2

end module test_helpers


<|start_filename|>src/fortran/status.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module status

  use, intrinsic :: iso_c_binding, only: c_int
  implicit none
  private
  public &
       Status_SUCCESS, Status_BAD_MULTIPLICITY, Status_NO_CONVERGE, &
       Status_INSUFFICIENT_SPACE, Status_SAME_CURVATURE, Status_BAD_INTERIOR, &
       Status_EDGE_END, Status_SINGULAR, Status_UNKNOWN

  ! Values of Status enum:
  ! SUCCESS: Procedure exited with no error.
  integer(c_int), parameter :: Status_SUCCESS = 0
  ! BAD_MULTIPLICITY: An iterative method (e.g. Newton's method) failed to
  !                   converge because it encountered a solution with an
  !                   unsupported multiplicity (i.e. it was a triple root or
  !                   higher). The multiplicity is detected by the observed
  !                   rate of convergence. (Used by
  !                   ``curve_intersection.full_newton_nonzero()``.)
  integer(c_int), parameter :: Status_BAD_MULTIPLICITY = 1
  ! NO_CONVERGE: An iterative method failed to converge in the maximum allowed
  !              number of iterations. (Used by
  !              ``curve_intersection.all_intersections()``.)
  integer(c_int), parameter :: Status_NO_CONVERGE = 2
  ! INSUFFICIENT_SPACE: Intended to be used by ABI versions of procedures. This
  !                     will be used when the caller has not allocated enough
  !                     space for the output values. (On the Fortran side, an
  !                     ``allocatable`` array can be resized, but in the ABI,
  !                     we can only use what the caller has passed.)
  integer(c_int), parameter :: Status_INSUFFICIENT_SPACE = 3
  ! SAME_CURVATURE: Classification of a curve-curve intersection failed due to
  !                 two curves having identical at a tangent intersection.
  integer(c_int), parameter :: Status_SAME_CURVATURE = 4
  ! BAD_INTERIOR: Caused by a failure during the process of triangle-triangle
  !               intersection. Occurs when the corners and edge-edge
  !               intersections can't be converted into the curved polygon(s)
  !               that make up the intersection of the two triangles.
  integer(c_int), parameter :: Status_BAD_INTERIOR = 5
  ! EDGE_END: A triangle-triangle intersection point occurs at the **end** of
  !           an edge (only intersections at the beginning of an edge should
  !           be used).
  integer(c_int), parameter :: Status_EDGE_END = 6
  ! SINGULAR: Signifies that an attempt was made to solve a linear system
  !           that was singular.
  integer(c_int), parameter :: Status_SINGULAR = 7
  ! UNKNOWN: Signifies a block of code reached an "impossible" state. Either
  !          the code has violated some mathematical invariant or the author
  !          of that block of code misunderstood the possible states of the
  !          system.
  integer(c_int), parameter :: Status_UNKNOWN = 999

end module status


<|start_filename|>tests/fortran/functional_test_helpers.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module functional_test_helpers

  use, intrinsic :: iso_c_binding, only: c_double, c_int, c_bool
  use types, only: dp
  use status, only: &
       Status_SUCCESS, Status_BAD_MULTIPLICITY, Status_NO_CONVERGE, &
       Status_SAME_CURVATURE, Status_BAD_INTERIOR, Status_EDGE_END, &
       Status_SINGULAR, Status_UNKNOWN
  use curve_intersection, only: &
       all_intersections, free_curve_intersections_workspace
  implicit none
  private CURVE_INTERSECTIONS, max_ulp, show_curve_intersect_result, sort_vals
  public intersect_and_check, clean_up

  real(c_double), allocatable :: CURVE_INTERSECTIONS(:, :)

contains

  integer(c_int) function max_ulp(m, n, guess, known) result(ulp_err)
    integer(c_int), intent(in) :: m, n
    real(c_double), intent(in) :: guess(m, n)
    real(c_double), intent(in) :: known(m, n)
    ! Variables outside of signature.
    real(c_double) :: rel_errs(m, n)

    if (m == 0 .OR. n == 0) then
       ulp_err = 0
       return
    end if

    rel_errs = guess - known
    where (known == 0.0_dp)
       where (guess == 0.0_dp)
          rel_errs = 0.0_dp
       elsewhere (abs(guess) < 1.0_dp)
          rel_errs = exponent(guess) - 1
       elsewhere
          rel_errs = HUGE(ulp_err)
       end where
    elsewhere
       rel_errs = abs(rel_errs / spacing(known))
    end where

    ulp_err = minval(rel_errs)
    if (ulp_err >= 0) then
       ulp_err = maxval(rel_errs)
    end if

  end function max_ulp

  subroutine show_curve_intersect_result( &
       case_id, status, actual_n, expected_n, known)

    integer(c_int), intent(in) :: case_id, status, actual_n, expected_n
    real(c_double), intent(in) :: known(2, expected_n)
    ! Variables outside of signature.
    integer(c_int) :: ulp_err

    if (status == Status_SUCCESS) then
       if (actual_n == expected_n) then
          ulp_err = max_ulp( &
               2, expected_n, CURVE_INTERSECTIONS(:, :expected_n), known)
          write (*, '(A, I2, A, I0, A, I0)') &
               "Case ", &
               case_id, &
               " (success): num_intersections = ", &
               expected_n, &
               ", Max ULP error = ", &
               ulp_err
       else
          write (*, '(A, I2, A, I0, A, I0, A)') &
               "Case ", &
               case_id, &
               " (failure): ", &
               actual_n, &
               " intersections (expected ", &
               expected_n, &
               ")"
       end if
    else if (status == Status_NO_CONVERGE) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): NO_CONVERGE"
    else if (status == Status_BAD_MULTIPLICITY) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): BAD_MULTIPLICITY"
    else if (status == Status_SAME_CURVATURE) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): SAME_CURVATURE"
    else if (status == Status_BAD_INTERIOR) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): BAD_INTERIOR"
    else if (status == Status_EDGE_END) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): EDGE_END"
    else if (status == Status_SINGULAR) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): SINGULAR"
    else if (status == Status_UNKNOWN) then
       write (*, '(A, I2, A)') &
            "Case ", &
            case_id, &
            " (failure): UNKNOWN"
    else
       write (*, '(A, I2, A, I0, A)') &
            "Case ", &
            case_id, &
            " (failure): ", &
            status, &
            " intersection candidates"
    end if

  end subroutine show_curve_intersect_result

  subroutine sort_vals(n, status)
    ! Sort by the first row.

    integer(c_int), intent(in) :: n
    integer(c_int), intent(in) :: status
    ! Variables outside of signature.
    real(c_double) :: swap(2)
    integer(c_int) :: i, w

    if (status /= Status_SUCCESS) then
       return
    end if

    do i = 1, n
       w = minloc(CURVE_INTERSECTIONS(1, i:n), 1)
       if (w /= 1) then
          swap = CURVE_INTERSECTIONS(:, i + w - 1)
          CURVE_INTERSECTIONS(:, i + w - 1) = CURVE_INTERSECTIONS(:, i)
          CURVE_INTERSECTIONS(:, i) = swap
       end if
    end do

  end subroutine sort_vals

  subroutine intersect_and_check( &
       case_id, num_nodes1, nodes1, num_nodes2, nodes2, &
       expected_n, expected_params)

    integer(c_int), intent(in) :: case_id
    integer(c_int), intent(in) :: num_nodes1
    real(c_double), intent(in) :: nodes1(2, num_nodes1)
    integer(c_int), intent(in) :: num_nodes2
    real(c_double), intent(in) :: nodes2(2, num_nodes2)
    integer(c_int), intent(in) :: expected_n
    real(c_double), intent(in) :: expected_params(2, expected_n)
    ! Variables outside of signature.
    integer(c_int) :: num_intersections, status
    logical(c_bool) :: unused_coincident

    call all_intersections( &
         num_nodes1, nodes1, &
         num_nodes2, nodes2, &
         CURVE_INTERSECTIONS, num_intersections, &
         unused_coincident, status)
    call sort_vals(num_intersections, status)
    call show_curve_intersect_result( &
         case_id, status, num_intersections, expected_n, expected_params)

  end subroutine intersect_and_check

  subroutine clean_up()
    if (allocated(CURVE_INTERSECTIONS)) then
       deallocate(CURVE_INTERSECTIONS)
    end if
    call free_curve_intersections_workspace()
  end subroutine clean_up

end module functional_test_helpers


<|start_filename|>src/fortran/triangle_intersection.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module triangle_intersection

  use, intrinsic :: iso_c_binding, only: c_double, c_int, c_bool
  use status, only: &
       Status_SUCCESS, Status_INSUFFICIENT_SPACE, Status_SAME_CURVATURE, &
       Status_BAD_INTERIOR, Status_EDGE_END, Status_UNKNOWN
  use curve, only: CurveData, LOCATE_MISS, evaluate_hodograph, get_curvature
  use curve_intersection, only: &
       BoxIntersectionType_INTERSECTION, INTERSECTIONS_WORKSPACE, &
       bbox_intersect, all_intersections
  use helpers, only: cross_product, contains_nd, vector_close
  use types, only: dp
  use triangle, only: &
       evaluate_barycentric, jacobian_both, subdivide_nodes, compute_edge_nodes
  implicit none
  private &
       LocateCandidate, &
       MAX_LOCATE_SUBDIVISIONS, LOCATE_EPS, MAX_EDGES, &
       ALMOST_TANGENT, SEGMENT_ENDS_WORKSPACE, SEGMENTS_WORKSPACE, &
       newton_refine_solve, split_candidate, allocate_candidates, &
       update_candidates, ignored_edge_corner, ignored_double_corner, &
       ignored_corner, classify_tangent_intersection, &
       no_intersections, remove_node, finalize_segment, &
       check_contained
  public &
       Intersection, CurvedPolygonSegment, IntersectionClassification_UNSET, &
       IntersectionClassification_FIRST, IntersectionClassification_SECOND, &
       IntersectionClassification_OPPOSED, &
       IntersectionClassification_TANGENT_FIRST, &
       IntersectionClassification_TANGENT_SECOND, &
       IntersectionClassification_IGNORED_CORNER, &
       IntersectionClassification_TANGENT_BOTH, &
       IntersectionClassification_COINCIDENT, &
       IntersectionClassification_COINCIDENT_UNUSED, &
       TriangleContained_NEITHER, &
       TriangleContained_FIRST, TriangleContained_SECOND, newton_refine, &
       locate_point, classify_intersection, update_edge_end_unused, &
       find_corner_unused, add_st_vals, should_keep, &
       triangles_intersection_points, is_first, is_second, &
       get_next, to_front, add_segment, &
       interior_combine, triangles_intersect, triangles_intersect_abi, &
       free_triangle_intersections_workspace

  integer(c_int), parameter :: IntersectionClassification_UNSET = -99

  ! NOTE: This (for now) is not meant to be C-interoperable.
  type :: Intersection
     real(c_double) :: s = -1.0_dp
     real(c_double) :: t = -1.0_dp
     integer(c_int) :: index_first = -1
     integer(c_int) :: index_second = -1
     integer(c_int) :: interior_curve = IntersectionClassification_UNSET
  end type Intersection

  ! For ``locate_point``; this is not meant to be C-interoperable.
  type :: LocateCandidate
     real(c_double) :: centroid_x = 1.0_dp  ! Actually triple.
     real(c_double) :: centroid_y = 1.0_dp  ! Actually triple.
     real(c_double) :: width = 1.0_dp
     real(c_double), allocatable :: nodes(:, :)
  end type LocateCandidate

  type, bind(c) :: CurvedPolygonSegment
     real(c_double) :: start
     real(c_double) :: end_
     integer(c_int) :: edge_index
  end type CurvedPolygonSegment

  ! NOTE: These values are also defined in equivalent Python source.
  integer(c_int), parameter :: MAX_LOCATE_SUBDIVISIONS = 20
  real(c_double), parameter :: LOCATE_EPS = 0.5_dp**47
  integer(c_int), parameter :: MAX_EDGES = 10
  ! Values of IntersectionClassification enum. These values must be
  ! non-negative, they will be used as exponents for "bit flip" check.
  ! There is a "special" ``UNSET`` value which won't actually be used
  ! after a classification is finalized. See:
  integer(c_int), parameter :: IntersectionClassification_FIRST = 0
  integer(c_int), parameter :: IntersectionClassification_SECOND = 1
  integer(c_int), parameter :: IntersectionClassification_OPPOSED = 2
  integer(c_int), parameter :: IntersectionClassification_TANGENT_FIRST = 3
  integer(c_int), parameter :: IntersectionClassification_TANGENT_SECOND = 4
  integer(c_int), parameter :: IntersectionClassification_IGNORED_CORNER = 5
  integer(c_int), parameter :: IntersectionClassification_TANGENT_BOTH = 6
  integer(c_int), parameter :: IntersectionClassification_COINCIDENT = 7
  integer(c_int), parameter :: IntersectionClassification_COINCIDENT_UNUSED = 8
  ! Values of TriangleContained enum:
  integer(c_int), parameter :: TriangleContained_NEITHER = 0
  integer(c_int), parameter :: TriangleContained_FIRST = 1
  integer(c_int), parameter :: TriangleContained_SECOND = 2
  ! Threshold where a vector cross-product (u x v) is considered
  ! to be "zero". This is a "hack", since it doesn't take ||u||
  ! or ||v|| into account.
  real(c_double), parameter :: ALMOST_TANGENT = 0.5_dp**50
  ! Long-lived workspaces for ``triangles_intersect_abi()``. If multiple
  ! threads are used, each of these **should** be thread-local.
  integer(c_int), allocatable :: SEGMENT_ENDS_WORKSPACE(:)
  type(CurvedPolygonSegment), allocatable :: SEGMENTS_WORKSPACE(:)

contains

  subroutine newton_refine_solve( &
       jac_both, x_val, triangle_x, y_val, triangle_y, delta_s, delta_t)

    ! NOTE: This is a helper for ``newton_refine``.

    real(c_double), intent(in) :: jac_both(4, 1)
    real(c_double), intent(in) :: x_val, triangle_x
    real(c_double), intent(in) :: y_val, triangle_y
    real(c_double), intent(out) :: delta_s, delta_t
    ! Variables outside of signature.
    real(c_double) :: e_val, f_val, denominator

    e_val = x_val - triangle_x
    f_val = y_val - triangle_y
    denominator = ( &
         jac_both(1, 1) * jac_both(4, 1) - jac_both(2, 1) * jac_both(3, 1))
    delta_s = (jac_both(4, 1) * e_val - jac_both(3, 1) * f_val) / denominator
    delta_t = (jac_both(1, 1) * f_val - jac_both(2, 1) * e_val) / denominator

  end subroutine newton_refine_solve

  subroutine newton_refine( &
       num_nodes, nodes, degree, x_val, y_val, &
       s, t, updated_s, updated_t) &
       bind(c, name='BEZ_newton_refine_triangle')

    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: nodes(2, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(in) :: x_val, y_val
    real(c_double), intent(in) :: s, t
    real(c_double), intent(out) :: updated_s, updated_t
    ! Variables outside of signature.
    real(c_double) :: point(2, 1), jac_both(4, 1)
    real(c_double) :: jac_nodes(4, num_nodes - degree - 1)
    real(c_double) :: delta_s, delta_t

    call evaluate_barycentric( &
         num_nodes, 2, nodes, degree, &
         1.0_dp - s - t, s, t, point)

    if (point(1, 1) == x_val .AND. point(2, 1) == y_val) then
       ! No refinement is needed.
       updated_s = s
       updated_t = t
       return
    end if

    call jacobian_both( &
         num_nodes, 2, nodes, degree, jac_nodes)
    call evaluate_barycentric( &
         num_nodes - degree - 1, 4, jac_nodes, degree - 1, &
         1.0_dp - s - t, s, t, jac_both)
    call newton_refine_solve( &
         jac_both, x_val, point(1, 1), &
         y_val, point(2, 1), delta_s, delta_t)
    updated_s = s + delta_s
    updated_t = t + delta_t

  end subroutine newton_refine

  subroutine split_candidate( &
       num_nodes, degree, candidate, num_next_candidates, next_candidates)

    ! NOTE: This assumes nodes are 2-dimensional.
    ! NOTE: This assumes that the nodes in each sub-candidate are
    !       not yet allocated.

    integer(c_int), intent(in) :: num_nodes
    integer(c_int), intent(in) :: degree
    type(LocateCandidate), intent(in) :: candidate
    integer(c_int), intent(in) :: num_next_candidates
    type(LocateCandidate), intent(inout) :: next_candidates(:)
    ! Variables outside of signature.
    real(c_double) :: half_width

    ! Allocate the new nodes and call sub-divide.
    ! NOTE: This **assumes** but does not check that if the nodes are
    !       allocated, they are also the correct shape.
    if (.NOT. allocated(next_candidates(num_next_candidates - 3)%nodes)) then
       allocate(next_candidates(num_next_candidates - 3)%nodes(2, num_nodes))
    end if
    if (.NOT. allocated(next_candidates(num_next_candidates - 2)%nodes)) then
       allocate(next_candidates(num_next_candidates - 2)%nodes(2, num_nodes))
    end if
    if (.NOT. allocated(next_candidates(num_next_candidates - 1)%nodes)) then
       allocate(next_candidates(num_next_candidates - 1)%nodes(2, num_nodes))
    end if
    if (.NOT. allocated(next_candidates(num_next_candidates)%nodes)) then
       allocate(next_candidates(num_next_candidates)%nodes(2, num_nodes))
    end if

    call subdivide_nodes( &
         num_nodes, 2, candidate%nodes, degree, &
         next_candidates(num_next_candidates - 3)%nodes, &
         next_candidates(num_next_candidates - 2)%nodes, &
         next_candidates(num_next_candidates - 1)%nodes, &
         next_candidates(num_next_candidates)%nodes)

    half_width = 0.5_dp * candidate%width

    ! Subdivision A.
    next_candidates(num_next_candidates - 3)%centroid_x = ( &
         candidate%centroid_x - half_width)
    next_candidates(num_next_candidates - 3)%centroid_y = ( &
         candidate%centroid_y - half_width)
    next_candidates(num_next_candidates - 3)%width = half_width

    ! Subdivision B.
    next_candidates(num_next_candidates - 2)%centroid_x = candidate%centroid_x
    next_candidates(num_next_candidates - 2)%centroid_y = candidate%centroid_y
    next_candidates(num_next_candidates - 2)%width = -half_width

    ! Subdivision C.
    next_candidates(num_next_candidates - 1)%centroid_x = ( &
         candidate%centroid_x + candidate%width)
    next_candidates(num_next_candidates - 1)%centroid_y = ( &
         next_candidates(num_next_candidates - 3)%centroid_y)
    next_candidates(num_next_candidates - 1)%width = half_width

    ! Subdivision D.
    next_candidates(num_next_candidates)%centroid_x = ( &
         next_candidates(num_next_candidates - 3)%centroid_x)
    next_candidates(num_next_candidates)%centroid_y = ( &
         candidate%centroid_y + candidate%width)
    next_candidates(num_next_candidates)%width = half_width

  end subroutine split_candidate

  subroutine allocate_candidates(num_candidates, next_candidates)
    integer(c_int), intent(in) :: num_candidates
    type(LocateCandidate), allocatable, intent(inout) :: next_candidates(:)

    if (allocated(next_candidates)) then
       if (size(next_candidates) < 4 * num_candidates) then
          deallocate(next_candidates)
          allocate(next_candidates(4 * num_candidates))
       end if
    else
       allocate(next_candidates(4 * num_candidates))
    end if

  end subroutine allocate_candidates

  subroutine update_candidates( &
       num_nodes, degree, point, num_candidates, candidates, &
       num_next_candidates, next_candidates)

    integer(c_int), intent(in) :: num_nodes, degree
    real(c_double), intent(in) :: point(2)
    integer(c_int), intent(in) :: num_candidates
    type(LocateCandidate), intent(in) :: candidates(:)
    integer(c_int), intent(inout) :: num_next_candidates
    type(LocateCandidate), allocatable, intent(inout) :: next_candidates(:)
    ! Variables outside of signature.
    integer(c_int) :: cand_index
    logical(c_bool) :: predicate

    call allocate_candidates(num_candidates, next_candidates)

    do cand_index = 1, num_candidates
       call contains_nd( &
            num_nodes, 2, candidates(cand_index)%nodes, &
            point, predicate)

       if (predicate) then
          num_next_candidates = num_next_candidates + 4
          call split_candidate( &
               num_nodes, degree, candidates(cand_index), &
               num_next_candidates, next_candidates)
       end if
    end do

  end subroutine update_candidates

  subroutine locate_point( &
       num_nodes, nodes, degree, x_val, y_val, s_val, t_val) &
       bind(c, name='BEZ_locate_point_triangle')

    ! NOTE: This solves the inverse problem B(s, t) = (x, y) (if it can be
    !       solved). Does so by subdividing the triangle until the sub-triangles
    !       are sufficiently small, then using Newton's method to narrow
    !       in on the pre-image of the point.
    ! NOTE: This returns ``-1`` (``LOCATE_MISS``) for ``s_val`` as a signal
    !       for "point is not on the triangle".
    ! NOTE: This assumes, but does not check, that the triangle is "valid",
    !       i.e. all pre-images are unique.

    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: nodes(2, num_nodes)
    integer(c_int), intent(in) :: degree
    real(c_double), intent(in) :: x_val, y_val
    real(c_double), intent(out) :: s_val, t_val
    ! Variables outside of signature.
    real(c_double) :: point(2)
    integer(c_int) :: sub_index
    integer(c_int) :: num_candidates, num_next_candidates
    type(LocateCandidate), allocatable :: candidates_odd(:), candidates_even(:)
    real(c_double) :: s_approx, t_approx
    real(c_double) :: actual(2)
    logical(c_bool) :: is_even

    point = [x_val, y_val]
    ! Start out with the full curve.
    allocate(candidates_odd(1))  ! First iteration is odd.
    candidates_odd(1) = LocateCandidate(1.0_dp, 1.0_dp, 1.0_dp, nodes)
    num_candidates = 1
    s_val = LOCATE_MISS

    is_even = .TRUE.  ! At zero.
    do sub_index = 1, MAX_LOCATE_SUBDIVISIONS + 1
       is_even = .NOT. is_even  ! Switch parity.
       num_next_candidates = 0

       if (is_even) then
          ! Read from even, write to odd.
          call update_candidates( &
               num_nodes, degree, point, num_candidates, candidates_even, &
               num_next_candidates, candidates_odd)
       else
          ! Read from odd, write to even.
          call update_candidates( &
               num_nodes, degree, point, num_candidates, candidates_odd, &
               num_next_candidates, candidates_even)
       end if

       ! If there are no more candidates, we are done.
       if (num_next_candidates == 0) then
          return
       end if

       num_candidates = num_next_candidates

    end do

    ! Compute the s- and t-parameters as the mean of the centroid positions.
    ! We divide by `3n` rather than `n` since we have tracked thrice the
    ! centroid rather than the centroid itself (to avoid round-off until
    ! right now).
    if (is_even) then
       ! NOTE: We "exclude" this block from ``lcov`` because it can never
       !       be invoked while ``MAX_LOCATE_SUBDIVISIONS`` is even.
       ! LCOV_EXCL_START
       s_approx = ( &
            sum(candidates_odd(:num_candidates)%centroid_x) / &
            (3.0_dp * num_candidates))
       t_approx = ( &
            sum(candidates_odd(:num_candidates)%centroid_y) / &
            (3.0_dp * num_candidates))
       ! LCOV_EXCL_STOP
    else
       s_approx = ( &
            sum(candidates_even(:num_candidates)%centroid_x) / &
            (3.0_dp * num_candidates))
       t_approx = ( &
            sum(candidates_even(:num_candidates)%centroid_y) / &
            (3.0_dp * num_candidates))
    end if

    call newton_refine( &
         num_nodes, nodes, degree, x_val, y_val, &
         s_approx, t_approx, s_val, t_val)

    ! Check if the solution is "close enough" ...
    call evaluate_barycentric( &
         num_nodes, 2, nodes, degree, &
         1.0_dp - s_val - t_val, s_val, t_val, actual)

    if (vector_close(2, point, actual, LOCATE_EPS)) then
       return
    end if

    ! ... and if **not** close enough, do one more round of
    ! Newton's method if not.
    s_approx = s_val
    t_approx = t_val
    call newton_refine( &
         num_nodes, nodes, degree, x_val, y_val, &
         s_approx, t_approx, s_val, t_val)

  end subroutine locate_point

  logical(c_bool) function ignored_edge_corner( &
       edge_tangent, corner_tangent, num_nodes, &
       previous_edge_nodes) result(predicate)

    real(c_double), intent(in) :: edge_tangent(2)
    real(c_double), intent(in) :: corner_tangent(2)
    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: previous_edge_nodes(2, num_nodes)
    ! Variables outside of signature.
    real(c_double) :: cross_prod
    real(c_double) :: alt_corner_tangent(2)

    call cross_product( &
         edge_tangent, corner_tangent, cross_prod)
    ! A negative cross product indicates that ``edge_tangent`` is
    ! "inside" / "to the left" of ``corner_tangent`` (due to right-hand rule).
    if (cross_prod > 0.0_dp) then
       predicate = .FALSE.
       return
    end if

    ! Do the same for the **other** tangent at the corner.
    call evaluate_hodograph( &
         1.0_dp, num_nodes, 2, &
         previous_edge_nodes, alt_corner_tangent)
    ! Change the direction of the "in" tangent so that it points "out".
    alt_corner_tangent = -alt_corner_tangent
    call cross_product( &
         edge_tangent, alt_corner_tangent, cross_prod)
    predicate = (cross_prod <= 0.0_dp)

  end function ignored_edge_corner

  logical(c_bool) function ignored_double_corner( &
       edges_first, edges_second, intersection_, &
       tangent_s, tangent_t) result(predicate)

    ! NOTE: This assumes that ``intersection_%index_(first|second)``
    !       are in [1, 2, 3] (marked as the edges of a triangle).

    type(CurveData), intent(in) :: edges_first(3), edges_second(3)
    type(Intersection), intent(in) :: intersection_
    real(c_double), intent(in) :: tangent_s(2), tangent_t(2)
    ! Variables outside of signature.
    integer(c_int) :: index, num_nodes
    real(c_double) :: alt_tangent_s(2), alt_tangent_t(2)
    real(c_double) :: cross_prod1, cross_prod2, cross_prod3

    ! Compute the other edge for the ``s`` triangle.
    index = 1 + modulo(intersection_%index_first - 2, 3)
    num_nodes = size(edges_first(index)%nodes, 2)
    call evaluate_hodograph( &
         1.0_dp, num_nodes, 2, &
         edges_first(index)%nodes, alt_tangent_s)

    ! First check if ``tangent_t`` is interior to the ``s`` triangle.
    call cross_product( &
         tangent_s, tangent_t, cross_prod1)
    ! A positive cross product indicates that ``tangent_t`` is
    ! interior to ``tangent_s``. Similar for ``alt_tangent_s``.
    ! If ``tangent_t`` is interior to both, then the triangles
    ! do more than just "kiss" at the corner, so the corner should
    ! not be ignored.
    if (cross_prod1 >= 0.0_dp) then
       ! Only compute ``cross_prod2`` if we need to.
       call cross_product( &
            alt_tangent_s, tangent_t, cross_prod2)
       if (cross_prod2 >= 0.0_dp) then
          predicate = .FALSE.
          return
       end if
    end if

    ! If ``tangent_t`` is not interior, we check the other ``t``
    ! edge that ends at the corner.
    index = 1 + modulo(intersection_%index_second - 2, 3)
    num_nodes = size(edges_second(index)%nodes, 2)
    call evaluate_hodograph( &
         1.0_dp, num_nodes, 2, &
         edges_second(index)%nodes, alt_tangent_t)
    ! Change the direction of the "in" tangent so that it points "out".
    alt_tangent_t = -alt_tangent_t

    call cross_product( &
         tangent_s, alt_tangent_t, cross_prod2)
    if (cross_prod2 >= 0.0_dp) then
       ! Only compute ``cross_prod3`` if we need to.
       call cross_product( &
            alt_tangent_s, alt_tangent_t, cross_prod3)
       if (cross_prod3 >= 0.0_dp) then
          predicate = .FALSE.
          return
       end if
    end if

    ! If neither of ``tangent_t`` or ``alt_tangent_t`` are interior
    ! to the ``s`` triangle, one of two things is true. Either
    ! the two triangles have no interior intersection (1) or the
    ! ``s`` triangle is bounded by both edges of the ``t`` triangle
    ! at the corner intersection (2). To detect (2), we only need
    ! check if ``tangent_s`` is interior to both ``tangent_t``
    ! and ``alt_tangent_t``. ``cross_prod1`` contains
    ! (tangent_s) x (tangent_t), so it's negative will tell if
    ! ``tangent_s`` is interior. Similarly, ``cross_prod3``
    ! contains (tangent_s) x (alt_tangent_t), but we also reversed
    ! the sign on ``alt_tangent_t`` so switching the sign back
    ! and reversing the arguments in the cross product cancel out.
    predicate = (cross_prod1 > 0.0_dp .OR. cross_prod2 < 0.0_dp)

  end function ignored_double_corner

  logical(c_bool) function ignored_corner( &
       edges_first, edges_second, intersection_, &
       tangent_s, tangent_t) result(predicate)

    ! NOTE: This assumes that ``intersection_%index_(first|second)``
    !       are in [1, 2, 3] (marked as the edges of a triangle).

    type(CurveData), intent(in) :: edges_first(3), edges_second(3)
    type(Intersection), intent(in) :: intersection_
    real(c_double), intent(in) :: tangent_s(2), tangent_t(2)
    ! Variables outside of signature.
    integer(c_int) :: index, num_nodes

    if (intersection_%s == 0.0_dp) then
       if (intersection_%t == 0.0_dp) then
          ! Double corner.
          predicate = ignored_double_corner( &
               edges_first, edges_second, intersection_, &
               tangent_s, tangent_t)
       else
          ! s-only corner.
          index = 1 + modulo(intersection_%index_first - 2, 3)
          ! NOTE: This is a "trick" which requires `modulo` (not `mod`)
          !       since it will return values in {0, 1, 2}. The goal is
          !       to send [1, 2, 3] --> [3, 1, 2] (i.e. move indices to
          !       the left and wrap around).
          num_nodes = size(edges_first(index)%nodes, 2)
          predicate = ignored_edge_corner( &
               tangent_t, tangent_s, num_nodes, edges_first(index)%nodes)
       end if
    else if (intersection_%t == 0.0_dp) then
       ! t-only corner.
       index = 1 + modulo(intersection_%index_second - 2, 3)
       ! NOTE: This is a "trick" which requires `modulo` (not `mod`)
       !       since it will return values in {0, 1, 2}. The goal is
       !       to send [1, 2, 3] --> [3, 1, 2] (i.e. move indices to
       !       the left and wrap around).
       num_nodes = size(edges_second(index)%nodes, 2)
       predicate = ignored_edge_corner( &
            tangent_s, tangent_t, num_nodes, edges_second(index)%nodes)
    else
       predicate = .FALSE.
    end if

  end function ignored_corner

  subroutine classify_tangent_intersection( &
       edges_first, edges_second, intersection_, &
       tangent_s, tangent_t, enum_, status)

    ! NOTE: This **assumes**, but does not check that
    !       ``intersection_%index_(first|second)`` are valid indices within
    !       ``edges_(first|second)`` and that each of those ``CurveData``
    !       instances have already allocated ``%nodes``.

    ! Possible error states:
    ! * Status_SUCCESS       : On success.
    ! * Status_SAME_CURVATURE: If the curves have identical curvature at the
    !                          point of tangency.

    type(CurveData), intent(in) :: edges_first(3), edges_second(3)
    type(Intersection), intent(in) :: intersection_
    real(c_double), intent(in) :: tangent_s(2), tangent_t(2)
    integer(c_int), intent(out) :: enum_
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    real(c_double) :: dot_prod
    integer(c_int) :: num_nodes
    real(c_double) :: curvature1, curvature2
    real(c_double) :: sign1, sign2
    real(c_double) :: delta_c

    status = Status_SUCCESS
    dot_prod = dot_product(tangent_s, tangent_t)
    ! NOTE: When computing curvatures we assume that we don't have lines
    !       here, because lines that are tangent at an intersection are
    !       parallel and we don't handle that case.
    num_nodes = size(edges_first(intersection_%index_first)%nodes, 2)
    call get_curvature( &
         num_nodes, edges_first(intersection_%index_first)%nodes, &
         tangent_s, intersection_%s, curvature1)

    num_nodes = size(edges_second(intersection_%index_second)%nodes, 2)
    call get_curvature( &
         num_nodes, edges_second(intersection_%index_second)%nodes, &
         tangent_t, intersection_%t, curvature2)

    if (dot_prod < 0.0_dp) then
       ! If the tangent vectors are pointing in the opposite direction,
       ! then the curves are facing opposite directions.
       sign1 = sign(1.0_dp, curvature1)
       sign2 = sign(1.0_dp, curvature2)
       if (sign1 == sign2) then
          ! If both curvatures are positive, since the curves are
          ! moving in opposite directions, the tangency isn't part of
          ! the triangle intersection.
          if (sign1 == 1.0_dp) then
             enum_ = IntersectionClassification_OPPOSED
          else
             enum_ = IntersectionClassification_TANGENT_BOTH
          end if
       else
          delta_c = abs(curvature1) - abs(curvature2)
          if (delta_c == 0.0_dp) then
             status = Status_SAME_CURVATURE
          else
             sign2 = sign(1.0_dp, delta_c)
             if (sign1 == sign2) then
                enum_ = IntersectionClassification_OPPOSED
             else
                enum_ = IntersectionClassification_TANGENT_BOTH
             end if
          end if
       end if
    else
       if (curvature1 > curvature2) then
          enum_ = IntersectionClassification_TANGENT_FIRST
       else if (curvature1 < curvature2) then
          enum_ = IntersectionClassification_TANGENT_SECOND
       else
          status = Status_SAME_CURVATURE
       end if
    end if

  end subroutine classify_tangent_intersection

  subroutine classify_intersection( &
       edges_first, edges_second, intersection_, enum_, status)

    ! NOTE: This is **explicitly** not intended for C inter-op.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.
    ! NOTE: This **assumes**, but does not check that
    !       ``intersection_%index_(first|second)`` are valid indices within
    !       ``edges_(first|second)`` and that each of those ``CurveData``
    !       instances have already allocated ``%nodes``.

    ! Possible error states:
    ! * Status_SUCCESS       : On success.
    ! * Status_EDGE_END      : If either the s- or t-parameter of the
    !                          intersection is equal to ``1.0``, i.e. if the
    !                          intersection is at the end of an edge. Since
    !                          another edge of the triangle will also contain
    !                          that point (at it's beginning), that edge
    !                          should be used.
    ! * Status_SAME_CURVATURE: Via ``classify_tangent_intersection()``.

    type(CurveData), intent(in) :: edges_first(3), edges_second(3)
    type(Intersection), intent(in) :: intersection_
    integer(c_int), intent(out) :: enum_
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    integer(c_int) :: num_nodes
    real(c_double) :: tangent_s(2), tangent_t(2)
    real(c_double) :: cross_prod

    status = Status_SUCCESS
    if (intersection_%s == 1.0_dp .OR. intersection_%t == 1.0_dp) then
       status = Status_EDGE_END
       return
    end if

    ! NOTE: We assume, but don't check that ``%nodes`` is allocated
    !       and that it has 2 columns.
    num_nodes = size(edges_first(intersection_%index_first)%nodes, 2)
    call evaluate_hodograph( &
         intersection_%s, num_nodes, 2, &
         edges_first(intersection_%index_first)%nodes, tangent_s)

    ! NOTE: We assume, but don't check that ``%nodes`` is allocated
    !       and that it has 2 columns.
    num_nodes = size(edges_second(intersection_%index_second)%nodes, 2)
    call evaluate_hodograph( &
         intersection_%t, num_nodes, 2, &
         edges_second(intersection_%index_second)%nodes, tangent_t)

    if (ignored_corner( &
         edges_first, edges_second, intersection_, &
         tangent_s, tangent_t)) then
       enum_ = IntersectionClassification_IGNORED_CORNER
       return
    end if

    ! Take the cross product of tangent vectors to determine which one
    ! is more "inside" / "to the left".
    call cross_product( &
         tangent_s, tangent_t, cross_prod)
    if (cross_prod < -ALMOST_TANGENT) then
       enum_ = IntersectionClassification_FIRST
    else if (cross_prod > ALMOST_TANGENT) then
       enum_ = IntersectionClassification_SECOND
    else
       ! NOTE: A more robust approach would take ||tangent1|| and ||tangent2||
       !       into account when comparing (tangent1 x tangent2) to the
       !       "almost zero" threshold. We (for now) avoid doing this because
       !       normalizing the tangent vectors has a "cost" of ~6 flops each
       !       and that cost would happen for **every** single intersection.
       call classify_tangent_intersection( &
            edges_first, edges_second, intersection_, &
            tangent_s, tangent_t, enum_, status)
    end if

  end subroutine classify_intersection

  subroutine update_edge_end_unused( &
       s, index_first, t, index_second, &
       intersections, num_intersections)

    ! NOTE: This assumes, but does not check, that at least one of
    !       ``s == 1`` or ``t == 1`` is true. I.e. the caller must **pass**
    !       in a corner that is at the end of an edge.
    ! NOTE: This is **explicitly** not intended for C inter-op.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    real(c_double), intent(in) :: s
    integer(c_int), intent(in) :: index_first
    real(c_double), intent(in) :: t
    integer(c_int), intent(in) :: index_second
    type(Intersection), intent(inout) :: intersections(:)
    integer(c_int), intent(inout) :: num_intersections
    ! Variables outside of signature.
    real(c_double) :: front_s, front_t
    integer(c_int) :: i, index1, index2

    ! First, "rotate" the indices according the which edge is at the end.
    if (s == 1.0_dp) then
       front_s = 0.0_dp
       index1 = 1 + modulo(index_first, 3)
    else
       front_s = s
       index1 = index_first
    end if
    if (t == 1.0_dp) then
       front_t = 0.0_dp
       index2 = 1 + modulo(index_second, 3)
    else
       front_t = t
       index2 = index_second
    end if

    ! Then, try to find an intersection matching our edge indices and
    ! starting at a relevant corner. If we do find a match, edit the
    ! classification in place.
    if (front_s == 0.0_dp) then
       do i = 1, num_intersections
          if (index1 == intersections(i)%index_first .AND. &
               index2 == intersections(i)%index_second .AND. &
               intersections(i)%s == 0.0_dp) then
             intersections(i)%interior_curve = ( &
                  IntersectionClassification_COINCIDENT_UNUSED)
             return
          end if
       end do
    else
       ! NOTE: This assumes, but does not check, that ``front_t == 0``.
       do i = 1, num_intersections
          if (index1 == intersections(i)%index_first .AND. &
               index2 == intersections(i)%index_second .AND. &
               intersections(i)%t == 0.0_dp) then
             intersections(i)%interior_curve = ( &
                  IntersectionClassification_COINCIDENT_UNUSED)
             return
          end if
       end do
    end if

    ! If we have reached this point, then the ``COINCIDENT_UNUSED``
    ! intersection should be added.
    num_intersections = num_intersections + 1
    intersections(num_intersections)%s = front_s
    intersections(num_intersections)%t = front_t
    intersections(num_intersections)%index_first = index1
    intersections(num_intersections)%index_second = index2
    intersections(num_intersections)%interior_curve = ( &
         IntersectionClassification_COINCIDENT_UNUSED)

  end subroutine update_edge_end_unused

  subroutine find_corner_unused( &
       s, index_first, index_second, &
       intersections, num_intersections, found)

    ! We want to see if a candidate intersection was already added by
    ! ``update_edge_end_unused()``. This assumes the caller has checked
    ! that the ``COINCIDENT_UNUSED`` classification has already been seen
    ! and that the candidate intersection is a corner (i.e. this subroutine
    ! assumes, but does not check, that at least one of ``s == 0`` or
    ! ``t == 0`` is true.)

    ! NOTE: This is **explicitly** not intended for C inter-op.
    ! NOTE: This subroutine is **very** similar to
    !       ``update_edge_end_unused()``.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    real(c_double), intent(in) :: s
    integer(c_int), intent(in) :: index_first
    integer(c_int), intent(in) :: index_second
    type(Intersection), intent(in) :: intersections(:)
    integer(c_int), intent(in) :: num_intersections
    logical(c_bool), intent(out) :: found
    ! Variables outside of signature.
    integer(c_int) :: i

    found = .FALSE.
    if (s == 0.0_dp) then
       do i = 1, num_intersections
          if (intersections(i)%interior_curve == &
               IntersectionClassification_COINCIDENT_UNUSED .AND. &
               index_first == intersections(i)%index_first .AND. &
               index_second == intersections(i)%index_second .AND. &
               intersections(i)%s == 0.0_dp) then
             found = .TRUE.
             return
          end if
       end do
    else
       ! NOTE: This assumes, but does not check, that ``t == 0``.
       do i = 1, num_intersections
          if (intersections(i)%interior_curve == &
               IntersectionClassification_COINCIDENT_UNUSED .AND. &
               index_first == intersections(i)%index_first .AND. &
               index_second == intersections(i)%index_second .AND. &
               intersections(i)%t == 0.0_dp) then
             found = .TRUE.
             return
          end if
       end do
    end if

  end subroutine find_corner_unused

  subroutine add_st_vals( &
       edges_first, edges_second, num_st_vals, st_vals, known_enum, &
       index_first, index_second, intersections, num_intersections, status)

    ! NOTE: This is **explicitly** not intended for C inter-op.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.
    ! NOTE: This assumes but does not check that ``num_st_vals > 0``.
    ! NOTE: This assumes but does not check that each of ``index_first``
    !       and ``index_second`` is in {1, 2, 3}.

    ! Possible error states:
    ! * Status_SUCCESS       : On success.
    ! * Status_EDGE_END      : Via ``classify_intersection()``.
    ! * Status_SAME_CURVATURE: Via ``classify_intersection()``.

    type(CurveData), intent(in) :: edges_first(3), edges_second(3)
    integer(c_int), intent(in) :: num_st_vals
    real(c_double), intent(in) :: st_vals(2, num_st_vals)
    integer(c_int), intent(inout) :: known_enum
    integer(c_int), intent(in) :: index_first, index_second
    type(Intersection), allocatable, intent(inout) :: intersections(:)
    integer(c_int), intent(inout) :: num_intersections
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    integer(c_int) :: curr_size, i, intersection_index
    type(Intersection), allocatable :: intersections_swap(:)
    integer(c_int) :: enum_
    logical(c_bool) :: found

    status = Status_SUCCESS

    intersection_index = num_intersections
    ! NOTE: Intersections at the end of an edge will be skipped, so this
    !       may over-estimate the number of intersections.
    num_intersections = num_intersections + num_st_vals
    if (allocated(intersections)) then
       curr_size = size(intersections)
       if (curr_size < num_intersections) then
          allocate(intersections_swap(num_intersections))
          intersections_swap(:curr_size) = intersections(:curr_size)
          call move_alloc(intersections_swap, intersections)
       end if
    else
       allocate(intersections(num_intersections))
    end if

    value_loop: do i = 1, num_st_vals
       if (st_vals(1, i) == 1.0_dp .OR. st_vals(2, i) == 1.0_dp) then
          ! If the intersection is at the end of an edge, ignore it.
          ! This intersection **could** be saved to verify that it matches an
          ! equivalent intersection from the beginning of the previous edge.
          ! In the **special** case that the intersection is classified as
          ! ``COINCIDENT_UNUSED``, we **might** add it (since an intersection
          ! at a corner may be classified differently depending on which
          ! of the 2 or 4 edge pairs it lies on).
          if (known_enum == IntersectionClassification_COINCIDENT_UNUSED) then
             call update_edge_end_unused( &
                  st_vals(1, i), index_first, st_vals(2, i), index_second, &
                  intersections, intersection_index)
          end if
          cycle value_loop
       end if

       ! Before classifying, try to determine if this intersection was
       ! already added as a ``COINCIDENT_UNUSED`` intersection. Only check
       ! if the intersection is at a corner (though it'd be nice to know
       ! check if ``COINCIDENT_UNUSED`` has been encountered).
       if (st_vals(1, i) == 0.0_dp .OR. st_vals(2, i) == 0.0_dp) then
          call find_corner_unused( &
               st_vals(1, i), index_first, index_second, &
               intersections, intersection_index, found)
          if (found) then
             cycle value_loop
          end if
       end if

       intersection_index = intersection_index + 1
       intersections(intersection_index)%s = st_vals(1, i)
       intersections(intersection_index)%t = st_vals(2, i)
       intersections(intersection_index)%index_first = index_first
       intersections(intersection_index)%index_second = index_second

       if (known_enum == IntersectionClassification_UNSET) then
          call classify_intersection( &
               edges_first, edges_second, &
               intersections(intersection_index), enum_, status)
          if (status /= Status_SUCCESS) then
             return
          end if
       else
          enum_ = known_enum
       end if
       intersections(intersection_index)%interior_curve = enum_
    end do value_loop

    ! Actually set ``num_intersections`` based on the number of **accepted**
    ! ``s-t`` pairs.
    num_intersections = intersection_index

  end subroutine add_st_vals

  logical(c_bool) function should_keep(intersection_) result(predicate)

    ! NOTE: This function is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    type(Intersection), intent(in) :: intersection_
    ! Variables outside of signature.
    integer(c_int) :: enum_

    enum_ = intersection_%interior_curve
    ! "Keep" the intersection if it is ``FIRST``, ``SECOND`` or
    ! ``COINCIDENT``.
    if ( &
         enum_ == IntersectionClassification_FIRST .OR. &
         enum_ == IntersectionClassification_SECOND .OR. &
         enum_ == IntersectionClassification_COINCIDENT) then
       predicate = .TRUE.
       return
    end if

    ! "Keep" the intersection if it is tangent and a corner.
    if ( &
         enum_ == IntersectionClassification_TANGENT_FIRST .OR. &
         enum_ == IntersectionClassification_TANGENT_SECOND) then
       if (intersection_%s == 0.0_dp .OR. intersection_%t == 0.0_dp) then
          predicate = .TRUE.
          return
       end if
    end if

    predicate = .FALSE.

  end function should_keep

  subroutine triangles_intersection_points( &
       num_nodes1, nodes1, degree1, &
       num_nodes2, nodes2, degree2, &
       intersections, num_intersections, all_types, status)

    ! NOTE: This is **explicitly** not intended for C inter-op.
    ! NOTE: This (and ``add_st_vals``) ignores duplicate nodes (caused when
    !       an intersection happens at a corner of the triangle, which will
    !       be at the end of one edge and the start of another). If desired,
    !       a "verify" option could be added (as is done in Python) to make
    !       sure that any "duplicate" intersections (i.e. ones that occur at
    !       the end of an edge) do match with the corresponding intersection
    !       at the beginning of an edge (in the case of a double corner, this
    !       means **three** duplicate intersections).
    ! NOTE: The returned ``all_types`` uses the first 9 bits to identify
    !       which classified states are among the intersections. (The
    !       possible classifications must be in {0, 1, 2, 3, 4, 5, 7, 8}).

    ! Possible error states:
    ! * Status_SUCCESS         : On success.
    ! * Status_NO_CONVERGE     : Via ``all_intersections()`` from
    !                            ``curve_intersection.f90``.
    ! * (N >= MAX_CANDIDATES)  : Via ``all_intersections()``.
    ! * Status_BAD_MULTIPLICITY: Via ``all_intersections()``.
    ! * Status_EDGE_END        : Via ``add_st_vals()``.
    ! * Status_SAME_CURVATURE  : Via ``add_st_vals()``.

    integer(c_int), intent(in) :: num_nodes1
    real(c_double), intent(in) :: nodes1(2, num_nodes1)
    integer(c_int), intent(in) :: degree1
    integer(c_int), intent(in) :: num_nodes2
    real(c_double), intent(in) :: nodes2(2, num_nodes2)
    integer(c_int), intent(in) :: degree2
    type(Intersection), allocatable, intent(inout) :: intersections(:)
    integer(c_int), intent(out) :: num_intersections
    integer(c_int), intent(out) :: all_types
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    type(CurveData) :: edges_first(3), edges_second(3)
    integer(c_int) :: index1, index2
    integer(c_int) :: num_st_vals
    logical(c_bool) :: coincident
    integer(c_int) :: enum_

    ! Compute the edge nodes for the first triangle.
    allocate(edges_first(1)%nodes(2, degree1 + 1))
    allocate(edges_first(2)%nodes(2, degree1 + 1))
    allocate(edges_first(3)%nodes(2, degree1 + 1))
    call compute_edge_nodes( &
         num_nodes1, 2, nodes1, degree1, &
         edges_first(1)%nodes, edges_first(2)%nodes, edges_first(3)%nodes)

    ! Compute the edge nodes for the second triangle.
    allocate(edges_second(1)%nodes(2, degree2 + 1))
    allocate(edges_second(2)%nodes(2, degree2 + 1))
    allocate(edges_second(3)%nodes(2, degree2 + 1))
    call compute_edge_nodes( &
         num_nodes2, 2, nodes2, degree2, &
         edges_second(1)%nodes, edges_second(2)%nodes, edges_second(3)%nodes)

    num_intersections = 0
    all_types = 0
    do index1 = 1, 3
       do index2 = 1, 3
          call all_intersections( &
               degree1 + 1, edges_first(index1)%nodes, &
               degree2 + 1, edges_second(index2)%nodes, &
               INTERSECTIONS_WORKSPACE, num_st_vals, coincident, status)
          if (coincident) then
             ! NOTE: This assumes, but doesn't check, that ``num_st_vals == 2``
             !       in the coincident case.
             ! The parameters are ``(s1, t1)`` and ``(s2, t2)`` and if
             ! ``s1 >= s2`` or ``t1 >= t2`` then the curves are moving in
             ! opposite directions, hence don't define an interior of an
             ! intersection.
             if (INTERSECTIONS_WORKSPACE(1, 1) >= &
                  INTERSECTIONS_WORKSPACE(1, 2) .OR. &
                  INTERSECTIONS_WORKSPACE(2, 1) >= &
                  INTERSECTIONS_WORKSPACE(2, 2)) then
                enum_ = IntersectionClassification_COINCIDENT_UNUSED
             else
                enum_ = IntersectionClassification_COINCIDENT
             end if
          else
             enum_ = IntersectionClassification_UNSET
          end if
          if (status == Status_SUCCESS) then
             if (num_st_vals > 0) then
                call add_st_vals( &
                     edges_first, edges_second, &
                     num_st_vals, INTERSECTIONS_WORKSPACE(:, :num_st_vals), &
                     enum_, index1, index2, intersections, &
                     num_intersections, status)
                if (status /= Status_SUCCESS) then
                   return  ! LCOV_EXCL_LINE
                end if
             end if
          else
             return
          end if
       end do
    end do

    ! After considering all 9 edge pairs, we go through ``intersections``
    ! and remove any intersections classified as ``COINCIDENT_UNUSED``.
    index1 = 1
    do while (index1 <= num_intersections)
       ! First, update the ``all_types`` "set" with the encountered
       ! classification (whether or not we "keep" the intersection).
       enum_ = intersections(index1)%interior_curve
       ! NOTE: This assumes, but does not check, that ``enum_`` is in
       !       {0, 1, 2, 3, 4, 5, 6, 7, 8} (should be an enum value from
       !       ``IntersectionClassification``) which limits the value of
       !       ``all_types`` to [0, 511] (inclusive).
       all_types = ior(all_types, 2**enum_)
       if (should_keep(intersections(index1))) then
          index1 = index1 + 1
       else
          ! "Discard" the intersection.
          intersections(index1:num_intersections - 1) = ( &
               intersections(index1 + 1:num_intersections))
          num_intersections = num_intersections - 1
       end if
    end do

  end subroutine triangles_intersection_points

  subroutine no_intersections( &
       num_nodes1, nodes1, degree1, &
       num_nodes2, nodes2, degree2, contained)

    ! NOTE: This is a helper for ``triangles_intersect()``.

    integer(c_int), intent(in) :: num_nodes1
    real(c_double), intent(in) :: nodes1(2, num_nodes1)
    integer(c_int), intent(in) :: degree1
    integer(c_int), intent(in) :: num_nodes2
    real(c_double), intent(in) :: nodes2(2, num_nodes2)
    integer(c_int), intent(in) :: degree2
    integer(c_int), intent(out) :: contained
    ! Variables outside of signature.
    real(c_double) :: s_val, t_val

    ! If the first corner of ``triangle1`` is contained in ``triangle2``,
    ! then the whole triangle must be since there are no intersections.
    call locate_point( &
         num_nodes2, nodes2, degree2, &
         nodes1(1, 1), nodes1(2, 1), s_val, t_val)
    if (s_val /= LOCATE_MISS) then
       contained = TriangleContained_FIRST
       return
    end if

    ! If the first corner of ``triangle2`` is contained in ``triangle1``,
    ! then the whole triangle must be since there are no intersections.
    call locate_point( &
         num_nodes1, nodes1, degree1, &
         nodes2(1, 1), nodes2(2, 1), s_val, t_val)
    if (s_val /= LOCATE_MISS) then
       contained = TriangleContained_SECOND
       return
    end if

    ! If neither corner is contained, then there is no intersection.
    contained = TriangleContained_NEITHER

  end subroutine no_intersections

  subroutine remove_node(node, values, remaining)

    ! Removes a value from a list, if it is contained there.
    ! For example, if ``node == 4``, ``values == [1, 2, 4, 7, ...]`` and
    ! ``remainining == 4``, then after this subroutine will update to
    ! ``values == [1, 2, 7, ...]`` and ``remainining == 3``.
    ! NOTE: This assumes the values in ``values`` are in ascending order
    !       and unique.
    ! NOTE: This assumes that ``remaining`` does not exceed ``size(values)``

    integer(c_int), intent(in) :: node
    integer(c_int), intent(inout) :: values(:)
    integer(c_int), intent(inout) :: remaining
    ! Variables outside of signature.
    integer(c_int) :: i

    ! NOTE: Since we assume the values are in ascending order and unique, a
    !       binary search could speed this up. In practice, ``values``
    !       will likely be too small for this to matter.
    do i = 1, remaining
       if (values(i) == node) then
          ! Remove ``values(i)`` by shifting down all remaining values.
          values(i:remaining - 1) = values(i + 1:remaining)
          remaining = remaining - 1
          return
       end if
    end do

  end subroutine remove_node

  logical(c_bool) function is_first(enum_) result(predicate)

    ! NOTE: This function is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    integer(c_int), intent(in) :: enum_

    predicate = ( &
         enum_ == IntersectionClassification_FIRST .OR. &
         enum_ == IntersectionClassification_TANGENT_FIRST)

  end function is_first

  logical(c_bool) function is_second(enum_) result(predicate)

    ! NOTE: This function is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    integer(c_int), intent(in) :: enum_

    predicate = ( &
         enum_ == IntersectionClassification_SECOND .OR. &
         enum_ == IntersectionClassification_TANGENT_SECOND)

  end function is_second

  subroutine get_next( &
       num_intersections, intersections, unused, remaining, &
       start, curr_node, next_node, at_start)

    ! NOTE: This subroutine is not meant to be part of the interface for this
    !       module, but it is (for now) public, so that it can be tested.

    integer(c_int), intent(in) :: num_intersections
    type(Intersection), intent(in) :: intersections(num_intersections)
    ! ``unused`` contains the indices of intersections that have not yet been
    ! used as a node.
    integer(c_int), intent(inout) :: unused(:)
    integer(c_int), intent(inout) :: remaining
    integer(c_int), intent(in) :: start
    type(Intersection), intent(in) :: curr_node
    type(Intersection), intent(out) :: next_node
    logical(c_bool), intent(out) :: at_start
    ! Variables outside of signature.
    real(c_double) :: edge_param
    integer(c_int) :: i, intersection_index

    intersection_index = -1
    at_start = .FALSE.
    if (is_first(curr_node%interior_curve)) then
       do i = 1, num_intersections
          if ( &
               intersections(i)%index_first == curr_node%index_first .AND. &
               intersections(i)%s > curr_node%s) then
             if (intersection_index == -1) then
                intersection_index = i
                edge_param = intersections(i)%s
             else
                if (intersections(i)%s < edge_param) then
                   intersection_index = i
                   edge_param = intersections(i)%s
                end if
             end if
          end if
       end do

       ! If there is no other intersection on the edge, just return
       ! the segment end.
       if (intersection_index == -1) then
          ! NOTE: We **explicitly** do not set ``t`` or ``index_second``.
          next_node%index_first = curr_node%index_first
          next_node%s = 1.0_dp
          next_node%interior_curve = IntersectionClassification_FIRST
       else
          next_node = intersections(intersection_index)
          at_start = (intersection_index == start)
          ! Remove the index from the set of ``unused`` intersections, if
          ! it is contained there.
          call remove_node(intersection_index, unused, remaining)
       end if
    else if (is_second(curr_node%interior_curve)) then
       do i = 1, num_intersections
          if ( &
               intersections(i)%index_second == curr_node%index_second .AND. &
               intersections(i)%t > curr_node%t) then
             if (intersection_index == -1) then
                intersection_index = i
                edge_param = intersections(i)%t
             else
                if (intersections(i)%t < edge_param) then
                   intersection_index = i
                   edge_param = intersections(i)%t
                end if
             end if
          end if
       end do

       ! If there is no other intersection on the edge, just return
       ! the segment end.
       if (intersection_index == -1) then
          ! NOTE: We **explicitly** do not set ``s`` or ``index_first``.
          next_node%index_second = curr_node%index_second
          next_node%t = 1.0_dp
          next_node%interior_curve = IntersectionClassification_SECOND
       else
          next_node = intersections(intersection_index)
          at_start = (intersection_index == start)
          ! Remove the index from the set of ``unused`` intersections, if
          ! it is contained there.
          call remove_node(intersection_index, unused, remaining)
       end if
    else
       ! NOTE: This assumes but does not check that
       !       ``curr_node%interior_curve`` is ``COINCIDENT``.
       ! Moving along the first or second edge will produce the same result,
       ! but since we "rotate" all intersections to the beginning of an edge,
       ! the index may not match the first or second (or both).
       do i = 1, num_intersections
          if ( &
               intersections(i)%index_first == curr_node%index_first .AND. &
               intersections(i)%s > curr_node%s) then
             if (intersection_index == -1) then
                intersection_index = i
                edge_param = intersections(i)%s
             else
                if (intersections(i)%s < edge_param) then
                   intersection_index = i
                   edge_param = intersections(i)%s
                end if
             end if
          end if
       end do

       if (intersection_index /= -1) then
          next_node = intersections(intersection_index)
          at_start = (intersection_index == start)
          ! Remove the index from the set of ``unused`` intersections, if
          ! it is contained there.
          call remove_node(intersection_index, unused, remaining)
          return
       end if

       ! If there is no other intersection on the first edge, try the
       ! second edge.
       do i = 1, num_intersections
          if ( &
               intersections(i)%index_second == curr_node%index_second .AND. &
               intersections(i)%t > curr_node%t) then
             if (intersection_index == -1) then
                intersection_index = i
                edge_param = intersections(i)%t
             else
                if (intersections(i)%t < edge_param) then
                   intersection_index = i
                   edge_param = intersections(i)%t
                end if
             end if
          end if
       end do

       if (intersection_index /= -1) then
          next_node = intersections(intersection_index)
          at_start = (intersection_index == start)
          ! Remove the index from the set of ``unused`` intersections, if
          ! it is contained there.
          call remove_node(intersection_index, unused, remaining)
          return
       end if

       ! If there is no other intersection on either edge, just return
       ! the end of both segments.
       next_node%index_first = curr_node%index_first
       next_node%s = 1.0_dp
       next_node%index_second = curr_node%index_second
       next_node%t = 1.0_dp
       next_node%interior_curve = IntersectionClassification_COINCIDENT
    end if

  end subroutine get_next

  subroutine to_front( &
       num_intersections, intersections, unused, remaining, &
       start, curr_node, next_node, at_start)

    ! NOTE: This subroutine is not meant to be part of the interface for this
    !       module, but it is (for now) public, so that it can be tested.

    ! This assumes (but does not check) that all intersections at the "end" of
    ! an edge (i.e. with ``s == 1.0`` or ``t == 1.0``) have been pruned from
    ! ``intersections`` (see e.g. ``add_st_vals()``). Therefore, if
    ! ``curr_node`` **is** at the end of an edge, it must be one of the
    ! artificial nodes created by ``get_next()``.

    integer(c_int), intent(in) :: num_intersections
    type(Intersection), intent(in) :: intersections(num_intersections)
    ! ``unused`` contains the indices of intersections that have not yet been
    ! used as a node.
    integer(c_int), intent(inout) :: unused(:)
    integer(c_int), intent(inout) :: remaining
    integer(c_int), intent(in) :: start
    type(Intersection), intent(in) :: curr_node
    type(Intersection), intent(out) :: next_node
    logical(c_bool), intent(out) :: at_start
    ! Variables outside of signature.
    integer(c_int) :: i, index

    at_start = .FALSE.
    if (curr_node%s == 1.0_dp) then
       ! This means ``curr_node`` is an "artificial" corner.
       index = 1 + modulo(curr_node%index_first, 3)
       ! First check if the intersection exists when "rotated" to the
       ! next edge.
       do i = 1, num_intersections
          if ( &
               intersections(i)%s == 0.0_dp .AND. &
               intersections(i)%index_first == index) then
             next_node = intersections(i)
             at_start = (i == start)
             ! Remove the index from the set of ``unused`` intersections, if
             ! it is contained there.
             call remove_node(i, unused, remaining)
             return
          end if
       end do

       ! If we didn't match an existing intersection, create another artificial
       ! intersection.
       next_node%s = 0.0_dp
       next_node%index_first = index
       next_node%interior_curve = IntersectionClassification_FIRST
    else if (curr_node%t == 1.0_dp) then
       ! NOTE: We assume, but do not verify, that ``s == 1`` and ``t == 1``
       !       are mutually exclusive since each **must** correspond to an
       !       artificial node.
       ! This means ``curr_node`` is an "artificial" corner.
       index = 1 + modulo(curr_node%index_second, 3)
       do i = 1, num_intersections
          if ( &
               intersections(i)%t == 0.0_dp .AND. &
               intersections(i)%index_second == index) then
             next_node = intersections(i)
             at_start = (i == start)
             ! Remove the index from the set of ``unused`` intersections, if
             ! it is contained there.
             call remove_node(i, unused, remaining)
             return
          end if
       end do

       ! If we didn't match an existing intersection, create another artificial
       ! intersection.
       next_node%t = 0.0_dp
       next_node%index_second = index
       next_node%interior_curve = IntersectionClassification_SECOND
    else
       ! The node doesn't need to be moved to the front of the edge.
       next_node = curr_node
       return
    end if

  end subroutine to_front

  subroutine add_segment(curr_node, next_node, count, segments)

    ! NOTE: This subroutine is not meant to be part of the interface for this
    !       module, but it is (for now) public, so that it can be tested.
    ! NOTE: We assume, but do not check, that ``curr_node%interior_curve``
    !       is either ``FIRST`` or ``SECOND``.

    type(Intersection), intent(in) :: curr_node, next_node
    integer(c_int), intent(inout) :: count
    type(CurvedPolygonSegment), allocatable, intent(inout) :: segments(:)
    ! Variables outside of signature.
    integer(c_int) :: curr_size
    type(CurvedPolygonSegment), allocatable :: segments_swap(:)

    ! Update the count (assumes caller will start with zero).
    count = count + 1

    ! First, make sure we have enough space.
    if (allocated(segments)) then
       curr_size = size(segments)
       if (curr_size < count) then
          allocate(segments_swap(count))
          segments_swap(:curr_size) = segments(:curr_size)
          call move_alloc(segments_swap, segments)
       end if
    else
       allocate(segments(count))
    end if

    if (is_first(curr_node%interior_curve)) then
       segments(count)%start = curr_node%s
       segments(count)%end_ = next_node%s
       ! NOTE: This **assumes**, but does not check that ``index_first``
       !       is the same for both ``curr_node`` and ``next_node``.
       segments(count)%edge_index = curr_node%index_first
    else if (is_second(curr_node%interior_curve)) then
       segments(count)%start = curr_node%t
       segments(count)%end_ = next_node%t
       ! NOTE: This **assumes**, but does not check that ``index_second``
       !       is the same for both ``curr_node`` and ``next_node``.
       segments(count)%edge_index = curr_node%index_second + 3
    else
       ! NOTE: This assumes but does not check that
       !       ``curr_node%interior_curve`` is ``COINCIDENT``.
       if (curr_node%index_first == next_node%index_first) then
          segments(count)%start = curr_node%s
          segments(count)%end_ = next_node%s
          segments(count)%edge_index = curr_node%index_first
       else
          ! NOTE: This **assumes**, but does not check that ``index_second``
          !       is the same for both ``curr_node`` and ``next_node``.
          segments(count)%start = curr_node%t
          segments(count)%end_ = next_node%t
          segments(count)%edge_index = curr_node%index_second + 3
       end if
    end if

  end subroutine add_segment

  subroutine finalize_segment(segment_ends, num_intersected, count)

    integer(c_int), allocatable, intent(inout) :: segment_ends(:)
    integer(c_int), intent(inout) :: num_intersected
    integer(c_int), intent(in) :: count
    ! Variables outside of signature.
    integer(c_int) :: curr_size
    integer(c_int), allocatable :: segment_ends_swap(:)

    ! Update the number intersected (assumes caller will start with zero).
    num_intersected = num_intersected + 1

    if (allocated(segment_ends)) then
       curr_size = size(segment_ends)
       if (curr_size < num_intersected) then
          allocate(segment_ends_swap(num_intersected))
          segment_ends_swap(:curr_size) = segment_ends(:curr_size)
          call move_alloc(segment_ends_swap, segment_ends)
       end if
    else
       allocate(segment_ends(num_intersected))
    end if

    segment_ends(num_intersected) = count

  end subroutine finalize_segment

  subroutine check_contained( &
       num_intersected, segment_ends, segments, contained)

    integer(c_int), intent(inout) :: num_intersected
    integer(c_int), intent(in) :: segment_ends(:)
    type(CurvedPolygonSegment), intent(in) :: segments(:)
    integer(c_int), intent(out) :: contained

    contained = TriangleContained_NEITHER

    ! Only consider cases where there is exactly one curved polygon.
    if (num_intersected /= 1) then
       return
    end if

    ! Only consider cases where the curved polygon has 3 edges.
    if (segment_ends(1) /= 3) then
       return
    end if

    ! NOTE: This assumes, but does not check, that if ``segment_ends == [3]``
    !       then ``segments`` is allocated and at least length 3.
    ! Only consider cases where the **entire** edge is used (no roundoff).
    if ( &
         any(segments(:3)%start /= 0.0_dp) .OR. &
         any(segments(:3)%end_ /= 1.0_dp)) then
       return
    end if

    ! Finally, check if the edges all come from the same triangle.
    if ( &
         all(segments(:3)%edge_index == [1, 2, 3]) .OR. &
         all(segments(:3)%edge_index == [2, 3, 1]) .OR. &
         all(segments(:3)%edge_index == [3, 1, 2])) then
       num_intersected = 0
       contained = TriangleContained_FIRST
    else if ( &
         all(segments(:3)%edge_index == [4, 5, 6]) .OR. &
         all(segments(:3)%edge_index == [5, 6, 4]) .OR. &
         all(segments(:3)%edge_index == [6, 4, 5])) then
       num_intersected = 0
       contained = TriangleContained_SECOND
    end if

  end subroutine check_contained

  subroutine interior_combine( &
       num_intersections, intersections, &
       num_intersected, segment_ends, segments, &
       contained, status)

    ! NOTE: This subroutine is not meant to be part of the interface for this
    !       module, but it is (for now) public, so that it can be tested.
    ! NOTE: ``num_intersected`` will be the **actual** size of
    !       ``segment_ends``. The size is de-coupled from the **actual**
    !       size since allocatable and we want to allow re-use.
    ! NOTE: This assumes, but does not check, that ``num_intersections > 0``.
    ! NOTE: If ``segments`` is already allocated / with data, the data will be
    !       overwritten in place.

    ! Possible error states:
    ! * Status_SUCCESS     : On success.
    ! * Status_BAD_INTERIOR: If a curved polygon requires more than
    !                        ``MAX_EDGES`` sides. (This could be due to either
    !                        a particular complex intersection or a programming
    !                        error which causes ``at_start`` to never be true.)

    integer(c_int), intent(in) :: num_intersections
    type(Intersection), intent(in) :: intersections(num_intersections)
    integer(c_int), intent(out) :: num_intersected
    integer(c_int), allocatable, intent(inout) :: segment_ends(:)
    type(CurvedPolygonSegment), allocatable, intent(inout) :: segments(:)
    integer(c_int), intent(out) :: contained
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    integer(c_int) :: unused(num_intersections)
    integer(c_int) :: segment_index
    integer(c_int) :: remaining, i, start
    type(Intersection) :: curr_node, next_node
    logical(c_bool) :: at_start

    ! In this case, we know we'll have at least ``num_intersections`` segments
    ! (and may have more due to corners).
    if (allocated(segments)) then
       if (size(segments) < num_intersections) then
          deallocate(segments)
          allocate(segments(num_intersections))
       end if
    else
       allocate(segments(num_intersections))
    end if

    status = Status_SUCCESS
    contained = TriangleContained_NEITHER

    ! Set all of the unused indices.
    unused = [ (i, i = 1, num_intersections) ]
    remaining = num_intersections
    segment_index = 0  ! Last written index.
    num_intersected = 0
    do while (remaining > 0)
       ! "Pop" off intersection from the end to start a curved polygon.
       start = unused(remaining)
       remaining = remaining - 1

       curr_node = intersections(start)
       at_start = .FALSE.
       ! Now move around the edge segments until the curved polygon's
       ! entire boundary has been traversed.
       edge_loop: do i = 1, MAX_EDGES
          ! Follow along the current edge to the next node.
          call get_next( &
               num_intersections, intersections, unused, remaining, &
               start, curr_node, next_node, at_start)
          call add_segment(curr_node, next_node, segment_index, segments)
          ! After adding the segment, check if we are back where we started.
          if (at_start) then
             exit edge_loop
          end if

          ! Now the ``next_node`` becomes the current node, but we may
          ! need to "rotate" it to the next edge if on a corner.
          call to_front( &
               num_intersections, intersections, unused, remaining, &
               start, next_node, curr_node, at_start)
          ! After "rotating" to the next edge, check if we are back where
          ! we started.
          if (at_start) then
             exit edge_loop
          end if
       end do edge_loop

       if (at_start) then
          call finalize_segment( &
               segment_ends, num_intersected, segment_index)
       else
          ! If the loop terminated without reaching the start node, then
          ! we have encountered an error.
          status = Status_BAD_INTERIOR  ! LCOV_EXCL_LINE
          return  ! LCOV_EXCL_LINE
       end if
    end do

    ! As a final pass, check if the intersection is one of the two triangles.
    call check_contained(num_intersected, segment_ends, segments, contained)

  end subroutine interior_combine

  subroutine triangles_intersect( &
       num_nodes1, nodes1, degree1, &
       num_nodes2, nodes2, degree2, &
       segment_ends, segments, &
       num_intersected, contained, status)

    ! NOTE: ``contained`` will be a ``TriangleContained`` enum.
    ! NOTE: ``num_intersected`` will be the **actual** size of
    !       ``segment_ends``. The size is de-coupled from the allocated
    !       size since we want to allow re-use.
    ! NOTE: ``segment_ends`` will contain the indices that split
    !       ``segments`` into distinct curved polygons. For example,
    !       if the first 3 segments correspond to one curved polygon
    !       and the second 4 segments correspond to another, then
    !       ``segment_ends`` will be ``[3, 7]``.

    ! Possible error states:
    ! * Status_SUCCESS         : On success.
    ! * Status_UNKNOWN         : If all of the intersections are classified
    !                            as ``OPPOSED / IGNORED_CORNER / TANGENT_*``
    !                            but not uniquely one type. (This should
    !                            never occur).
    ! * Status_NO_CONVERGE     : Via ``triangles_intersection_points()``.
    ! * (N >= MAX_CANDIDATES)  : Via ``triangles_intersection_points()``.
    ! * Status_BAD_MULTIPLICITY: Via ``triangles_intersection_points()``.
    ! * Status_EDGE_END        : Via ``triangles_intersection_points()``.
    ! * Status_SAME_CURVATURE  : Via ``triangles_intersection_points()``.
    ! * Status_BAD_INTERIOR    : Via ``interior_combine()``.

    integer(c_int), intent(in) :: num_nodes1
    real(c_double), intent(in) :: nodes1(2, num_nodes1)
    integer(c_int), intent(in) :: degree1
    integer(c_int), intent(in) :: num_nodes2
    real(c_double), intent(in) :: nodes2(2, num_nodes2)
    integer(c_int), intent(in) :: degree2
    integer(c_int), allocatable, intent(inout) :: segment_ends(:)
    type(CurvedPolygonSegment), allocatable, intent(inout) :: segments(:)
    integer(c_int), intent(out) :: num_intersected
    integer(c_int), intent(out) :: contained
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    integer(c_int) :: bbox_int
    type(Intersection), allocatable :: intersections(:)
    integer(c_int) :: num_intersections, all_types

    num_intersected = 0
    contained = TriangleContained_NEITHER
    status = Status_SUCCESS

    ! If the bounded boxes do not intersect, the triangles cannot.
    call bbox_intersect( &
         num_nodes1, nodes1, num_nodes2, nodes2, bbox_int)
    if (bbox_int /= BoxIntersectionType_INTERSECTION) then
       return
    end if

    call triangles_intersection_points( &
         num_nodes1, nodes1, degree1, &
         num_nodes2, nodes2, degree2, &
         intersections, num_intersections, all_types, status)
    if (status /= Status_SUCCESS) then
       return
    end if

    if (num_intersections == 0) then
       if (all_types == 0) then
          call no_intersections( &
               num_nodes1, nodes1, degree1, &
               num_nodes2, nodes2, degree2, contained)
          return
       else if (all_types == 2**IntersectionClassification_OPPOSED) then
          return
       else if (all_types == 2**IntersectionClassification_IGNORED_CORNER) then
          return
       else if (all_types == 2**IntersectionClassification_TANGENT_FIRST) then
          contained = TriangleContained_FIRST
          return
       else if (all_types == 2**IntersectionClassification_TANGENT_SECOND) then
          contained = TriangleContained_SECOND
          return
       else if (all_types == &
            2**IntersectionClassification_COINCIDENT_UNUSED) then
          return
       else
          ! NOTE: We "exclude" this block from ``lcov`` because it **should**
          !       never occur. In the case that **none** of the intersections
          !       are ``FIRST`` or ``SECOND``, then they all **should** fall
          !       into the exact same category (which would be one of the
          !       four states above).
          ! LCOV_EXCL_START
          status = Status_UNKNOWN
          return
          ! LCOV_EXCL_STOP
       end if
    end if

    call interior_combine( &
         num_intersections, intersections(:num_intersections), &
         num_intersected, segment_ends, segments, contained, status)

  end subroutine triangles_intersect

  subroutine triangles_intersect_abi( &
       num_nodes1, nodes1, degree1, &
       num_nodes2, nodes2, degree2, &
       segment_ends_size, segment_ends, segments_size, segments, &
       num_intersected, contained, status) &
       bind(c, name='BEZ_triangle_intersections')

    ! NOTE: The number of intersections cannot be known beforehand. If
    !       ``segment_ends`` is not large enough, then it will not be
    !       populated and ``status`` will be set to ``INSUFFICIENT_SPACE``.
    !       However, the value of ``num_intersected`` will be accurate and
    !       ``segment_ends`` should be re-sized by the caller to accommodate.
    !       Additionally, the final element of ``segment_ends`` determines
    !       the number of segments and this may exceed ``segments_size``.
    !       In this case, the ``status`` will also be ``INSUFFICIENT_SPACE``
    !       but the size can be determined by the final element of
    !       ``segment_ends`` and the caller can resize ``segments``
    !       accordingly.

    ! Possible error states:
    ! * Status_SUCCESS           : On success.
    ! * Status_INSUFFICIENT_SPACE: If ``segment_ends_size`` is smaller than
    !                              ``num_intersected`` **OR** if
    !                              ``segments_size`` is smaller than the number
    !                              of segments.
    ! * Status_UNKNOWN           : Via ``triangles_intersect()``.
    ! * Status_NO_CONVERGE       : Via ``triangles_intersect()``.
    ! * (N >= MAX_CANDIDATES)    : Via ``triangles_intersect()``.
    ! * Status_BAD_MULTIPLICITY  : Via ``triangles_intersect()``.
    ! * Status_EDGE_END          : Via ``triangles_intersect()``.
    ! * Status_SAME_CURVATURE    : Via ``triangles_intersect()``.
    ! * Status_BAD_INTERIOR      : Via ``triangles_intersect()``.

    integer(c_int), intent(in) :: num_nodes1
    real(c_double), intent(in) :: nodes1(2, num_nodes1)
    integer(c_int), intent(in) :: degree1
    integer(c_int), intent(in) :: num_nodes2
    real(c_double), intent(in) :: nodes2(2, num_nodes2)
    integer(c_int), intent(in) :: degree2
    integer(c_int), intent(in) :: segment_ends_size
    integer(c_int), intent(out) :: segment_ends(segment_ends_size)
    integer(c_int), intent(in) :: segments_size
    type(CurvedPolygonSegment), intent(out) :: segments(segments_size)
    integer(c_int), intent(out) :: num_intersected
    integer(c_int), intent(out) :: contained
    integer(c_int), intent(out) :: status
    ! Variables outside of signature.
    integer(c_int) :: num_segments

    call triangles_intersect( &
         num_nodes1, nodes1, degree1, &
         num_nodes2, nodes2, degree2, &
         SEGMENT_ENDS_WORKSPACE, SEGMENTS_WORKSPACE, num_intersected, &
         contained, status)

    if (status /= Status_SUCCESS) then
       return
    end if

    if (num_intersected == 0) then
       return
    end if

    if (num_intersected > segment_ends_size) then
       status = Status_INSUFFICIENT_SPACE
       return
    end if

    segment_ends(:num_intersected) = ( &
         SEGMENT_ENDS_WORKSPACE(:num_intersected))
    num_segments = segment_ends(num_intersected)
    if (num_segments > segments_size) then
       status = Status_INSUFFICIENT_SPACE
       return
    end if

    segments(:num_segments) = SEGMENTS_WORKSPACE(:num_segments)

  end subroutine triangles_intersect_abi

  subroutine free_triangle_intersections_workspace() &
       bind(c, name='BEZ_free_triangle_intersections_workspace')

    ! NOTE: This **should** be run during clean-up for any code which
    !       invokes ``triangles_intersect_abi()``.

    if (allocated(SEGMENT_ENDS_WORKSPACE)) then
       deallocate(SEGMENT_ENDS_WORKSPACE)
    end if

    if (allocated(SEGMENTS_WORKSPACE)) then
       deallocate(SEGMENTS_WORKSPACE)
    end if

  end subroutine free_triangle_intersections_workspace

end module triangle_intersection


<|start_filename|>docs/abi/example_evaluate_hodograph.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    double s = 0.125;
    int num_nodes = 4;
    int dimension = 2;
    double nodes[8] = { 1.0, 0.0, 1.0, 1.0, 2.0, 0.0, 2.0, 1.0 };

    // Outputs.
    double hodograph[2];

    BEZ_evaluate_hodograph(&s, &num_nodes, &dimension, nodes, hodograph);
    printf("Hodograph:\n%f\n%f\n", hodograph[0], hodograph[1]);

    return 0;
}


<|start_filename|>tests/fortran/unit_test.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

program unit_test

  use, intrinsic :: iso_c_binding, only: c_bool
  use curve_intersection, only: free_curve_intersections_workspace
  use triangle_intersection, only: free_triangle_intersections_workspace
  use test_helpers, only: helpers_all_tests
  use test_curve, only: curve_all_tests
  use test_triangle, only: triangle_all_tests
  use test_curve_intersection, only: curve_intersection_all_tests
  use test_triangle_intersection, only: triangle_intersection_all_tests
  implicit none

  logical(c_bool) :: success

  success = .TRUE.
  call helpers_all_tests(success)
  call curve_all_tests(success)
  call triangle_all_tests(success)
  call curve_intersection_all_tests(success)
  call triangle_intersection_all_tests(success)
  ! Wrap up allocated globals.
  call free_curve_intersections_workspace()
  call free_triangle_intersections_workspace()
  if (.NOT. success) then
     stop 1  ! LCOV_EXCL_LINE
  end if

end program unit_test


<|start_filename|>src/fortran/helpers.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module helpers

  use, intrinsic :: iso_c_binding, only: c_double, c_int, c_bool
  use types, only: dp
  implicit none
  private min_index, sort_in_place, is_separating
  public &
       WIGGLE, VECTOR_CLOSE_EPS, cross_product, bbox, wiggle_interval, &
       contains_nd, vector_close, in_interval, in_sorted, convex_hull, &
       polygon_collide, solve2x2

  real(c_double), parameter :: WIGGLE = 0.5_dp**44
  ! NOTE: This is intended to be used as the default value for ``eps``
  !       in ``vector_close``.
  real(c_double), parameter :: VECTOR_CLOSE_EPS = 0.5_dp**40

contains

  pure subroutine cross_product( &
       vec0, vec1, result_) &
       bind(c, name='BEZ_cross_product')

    real(c_double), intent(in) :: vec0(2)
    real(c_double), intent(in) :: vec1(2)
    real(c_double), intent(out) :: result_

    result_ = vec0(1) * vec1(2) - vec0(2) * vec1(1)

  end subroutine cross_product

  subroutine bbox( &
       num_nodes, nodes, left, right, bottom, top) &
       bind(c, name='BEZ_bbox')

    integer(c_int), intent(in) :: num_nodes
    real(c_double), intent(in) :: nodes(2, num_nodes)
    real(c_double), intent(out) :: left, right, bottom, top
    ! Variables outside of signature.
    real(c_double) :: workspace(2)

    workspace = minval(nodes, 2)
    left = workspace(1)
    bottom = workspace(2)
    workspace = maxval(nodes, 2)
    right = workspace(1)
    top = workspace(2)

  end subroutine bbox

  subroutine wiggle_interval( &
       value_, result_, success) &
       bind(c, name='BEZ_wiggle_interval')

    real(c_double), intent(in) :: value_
    real(c_double), intent(out) :: result_
    logical(c_bool), intent(out) :: success

    success = .TRUE.
    if (-WIGGLE < value_ .AND. value_ < WIGGLE) then
       result_ = 0.0_dp
    else if (WIGGLE <= value_ .AND. value_ <= 1.0_dp - WIGGLE) then
       result_ = value_
    else if ( &
         1.0_dp - WIGGLE < value_ .AND. value_ < 1.0_dp + WIGGLE) then
       result_ = 1.0_dp
    else
       success = .FALSE.
    end if

  end subroutine wiggle_interval

  pure subroutine contains_nd( &
       num_nodes, dimension_, nodes, point, predicate) &
       bind(c, name='BEZ_contains_nd')

    integer(c_int), intent(in) :: num_nodes, dimension_
    real(c_double), intent(in) :: nodes(dimension_, num_nodes)
    real(c_double), intent(in) :: point(dimension_)
    logical(c_bool), intent(out) :: predicate

    if (any(point < minval(nodes, 2))) then
       predicate = .FALSE.
    else if (any(maxval(nodes, 2) < point)) then
       predicate = .FALSE.
    else
       predicate = .TRUE.
    end if

  end subroutine contains_nd

  logical(c_bool) pure function vector_close( &
       num_values, vec1, vec2, eps) result(is_close) &
       bind(c, name='BEZ_vector_close')

    integer(c_int), intent(in) :: num_values
    real(c_double), intent(in) :: vec1(num_values)
    real(c_double), intent(in) :: vec2(num_values)
    real(c_double), intent(in) :: eps
    ! Variables outside of signature.
    real(c_double) :: size1, size2

    size1 = norm2(vec1)
    size2 = norm2(vec2)
    if (size1 == 0.0_dp) then
       is_close = size2 <= eps
    else if (size2 == 0.0_dp) then
       is_close = size1 <= eps
    else
       ! This is the most common path.
       is_close = norm2(vec1 - vec2) <= eps * min(size1, size2)
    end if

  end function vector_close

  pure function in_interval( &
       value_, start, end) result(predicate) &
       bind(c, name='BEZ_in_interval')

    real(c_double), intent(in) :: value_, start, end
    logical(c_bool) :: predicate

    predicate = (start <= value_) .AND. (value_ <= end)

  end function in_interval

  subroutine min_index(num_points, points, match)

    ! Finds the minimum point when sorting first by ``x`` then by
    ! ``y`` coordinate (in the case of a tie in ``x``).

    ! NOTE: This is a helper for ``sort_in_place``.
    ! NOTE: This assumes, but does not check, that ``num_points > 0``.

    integer(c_int), intent(in) :: num_points
    real(c_double), intent(inout) :: points(2, num_points)
    integer(c_int), intent(out) :: match
    ! Variables outside of signature.
    integer(c_int) :: i

    match = 1
    do i = 2, num_points
       if (points(1, i) < points(1, match)) then
          match = i
       else if (points(1, i) == points(1, match)) then
          if (points(2, i) < points(2, match)) then
             match = i
          end if
       end if
    end do

  end subroutine min_index

  subroutine sort_in_place(num_points, points, num_uniques)

    ! NOTE: This is a helper for ``convex_hull``. This does a simple quadratic
    !       sort (i.e. it is suboptimal) because it expects the number of
    !       points to be small. It **also** makes sure the values are unique
    !       to exact precision.

    integer(c_int), intent(in) :: num_points
    real(c_double), intent(inout) :: points(2, num_points)
    integer(c_int), intent(out) :: num_uniques
    ! Variables outside of signature.
    integer(c_int) :: i, match
    real(c_double) :: swap(2)

    num_uniques = num_points
    ! Place the "smallest" point first (since it can't be a duplicate).
    call min_index(num_points, points, match)
    if (match /= 1) then
       swap = points(:, match)
       points(:, match) = points(:, 1)
       points(:, 1) = swap
    end if

    i = 2
    do while (i <= num_uniques)
       call min_index(num_uniques + 1 - i, points(:, i:num_uniques), match)
       ! Shift ``match`` based on the slice ``points(:, i:...)``.
       match = match + i - 1
       if (match /= i) then
          swap = points(:, match)
          if (all(swap == points(:, i - 1))) then
             ! This means ``match`` is a duplicate.
             points(:, match) = points(:, num_uniques)
             points(:, num_uniques) = swap
             num_uniques = num_uniques - 1
          else
             points(:, match) = points(:, i)
             points(:, i) = swap
          end if
       end if
       ! Increment for next iteration.
       i = i + 1
    end do

  end subroutine sort_in_place

  logical(c_bool) pure function in_sorted( &
       num_values, values, value_) result(contained)

    ! NOTE: This assumes ``num_values >= 1``.
    ! NOTE: This subroutine is not part of the C ABI for this module,
    !       but it is (for now) public, so that it can be tested.

    integer(c_int), intent(in) :: num_values
    integer(c_int), intent(in) :: values(num_values)
    integer(c_int), intent(in) :: value_
    ! Variables outside of signature.
    integer(c_int) :: left, right, midpoint

    left = 1
    right = num_values

    do while (left < right)
       midpoint = (left + right) / 2
       if (value_ == values(midpoint)) then
          contained = .TRUE.
          return
       else if (value_ < values(midpoint)) then
          right = midpoint - 1
       else
          left = midpoint + 1
       end if
    end do

    contained = values(left) == value_

  end function in_sorted

  subroutine convex_hull( &
       num_points, points, polygon_size, polygon) &
       bind(c, name='BEZ_simple_convex_hull')

    ! NOTE: This uses Andrew's monotone chain convex hull algorithm and used
    !       (https://en.wikibooks.org/wiki/Algorithm_Implementation/
    !        Geometry/Convex_hull/Monotone_chain)
    !       as motivation. The code there is licensed CC BY-SA 3.0.

    ! NOTE: The "standard" implementation for this is in Qhull, but for now
    !       that is avoided as an extra dependency.

    integer(c_int), intent(in) :: num_points
    real(c_double), intent(in) :: points(2, num_points)
    integer(c_int), intent(out) :: polygon_size
    real(c_double), intent(out) :: polygon(2, num_points)
    ! Variables outside of signature.
    real(c_double) :: point1(2), point2(2), point3(2)
    integer(c_int) :: num_uniques
    real(c_double) :: uniques(2, num_points)
    integer(c_int) :: num_lower, num_upper
    integer(c_int) :: lower(num_points), upper(num_points)
    integer(c_int) :: i
    real(c_double) :: result_

    uniques = points
    call sort_in_place(num_points, uniques, num_uniques)

    ! In the "boring" case that we have fewer than 2 points, return.
    if (num_uniques == 0) then
       polygon_size = 0
       return
    else if (num_uniques < 3) then
       polygon_size = num_uniques
       polygon(:, :num_uniques) = uniques(:, :num_uniques)
       return
    end if

    ! First create a "lower" convex hull
    num_lower = 2  ! We know ``num_uniques >= 3``.
    lower(:2) = [1, 2]
    do i = 3, num_uniques
       point3 = uniques(:, i)
       result_ = -1.0_dp  ! Dummy value that is ``<= 0.0``.
       do while (num_lower > 1 .AND. result_ <= 0.0_dp)
          point1 = uniques(:, lower(num_lower - 1))
          point2 = uniques(:, lower(num_lower))
          ! If ``point3`` (the one we are considering) is more "inside"
          ! of ``point1`` than ``point2`` is, then we drop ``point2``.
          call cross_product(point2 - point1, point3 - point1, result_)
          if (result_ <= 0.0_dp) then
             num_lower = num_lower - 1
          end if
       end do
       num_lower = num_lower + 1
       lower(num_lower) = i
    end do

    ! Then create an "upper" convex hull
    num_upper = 1
    upper(1) = num_uniques
    upper_loop: do i = num_uniques - 1, 1, -1
       ! Don't consider indices from the lower hull (other than the ends).
       if (i > 1 .AND. in_sorted(num_lower, lower(:num_lower), i)) then
          cycle upper_loop
       end if
       point3 = uniques(:, i)
       result_ = -1.0_dp  ! Dummy value that is ``<= 0.0``.
       do while (num_upper > 1 .AND. result_ <= 0.0_dp)
          point1 = uniques(:, upper(num_upper - 1))
          point2 = uniques(:, upper(num_upper))
          ! If ``point3`` (the one we are considering) is more "inside"
          ! of ``point1`` than ``point2`` is, then we drop ``point2``.
          call cross_product(point2 - point1, point3 - point1, result_)
          if (result_ <= 0.0_dp) then
             num_upper = num_upper - 1
          end if
       end do
       num_upper = num_upper + 1
       upper(num_upper) = i
    end do upper_loop

    ! The endpoints are **both** double counted, so we skip the "end"
    ! of each hull (lower and upper).
    polygon_size = 0
    do i = 1, num_lower - 1
       polygon_size = polygon_size + 1
       polygon(:, polygon_size) = uniques(:, lower(i))
    end do
    do i = 1, num_upper - 1
       polygon_size = polygon_size + 1
       polygon(:, polygon_size) = uniques(:, upper(i))
    end do

  end subroutine convex_hull

  logical(c_bool) pure function is_separating( &
       edge_direction, polygon_size1, polygon1, polygon_size2, polygon2) &
       result(predicate)

    ! NOTE: This assumes, but does not check, that ``polygon_sizeX`` is
    !       at least two.
    real(c_double), intent(in) :: edge_direction(2)
    integer(c_int), intent(in) :: polygon_size1
    real(c_double), intent(in) :: polygon1(2, polygon_size1)
    integer(c_int), intent(in) :: polygon_size2
    real(c_double), intent(in) :: polygon2(2, polygon_size2)
    ! Variables outside of signature.
    real(c_double) :: vertex(2), norm_squared, cp_result, param
    real(c_double) :: min_param1, max_param1
    real(c_double) :: min_param2, max_param2
    integer(c_int) :: i

    ! NOTE: We assume throughout that ``norm_squared != 0``. If it **were**
    !       zero that would mean the ``edge_direction`` corresponds to an
    !       invalid edge.
    norm_squared = dot_product(edge_direction, edge_direction)

    ! Compute the parameters along the "separating axis" for the vertices
    ! of the first polygon.
    vertex = polygon1(:, 1)
    call cross_product(edge_direction, vertex, cp_result)
    param = cp_result / norm_squared
    min_param1 = param
    max_param1 = param
    do i = 2, polygon_size1
       vertex = polygon1(:, i)
       call cross_product(edge_direction, vertex, cp_result)
       param = cp_result / norm_squared
       min_param1 = min(min_param1, param)
       max_param1 = max(max_param1, param)
    end do

    ! Compute the parameters along the "separating axis" for the vertices
    ! of the first polygon.
    vertex = polygon2(:, 1)
    call cross_product(edge_direction, vertex, cp_result)
    param = cp_result / norm_squared
    min_param2 = param
    max_param2 = param
    do i = 2, polygon_size2
       vertex = polygon2(:, i)
       call cross_product(edge_direction, vertex, cp_result)
       param = cp_result / norm_squared
       min_param2 = min(min_param2, param)
       max_param2 = max(max_param2, param)
    end do

    ! Determine if [min_param1, max_param1] and [min_param2, max_param2]
    ! are disjoint intervals.
    predicate = (min_param1 > max_param2 .OR. max_param1 < min_param2)

  end function is_separating

  subroutine polygon_collide( &
       polygon_size1, polygon1, polygon_size2, polygon2, collision) &
       bind(c, name='BEZ_polygon_collide')

    ! This determines if two **convex** polygons collide. The polygons
    ! are given as ``2 x N`` arrays of ``x-y`` points (one per column)
    ! in order they appear (the first and last node are **not** the same
    ! as is sometimes expected for closed polygons).

    ! This code uses the Separating axis theorem (SAT) [1] [2] to quickly
    ! determine if the polygons intersect.
    ! [1]: https://en.wikipedia.org/wiki/Hyperplane_separation_theorem
    ! [2]: https://hackmd.io/s/ryFmIZrsl

    ! A "standard" implementation for this is in GEOS [3], but for now
    ! that is avoided as an extra dependency.
    ! [3]: https://trac.osgeo.org/geos

    integer(c_int), intent(in) :: polygon_size1
    real(c_double), intent(in) :: polygon1(2, polygon_size1)
    integer(c_int), intent(in) :: polygon_size2
    real(c_double), intent(in) :: polygon2(2, polygon_size2)
    logical(c_bool), intent(out) :: collision
    ! Variables outside of signature.
    real(c_double) :: edge_direction(2)
    integer(c_int) :: i

    collision = .TRUE.

    ! First handle the "wrap-around" edge from polygon1.
    edge_direction = polygon1(:, 1) - polygon1(:, polygon_size1)
    if (is_separating( &
         edge_direction, polygon_size1, polygon1, &
         polygon_size2, polygon2)) then
       collision = .FALSE.
       return
    end if

    ! Then, check all other edges from polygon1.
    do i = 2, polygon_size1
       edge_direction = polygon1(:, i) - polygon1(:, i - 1)
       if (is_separating( &
            edge_direction, polygon_size1, polygon1, &
            polygon_size2, polygon2)) then
          collision = .FALSE.
          return
       end if
    end do

    ! Then, handle the "wrap-around" edge from polygon2.
    edge_direction = polygon2(:, 1) - polygon2(:, polygon_size2)
    if (is_separating( &
         edge_direction, polygon_size1, polygon1, &
         polygon_size2, polygon2)) then
       collision = .FALSE.
       return
    end if

    ! Then, check all other edges from polygon1.
    do i = 2, polygon_size2
       edge_direction = polygon2(:, i) - polygon2(:, i - 1)
       if (is_separating( &
            edge_direction, polygon_size1, polygon1, &
            polygon_size2, polygon2)) then
          collision = .FALSE.
          return
       end if
    end do

  end subroutine polygon_collide

  subroutine solve2x2(lhs, rhs, singular, x_val, y_val)

    real(c_double), intent(in) :: lhs(2, 2)
    real(c_double), intent(in) :: rhs(2)
    logical(c_bool), intent(out) :: singular
    real(c_double), intent(out) :: x_val
    real(c_double), intent(out) :: y_val
    ! Variables outside of signature.
    real(c_double) :: ratio, denominator

    ! A <--> lhs(1, 1)
    ! B <--> lhs(1, 2)
    ! C <--> lhs(2, 1)
    ! D <--> lhs(2, 2)
    ! E <--> rhs(1)
    ! F <--> rhs(2)
    if (abs(lhs(2, 1)) > abs(lhs(1, 1))) then
       ! NOTE: We know there is no division by zero here since ``C``
       !       is **strictly** bigger than **some** value (in magnitude).
       ! [A | B][x] = [E]
       ! [C | D][y]   [F]
       ratio = lhs(1, 1) / lhs(2, 1)
       ! r = A / C
       ! [A - rC | B - rD][x]   [E - rF]
       ! [C      | D     ][y] = [F     ]
       ! ==> 0x + (B - rD) y = E - rF
       denominator = lhs(1, 2) - ratio * lhs(2, 2)
       if (denominator == 0.0_dp) then
          singular = .TRUE.
          return
       end if

       y_val = (rhs(1) - ratio * rhs(2)) / denominator
       ! Cx + Dy = F ==> x = (F - Dy) / C
       x_val = (rhs(2) - lhs(2, 2) * y_val) / lhs(2, 1)
       singular = .FALSE.
    else
       if (lhs(1, 1) == 0.0_dp) then
          singular = .TRUE.
          return
       end if
       ! [A | B][x] = [E]
       ! [C | D][y]   [F]
       ratio = lhs(2, 1) / lhs(1, 1)
       ! r = C / A
       ! [A      | B     ][x] = [E     ]
       ! [C - rA | D - rB][y]   [F - rE]
       ! ==> 0x + (D - rB) y = F - rE
       denominator = lhs(2, 2) - ratio * lhs(1, 2)
       if (denominator == 0.0_dp) then
          singular = .TRUE.
          return
       end if

       y_val = (rhs(2) - ratio * rhs(1)) / denominator
       ! Ax + By = E ==> x = (E - B y) / A
       x_val = (rhs(1) - lhs(1, 2) * y_val) / lhs(1, 1)
       singular = .FALSE.
    end if

  end subroutine solve2x2

end module helpers


<|start_filename|>src/fortran/include/bezier/helpers.h<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#ifndef BEZIER_HELPERS_H
#define BEZIER_HELPERS_H

#include <stdbool.h>

#if defined(__cplusplus)
extern "C" {
#endif

void BEZ_cross_product(const double* vec0, const double* vec1, double* result);
void BEZ_bbox(const int* num_nodes, const double* nodes, double* left,
    double* right, double* bottom, double* top);
void BEZ_wiggle_interval(const double* value, double* result, bool* success);
void BEZ_contains_nd(const int* num_nodes, const int* dimension,
    const double* nodes, const double* point, bool* predicate);
bool BEZ_vector_close(int* num_values, const double* vec1, const double* vec2,
    const double* eps);
bool BEZ_in_interval(
    const double* value, const double* start, const double* end);
void BEZ_simple_convex_hull(
    int* num_points, const double* points, int* polygon_size, double* polygon);
void BEZ_polygon_collide(const int* polygon_size1, const double* polygon1,
    const int* polygon_size2, const double* polygon2, bool* collision);

#if defined(__cplusplus)
}
#endif

#endif /* BEZIER_HELPERS_H */


<|start_filename|>docs/abi/example_evaluate_multi.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 4;
    int dimension = 2;
    double nodes[8] = { 1.0, 0.0, 1.0, 1.0, 2.0, 0.0, 2.0, 1.0 };
    int num_vals = 3;
    double s_vals[3] = { 0.0, 0.5, 1.0 };

    // Outputs.
    double evaluated[6];

    BEZ_evaluate_multi(
        &num_nodes, &dimension, nodes, &num_vals, s_vals, evaluated);
    printf("Evaluated:\n");
    printf("%f, %f, %f\n", evaluated[0], evaluated[2], evaluated[4]);
    printf("%f, %f, %f\n", evaluated[1], evaluated[3], evaluated[5]);

    return 0;
}


<|start_filename|>docs/abi/example_reduce_pseudo_inverse.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 4;
    int dimension = 2;
    double nodes[8] = { -3.0, 3.0, 0.0, 2.0, 1.0, 3.0, 0.0, 6.0 };

    // Outputs.
    double reduced[6];
    bool not_implemented;

    BEZ_reduce_pseudo_inverse(
        &num_nodes, &dimension, nodes, reduced, &not_implemented);
    printf("Reduced:\n");
    printf("% f, %f, %f\n", reduced[0], reduced[2], reduced[4]);
    printf("% f, %f, %f\n", reduced[1], reduced[3], reduced[5]);
    printf("Not implemented: %s\n", not_implemented ? "TRUE" : "FALSE");

    return 0;
}


<|start_filename|>docs/abi/example_status.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes1 = 3;
    double nodes1[6] = { 0.0, 0.0, 6.0, 4.0, 12.0, 0.0 };
    double s = 7.0 / 8.0;
    int num_nodes2 = 2;
    double nodes2[4] = { 6.0, 0.0, 0.0, 3.0 };
    double t = -2.0;

    // Outputs.
    double new_s, new_t;
    Status status;

    BEZ_newton_refine_curve_intersect(&s, &num_nodes1, nodes1, &t, &num_nodes2,
        nodes2, &new_s, &new_t, &status);
    if (status == SINGULAR) {
        printf("Jacobian is singular.\n");
    }

    return 0;
}


<|start_filename|>tests/fortran/unit_test_helpers.f90<|end_filename|>
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
!     https://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.

module unit_test_helpers

  use, intrinsic :: iso_c_binding, only: c_double, c_bool
  use types, only: dp
  implicit none
  private
  public &
       MACHINE_EPS, print_status, get_random_nodes, binary_round, &
       get_id_mat, ref_triangle_uniform_params

  ! NOTE: Should probably use ``d1mach`` to determine this.
  real(c_double), parameter :: MACHINE_EPS = 0.5_dp**52

contains

  subroutine print_status(name, case_id, case_success, suite_success)
    character(len=*), intent(in) :: name
    integer, intent(inout) :: case_id
    logical, intent(in) :: case_success
    logical(c_bool), intent(inout) :: suite_success
    ! Variables outside of signature.
    character(len=8) :: status_msg

    if (case_success) then
       status_msg = " success"
    else
       status_msg = " failure"  ! LCOV_EXCL_LINE
       suite_success = .FALSE.  ! LCOV_EXCL_LINE
    end if

    write (*, "(A28, A, I2, A)") name, ": Case ", case_id, status_msg

    ! Increment case ID for next case.
    case_id = case_id + 1

  end subroutine print_status

  subroutine get_random_nodes(nodes, multiplier, modulus, num_bits)
    real(c_double), intent(inout) :: nodes(:, :)
    integer, intent(in) :: multiplier, modulus
    integer, optional, intent(in) :: num_bits
    ! Variables outside of signature.
    integer, allocatable :: old_seed(:)
    integer, allocatable :: new_seed(:)
    integer :: size_, i

    ! Get the size of the random seed.
    call random_seed(size=size_)
    ! Store the old seed before replacing it.
    allocate(old_seed(size_))
    call random_seed(get=old_seed)

    ! Set a temporary seed based on ``multiplier`` and ``modulus``.
    new_seed = [(mod(multiplier * i, modulus), i = 0, size_ - 1)]
    call random_seed(put=new_seed)
    ! Populate the matrix with random values from our seed.
    call random_number(nodes)

    ! If ``num_bits`` is specified, then binary round the ``nodes``.
    if (present(num_bits)) then
       call binary_round(nodes, num_bits)
    end if

    ! Put back the original seed.
    call random_seed(put=old_seed)

  end subroutine get_random_nodes

  subroutine binary_round(value_, num_bits)
    real(c_double), intent(inout) :: value_(:, :)
    integer, intent(in) :: num_bits
    ! Variables outside of signature.
    real(c_double), allocatable :: work(:, :)

    ! E.g. The first 4 bits of -6691/512 = -13.068359375 = -0x1.a23p+3
    ! are -0x1.ap+3 = -13. To get this, we use `fraction` to compute the
    ! unsigned significand (i.e. `1 + mantissa`) 6691/4096.
    ! NOTE: The ``allocate`` below is unnecessary, but added in because
    !       ``gfortran==7.3.0`` complains that "`work.offset` may be used
    !       uninitialized"
    allocate(work(size(value_, 1), size(value_, 2)))
    work = 2 * fraction(abs(value_))
    ! Then we multiply by 2^(num_bits) and truncate to an integer
    ! 26 = 0x1.ap+4.
    work = floor(work * 2.0_dp**num_bits)
    ! Then we remove the added exponents (1 from doubling the output
    ! of `fraction` and `num_bits` from the scaling).
    work = work * 0.5_dp**(1 + num_bits)
    ! Finally we restore the original exponent and sign.
    value_ = sign(work * 2.0_dp**exponent(value_), value_)

  end subroutine binary_round

  function get_id_mat(n) result(id_mat)
    integer, intent(in) :: n
    real(c_double) :: id_mat(n, n)
    ! Variables outside of signature.
    integer :: i

    ! Populate as the identity matrix.
    id_mat = 0
    forall (i = 1:n)
       id_mat(i, i) = 1
    end forall

  end function get_id_mat

  function ref_triangle_uniform_params(pts_exponent) result(params)
    integer, intent(in) :: pts_exponent
    real(c_double) :: &
         params((2**pts_exponent + 1) * (2**(pts_exponent - 1) + 1), 2)
    ! Variables outside of signature.
    integer :: index, x_val, y_val

    index = 1
    do y_val = 0, 2**pts_exponent
       do x_val = 0, 2**pts_exponent - y_val
          params(index, :) = [x_val, y_val]
          index = index + 1
       end do
    end do

    params = 0.5_dp**pts_exponent * params

  end function ref_triangle_uniform_params

end module unit_test_helpers


<|start_filename|>docs/abi/example_get_curvature.c<|end_filename|>
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
//     https://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.

#include "bezier.h"
#include <stdio.h>

int main(void)
{
    // Inputs.
    int num_nodes = 5;
    double nodes[10] = { 1.0, 0.0, 0.75, 2.0, 0.5, -2.0, 0.25, 2.0, 0.0, 0.0 };
    double tangent_vec[2] = { -1.0, 0.0 };
    double s = 0.5;

    // Outputs.
    double curvature;

    BEZ_get_curvature(&num_nodes, nodes, tangent_vec, &s, &curvature);
    printf("Curvature: %f\n", curvature);

    return 0;
}
