Skip to content

Commit

Permalink
Add contigous and remove dimension
Browse files Browse the repository at this point in the history
  • Loading branch information
@gha3mi
gha3mi committed Apr 14, 2024
1 parent 4380cf4 commit 69c5301
Show file tree
Hide file tree
Showing 11 changed files with 138 additions and 138 deletions.
2 changes: 1 addition & 1 deletion example/demo_curve.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ program example_nurbs_curve
function generate_Xc(num_coils, radius, height, num_points_per_coil) result(control_points)
integer, intent(in) :: num_coils, num_points_per_coil
real(rk), intent(in) :: radius, height
real(rk), dimension(:,:), allocatable :: control_points
real(rk), allocatable :: control_points(:,:)
integer :: coil, i
real(rk) :: theta, coil_height
allocate(control_points(num_coils * num_points_per_coil, 3))
Expand Down
2 changes: 1 addition & 1 deletion example/demo_surface.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ program example_nurbs_surface
function generate_Xc(num_rows, num_cols, peak_height) result(control_points)
integer, intent(in) :: num_rows, num_cols
real(rk), intent(in) :: peak_height
real(rk), dimension(:,:), allocatable :: control_points
real(rk), allocatable :: control_points(:,:)
integer :: i, j
real(rk) :: x_spacing, y_spacing, x_offset, y_offset
x_spacing = 1.0_rk / real(num_cols - 1)
Expand Down
2 changes: 1 addition & 1 deletion example/demo_volume.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ program example_nurbs_volume
function generate_Xc(L) result(control_points)
implicit none
real(rk), intent(in) :: L
real(rk), dimension(:,:), allocatable :: control_points
real(rk), allocatable :: control_points(:,:)
real(rk) :: L2
L2 = L / 2.0_rk
allocate(control_points(8, 3))
Expand Down
2 changes: 1 addition & 1 deletion example/example_surface_1.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ program example3_surface
function generate_Xc(num_rows, num_cols, peak_height) result(control_points)
integer, intent(in) :: num_rows, num_cols
real(rk), intent(in) :: peak_height
real(rk), dimension(:,:), allocatable :: control_points
real(rk), allocatable :: control_points(:,:)
integer :: i, j
real(rk) :: x_spacing, y_spacing, x_offset, y_offset
x_spacing = 1.0_rk / real(num_cols - 1)
Expand Down
2 changes: 1 addition & 1 deletion example/example_volume_1.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ program example3_volume
function generate_Xc(L) result(control_points)
implicit none
real(rk), intent(in) :: L
real(rk), dimension(:,:), allocatable :: control_points
real(rk), allocatable :: control_points(:,:)
real(rk) :: L2
L2 = L / 2.0_rk
allocate(control_points(8, 3))
Expand Down
48 changes: 24 additions & 24 deletions src/forcad_nurbs_curve.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,9 +71,9 @@ module forcad_nurbs_curve
!> Set knot vector, control points and weights for the NURBS curve object.
pure subroutine set1(this, knot, Xc, Wc)
class(nurbs_curve), intent(inout) :: this
real(rk), intent(in) :: knot(:)
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
real(rk), intent(in), contiguous :: knot(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

if (allocated(this%knot)) deallocate(this%knot)
if (allocated(this%Xc)) deallocate(this%Xc)
Expand All @@ -100,11 +100,11 @@ pure subroutine set1(this, knot, Xc, Wc)
!> Set NURBS curve using nodes of parameter space (Xth), degree, continuity, control points and weights.
pure subroutine set2(this, Xth_dir, degree, continuity, Xc, Wc)
class(nurbs_curve), intent(inout) :: this
real(rk), intent(in) :: Xth_dir(:)
real(rk), intent(in), contiguous :: Xth_dir(:)
integer, intent(in) :: degree
integer, intent(in) :: continuity(:)
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
integer, intent(in), contiguous :: continuity(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

if (allocated(this%knot)) deallocate(this%knot)
if (allocated(this%Xc)) deallocate(this%Xc)
Expand All @@ -131,8 +131,8 @@ pure subroutine set2(this, Xth_dir, degree, continuity, Xc, Wc)
!> Set Bezier or Rational Bezier curve using control points and weights.
pure subroutine set3(this, Xc, Wc)
class(nurbs_curve), intent(inout) :: this
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

if (allocated(this%knot)) deallocate(this%knot)
if (allocated(this%Xc)) deallocate(this%Xc)
Expand Down Expand Up @@ -163,7 +163,7 @@ pure subroutine set3(this, Xc, Wc)
pure subroutine create(this, res, Xt)
class(nurbs_curve), intent(inout) :: this
integer, intent(in), optional :: res
real(rk), intent(in), optional :: Xt(:)
real(rk), intent(in), contiguous, optional :: Xt(:)
real(rk), allocatable :: Tgc(:)
integer :: i, j

Expand Down Expand Up @@ -360,7 +360,7 @@ pure subroutine finalize(this)
!> license: BSD 3-Clause
pure function cmp_elem_Xc_vis(this, p) result(elemConn)
class(nurbs_curve), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)
integer, intent(in), optional :: p

if (present(p)) then
Expand All @@ -377,7 +377,7 @@ pure function cmp_elem_Xc_vis(this, p) result(elemConn)
!> license: BSD 3-Clause
pure function cmp_elem_Xg_vis(this, p) result(elemConn)
class(nurbs_curve), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)
integer, intent(in), optional :: p

