diff --git a/src/fortplot_figure_core.f90 b/src/fortplot_figure_core.f90 index 892b0fdd..c2384325 100644 --- a/src/fortplot_figure_core.f90 +++ b/src/fortplot_figure_core.f90 @@ -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 @@ -212,7 +213,10 @@ 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 @@ -220,24 +224,10 @@ subroutine streamplot(self, x, y, u, v, density, color, linewidth, rtol, atol, m 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) diff --git a/src/fortplot_global.f90 b/src/fortplot_global.f90 index 702a217a..b070f831 100644 --- a/src/fortplot_global.f90 +++ b/src/fortplot_global.f90 @@ -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 \ No newline at end of file diff --git a/src/fortplot_matplotlib.f90 b/src/fortplot_matplotlib.f90 index bf542dec..14916773 100644 --- a/src/fortplot_matplotlib.f90 +++ b/src/fortplot_matplotlib.f90 @@ -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 @@ -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 @@ -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) diff --git a/src/fortplot_plotting.f90 b/src/fortplot_plotting.f90 index 6da1206b..ca5d1de0 100644 --- a/src/fortplot_plotting.f90 +++ b/src/fortplot_plotting.f90 @@ -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 @@ -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 @@ -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 \ No newline at end of file diff --git a/src/fortplot_streamplot_core.f90 b/src/fortplot_streamplot_core.f90 index 03b329db..87f2b014 100644 --- a/src/fortplot_streamplot_core.f90 +++ b/src/fortplot_streamplot_core.f90 @@ -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 @@ -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