1! Shade plot demo. 2! Does a variety of shade plots. 3! 4! Copyright (C) 2004-2016 Alan W. Irwin 5! 6! This file is part of PLplot. 7! 8! PLplot is free software; you can redistribute it and/or modify 9! it under the terms of the GNU Library General Public License as 10! published by the Free Software Foundation; either version 2 of the 11! License, or (at your option) any later version. 12! 13! PLplot is distributed in the hope that it will be useful, 14! but WITHOUT ANY WARRANTY; without even the implied warranty of 15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16! GNU Library General Public License for more details. 17! 18! You should have received a copy of the GNU Library General Public 19! License along with PLplot; if not, write to the Free Software 20! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 21 22! N.B. the pl_test_flt parameter used in this code is only 23! provided by the plplot module to allow convenient developer 24! testing of either kind(1.0) or kind(1.0d0) floating-point 25! precision regardless of the floating-point precision of the 26! PLplot C libraries. We do not guarantee the value of this test 27! parameter so it should not be used by users, and instead user 28! code should replace the pl_test_flt parameter by whatever 29! kind(1.0) or kind(1.0d0) precision is most convenient for them. 30! For further details on floating-point precision issues please 31! consult README_precision in this directory. 32! 33program x15f 34 use plplot 35 use plfortrandemolib 36 use iso_c_binding, only: c_ptr, c_loc, c_f_pointer 37 implicit none 38 39 integer xdim, ydim, XPTS, YPTS 40 ! xdim and ydim are the static dimensions of the 2D arrays while 41 ! NX and NY are the defined area. 42 parameter( xdim = 99, XPTS = 35, ydim = 100, YPTS = 46 ) 43 44 integer i, j 45 integer :: plparseopts_rc 46 real(kind=pl_test_flt) xx, yy 47 real(kind=pl_test_flt) z(xdim, ydim), zmin, zmax, tr(6) 48 49 ! Global parameters to be used in mypltr callback 50 real(kind=pl_test_flt), parameter :: xmin = -1.0_pl_test_flt 51 real(kind=pl_test_flt), parameter :: xmax = 1.0_pl_test_flt 52 real(kind=pl_test_flt), parameter :: ymin = -1.0_pl_test_flt 53 real(kind=pl_test_flt), parameter :: ymax = 1.0_pl_test_flt 54 55 ! Use tr callback? 56 logical, parameter :: tr_callback = .false. 57 58 ! Use C pltr1 callback? (only meaningful 59 ! if tr_callback is .false.). 60 logical, parameter :: pltr1_callback = .false. 61 62 ! Use Fortran callback with no data? (only meaningful 63 ! if tr_callback and pltr1_callback are .false.). 64 logical, parameter :: mypltr_callback = .false. 65 66 type mypltr_data_type 67 ! Only contains data required by the mypltr_data callback 68 integer :: xpts_data, ypts_data 69 real(kind=pl_test_flt) :: xmin_data, xmax_data, ymin_data, ymax_data 70 end type mypltr_data_type 71 72 ! Global data type to be used in mypltr_data callback 73 type(mypltr_data_type), target :: data 74 75 data%xpts_data = XPTS 76 data%ypts_data = YPTS 77 data%xmin_data = xmin 78 data%xmax_data = xmax 79 data%ymin_data = ymin 80 data%ymax_data = ymax 81 82 tr = (/ (xmax-xmin)/real(XPTS-1,kind=pl_test_flt), 0.0_pl_test_flt, xmin, & 83 0.0_pl_test_flt, (ymax-ymin)/real(YPTS-1,kind=pl_test_flt), ymin /) 84 ! Process command-line arguments 85 plparseopts_rc = plparseopts(PL_PARSE_FULL) 86 if(plparseopts_rc .ne. 0) stop "plparseopts error" 87 88 ! Set up color map 1 89 90 call cmap1_init2() 91 92 ! Initialize plplot 93 94 call plinit() 95 96 ! Set up data array 97 98 do i = 1,XPTS 99 xx = real(i-1 - (XPTS / 2),kind=pl_test_flt) / real(XPTS / 2,kind=pl_test_flt) 100 do j = 1,YPTS 101 yy = real(j-1 - (YPTS / 2),kind=pl_test_flt) / real(YPTS / 2,kind=pl_test_flt) - 1.0_pl_test_flt 102 z(i,j) = xx*xx - yy*yy + (xx - yy)/(xx*xx+yy*yy + 0.1_pl_test_flt) 103 enddo 104 enddo 105 106 call a2mnmx(z, XPTS, YPTS, zmin, zmax, xdim) 107 108 call plot1(z, XPTS, YPTS, zmin, zmax, xdim) 109 call plot2(z, XPTS, YPTS, zmin, zmax, xdim) 110 call plot3() 111 112 call plend() 113 114contains 115 116 ! Callback function that relies on global XPTS, YPTS, xmin, xmax, ymin, ymax 117 subroutine mypltr( x, y, xt, yt ) 118 119 ! These callback arguments must have exactly these attributes. 120 real(kind=pl_test_flt), intent(in) :: x, y 121 real(kind=pl_test_flt), intent(out) :: xt, yt 122 123 xt = xmin + ((xmax-xmin)/real(XPTS-1,kind=pl_test_flt))*x 124 yt = ymin + ((ymax-ymin)/real(YPTS-1,kind=pl_test_flt))*y 125 126 end subroutine mypltr 127 128 ! Callback function that uses data argument to pass required data. 129 subroutine mypltr_data( x, y, xt, yt, data ) 130 131 ! These callback arguments must have exactly these attributes. 132 real(kind=pl_test_flt), intent(in) :: x, y 133 real(kind=pl_test_flt), intent(out) :: xt, yt 134 type(c_ptr), intent(in) :: data 135 136 type(mypltr_data_type), pointer :: d 137 call c_f_pointer(data, d) 138 139 xt = d%xmin_data + ((d%xmax_data-d%xmin_data)/real(d%xpts_data-1,kind=pl_test_flt))*x 140 yt = d%ymin_data + ((d%ymax_data-d%ymin_data)/real(d%ypts_data-1,kind=pl_test_flt))*y 141 142 end subroutine mypltr_data 143 144 ! ------------------------------------------------------------------------- 145 ! cmap1_init1 146 ! 147 ! Initializes color map 1 in HLS space. 148 ! ------------------------------------------------------------------------- 149 150! subroutine cmap1_init1() 151! use plplot 152! implicit none 153! real(kind=pl_test_flt) i(4), h(4), l(4), s(4) 154! 155! i(1) = 0.0_pl_test_flt ! left boundary 156! i(2) = 0.45_pl_test_flt ! just before center 157! i(3) = 0.55_pl_test_flt ! just after center 158! i(4) = 1.0_pl_test_flt ! right boundary 159! 160! h(1) = 260.0_pl_test_flt ! hue -- low: blue-violet 161! h(2) = 260.0_pl_test_flt ! only change as we go over vertex 162! h(3) = 20.0_pl_test_flt ! hue -- high: red 163! h(4) = 20.0_pl_test_flt ! keep fixed 164! 165! 166! l(1) = 0.5_pl_test_flt ! lightness -- low 167! l(2) = 0.0_pl_test_flt ! lightness -- center 168! l(3) = 0.0_pl_test_flt ! lightness -- center 169! l(4) = 0.5_pl_test_flt ! lightness -- high 170! 171! ! call plscolbg(255,255,255) 172! ! l(1) = 0.5_pl_test_flt ! lightness -- low 173! ! l(2) = 1.0_pl_test_flt ! lightness -- center 174! ! l(3) = 1.0_pl_test_flt ! lightness -- center 175! ! l(4) = 0.5_pl_test_flt ! lightness -- high 176! 177! s(1) = 1.0_pl_test_flt ! maximum saturation 178! s(2) = 1.0_pl_test_flt ! maximum saturation 179! s(3) = 1.0_pl_test_flt ! maximum saturation 180! s(4) = 1.0_pl_test_flt ! maximum saturation 181! 182! call plscmap1l(.false., i, h, l, s) 183! end subroutine cmap1_init1 184 185 ! ------------------------------------------------------------------------- 186 ! cmap1_init2 187 ! 188 ! Initializes color map 1 in HLS space. 189 ! ------------------------------------------------------------------------- 190 191 subroutine cmap1_init2() 192 use plplot 193 implicit none 194 real(kind=pl_test_flt) i(4), h(4), l(4), s(4) 195 196 i(1) = 0.0_pl_test_flt ! left boundary 197 i(2) = 0.45_pl_test_flt ! just before center 198 i(3) = 0.55_pl_test_flt ! just after center 199 i(4) = 1.0_pl_test_flt ! right boundary 200 201 h(1) = 260.0_pl_test_flt ! hue -- low: blue-violet 202 h(2) = 260.0_pl_test_flt ! only change as we go over vertex 203 h(3) = 20.0_pl_test_flt ! hue -- high: red 204 h(4) = 20.0_pl_test_flt ! keep fixed 205 206 207 l(1) = 0.6_pl_test_flt ! lightness -- low 208 l(2) = 0.0_pl_test_flt ! lightness -- center 209 l(3) = 0.0_pl_test_flt ! lightness -- center 210 l(4) = 0.6_pl_test_flt ! lightness -- high 211 212 ! call plscolbg(255,255,255) 213 ! l(1) = 0.5_pl_test_flt ! lightness -- low 214 ! l(2) = 1.0_pl_test_flt ! lightness -- center 215 ! l(3) = 1.0_pl_test_flt ! lightness -- center 216 ! l(4) = 0.5_pl_test_flt ! lightness -- high 217 218 s(1) = 1.0_pl_test_flt ! maximum saturation 219 s(2) = 0.5_pl_test_flt ! maximum saturation 220 s(3) = 0.5_pl_test_flt ! maximum saturation 221 s(4) = 1.0_pl_test_flt ! maximum saturation 222 223 call plscmap1l(.false., i, h, l, s) 224 end subroutine cmap1_init2 225 226 ! ------------------------------------------------------------------------- 227 ! plot1 228 ! 229 ! Illustrates a single shaded region. 230 ! ------------------------------------------------------------------------- 231 232 subroutine plot1(z, XPTS, YPTS, zmin, zmax, xdim) 233 use plplot 234 implicit none 235 236 integer xdim, XPTS, YPTS 237 real(kind=pl_test_flt) z(xdim,YPTS), zmin, zmax 238 239 real(kind=pl_test_flt) shade_min, shade_max, sh_color 240 integer sh_cmap 241 integer min_color, max_color 242 real(kind=pl_test_flt) sh_width, min_width, max_width 243 real(kind=pl_test_flt), dimension(:), allocatable :: xg, yg 244 245 sh_cmap = 0 246 min_color = 0 247 min_width = 0 248 max_color = 0 249 max_width = 0 250 251 call pladv(0) 252 call plvpor( 0.1_pl_test_flt, 0.9_pl_test_flt, 0.1_pl_test_flt, 0.9_pl_test_flt) 253 call plwind(-1.0_pl_test_flt, 1.0_pl_test_flt, -1.0_pl_test_flt, 1.0_pl_test_flt) 254 255 ! Plot using identity transform 256 257 shade_min = zmin + (zmax-zmin)*0.4_pl_test_flt 258 shade_max = zmin + (zmax-zmin)*0.6_pl_test_flt 259 sh_color = 7 260 sh_width = 2 261 min_color = 9 262 max_color = 2 263 min_width = 2 264 max_width = 2 265 266 call plpsty(8) 267 268 if(tr_callback) then 269 call plshade(z(:XPTS,:YPTS), & 270 -1._pl_test_flt, 1._pl_test_flt, -1._pl_test_flt, 1._pl_test_flt, & 271 shade_min, shade_max, & 272 sh_cmap, sh_color, sh_width, & 273 min_color, min_width, max_color, max_width, .true., tr ) 274 elseif(pltr1_callback) then 275 allocate( xg(XPTS), yg(YPTS) ) 276 xg = (2.0_pl_test_flt/real(XPTS-1,kind=pl_test_flt))*arange(XPTS) - 1.0_pl_test_flt 277 yg = (2.0_pl_test_flt/real(YPTS-1,kind=pl_test_flt))*arange(YPTS) - 1.0_pl_test_flt 278 call plshade(z(:XPTS,:YPTS), & 279 -1._pl_test_flt, 1._pl_test_flt, -1._pl_test_flt, 1._pl_test_flt, & 280 shade_min, shade_max, & 281 sh_cmap, sh_color, sh_width, & 282 min_color, min_width, max_color, max_width, .true., xg, yg ) 283 elseif(mypltr_callback) then 284 call plshade(z(:XPTS,:YPTS), & 285 -1._pl_test_flt, 1._pl_test_flt, -1._pl_test_flt, 1._pl_test_flt, & 286 shade_min, shade_max, & 287 sh_cmap, sh_color, sh_width, & 288 min_color, min_width, max_color, max_width, .true., mypltr ) 289 else 290 call plshade(z(:XPTS,:YPTS), & 291 -1._pl_test_flt, 1._pl_test_flt, -1._pl_test_flt, 1._pl_test_flt, & 292 shade_min, shade_max, & 293 sh_cmap, sh_color, sh_width, & 294 min_color, min_width, max_color, max_width, .true., mypltr_data, c_loc(data)) 295 endif 296 297 call plcol0(1) 298 call plbox('bcnst', 0.0_pl_test_flt, 0, 'bcnstv', 0.0_pl_test_flt, 0) 299 call plcol0(2) 300 call pllab('distance', 'altitude', 'Bogon flux') 301 302 end subroutine plot1 303 304 ! ------------------------------------------------------------------------- 305 ! plot2 306 ! 307 ! Illustrates multiple adjacent shaded regions, using different fill 308 ! patterns for each region. 309 ! ------------------------------------------------------------------------- 310 311 subroutine plot2(z, XPTS, YPTS, zmin, zmax, xdim) 312 use plplot 313 implicit none 314 315 integer xdim, XPTS, YPTS 316 real(kind=pl_test_flt) z(xdim,YPTS), zmin, zmax 317 318 real(kind=pl_test_flt) shade_min, shade_max, sh_color 319 integer sh_cmap 320 integer min_color, max_color 321 real(kind=pl_test_flt) sh_width, min_width, max_width 322 integer i, j 323 324 integer nlin(10), inc(2,10), del(2,10) 325 data nlin /1, 1, 1, 1, 1, 2, 2, 2, 2, 2/ 326 data ( (inc(i,j), i=1,2), j=1,10) / & 327 450, 0, -450, 0, 0, 0, 900, 0, & 328 300, 0, 450,-450, 0, 900, 0, 450, & 329 450, -450, 0, 900/ 330 data ( (del(i,j), i=1,2), j=1,10) / & 331 2000, 2000, 2000, 2000, 2000, 2000, & 332 2000, 2000, 2000, 2000, 2000, 2000, & 333 2000, 2000, 2000, 2000, 4000, 4000, & 334 4000, 2000/ 335 336 sh_cmap = 0 337 min_color = 0 338 min_width = 0 339 max_color = 0 340 max_width = 0 341 sh_width = 2 342 343 call pladv(0) 344 call plvpor( 0.1_pl_test_flt, 0.9_pl_test_flt, 0.1_pl_test_flt, 0.9_pl_test_flt) 345 call plwind(-1.0_pl_test_flt, 1.0_pl_test_flt, -1.0_pl_test_flt, 1.0_pl_test_flt) 346 347 do i = 1,10 348 shade_min = zmin + (zmax - zmin) * (i-1) / 10.0_pl_test_flt 349 shade_max = zmin + (zmax - zmin) * i / 10.0_pl_test_flt 350 sh_color = i+5 351 call plpat( inc(1:nlin(i),i),del(1:nlin(i),i)) 352 call plshade(z(:XPTS,:YPTS), & 353 -1._pl_test_flt, 1._pl_test_flt, -1._pl_test_flt, 1._pl_test_flt, & 354 shade_min, shade_max, & 355 sh_cmap, sh_color, sh_width, & 356 min_color, min_width, max_color, max_width, .true. ) 357 enddo 358 359 call plcol0(1) 360 call plbox('bcnst', 0.0_pl_test_flt, 0, 'bcnstv', 0.0_pl_test_flt, 0) 361 call plcol0(2) 362 call pllab('distance', 'altitude', 'Bogon flux') 363 364 end subroutine plot2 365 !-------------------------------------------------------------------------- 366 ! plot3 367 ! 368 ! Illustrates shaded regions in 3d, using a different fill pattern for 369 ! each region. 370 !-------------------------------------------------------------------------- 371 372 subroutine plot3 373 use plplot 374 implicit none 375 376 real(kind=pl_test_flt) xx1(5), xx2(5), yy1(5), yy2(5), zz1(5), zz2(5) 377 data xx1 / -1.0_pl_test_flt, 1.0_pl_test_flt, 1.0_pl_test_flt, -1.0_pl_test_flt, -1.0_pl_test_flt/ 378 data xx2 / -1.0_pl_test_flt, 1.0_pl_test_flt, 1.0_pl_test_flt, -1.0_pl_test_flt, -1.0_pl_test_flt/ 379 data yy1 /1.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt/ 380 data yy2 / -1.0_pl_test_flt, -1.0_pl_test_flt, 0.0_pl_test_flt, 0.0_pl_test_flt, -1.0_pl_test_flt/ 381 data zz1 / 0.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt/ 382 data zz2 / 0.0_pl_test_flt, 0.0_pl_test_flt, 1.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt/ 383 384 call pladv(0) 385 call plvpor(0.1_pl_test_flt, 0.9_pl_test_flt, 0.1_pl_test_flt, 0.9_pl_test_flt) 386 call plwind(-1.0_pl_test_flt, 1.0_pl_test_flt, -1.0_pl_test_flt, 1.0_pl_test_flt) 387 call plw3d(1._pl_test_flt, 1._pl_test_flt, 1._pl_test_flt, -1.0_pl_test_flt, 1.0_pl_test_flt, & 388 -1.0_pl_test_flt, 1.0_pl_test_flt, 0.0_pl_test_flt,1.5_pl_test_flt, 30._pl_test_flt, -40._pl_test_flt) 389 390 ! Plot using identity transform 391 392 call plcol0(1) 393 call plbox3("bntu", "X", 0.0_pl_test_flt, 0, "bntu", "Y", 0.0_pl_test_flt, 0, & 394 "bcdfntu", "Z", 0.5_pl_test_flt, 0) 395 call plcol0(2) 396 call pllab("","","3-d polygon filling") 397 398 call plcol0(3) 399 call plpsty(1) 400 call plline3(xx1, yy1, zz1) 401 call plfill3(xx1(1:4), yy1(1:4), zz1(1:4)) 402 call plpsty(2) 403 call plline3(xx2, yy2, zz2) 404 call plfill3(xx2(1:4), yy2(1:4), zz2(1:4)) 405 406 end subroutine plot3 407 408 !---------------------------------------------------------------------------- 409 ! Subroutine a2mnmx 410 ! Minimum and the maximum elements of a 2-d array. 411 412 subroutine a2mnmx(f, nx, ny, fmin, fmax, xdim) 413 use plplot 414 implicit none 415 416 integer i, j, nx, ny, xdim 417 real(kind=pl_test_flt) f(xdim, ny), fmin, fmax 418 419 fmax = f(1, 1) 420 fmin = fmax 421 do j = 1, ny 422 do i = 1, nx 423 fmax = max(fmax, f(i, j)) 424 fmin = min(fmin, f(i, j)) 425 enddo 426 enddo 427 end subroutine a2mnmx 428end program x15f 429