if (present(p)) then
Expand All @@ -396,7 +396,7 @@ impure subroutine export_Xc(this, filename)
class(nurbs_curve), intent(in) :: this
character(len=*), intent(in) :: filename
integer :: i, nc, nunit
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

! check
if (.not.allocated(this%Xc)) then
Expand Down Expand Up @@ -444,7 +444,7 @@ impure subroutine export_Xg(this, filename)
class(nurbs_curve), intent(in) :: this
character(len=*), intent(in) :: filename
integer :: i, ng, nunit
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

! check
if (.not.allocated(this%Xg)) then
Expand Down Expand Up @@ -573,8 +573,8 @@ pure function get_nc(this) result(nc)
!> license: BSD 3-Clause
pure subroutine insert_knots(this,Xth,r)
class(nurbs_curve), intent(inout) :: this
real(rk), intent(in) :: Xth(:)
integer, intent(in) :: r(:)
real(rk), intent(in), contiguous :: Xth(:)
integer, intent(in), contiguous :: r(:)
integer :: k, i, s, dim, j, n_new
real(rk), allocatable :: Xcw(:,:), Xcw_new(:,:), Xc_new(:,:), Wc_new(:), knot_new(:)

Expand Down Expand Up @@ -702,7 +702,7 @@ pure subroutine elevate_degree(this, t)
pure subroutine derivative(this, res, Xt, dTgc)
class(nurbs_curve), intent(inout) :: this
integer, intent(in), optional :: res
real(rk), intent(in), optional :: Xt(:)
real(rk), intent(in), contiguous, optional :: Xt(:)
real(rk), allocatable, intent(out) :: dTgc(:,:)
real(rk), allocatable :: dTgci(:)
integer :: i
Expand Down Expand Up @@ -743,7 +743,7 @@ pure subroutine derivative(this, res, Xt, dTgc)
pure subroutine basis(this, res, Xt, Tgc)
class(nurbs_curve), intent(inout) :: this
integer, intent(in), optional :: res
real(rk), intent(in), optional :: Xt(:)
real(rk), intent(in), contiguous, optional :: Xt(:)
real(rk), allocatable, intent(out) :: Tgc(:,:)
real(rk), allocatable :: Tgci(:)
integer :: i
Expand Down Expand Up @@ -800,7 +800,7 @@ pure function is_rational(this) result(r)
!> license: BSD 3-Clause
pure subroutine set_elem_Xc_vis(this, elemConn)
class(nurbs_curve), intent(inout) :: this
integer, intent(in) :: elemConn(:,:)
integer, intent(in), contiguous :: elemConn(:,:)

