| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module stl_wall_intersection | ||
| 2 | |||
| 3 | use, intrinsic :: iso_fortran_env, only: dp => real64 | ||
| 4 | use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_associated, c_int | ||
| 5 | use, intrinsic :: iso_c_binding, only: c_double, c_char, c_null_char | ||
| 6 | implicit none | ||
| 7 | |||
| 8 | private | ||
| 9 | public :: stl_wall_t | ||
| 10 | public :: stl_wall_init | ||
| 11 | public :: stl_wall_finalize | ||
| 12 | public :: stl_wall_first_hit_segment | ||
| 13 | public :: stl_wall_first_hit_segment_with_normal | ||
| 14 | public :: stl_wall_available | ||
| 15 | |||
| 16 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 17 | logical, parameter :: stl_wall_available = .true. | ||
| 18 | #else | ||
| 19 | logical, parameter :: stl_wall_available = .false. | ||
| 20 | #endif | ||
| 21 | |||
| 22 | type :: stl_wall_t | ||
| 23 | type(c_ptr) :: handle = c_null_ptr | ||
| 24 | integer :: facet_count = 0 | ||
| 25 | end type stl_wall_t | ||
| 26 | |||
| 27 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 28 | interface | ||
| 29 | function stl_wall_create(filename_c, scale_to_m) & | ||
| 30 | bind(C, name="stl_wall_create") result(h) | ||
| 31 | import :: c_ptr, c_char, c_double | ||
| 32 | character(kind=c_char), intent(in) :: filename_c(*) | ||
| 33 | real(c_double), value, intent(in) :: scale_to_m | ||
| 34 | type(c_ptr) :: h | ||
| 35 | end function stl_wall_create | ||
| 36 | |||
| 37 | subroutine stl_wall_destroy(h) bind(C, name="stl_wall_destroy") | ||
| 38 | import :: c_ptr | ||
| 39 | type(c_ptr), value, intent(in) :: h | ||
| 40 | end subroutine stl_wall_destroy | ||
| 41 | |||
| 42 | function stl_wall_facet_count(h) bind(C) result(count) | ||
| 43 | import :: c_ptr, c_int | ||
| 44 | type(c_ptr), value, intent(in) :: h | ||
| 45 | integer(c_int) :: count | ||
| 46 | end function stl_wall_facet_count | ||
| 47 | |||
| 48 | function stl_wall_first_hit_segment_c(h, p0_m, p1_m, hit_m) & | ||
| 49 | bind(C, name="stl_wall_first_hit_segment") result(hit) | ||
| 50 | import :: c_ptr, c_double, c_int | ||
| 51 | type(c_ptr), value, intent(in) :: h | ||
| 52 | real(c_double), intent(in) :: p0_m(3) | ||
| 53 | real(c_double), intent(in) :: p1_m(3) | ||
| 54 | real(c_double), intent(out) :: hit_m(3) | ||
| 55 | integer(c_int) :: hit | ||
| 56 | end function stl_wall_first_hit_segment_c | ||
| 57 | |||
| 58 | function stl_wall_first_hit_segment_with_normal_c( & | ||
| 59 | h, p0_m, p1_m, hit_m, normal, triangle) & | ||
| 60 | bind(C, name="stl_wall_first_hit_segment_with_normal") result(hit) | ||
| 61 | import :: c_ptr, c_double, c_int | ||
| 62 | type(c_ptr), value, intent(in) :: h | ||
| 63 | real(c_double), intent(in) :: p0_m(3) | ||
| 64 | real(c_double), intent(in) :: p1_m(3) | ||
| 65 | real(c_double), intent(out) :: hit_m(3) | ||
| 66 | real(c_double), intent(out) :: normal(3) | ||
| 67 | integer(c_int), intent(out) :: triangle | ||
| 68 | integer(c_int) :: hit | ||
| 69 | end function stl_wall_first_hit_segment_with_normal_c | ||
| 70 | end interface | ||
| 71 | #endif | ||
| 72 | |||
| 73 | contains | ||
| 74 | |||
| 75 | ✗ | subroutine stl_wall_init(wall, filename, scale_to_m) | |
| 76 | type(stl_wall_t), intent(inout) :: wall | ||
| 77 | character(len=*), intent(in) :: filename | ||
| 78 | real(dp), intent(in) :: scale_to_m | ||
| 79 | |||
| 80 | ✗ | character(kind=c_char), allocatable :: filename_c(:) | |
| 81 | integer :: n, i | ||
| 82 | |||
| 83 | ✗ | if (len_trim(filename) == 0) then | |
| 84 | ✗ | error stop "stl_wall_init: filename must be non-empty" | |
| 85 | end if | ||
| 86 | ✗ | if (.not. (scale_to_m > 0.0_dp)) then | |
| 87 | ✗ | error stop "stl_wall_init: scale_to_m must be > 0" | |
| 88 | end if | ||
| 89 | |||
| 90 | ✗ | n = len_trim(filename) | |
| 91 | ✗ | allocate (filename_c(n + 1)) | |
| 92 | ✗ | do i = 1, n | |
| 93 | ✗ | filename_c(i) = filename(i:i) | |
| 94 | end do | ||
| 95 | filename_c(n + 1) = c_null_char | ||
| 96 | |||
| 97 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 98 | wall%handle = stl_wall_create(filename_c, real(scale_to_m, c_double)) | ||
| 99 | if (.not. c_associated(wall%handle)) then | ||
| 100 | error stop "stl_wall_init: failed to create STL wall (CGAL)" | ||
| 101 | end if | ||
| 102 | wall%facet_count = int(stl_wall_facet_count(wall%handle)) | ||
| 103 | #else | ||
| 104 | ✗ | associate (dummy => wall) | |
| 105 | end associate | ||
| 106 | ✗ | print *, "stl_wall_init: SIMPLE built without CGAL support." | |
| 107 | ✗ | print *, "Rebuild with -DSIMPLE_ENABLE_CGAL=ON to use wall_input." | |
| 108 | ✗ | error stop "stl_wall_init: CGAL disabled" | |
| 109 | #endif | ||
| 110 | end subroutine stl_wall_init | ||
| 111 | |||
| 112 | 48 | subroutine stl_wall_finalize(wall) | |
| 113 | type(stl_wall_t), intent(inout) :: wall | ||
| 114 | |||
| 115 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 116 | if (c_associated(wall%handle)) then | ||
| 117 | call stl_wall_destroy(wall%handle) | ||
| 118 | end if | ||
| 119 | #endif | ||
| 120 | 48 | wall%handle = c_null_ptr | |
| 121 | 48 | wall%facet_count = 0 | |
| 122 | 48 | end subroutine stl_wall_finalize | |
| 123 | |||
| 124 | ✗ | subroutine stl_wall_first_hit_segment(wall, p0_m, p1_m, hit, hit_m) | |
| 125 | type(stl_wall_t), intent(in) :: wall | ||
| 126 | real(dp), intent(in) :: p0_m(3) | ||
| 127 | real(dp), intent(in) :: p1_m(3) | ||
| 128 | logical, intent(out) :: hit | ||
| 129 | real(dp), intent(out) :: hit_m(3) | ||
| 130 | |||
| 131 | integer(c_int) :: hit_i | ||
| 132 | |||
| 133 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 134 | if (.not. c_associated(wall%handle)) then | ||
| 135 | error stop "stl_wall_first_hit_segment: wall not initialized" | ||
| 136 | end if | ||
| 137 | hit_i = stl_wall_first_hit_segment_c(wall%handle, & | ||
| 138 | real(p0_m, c_double), & | ||
| 139 | real(p1_m, c_double), & | ||
| 140 | hit_m) | ||
| 141 | hit = (hit_i /= 0) | ||
| 142 | #else | ||
| 143 | ✗ | associate (dummy_wall => wall, dummy_p0 => p0_m, dummy_p1 => p1_m) | |
| 144 | end associate | ||
| 145 | ✗ | hit = .false. | |
| 146 | ✗ | hit_m = 0.0_dp | |
| 147 | ✗ | error stop "stl_wall_first_hit_segment: CGAL disabled" | |
| 148 | #endif | ||
| 149 | end subroutine stl_wall_first_hit_segment | ||
| 150 | |||
| 151 | ✗ | subroutine stl_wall_first_hit_segment_with_normal(wall, p0_m, p1_m, hit, hit_m, & | |
| 152 | normal, triangle) | ||
| 153 | type(stl_wall_t), intent(in) :: wall | ||
| 154 | real(dp), intent(in) :: p0_m(3) | ||
| 155 | real(dp), intent(in) :: p1_m(3) | ||
| 156 | logical, intent(out) :: hit | ||
| 157 | real(dp), intent(out) :: hit_m(3) | ||
| 158 | real(dp), intent(out) :: normal(3) | ||
| 159 | integer, intent(out), optional :: triangle | ||
| 160 | |||
| 161 | integer(c_int) :: hit_i, triangle_i | ||
| 162 | |||
| 163 | ✗ | if (present(triangle)) triangle = -1 | |
| 164 | |||
| 165 | #ifdef SIMPLE_ENABLE_CGAL | ||
| 166 | if (.not. c_associated(wall%handle)) then | ||
| 167 | error stop "stl_wall_first_hit_segment_with_normal: wall not initialized" | ||
| 168 | end if | ||
| 169 | hit_i = stl_wall_first_hit_segment_with_normal_c(wall%handle, & | ||
| 170 | real(p0_m, c_double), & | ||
| 171 | real(p1_m, c_double), & | ||
| 172 | hit_m, normal, triangle_i) | ||
| 173 | hit = (hit_i /= 0) | ||
| 174 | if (present(triangle)) triangle = int(triangle_i) | ||
| 175 | #else | ||
| 176 | ✗ | associate (dummy_wall => wall, dummy_p0 => p0_m, dummy_p1 => p1_m) | |
| 177 | end associate | ||
| 178 | ✗ | hit = .false. | |
| 179 | ✗ | hit_m = 0.0_dp | |
| 180 | ✗ | normal = 0.0_dp | |
| 181 | ✗ | error stop "stl_wall_first_hit_segment_with_normal: CGAL disabled" | |
| 182 | #endif | ||
| 183 | end subroutine stl_wall_first_hit_segment_with_normal | ||
| 184 | |||
| 185 | ✗ | end module stl_wall_intersection | |
| 186 |