fplot 1.7.1
A Fortran library providing a convenient interface for plotting with Gnuplot.
Loading...
Searching...
No Matches
fplot_plot_data_3d.f90
1! fplot_plot_data_3d.f90
2
3submodule(fplot_core) fplot_plot_data_3d
4contains
5! ------------------------------------------------------------------------------
6 pure module function pd3d_get_data_count(this) result(x)
7 class(plot_data_3d), intent(in) :: this
8 integer(int32) :: x
9 if (allocated(this%m_data)) then
10 x = size(this%m_data, 1)
11 else
12 x = 0
13 end if
14 end function
15
16! ------------------------------------------------------------------------------
17 pure module function pd3d_get_x_data(this, index) result(x)
18 class(plot_data_3d), intent(in) :: this
19 integer(int32), intent(in) :: index
20 real(real64) :: x
21 if (allocated(this%m_data)) then
22 x = this%m_data(index, 1)
23 else
24 x = 0.0d0
25 end if
26 end function
27
28! --------------------
29 module subroutine pd3d_set_x_data(this, index, x)
30 class(plot_data_3d), intent(inout) :: this
31 integer(int32), intent(in) :: index
32 real(real64), intent(in) :: x
33 if (allocated(this%m_data)) then
34 this%m_data(index, 1) = x
35 end if
36 end subroutine
37
38! ------------------------------------------------------------------------------
39 pure module function pd3d_get_y_data(this, index) result(x)
40 class(plot_data_3d), intent(in) :: this
41 integer(int32), intent(in) :: index
42 real(real64) :: x
43 if (allocated(this%m_data)) then
44 x = this%m_data(index, 2)
45 else
46 x = 0.0d0
47 end if
48 end function
49
50! --------------------
51 module subroutine pd3d_set_y_data(this, index, x)
52 class(plot_data_3d), intent(inout) :: this
53 integer(int32), intent(in) :: index
54 real(real64), intent(in) :: x
55 if (allocated(this%m_data)) then
56 this%m_data(index, 2) = x
57 end if
58 end subroutine
59
60! ------------------------------------------------------------------------------
61 pure module function pd3d_get_z_data(this, index) result(x)
62 class(plot_data_3d), intent(in) :: this
63 integer(int32), intent(in) :: index
64 real(real64) :: x
65 if (allocated(this%m_data)) then
66 x = this%m_data(index, 3)
67 else
68 x = 0.0d0
69 end if
70 end function
71
72! --------------------
73 module subroutine pd3d_set_z_data(this, index, x)
74 class(plot_data_3d), intent(inout) :: this
75 integer(int32), intent(in) :: index
76 real(real64), intent(in) :: x
77 if (allocated(this%m_data)) then
78 this%m_data(index, 3) = x
79 end if
80 end subroutine
81
82! ------------------------------------------------------------------------------
83 module function pd3d_get_axes_cmd(this) result(x)
84 ! Arguments
85 class(plot_data_3d), intent(in) :: this
86 character(len = :), allocatable :: x
87
88 ! Output
89 x = ""
90 end function
91
92! ------------------------------------------------------------------------------
93 module function pd3d_get_data_cmd(this) result(x)
94 ! Arguments
95 class(plot_data_3d), intent(in) :: this
96 character(len = :), allocatable :: x
97
98 ! Local Variables
99 type(string_builder) :: str
100 integer(int32) :: i
101 character :: delimiter, nl
102 real(real64), allocatable, dimension(:) :: xv, yv, zv, cv, ps
103 real(real64), allocatable, dimension(:,:) :: pts
104 real(real64) :: tol, maxz, minz, eps
105 logical :: usecolors, usevarpoints
106
107 ! Initialization
108 call str%initialize()
109 delimiter = achar(9) ! tab delimiter
110 nl = new_line(nl)
111 usecolors = this%get_use_data_dependent_colors()
112 usevarpoints = this%get_use_variable_size_points()
113
114 ! Process
115 xv = this%get_x_data()
116 yv = this%get_y_data()
117 zv = this%get_z_data()
118 if (usecolors .and. usevarpoints) then
119 cv = this%get_color_data()
120 ps = this%get_point_size_data()
121 do i = 1, size(xv)
122 call str%append(to_string(xv(i)))
123 call str%append(delimiter)
124 call str%append(to_string(yv(i)))
125 call str%append(delimiter)
126 call str%append(to_string(zv(i)))
127 call str%append(delimiter)
128 call str%append(to_string(ps(i)))
129 call str%append(delimiter)
130 call str%append(to_string(cv(i)))
131 call str%append(nl)
132 end do
133 else if (usecolors .and. .not.usevarpoints) then
134 cv = this%get_color_data()
135 do i = 1, size(xv)
136 call str%append(to_string(xv(i)))
137 call str%append(delimiter)
138 call str%append(to_string(yv(i)))
139 call str%append(delimiter)
140 call str%append(to_string(zv(i)))
141 call str%append(delimiter)
142 call str%append(to_string(cv(i)))
143 call str%append(nl)
144 end do
145 else if (.not.usecolors .and. usevarpoints) then
146 ps = this%get_point_size_data()
147 do i = 1, size(xv)
148 call str%append(to_string(xv(i)))
149 call str%append(delimiter)
150 call str%append(to_string(yv(i)))
151 call str%append(delimiter)
152 call str%append(to_string(zv(i)))
153 call str%append(delimiter)
154 call str%append(to_string(ps(i)))
155 call str%append(nl)
156 end do
157 else
158 if (this%get_simplify_data()) then
159 maxz = maxval(zv)
160 minz = minval(zv)
161 tol = abs(this%get_simplification_factor() * (maxz - minz))
162 eps = 10.0d0 * epsilon(eps)
163 if (tol < eps) tol = eps
164 pts = simplify_polyline(xv, yv, zv, tol)
165 do i = 1, size(pts, 1)
166 call str%append(to_string(pts(i,1)))
167 call str%append(delimiter)
168 call str%append(to_string(pts(i,2)))
169 call str%append(delimiter)
170 call str%append(to_string(pts(i,3)))
171 call str%append(nl)
172 end do
173 else
174 do i = 1, size(xv)
175 call str%append(to_string(xv(i)))
176 call str%append(delimiter)
177 call str%append(to_string(yv(i)))
178 call str%append(delimiter)
179 call str%append(to_string(zv(i)))
180 call str%append(nl)
181 end do
182 end if
183 end if
184
185 ! End
186 x = char(str%to_string())
187 end function
188
189! ------------------------------------------------------------------------------
190 module subroutine pd3d_set_data_1(this, x, y, z, c, ps, err)
191 ! Arguments
192 class(plot_data_3d), intent(inout) :: this
193 real(real64), intent(in), dimension(:) :: x, y, z
194 real(real64), intent(in), dimension(:), optional :: c, ps
195 class(errors), intent(inout), optional, target :: err
196
197 ! Local Variables
198 integer(int32) :: i, n, flag, ncols
199 class(errors), pointer :: errmgr
200 type(errors), target :: deferr
201
202 ! Initialization
203 n = size(x)
204 ncols = 3
205 if (present(c)) ncols = ncols + 1
206 if (present(ps)) ncols = ncols + 1
207 if (present(err)) then
208 errmgr => err
209 else
210 errmgr => deferr
211 end if
212
213 ! Input Check
214 if (size(y) /= n .or. size(z) /= n) then
215 call errmgr%report_error("pd3d_set_data_1", &
216 "The input arrays are not the same size.", &
217 plot_array_size_mismatch_error)
218 return
219 end if
220 if (present(c)) then
221 if (size(c) /= n) then
222 call errmgr%report_error("pd3d_set_data_1", &
223 "The input arrays are not the same size.", &
224 plot_array_size_mismatch_error)
225 return
226 end if
227 end if
228
229 ! Process
230 if (allocated(this%m_data)) deallocate(this%m_data)
231 allocate(this%m_data(n, ncols), stat = flag)
232 if (flag /= 0) then
233 call errmgr%report_error("pd3d_set_data_1", &
234 "Insufficient memory available.", plot_out_of_memory_error)
235 return
236 end if
237 if (present(c) .and. present(ps)) then
238 call this%set_use_data_dependent_colors(.true.)
239 call this%set_use_variable_size_points(.true.)
240 do concurrent(i = 1:n)
241 this%m_data(i, 1) = x(i)
242 this%m_data(i, 2) = y(i)
243 this%m_data(i, 3) = z(i)
244 this%m_data(i, 4) = ps(i)
245 this%m_data(i, 5) = c(i)
246 end do
247 else if (present(c) .and. .not.present(ps)) then
248 call this%set_use_data_dependent_colors(.true.)
249 call this%set_use_variable_size_points(.false.)
250 do concurrent(i = 1:n)
251 this%m_data(i, 1) = x(i)
252 this%m_data(i, 2) = y(i)
253 this%m_data(i, 3) = z(i)
254 this%m_data(i, 4) = c(i)
255 end do
256 else if (.not.present(c) .and. present(ps)) then
257 call this%set_use_data_dependent_colors(.false.)
258 call this%set_use_variable_size_points(.true.)
259 do concurrent(i = 1:n)
260 this%m_data(i, 1) = x(i)
261 this%m_data(i, 2) = y(i)
262 this%m_data(i, 3) = z(i)
263 this%m_data(i, 4) = ps(i)
264 end do
265 else
266 call this%set_use_data_dependent_colors(.false.)
267 call this%set_use_variable_size_points(.false.)
268 do concurrent(i = 1:n)
269 this%m_data(i, 1) = x(i)
270 this%m_data(i, 2) = y(i)
271 this%m_data(i, 3) = z(i)
272 end do
273 end if
274 end subroutine
275
276! ------------------------------------------------------------------------------
277 module function pd3d_get_x_array(this) result(x)
278 ! Arguments
279 class(plot_data_3d), intent(in) :: this
280 real(real64), allocatable, dimension(:) :: x
281
282 ! Process
283 if (allocated(this%m_data)) then
284 x = this%m_data(:,1)
285 end if
286 end function
287
288! ------------------------------------------------------------------------------
289 module function pd3d_get_y_array(this) result(x)
290 ! Arguments
291 class(plot_data_3d), intent(in) :: this
292 real(real64), allocatable, dimension(:) :: x
293
294 ! Process
295 if (allocated(this%m_data)) then
296 x = this%m_data(:,2)
297 end if
298 end function
299
300! ------------------------------------------------------------------------------
301 module function pd3d_get_z_array(this) result(x)
302 ! Arguments
303 class(plot_data_3d), intent(in) :: this
304 real(real64), allocatable, dimension(:) :: x
305
306 ! Process
307 if (allocated(this%m_data)) then
308 x = this%m_data(:,3)
309 end if
310 end function
311
312! ******************************************************************************
313! ADDED: OCT. 9, 2020 - JAC
314! ------------------------------------------------------------------------------
315 module function pd3d_get_c_array(this) result(x)
316 ! Arguments
317 class(plot_data_3d), intent(in) :: this
318 real(real64), allocatable, dimension(:) :: x
319
320 ! Process
321 if (allocated(this%m_data)) then
322 if (size(this%m_data, 2) == 4) then
323 x = this%m_data(:,4)
324 else if (size(this%m_data, 2) == 5) then
325 x = this%m_data(:,5)
326 end if
327 end if
328 end function
329
330! ******************************************************************************
331! ADDED: JAN. 12, 2020 - JAC
332! ------------------------------------------------------------------------------
333 module function pd3d_get_ps_array(this) result(x)
334 ! Arguments
335 class(plot_data_3d), intent(in) :: this
336 real(real64), allocatable, dimension(:) :: x
337
338 ! Process
339 if (allocated(this%m_data)) then
340 if (size(this%m_data, 2) > 3) then
341 x = this%m_data(:,4)
342 end if
343 end if
344 end function
345
346! ------------------------------------------------------------------------------
347end submodule
fplot_core
fplot_core
Definition fplot_core.f90:14