if (allocated(this%elemConn_Xc_vis)) deallocate(this%elemConn_Xc_vis)
this%elemConn_Xc_vis = elemConn
Expand All @@ -813,7 +813,7 @@ pure subroutine set_elem_Xc_vis(this, elemConn)
!> license: BSD 3-Clause
pure subroutine set_elem_Xg_vis(this, elemConn)
class(nurbs_curve), intent(inout) :: this
integer, intent(in) :: elemConn(:,:)
integer, intent(in), contiguous :: elemConn(:,:)

if (allocated(this%elemConn_Xg_vis)) deallocate(this%elemConn_Xg_vis)
this%elemConn_Xg_vis = elemConn
Expand All @@ -826,7 +826,7 @@ pure subroutine set_elem_Xg_vis(this, elemConn)
!> license: BSD 3-Clause
pure function get_elem_Xc_vis(this) result(elemConn)
class(nurbs_curve), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

elemConn = this%elemConn_Xc_vis
end function
Expand All @@ -838,7 +838,7 @@ pure function get_elem_Xc_vis(this) result(elemConn)
!> license: BSD 3-Clause
pure function get_elem_Xg_vis(this) result(elemConn)
class(nurbs_curve), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

elemConn = this%elemConn_Xg_vis
end function
Expand All @@ -850,8 +850,8 @@ pure function get_elem_Xg_vis(this) result(elemConn)
!> license: BSD 3-Clause
pure subroutine remove_knots(this,Xth,r)
class(nurbs_curve), intent(inout) :: this
real(rk), intent(in) :: Xth(:)
integer, intent(in) :: r(:)
real(rk), intent(in), contiguous :: Xth(:)
integer, intent(in), contiguous :: r(:)
integer :: k, i, s, dim, j, nc_new, t
real(rk), allocatable :: Xcw(:,:), Xcw_new(:,:), Xc_new(:,:), Wc_new(:), knot_new(:)

