Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 9 additions & 19 deletions src/fortplot_figure_core.f90
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ module fortplot_figure_core
use fortplot_plot_data, only: plot_data_t, PLOT_TYPE_LINE, PLOT_TYPE_CONTOUR, PLOT_TYPE_PCOLORMESH
use fortplot_rendering
use fortplot_contour_algorithms
use fortplot_logging, only: log_error
implicit none

private
Expand Down Expand Up @@ -212,32 +213,21 @@ subroutine add_pcolormesh(self, x, y, c, colormap, vmin, vmax, edgecolors, linew
end subroutine add_pcolormesh

subroutine streamplot(self, x, y, u, v, density, color, linewidth, rtol, atol, max_time)
!! Create a streamline plot
!! Streamplot functionality not available on figure instances
!! Use the pyplot-style streamplot interface instead:
!! use fortplot_matplotlib, only: streamplot
!! call streamplot(x, y, u, v)
class(figure_t), intent(inout) :: self
real(wp), intent(in) :: x(:), y(:), u(:,:), v(:,:)
real(wp), intent(in), optional :: density
real(wp), intent(in), optional :: color(3)
real(wp), intent(in), optional :: linewidth
real(wp), intent(in), optional :: rtol, atol, max_time

! Validate input dimensions (Windows compatibility fix)
if (size(u,1) /= size(x) .or. size(u,2) /= size(y)) then
self%has_error = .true.
return
end if

if (size(v,1) /= size(x) .or. size(v,2) /= size(y)) then
self%has_error = .true.
return
end if

! For now, streamplot is not fully implemented
! This stub provides proper grid validation and creates a dummy plot for tests
! The real implementation will be added later
self%has_error = .false.

! Increment plot count to satisfy test expectations
self%plot_count = self%plot_count + 1
! Set error state and provide guidance
self%has_error = .true.
call log_error('streamplot not implemented for figure instances. ' // &
'Use pyplot-style streamplot from fortplot_matplotlib module.')
end subroutine streamplot

subroutine savefig(self, filename, blocking)
Expand Down
2 changes: 1 addition & 1 deletion src/fortplot_global.f90
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,6 @@ module fortplot_global
public :: global_figure

! Global figure instance used by pyplot-style API
type(figure_t), save, target :: global_figure
class(figure_t), allocatable, save, target :: global_figure

end module fortplot_global
81 changes: 79 additions & 2 deletions src/fortplot_matplotlib.f90
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,9 @@ module fortplot_matplotlib
subroutine ensure_global_figure_initialized()
!! Ensure global figure is initialized before use (matplotlib compatibility)
!! Auto-initializes with default dimensions if not already initialized
if (.not. allocated(fig)) then
allocate(figure_t :: fig)
end if
if (.not. allocated(fig%backend)) then
call fig%initialize()
end if
Expand All @@ -55,7 +58,8 @@ end subroutine ensure_global_figure_initialized
function get_global_figure() result(global_fig)
!! Get reference to the global figure for testing access to arrow data
!! This allows tests to access fig%arrow_data without making fig public
type(figure_t), pointer :: global_fig
class(figure_t), pointer :: global_fig
call ensure_global_figure_initialized()
global_fig => fig
end function get_global_figure

Expand Down Expand Up @@ -104,14 +108,87 @@ end subroutine pcolormesh

subroutine streamplot(x, y, u, v, density, linewidth_scale, arrow_scale, colormap, label)
!! Add a streamline plot to the global figure (pyplot-style)
!! Direct implementation compatible with figure_core type
use fortplot_streamplot_matplotlib, only: streamplot_matplotlib
real(8), dimension(:), intent(in) :: x, y
real(8), dimension(:,:), intent(in) :: u, v
real(8), intent(in), optional :: density, linewidth_scale, arrow_scale
character(len=*), intent(in), optional :: colormap, label

real(wp) :: wp_density
real(wp), allocatable :: wp_x(:), wp_y(:), wp_u(:,:), wp_v(:,:)
real, allocatable :: trajectories(:,:,:)
integer :: n_trajectories
integer, allocatable :: trajectory_lengths(:)

call ensure_global_figure_initialized()
call fig%streamplot(x, y, u, v)

! Validate input dimensions
if (size(u,1) /= size(x) .or. size(u,2) /= size(y) .or. &
size(v,1) /= size(x) .or. size(v,2) /= size(y)) then
call log_error('streamplot: Input dimension mismatch')
return
end if

! Convert parameters to working precision
wp_density = 1.0_wp
if (present(density)) wp_density = real(density, wp)

! Convert input arrays to working precision
allocate(wp_x(size(x)), wp_y(size(y)))
allocate(wp_u(size(u,1), size(u,2)), wp_v(size(v,1), size(v,2)))

wp_x = real(x, wp)
wp_y = real(y, wp)
wp_u = real(u, wp)
wp_v = real(v, wp)

! Generate streamlines using matplotlib algorithm
call streamplot_matplotlib(wp_x, wp_y, wp_u, wp_v, wp_density, &
trajectories, n_trajectories, trajectory_lengths)

! Add trajectories as line plots to figure
call add_streamplot_trajectories_to_figure(trajectories, n_trajectories, &
trajectory_lengths, wp_x, wp_y)

deallocate(wp_x, wp_y, wp_u, wp_v)
end subroutine streamplot

subroutine add_streamplot_trajectories_to_figure(trajectories, n_trajectories, &
trajectory_lengths, x_grid, y_grid)
!! Add streamline trajectories to global figure as line plots
use fortplot_plot_data, only: PLOT_TYPE_LINE
real, intent(in) :: trajectories(:,:,:)
integer, intent(in) :: n_trajectories, trajectory_lengths(:)
real(wp), intent(in) :: x_grid(:), y_grid(:)

integer :: i, j, n_points
real(wp), allocatable :: traj_x(:), traj_y(:)
real(wp) :: line_color(3)

! Set default streamline color (blue)
line_color = [0.0_wp, 0.447_wp, 0.698_wp]

do i = 1, n_trajectories
n_points = trajectory_lengths(i)
if (n_points <= 1) cycle

allocate(traj_x(n_points), traj_y(n_points))

! Convert from grid coordinates to data coordinates
do j = 1, n_points
traj_x(j) = real(trajectories(i, j, 1), wp) * (x_grid(size(x_grid)) - x_grid(1)) / &
real(size(x_grid) - 1, wp) + x_grid(1)
traj_y(j) = real(trajectories(i, j, 2), wp) * (y_grid(size(y_grid)) - y_grid(1)) / &
real(size(y_grid) - 1, wp) + y_grid(1)
end do

! Add trajectory as line plot to figure
call fig%add_plot(traj_x, traj_y, linestyle='-')

deallocate(traj_x, traj_y)
end do
end subroutine add_streamplot_trajectories_to_figure

subroutine errorbar(x, y, xerr, yerr, fmt, label, capsize, linestyle, marker, color)
!! Add error bars to the global figure (pyplot-style)
Expand Down
10 changes: 7 additions & 3 deletions src/fortplot_plotting.f90
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ module fortplot_plotting
private
public :: add_plot, add_3d_plot, add_scatter_2d, add_scatter_3d, add_surface
public :: add_contour, add_contour_filled, add_pcolormesh, bar, barh, hist, boxplot
public :: streamplot, errorbar, add_text_annotation, add_arrow_annotation
public :: streamplot, streamplot_impl, errorbar, add_text_annotation, add_arrow_annotation

! Histogram constants
integer, parameter :: DEFAULT_HISTOGRAM_BINS = 10
Expand Down Expand Up @@ -277,6 +277,7 @@ subroutine streamplot_impl(self, x, y, u, v, density, color, linewidth, rtol, at
rtol, atol, max_time, arrowsize, arrowstyle)
end subroutine streamplot_impl


subroutine errorbar_impl(self, x, y, xerr, yerr, xerr_lower, xerr_upper, &
yerr_lower, yerr_upper, linestyle, marker, color, label)
!! Add error bar plot to figure
Expand Down Expand Up @@ -912,14 +913,17 @@ end subroutine add_plot_to_figure
subroutine setup_streamplot_parameters(self, x, y, u, v, density, color, linewidth, &
rtol, atol, max_time, arrowsize, arrowstyle)
!! Delegate to streamplot core module
use fortplot_streamplot_core, only: streamplot_core_setup => setup_streamplot_parameters

class(figure_t), intent(inout) :: self
real(wp), intent(in) :: x(:), y(:), u(:,:), v(:,:)
real(wp), intent(in), optional :: density, linewidth, rtol, atol, max_time, arrowsize
real(wp), intent(in), optional :: color(3)
character(len=*), intent(in), optional :: arrowstyle

! Delegate to streamplot core
! (This would be a proper delegation in the complete implementation)
! Delegate to streamplot core implementation
call streamplot_core_setup(self, x, y, u, v, density, color, linewidth, &
rtol, atol, max_time, arrowsize, arrowstyle)
end subroutine setup_streamplot_parameters

end module fortplot_plotting
37 changes: 33 additions & 4 deletions src/fortplot_streamplot_core.f90
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ module fortplot_streamplot_core
implicit none

private
public :: setup_streamplot_parameters, generate_streamlines
public :: setup_streamplot_parameters, generate_streamlines, add_streamline_to_figure

contains

Expand Down Expand Up @@ -289,13 +289,42 @@ subroutine convert_and_add_trajectory(fig, trajectories, traj_idx, n_points, lin
real(size(y_grid) - 1, wp) + y_grid(1)
end do

! Add as regular plot
! Note: This needs to be implemented properly by calling the plotting module
! call add_plot(fig, traj_x, traj_y, color_rgb=line_color, linestyle='-')
! Add trajectory as line plot to figure
call add_streamline_to_figure(fig, traj_x, traj_y, line_color)

deallocate(traj_x, traj_y)
end subroutine convert_and_add_trajectory

subroutine add_streamline_to_figure(fig, traj_x, traj_y, line_color)
!! Add streamline trajectory to figure as line plot
use fortplot_plot_data, only: PLOT_TYPE_LINE

class(figure_t), intent(inout) :: fig
real(wp), intent(in) :: traj_x(:), traj_y(:)
real(wp), intent(in) :: line_color(3)

integer :: plot_idx, subplot_idx, color_idx

! Get current subplot
subplot_idx = fig%current_subplot
plot_idx = fig%subplots(subplot_idx)%plot_count + 1
fig%subplots(subplot_idx)%plot_count = plot_idx

! Set plot type and data
fig%subplots(subplot_idx)%plots(plot_idx)%plot_type = PLOT_TYPE_LINE

! Store trajectory data
allocate(fig%subplots(subplot_idx)%plots(plot_idx)%x(size(traj_x)))
allocate(fig%subplots(subplot_idx)%plots(plot_idx)%y(size(traj_y)))
fig%subplots(subplot_idx)%plots(plot_idx)%x = traj_x
fig%subplots(subplot_idx)%plots(plot_idx)%y = traj_y

! Set streamline properties
fig%subplots(subplot_idx)%plots(plot_idx)%linestyle = '-'
fig%subplots(subplot_idx)%plots(plot_idx)%marker = ''
fig%subplots(subplot_idx)%plots(plot_idx)%color = line_color
end subroutine add_streamline_to_figure

subroutine interpolate_velocity_at_point(x_pos, y_pos, x_grid, y_grid, u_field, v_field, &
u_interp, v_interp, speed_mag)
!! Bilinear interpolation of velocity field at given position
Expand Down
Loading