Expand Down
72 changes: 36 additions & 36 deletions src/forcad_nurbs_surface.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,10 +75,10 @@ module forcad_nurbs_surface
!> Set knot vectors, control points and weights for the NURBS surface object.
pure subroutine set1(this, knot1, knot2, Xc, Wc)
class(nurbs_surface), intent(inout) :: this
real(rk), intent(in) :: knot1(:)
real(rk), intent(in) :: knot2(:)
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
real(rk), intent(in), contiguous :: knot1(:)
real(rk), intent(in), contiguous :: knot2(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

this%knot1 = knot1
this%knot2 = knot2
Expand All @@ -97,11 +97,11 @@ pure subroutine set1(this, knot1, knot2, Xc, Wc)
!> Set NURBS surface using nodes of parameter space, degree, continuity, control points and weights
pure subroutine set2(this, Xth_dir1, Xth_dir2, degree, continuity1, continuity2, Xc, Wc)
class(nurbs_surface), intent(inout) :: this
real(rk), intent(in) :: Xth_dir1(:), Xth_dir2(:)
integer, intent(in) :: degree(:)
integer, intent(in) :: continuity1(:), continuity2(:)
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
real(rk), intent(in), contiguous :: Xth_dir1(:), Xth_dir2(:)
integer, intent(in), contiguous :: degree(:)
integer, intent(in), contiguous :: continuity1(:), continuity2(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

this%knot1 = compute_knot_vector(Xth_dir1, degree(1), continuity1)
this%knot2 = compute_knot_vector(Xth_dir2, degree(2), continuity2)
Expand All @@ -121,9 +121,9 @@ pure subroutine set2(this, Xth_dir1, Xth_dir2, degree, continuity1, continuity2,
!> Set Bezier or Rational Bezier surface using control points and weights.
pure subroutine set3(this, nc, Xc, Wc)
class(nurbs_surface), intent(inout) :: this
integer, intent(in) :: nc(:)
real(rk), intent(in) :: Xc(:,:)
real(rk), intent(in), optional :: Wc(:)
integer, intent(in), contiguous :: nc(:)
real(rk), intent(in), contiguous :: Xc(:,:)
real(rk), intent(in), contiguous, optional :: Wc(:)

if (allocated(this%Xc)) deallocate(this%Xc)

Expand Down Expand Up @@ -157,11 +157,11 @@ pure subroutine set3(this, nc, Xc, Wc)
pure subroutine create(this, res1, res2, Xt1, Xt2, Xt)
class(nurbs_surface), intent(inout) :: this
integer, intent(in), optional :: res1, res2
real(rk), intent(in), optional :: Xt1(:), Xt2(:)
real(rk), dimension(:,:), intent(in), optional :: Xt
real(rk), intent(in), contiguous, optional :: Xt1(:), Xt2(:)
real(rk), contiguous, intent(in), optional :: Xt(:,:)
integer :: i, j
real(rk), dimension(:), allocatable :: Tgc1, Tgc2, Tgc
real(rk), dimension(:,:), allocatable :: Xt_
real(rk), allocatable :: Tgc1(:), Tgc2(:), Tgc(:)
real(rk), allocatable :: Xt_(:,:)

! check
if (.not.allocated(this%Xc)) then
Expand Down Expand Up @@ -446,8 +446,8 @@ pure subroutine finalize(this)
!> license: BSD 3-Clause
pure function cmp_elem_Xc_vis(this, p) result(elemConn)
class(nurbs_surface), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, intent(in), optional :: p(:)
integer, allocatable :: elemConn(:,:)
integer, intent(in), contiguous, optional :: p(:)

if (present(p)) then
elemConn = elemConn_C0(this%nc(1), this%nc(2), p(1), p(2))
Expand All @@ -463,8 +463,8 @@ pure function cmp_elem_Xc_vis(this, p) result(elemConn)
!> license: BSD 3-Clause
pure function cmp_elem_Xg_vis(this, p) result(elemConn)
class(nurbs_surface), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, intent(in), optional :: p(:)
integer, allocatable :: elemConn(:,:)
integer, intent(in), contiguous, optional :: p(:)

if (present(p)) then
elemConn = elemConn_C0(this%ng(1), this%ng(2), p(1), p(2))
Expand All @@ -482,7 +482,7 @@ impure subroutine export_Xc(this, filename)
class(nurbs_surface), intent(in) :: this
character(len=*), intent(in) :: filename
integer :: i, nc, nunit
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

! check
if (.not.allocated(this%Xc)) then
Expand Down Expand Up @@ -530,7 +530,7 @@ impure subroutine export_Xg(this, filename)
class(nurbs_surface), intent(in) :: this
character(len=*), intent(in) :: filename
integer :: i, ng, nunit
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

! check
if (.not.allocated(this%Xg)) then
Expand Down Expand Up @@ -716,12 +716,12 @@ pure function get_nc(this, dir) result(nc)
pure subroutine derivative(this, res1, res2, Xt1, Xt2, dTgc)
class(nurbs_surface), intent(inout) :: this
integer, intent(in), optional :: res1, res2
real(rk), intent(in), optional :: Xt1(:), Xt2(:)
real(rk), intent(in), contiguous, optional :: Xt1(:), Xt2(:)
real(rk), allocatable, intent(out) :: dTgc(:,:)
real(rk), allocatable :: dTgci(:)
integer :: i
real(rk), dimension(:), allocatable :: dTgc1, dTgc2
real(rk), dimension(:,:), allocatable :: Xt
real(rk), allocatable :: dTgc1(:), dTgc2(:)
real(rk), allocatable :: Xt(:,:)

! Set parameter values
if (present(Xt1)) then
Expand Down Expand Up @@ -781,12 +781,12 @@ pure subroutine derivative(this, res1, res2, Xt1, Xt2, dTgc)
pure subroutine basis(this, res1, res2, Xt1, Xt2, Tgc)
class(nurbs_surface), intent(inout) :: this
integer, intent(in), optional :: res1, res2
real(rk), intent(in), optional :: Xt1(:), Xt2(:)
real(rk), intent(in), contiguous, optional :: Xt1(:), Xt2(:)
real(rk), allocatable, intent(out) :: Tgc(:,:)
real(rk), allocatable :: Tgci(:)
integer :: i
real(rk), dimension(:), allocatable :: Tgc1, Tgc2
real(rk), dimension(:,:), allocatable :: Xt
real(rk), allocatable :: Tgc1(:), Tgc2(:)
real(rk), allocatable :: Xt(:,:)

! Set parameter values
if (present(Xt1)) then
Expand Down Expand Up @@ -846,8 +846,8 @@ pure subroutine basis(this, res1, res2, Xt1, Xt2, Tgc)
pure subroutine insert_knots(this, dir ,Xth,r)
class(nurbs_surface), intent(inout) :: this
integer, intent(in) :: dir
real(rk), intent(in) :: Xth(:)
integer, intent(in) :: r(:)
real(rk), intent(in), contiguous :: Xth(:)
integer, intent(in), contiguous :: r(:)
integer :: k, i, s, dim, j, n_new
real(rk), allocatable :: Xc(:,:), Xcw(:,:), Xcw_new(:,:), Xc_new(:,:), Wc_new(:), knot_new(:)
real(rk), allocatable:: Xc3(:,:,:)
Expand Down Expand Up @@ -1173,7 +1173,7 @@ pure function is_rational(this) result(r)
!> license: BSD 3-Clause
pure subroutine set_elem_Xc_vis(this, elemConn)
class(nurbs_surface), intent(inout) :: this
integer, intent(in) :: elemConn(:,:)
integer, intent(in), contiguous :: elemConn(:,:)

if (allocated(this%elemConn_Xc_vis)) deallocate(this%elemConn_Xc_vis)
this%elemConn_Xc_vis = elemConn
Expand All @@ -1186,7 +1186,7 @@ pure subroutine set_elem_Xc_vis(this, elemConn)
!> license: BSD 3-Clause
pure subroutine set_elem_Xg_vis(this, elemConn)
class(nurbs_surface), intent(inout) :: this
integer, intent(in) :: elemConn(:,:)
integer, intent(in), contiguous :: elemConn(:,:)

if (allocated(this%elemConn_Xg_vis)) deallocate(this%elemConn_Xg_vis)
this%elemConn_Xg_vis = elemConn
Expand All @@ -1199,7 +1199,7 @@ pure subroutine set_elem_Xg_vis(this, elemConn)
!> license: BSD 3-Clause
pure function get_elem_Xc_vis(this) result(elemConn)
class(nurbs_surface), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

elemConn = this%elemConn_Xc_vis
end function
Expand All @@ -1211,7 +1211,7 @@ pure function get_elem_Xc_vis(this) result(elemConn)
!> license: BSD 3-Clause
pure function get_elem_Xg_vis(this) result(elemConn)
class(nurbs_surface), intent(in) :: this
integer, dimension(:,:), allocatable :: elemConn
integer, allocatable :: elemConn(:,:)

elemConn = this%elemConn_Xg_vis
end function
Expand All @@ -1224,8 +1224,8 @@ pure function get_elem_Xg_vis(this) result(elemConn)
pure subroutine remove_knots(this, dir ,Xth,r)
class(nurbs_surface), intent(inout) :: this
integer, intent(in) :: dir
real(rk), intent(in) :: Xth(:)
integer, intent(in) :: r(:)
real(rk), intent(in), contiguous :: Xth(:)
integer, intent(in), contiguous :: r(:)
integer :: k, i, s, dim, j, nc_new, t
real(rk), allocatable :: Xc(:,:), Xcw(:,:), Xcw_new(:,:), Xc_new(:,:), Wc_new(:), knot_new(:)
real(rk), allocatable:: Xc3(:,:,:)
Expand Down
Loading

0 comments on commit 69c5301

Please sign in to comment.