1 !*********************************************************************** 2 ! included_plplot_real_interfaces.f90 3 ! 4 ! Copyright (C) 2005-2016 Arjen Markus 5 ! Copyright (C) 2006-2018 Alan W. Irwin 6 ! 7 ! This file is part of PLplot. 8 ! 9 ! PLplot is free software; you can redistribute it and/or modify 10 ! it under the terms of the GNU Library General Public License as published 11 ! by the Free Software Foundation; either version 2 of the License, or 12 ! (at your option) any later version. 13 ! 14 ! PLplot is distributed in the hope that it will be useful, 15 ! but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ! GNU Library General Public License for more details. 18 ! 19 ! You should have received a copy of the GNU Library General Public License 20 ! along with PLplot; if not, write to the Free Software 21 ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 22 ! 23 ! 24 ! This file defines the Fortran interfaces for the the subset of the 25 ! PLplot API which has at least one real argument. Keeping this part 26 ! of the interface definitions separate allows convenient defining of 27 ! these interfaces for both single and double precision real 28 ! arguments. See plplot_bindings.f90 for the definition of the 29 ! Fortran interfaces for the remaining part of the PLplot API. 30 ! 31 !*********************************************************************** 32 33 private :: matrix_to_c 34 35 ! Private interfaces for wp-precision callbacks 36 37 abstract interface 38 subroutine plmapform_proc( x, y ) 39 import :: wp 40 real(kind=wp), dimension(:), intent(inout) :: x, y 41 end subroutine plmapform_proc 42 end interface 43 procedure(plmapform_proc), pointer :: plmapform 44 private:: plmapform_proc, plmapform 45 46 abstract interface 47 subroutine pllabeler_proc( axis, value, label ) 48 import :: wp 49 integer, intent(in) :: axis 50 real(kind=wp), intent(in) :: value 51 character(len=*), intent(out) :: label 52 end subroutine pllabeler_proc 53 end interface 54 procedure(pllabeler_proc), pointer :: pllabeler 55 private:: pllabeler_proc, pllabeler 56 57 abstract interface 58 subroutine pllabeler_proc_data( axis, value, label, data ) 59 import :: wp, c_ptr 60 implicit none 61 integer, intent(in) :: axis 62 real(kind=wp), intent(in) :: value 63 character(len=*), intent(out) :: label 64 type(c_ptr), intent(in) :: data 65 end subroutine pllabeler_proc_data 66 end interface 67 procedure(pllabeler_proc_data), pointer :: pllabeler_data 68 private:: pllabeler_proc_data, pllabeler_data 69 70 abstract interface 71 subroutine pltransform_proc( x, y, tx, ty ) 72 import :: wp 73 implicit none 74 real(kind=wp), intent(in) :: x, y 75 real(kind=wp), intent(out) :: tx, ty 76 end subroutine pltransform_proc 77 end interface 78 procedure(pltransform_proc), pointer :: pltransform 79 private:: pltransform_proc, pltransform 80 81 abstract interface 82 subroutine pltransform_proc_data( x, y, tx, ty, data ) 83 import :: wp, c_ptr 84 implicit none 85 real(kind=wp), intent(in) :: x, y 86 real(kind=wp), intent(out) :: tx, ty 87 type(c_ptr), intent(in) :: data 88 end subroutine pltransform_proc_data 89 end interface 90 procedure(pltransform_proc_data), pointer :: pltransform_data 91 private:: pltransform_proc_data, pltransform_data 92 93 ! Normally interface blocks describing the C routines that are 94 ! called by this Fortran binding are embedded as part of module 95 ! procedures, but when more than one module procedure uses such 96 ! interface blocks there is a requirement (enforced at least by 97 ! the nagfor compiler) that those interface blocks be consistent. 98 ! We could comply with that requirement by embedding such multiply 99 ! used interface blocks as part of module procedures using 100 ! duplicated code, but that is inefficient (in terms of the number 101 ! of lines of code to be compiled) and implies a maintenance issue 102 ! (to keep that code duplicated whenever there are changes on the 103 ! C side). To deal with those two potential issues we collect 104 ! here in alphabetical order all interface blocks describing C 105 ! routines that are called directly by more than one module 106 ! procedure below. 107 108 interface 109 subroutine interface_plcont( z, nx, ny, kx, lx, ky, ly, clevel, nlevel, transform, data ) & 110 bind(c,name='c_plcont') 111 import :: c_funptr, c_ptr 112 import :: private_plint, private_plflt 113 implicit none 114 integer(kind=private_plint), value, intent(in) :: nx, ny, kx, lx, ky, ly, nlevel 115 type(c_ptr), dimension(*), intent(in) :: z 116 real(kind=private_plflt), dimension(*), intent(in) :: clevel 117 type(c_ptr), value, intent(in) :: data 118 interface 119 subroutine transform( x, y, tx, ty, data ) bind(c) 120 import :: private_plflt 121 import :: c_ptr 122 implicit none 123 real(kind=private_plflt), value, intent(in) :: x, y 124 real(kind=private_plflt), intent(out) :: tx, ty 125 type(c_ptr), value, intent(in) :: data 126 end subroutine transform 127 end interface 128 end subroutine interface_plcont 129 end interface 130 private :: interface_plcont 131 132 interface 133 function interface_plf2evalr( ix, iy, data ) bind(c, name = 'plf2evalr' ) 134 import :: c_ptr 135 import :: private_plint, private_plflt 136 implicit none 137 real(kind=private_plflt) :: interface_plf2evalr 138 integer(kind=private_plint), value, intent(in) :: ix, iy 139 type(c_ptr), value, intent(in) :: data 140 end function interface_plf2evalr 141 end interface 142 private :: interface_plf2evalr 143 144 interface 145 subroutine interface_plfcont( lookup, grid, nx, ny, kx, lx, ky, ly, clevel, nlevel, transform, data ) & 146 bind(c,name='plfcont') 147 import :: c_funptr, c_ptr 148 import :: private_plint, private_plflt 149 implicit none 150 integer(kind=private_plint), value, intent(in) :: nx, ny, kx, lx, ky, ly, nlevel 151 real(kind=private_plflt), dimension(*), intent(in) :: clevel 152 type(c_ptr), value, intent(in) :: grid 153 type(c_ptr), value, intent(in) :: data 154 interface 155 function lookup( ix, iy, data ) bind(c) 156 import :: c_ptr 157 import :: private_plflt, private_plint 158 implicit none 159 real(kind=private_plflt) :: lookup 160 integer(kind=private_plint), value, intent(in) :: ix, iy 161 type(c_ptr), value, intent(in) :: data 162 end function lookup 163 end interface 164 interface 165 subroutine transform( x, y, tx, ty, data ) bind(c) 166 import :: private_plflt 167 import :: c_ptr 168 implicit none 169 real(kind=private_plflt), value, intent(in) :: x, y 170 real(kind=private_plflt), intent(out) :: tx, ty 171 type(c_ptr), value, intent(in) :: data 172 end subroutine transform 173 end interface 174 end subroutine interface_plfcont 175 end interface 176 private :: interface_plfcont 177 178 interface 179 subroutine interface_plfill( n, x, y ) bind( c, name='c_plfill') 180 import :: private_plint, private_plflt 181 implicit none 182 integer(kind=private_plint), value, intent(in) :: n 183 real(kind=private_plflt), dimension(*), intent(in) :: x, y 184 end subroutine interface_plfill 185 end interface 186 private :: interface_plfill 187 188 interface 189 subroutine interface_plfvect( lookup, fgrid1, fgrid2, nx, ny, scale, transform, data ) bind(c, name = 'plfvect' ) 190 import :: c_ptr, c_funptr 191 import :: private_plint, private_plflt, PLfGrid, PLcGrid 192 implicit none 193 integer(kind=private_plint), value, intent(in) :: nx, ny 194 type(PLfGrid), intent(in) :: fgrid1, fgrid2 195 real(kind=private_plflt), value, intent(in) :: scale 196 type(c_ptr), value, intent(in) :: data ! Not used in this case 197 interface 198 function lookup( ix, iy, data ) bind(c) 199 import :: c_ptr 200 import :: private_plint, private_plflt 201 implicit none 202 real(kind=private_plflt) :: lookup 203 integer(kind=private_plint), value, intent(in) :: ix, iy 204 type(c_ptr), value, intent(in) :: data 205 end function lookup 206 end interface 207 interface 208 subroutine transform( x, y, tx, ty, data ) bind(c) 209 import :: private_plflt 210 import :: c_ptr 211 implicit none 212 real(kind=private_plflt), value, intent(in) :: x, y 213 real(kind=private_plflt), intent(out) :: tx, ty 214 type(c_ptr), value, intent(in) :: data 215 end subroutine transform 216 end interface 217 end subroutine interface_plfvect 218 end interface 219 private :: interface_plfvect 220 221 interface 222 subroutine interface_plimagefr( idata, nx, ny, & 223 xmin, xmax, ymin, ymax, & 224 zmin, zmax, valuemin, valuemax, transform, data ) bind(c,name='c_plimagefr') 225 import :: c_ptr 226 import :: private_plint, private_plflt 227 implicit none 228 integer(kind=private_plint), value, intent(in) :: nx, ny 229 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 230 type(c_ptr), dimension(*), intent(in) :: idata 231 type(c_ptr), value, intent(in) :: data 232 interface 233 subroutine transform( x, y, tx, ty, data ) bind(c) 234 import :: private_plflt 235 import :: c_ptr 236 implicit none 237 real(kind=private_plflt), value, intent(in) :: x, y 238 real(kind=private_plflt), intent(out) :: tx, ty 239 type(c_ptr), value, intent(in) :: data 240 end subroutine transform 241 end interface 242 end subroutine interface_plimagefr 243 end interface 244 private :: interface_plimagefr 245 246 interface 247 subroutine interface_plimagefr_null( idata, nx, ny, & 248 xmin, xmax, ymin, ymax, & 249 zmin, zmax, valuemin, valuemax) bind(c,name='plimagefr_null') 250 import :: c_ptr 251 import :: private_plint, private_plflt 252 implicit none 253 integer(kind=private_plint), value, intent(in) :: nx, ny 254 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 255 type(c_ptr), dimension(*), intent(in) :: idata 256 end subroutine interface_plimagefr_null 257 end interface 258 private :: interface_plimagefr_null 259 260 interface 261 subroutine interface_plmap( proc, name, minx, maxx, miny, maxy ) & 262 bind(c, name = 'c_plmap' ) 263 import :: c_funptr, private_plflt 264 implicit none 265 type(c_funptr), value, intent(in) :: proc 266 character(len=1), dimension(*), intent(in) :: name 267 real(kind=private_plflt), value, intent(in) :: minx, maxx, miny, maxy 268 end subroutine interface_plmap 269 end interface 270 private interface_plmap 271 272 interface 273 subroutine interface_plmapfill( proc, name, minx, maxx, miny, maxy, plotentries, nplotentries ) & 274 bind(c, name = 'c_plmapfill' ) 275 import :: c_funptr, private_plflt, c_ptr, private_plint 276 implicit none 277 type(c_funptr), value, intent(in) :: proc 278 character(len=1), dimension(*), intent(in) :: name 279 real(kind=private_plflt), value, intent(in) :: minx, maxx, miny, maxy 280 type(c_ptr), value, intent(in) :: plotentries 281 integer(kind=private_plint), value, intent(in) :: nplotentries 282 end subroutine interface_plmapfill 283 end interface 284 private :: interface_plmapfill 285 286 interface 287 subroutine interface_plmapline( proc, name, minx, maxx, miny, maxy, plotentries, nplotentries ) & 288 bind(c, name = 'c_plmapline' ) 289 import :: c_funptr, private_plflt, c_ptr, private_plint 290 implicit none 291 type(c_funptr), value, intent(in) :: proc 292 character(len=1), dimension(*), intent(in) :: name 293 real(kind=private_plflt), value, intent(in) :: minx, maxx, miny, maxy 294 type(c_ptr), value, intent(in) :: plotentries 295 integer(kind=private_plint), value, intent(in) :: nplotentries 296 end subroutine interface_plmapline 297 end interface 298 private :: interface_plmapline 299 300 interface 301 subroutine interface_plmapstring( proc, name, string, minx, maxx, miny, maxy, plotentries, nplotentries ) & 302 bind(c, name = 'c_plmapstring' ) 303 import :: c_funptr, private_plflt, c_ptr, private_plint 304 implicit none 305 type(c_funptr), value, intent(in) :: proc 306 character(len=1), dimension(*), intent(in) :: name, string 307 real(kind=private_plflt), value, intent(in) :: minx, maxx, miny, maxy 308 type(c_ptr), value, intent(in) :: plotentries 309 integer(kind=private_plint), value, intent(in) :: nplotentries 310 end subroutine interface_plmapstring 311 end interface 312 private :: interface_plmapstring 313 314 interface 315 subroutine interface_plmaptex( proc, name, dx, dy, just, text, minx, maxx, miny, maxy, plotentry ) & 316 bind(c, name = 'c_plmaptex' ) 317 import :: c_funptr, private_plflt, c_ptr, private_plint 318 implicit none 319 type(c_funptr), value, intent(in) :: proc 320 character(len=1), dimension(*), intent(in) :: name, text 321 real(kind=private_plflt), value, intent(in) :: dx, dy, just, minx, maxx, miny, maxy 322 integer(kind=private_plint), value, intent(in) :: plotentry 323 end subroutine interface_plmaptex 324 end interface 325 private :: interface_plmaptex 326 327 interface 328 subroutine interface_plmeridians( proc, dlong, dlat, minlong, maxlong, minlat, maxlat ) & 329 bind(c, name = 'c_plmeridians' ) 330 import :: c_funptr, private_plflt 331 implicit none 332 type(c_funptr), value, intent(in) :: proc 333 real(kind=private_plflt), value, intent(in) :: dlong, dlat, minlong, maxlong, minlat, maxlat 334 end subroutine interface_plmeridians 335 end interface 336 private :: interface_plmeridians 337 338 interface 339 subroutine interface_plshade( a, nx, ny, defined, xmin, xmax, ymin, ymax, & 340 shade_min, shade_max, sh_cmap, sh_color, sh_width, & 341 min_color, min_width, max_color, max_width, & 342 fill, rectangular, transform, data ) bind(c, name = 'c_plshade' ) 343 import :: c_ptr, c_funptr, c_null_ptr 344 import :: private_plint, private_plbool, private_plflt, PLcGrid 345 implicit none 346 type(c_ptr), dimension(*), intent(in) :: a 347 integer(kind=private_plint), value, intent(in) :: nx, ny, sh_cmap, min_color, max_color 348 integer(kind=private_plbool), value, intent(in) :: rectangular 349 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 350 real(kind=private_plflt), value, intent(in) :: sh_width, min_width, max_width 351 real(kind=private_plflt), value, intent(in) :: shade_min, shade_max, sh_color 352 type(c_ptr), value, intent(in) :: data 353 type(c_ptr), value, intent(in) :: defined ! Not used in this case 354 interface 355 subroutine fill( n, x, y ) bind(c) 356 import :: private_plint, private_plflt 357 integer(kind=private_plint), value, intent(in) :: n 358 real(kind=private_plflt), dimension(*), intent(in) :: x, y 359 end subroutine fill 360 end interface 361 interface 362 subroutine transform( x, y, tx, ty, data ) bind(c) 363 import :: private_plflt 364 import :: c_ptr 365 implicit none 366 real(kind=private_plflt), value, intent(in) :: x, y 367 real(kind=private_plflt), intent(out) :: tx, ty 368 type(c_ptr), value, intent(in) :: data 369 end subroutine transform 370 end interface 371 end subroutine interface_plshade 372 end interface 373 private :: interface_plshade 374 375 interface 376 subroutine interface_plshade_null( a, nx, ny, defined, xmin, xmax, ymin, ymax, & 377 shade_min, shade_max, sh_cmap, sh_color, sh_width, & 378 min_color, min_width, max_color, max_width, & 379 fill, rectangular) bind(c, name = 'plshade_null' ) 380 import :: c_ptr, c_funptr, c_null_ptr 381 import :: private_plint, private_plbool, private_plflt, PLcGrid 382 implicit none 383 type(c_ptr), dimension(*), intent(in) :: a 384 integer(kind=private_plint), value, intent(in) :: nx, ny, sh_cmap, min_color, max_color 385 integer(kind=private_plbool), value, intent(in) :: rectangular 386 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 387 real(kind=private_plflt), value, intent(in) :: sh_width, min_width, max_width 388 real(kind=private_plflt), value, intent(in) :: shade_min, shade_max, sh_color 389 type(c_ptr), value, intent(in) :: defined ! Not used in this case 390 interface 391 subroutine fill( n, x, y ) bind(c) 392 import :: private_plint, private_plflt 393 integer(kind=private_plint), value, intent(in) :: n 394 real(kind=private_plflt), dimension(*), intent(in) :: x, y 395 end subroutine fill 396 end interface 397 end subroutine interface_plshade_null 398 end interface 399 private :: interface_plshade_null 400 401 interface 402 subroutine interface_plshades( a, nx, ny, defined, xmin, xmax, ymin, ymax, & 403 clevel, nlevel, fill_width, cont_color, cont_width, & 404 fill, rectangular, transform, data ) bind(c, name = 'c_plshades' ) 405 import :: c_ptr, c_funptr, c_null_ptr 406 import :: private_plint, private_plbool, private_plflt, PLcGrid 407 implicit none 408 type(c_ptr), dimension(*), intent(in) :: a 409 integer(kind=private_plint), value, intent(in) :: nx, ny, cont_color, nlevel 410 integer(kind=private_plbool), value, intent(in) :: rectangular 411 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, fill_width 412 real(kind=private_plflt), dimension(*), intent(in) :: clevel 413 real(kind=private_plflt), value, intent(in) :: cont_width 414 type(c_ptr), value, intent(in) :: data 415 type(c_ptr), value, intent(in) :: defined ! Not used in this case 416 interface 417 subroutine fill( n, x, y ) bind(c) 418 import :: private_plint, private_plflt 419 integer(kind=private_plint), value, intent(in) :: n 420 real(kind=private_plflt), dimension(*), intent(in) :: x, y 421 end subroutine fill 422 end interface 423 interface 424 subroutine transform( x, y, tx, ty, data ) bind(c) 425 import :: private_plflt 426 import :: c_ptr 427 implicit none 428 real(kind=private_plflt), value, intent(in) :: x, y 429 real(kind=private_plflt), intent(out) :: tx, ty 430 type(c_ptr), value, intent(in) :: data 431 end subroutine transform 432 end interface 433 end subroutine interface_plshades 434 end interface 435 private :: interface_plshades 436 437 interface 438 subroutine interface_plshades_null( a, nx, ny, defined, xmin, xmax, ymin, ymax, & 439 clevel, nlevel, fill_width, cont_color, cont_width, & 440 fill, rectangular ) bind(c, name = 'plshades_null' ) 441 import :: c_ptr, c_funptr, c_null_ptr 442 import :: private_plint, private_plbool, private_plflt, PLcGrid 443 implicit none 444 type(c_ptr), dimension(*), intent(in) :: a 445 integer(kind=private_plint), value, intent(in) :: nx, ny, cont_color, nlevel 446 integer(kind=private_plbool), value, intent(in) :: rectangular 447 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, fill_width 448 real(kind=private_plflt), dimension(*), intent(in) :: clevel 449 real(kind=private_plflt), value, intent(in) :: cont_width 450 type(c_ptr), value, intent(in) :: defined ! Not used in this case 451 interface 452 subroutine fill( n, x, y ) bind(c) 453 import :: private_plint, private_plflt 454 integer(kind=private_plint), value, intent(in) :: n 455 real(kind=private_plflt), dimension(*), intent(in) :: x, y 456 end subroutine fill 457 end interface 458 end subroutine interface_plshades_null 459 end interface 460 private :: interface_plshades_null 461 462 interface 463 subroutine interface_pltr0( x, y, tx, ty, data ) bind(c, name = 'pltr0' ) 464 import :: private_plflt, c_ptr 465 implicit none 466 real(kind=private_plflt), value, intent(in) :: x, y 467 real(kind=private_plflt), intent(out) :: tx, ty 468 type(c_ptr), value, intent(in) :: data 469 end subroutine interface_pltr0 470 end interface 471 private :: interface_pltr0 472 473 interface 474 subroutine interface_pltr1( x, y, tx, ty, data ) bind(c, name = 'pltr1' ) 475 import :: private_plflt, c_ptr 476 implicit none 477 real(kind=private_plflt), value, intent(in) :: x, y 478 real(kind=private_plflt), intent(out) :: tx, ty 479 type(c_ptr), value, intent(in) :: data 480 end subroutine interface_pltr1 481 end interface 482 private :: interface_pltr1 483 484 interface 485 subroutine interface_pltr2f( x, y, tx, ty, data ) bind(c, name = 'pltr2f' ) 486 import :: c_ptr 487 import :: private_plflt 488 implicit none 489 real(kind=private_plflt), value, intent(in) :: x, y 490 real(kind=private_plflt), intent(out) :: tx, ty 491 type(c_ptr), value, intent(in) :: data 492 end subroutine interface_pltr2f 493 end interface 494 private :: interface_pltr2f 495 496 interface 497 subroutine interface_plvect( u, v, nx, ny, scale, transform, data ) bind(c, name = 'c_plvect' ) 498 import :: c_funptr, c_ptr 499 import :: private_plint, private_plflt 500 implicit none 501 integer(kind=private_plint), value, intent(in) :: nx, ny 502 real(kind=private_plflt), value, intent(in) :: scale 503 type(c_ptr), dimension(*), intent(in) :: u, v 504 type(c_ptr), value, intent(in) :: data 505 interface 506 subroutine transform( x, y, tx, ty, data ) bind(c) 507 import :: private_plflt 508 import :: c_ptr 509 implicit none 510 real(kind=private_plflt), value, intent(in) :: x, y 511 real(kind=private_plflt), intent(out) :: tx, ty 512 type(c_ptr), value, intent(in) :: data 513 end subroutine transform 514 end interface 515 end subroutine interface_plvect 516 end interface 517 private :: interface_plvect 518 519 ! Interface blocks for module procedures 520 ! These interface blocks are ordered by the names of the module 521 ! procedures inside them. (Recall that the collating sequence has 522 ! numbers first, followed by underscores, followed by lower-case 523 ! letters. So "fill3_impl" sorts before "fill_impl".) 524 525 interface pl_setcontlabelparam 526 module procedure pl_setcontlabelparam_impl 527 end interface pl_setcontlabelparam 528 private :: pl_setcontlabelparam_impl 529 530 interface plarc 531 module procedure plarc_impl 532 end interface plarc 533 private :: plarc_impl 534 535 interface plaxes 536 module procedure plaxes_impl 537 end interface plaxes 538 private :: plaxes_impl 539 540 interface plbin 541 module procedure plbin_impl 542 end interface plbin 543 private :: plbin_impl 544 545 interface plbox3 546 module procedure plbox3_impl 547 end interface plbox3 548 private :: plbox3_impl 549 550 interface plbox 551 module procedure plbox_impl 552 end interface plbox 553 private :: plbox_impl 554 555 interface plbtime 556 module procedure plbtime_impl 557 end interface plbtime 558 private :: plbtime_impl 559 560 interface plcalc_world 561 module procedure plcalc_world_impl 562 end interface plcalc_world 563 private :: plcalc_world_impl 564 565 interface plcol1 566 module procedure plcol1_impl 567 end interface plcol1 568 private :: plcol1_impl 569 570 interface plcolorbar 571 module procedure plcolorbar_impl 572 end interface plcolorbar 573 private :: plcolorbar_impl 574 575 interface plconfigtime 576 module procedure plconfigtime_impl 577 end interface plconfigtime 578 private :: plconfigtime_impl 579 580 interface plcont 581 module procedure plcont_impl_0 582 module procedure plcont_impl_1 583 module procedure plcont_impl_2 584 module procedure plcont_impl_tr 585 module procedure plcont_impl 586 module procedure plcont_impl_data 587 end interface plcont 588 private :: plcont_impl_0 589 private :: plcont_impl_1 590 private :: plcont_impl_2 591 private :: plcont_impl_tr 592 private :: plcont_impl 593 private :: plcont_impl_data 594 595 interface plctime 596 module procedure plctime_impl 597 end interface plctime 598 private :: plctime_impl 599 600 interface plenv0 601 module procedure plenv0_impl 602 end interface plenv0 603 private :: plenv0_impl 604 605 interface plenv 606 module procedure plenv_impl 607 end interface plenv 608 private :: plenv_impl 609 610 interface plerrx 611 module procedure plerrx_impl 612 end interface plerrx 613 private :: plerrx_impl 614 615 interface plerry 616 module procedure plerry_impl 617 end interface plerry 618 private :: plerry_impl 619 620 interface plfill3 621 module procedure plfill3_impl 622 end interface plfill3 623 private :: plfill3_impl 624 625 interface plfill 626 module procedure plfill_impl 627 end interface plfill 628 private :: plfill_impl 629 630 interface plgchr 631 module procedure plgchr_impl 632 end interface plgchr 633 private :: plgchr_impl 634 635 interface plgcmap1_range 636 module procedure plgcmap1_range_impl 637 end interface plgcmap1_range 638 private :: plgcmap1_range_impl 639 640 interface plgcol0a 641 module procedure plgcol0a_impl 642 end interface plgcol0a 643 private :: plgcol0a_impl 644 645 interface plgcolbga 646 module procedure plgcolbga_impl 647 end interface plgcolbga 648 private :: plgcolbga_impl 649 650 interface plgdidev 651 module procedure plgdidev_impl 652 end interface plgdidev 653 private :: plgdidev_impl 654 655 interface plgdiori 656 module procedure plgdiori_impl 657 end interface plgdiori 658 private :: plgdiori_impl 659 660 interface plgdiplt 661 module procedure plgdiplt_impl 662 end interface plgdiplt 663 private :: plgdiplt_impl 664 665 interface plgpage 666 module procedure plgpage_impl 667 end interface plgpage 668 private :: plgpage_impl 669 670 interface plgradient 671 module procedure plgradient_impl 672 end interface plgradient 673 private :: plgradient_impl 674 675 interface plgriddata 676 module procedure plgriddata_impl 677 end interface plgriddata 678 private :: plgriddata_impl 679 680 interface plgspa 681 module procedure plgspa_impl 682 end interface plgspa 683 private :: plgspa_impl 684 685 interface plgvpd 686 module procedure plgvpd_impl 687 end interface plgvpd 688 private :: plgvpd_impl 689 690 interface plgvpw 691 module procedure plgvpw_impl 692 end interface plgvpw 693 private :: plgvpw_impl 694 695 interface plhist 696 module procedure plhist_impl 697 end interface plhist 698 private :: plhist_impl 699 700 interface plhlsrgb 701 module procedure plhlsrgb_impl 702 end interface plhlsrgb 703 private :: plhlsrgb_impl 704 705 interface plimage 706 module procedure plimage_impl 707 end interface plimage 708 private :: plimage_impl 709 710 interface plimagefr 711 module procedure plimagefr_impl_1 712 module procedure plimagefr_impl_2 713 module procedure plimagefr_impl_null 714 module procedure plimagefr_impl_tr 715 module procedure plimagefr_impl 716 module procedure plimagefr_impl_data 717 end interface plimagefr 718 private :: plimagefr_impl_1, plimagefr_impl_2, plimagefr_impl_null, plimagefr_impl_tr, plimagefr_impl, plimagefr_impl_data 719 720 interface pljoin 721 module procedure pljoin_impl 722 end interface pljoin 723 private :: pljoin_impl 724 725 interface pllegend 726 module procedure pllegend_impl 727 end interface pllegend 728 private :: pllegend_impl 729 730 interface pllightsource 731 module procedure pllightsource_impl 732 end interface pllightsource 733 private :: pllightsource_impl 734 735 interface plline3 736 module procedure plline3_impl 737 end interface plline3 738 private :: plline3_impl 739 740 interface plline 741 module procedure plline_impl 742 end interface plline 743 private :: plline_impl 744 745 interface plmap 746 module procedure plmap_impl 747 module procedure plmap_impl_null 748 end interface plmap 749 private :: plmap_impl 750 private :: plmap_impl_null 751 752 interface plmapfill 753 module procedure plmapfill_impl 754 module procedure plmapfill_impl_null 755 end interface plmapfill 756 private :: plmapfill_impl 757 private :: plmapfill_impl_null 758 759 interface plmapline 760 module procedure plmapline_impl 761 module procedure plmapline_impl_null 762 end interface plmapline 763 private :: plmapline_impl 764 private :: plmapline_impl_null 765 766 interface plmapstring 767 module procedure plmapstring_impl 768 module procedure plmapstring_impl_null 769 end interface plmapstring 770 private :: plmapstring_impl 771 private :: plmapstring_impl_null 772 773 interface plmaptex 774 module procedure plmaptex_impl 775 module procedure plmaptex_impl_null 776 end interface plmaptex 777 private :: plmaptex_impl 778 private :: plmaptex_impl_null 779 780 interface plmeridians 781 module procedure plmeridians_impl 782 module procedure plmeridians_impl_null 783 end interface plmeridians 784 private :: plmeridians_impl 785 private :: plmeridians_impl_null 786 787 interface plmesh 788 module procedure plmesh_impl 789 end interface plmesh 790 private :: plmesh_impl 791 792 interface plmeshc 793 module procedure plmeshc_impl 794 end interface plmeshc 795 private :: plmeshc_impl 796 797 interface plmtex3 798 module procedure plmtex3_impl 799 end interface plmtex3 800 private :: plmtex3_impl 801 802 interface plmtex 803 module procedure plmtex_impl 804 end interface plmtex 805 private :: plmtex_impl 806 807 interface plot3d 808 module procedure plot3d_impl 809 end interface plot3d 810 private :: plot3d_impl 811 812 interface plot3dc 813 module procedure plot3dc_impl 814 end interface plot3dc 815 private :: plot3dc_impl 816 817 interface plot3dcl 818 module procedure plot3dcl_impl 819 end interface plot3dcl 820 private :: plot3dcl_impl 821 822 interface plpath 823 module procedure plpath_impl 824 end interface plpath 825 private :: plpath_impl 826 827 interface plpoin3 828 module procedure plpoin3_impl 829 end interface plpoin3 830 private :: plpoin3_impl 831 832 interface plpoin 833 module procedure plpoin_impl 834 end interface plpoin 835 private :: plpoin_impl 836 837 interface plpoly3 838 module procedure plpoly3_impl 839 end interface plpoly3 840 private :: plpoly3_impl 841 842 interface plptex3 843 module procedure plptex3_impl 844 end interface plptex3 845 private :: plptex3_impl 846 847 interface plptex 848 module procedure plptex_impl 849 end interface plptex 850 private :: plptex_impl 851 852 interface plrgbhls 853 module procedure plrgbhls_impl 854 end interface plrgbhls 855 private :: plrgbhls_impl 856 857 interface plschr 858 module procedure plschr_impl 859 end interface plschr 860 private :: plschr_impl 861 862 interface plscmap0a 863 module procedure plscmap0a_impl 864 end interface plscmap0a 865 private :: plscmap0a_impl 866 867 interface plscmap1_range 868 module procedure plscmap1_range_impl 869 end interface plscmap1_range 870 private :: plscmap1_range_impl 871 872 interface plscmap1a 873 module procedure plscmap1a_impl 874 end interface plscmap1a 875 private :: plscmap1a_impl 876 877 interface plscmap1l 878 module procedure plscmap1l_impl 879 end interface plscmap1l 880 private :: plscmap1l_impl 881 882 interface plscmap1la 883 module procedure plscmap1la_impl 884 end interface plscmap1la 885 private :: plscmap1la_impl 886 887 interface plscol0a 888 module procedure plscol0a_impl 889 end interface plscol0a 890 private :: plscol0a_impl 891 892 interface plscolbga 893 module procedure plscolbga_impl 894 end interface plscolbga 895 private :: plscolbga_impl 896 897 interface plsdidev 898 module procedure plsdidev_impl 899 end interface plsdidev 900 private :: plsdidev_impl 901 902 interface plsdimap 903 module procedure plsdimap_impl 904 end interface plsdimap 905 private :: plsdimap_impl 906 907 interface plsdiori 908 module procedure plsdiori_impl 909 end interface plsdiori 910 private :: plsdiori_impl 911 912 interface plsdiplt 913 module procedure plsdiplt_impl 914 end interface plsdiplt 915 private :: plsdiplt_impl 916 917 interface plsdiplz 918 module procedure plsdiplz_impl 919 end interface plsdiplz 920 private :: plsdiplz_impl 921 922 interface plshade 923 module procedure plshade_impl_0 924 module procedure plshade_impl_1 925 module procedure plshade_impl_2 926 module procedure plshade_impl_tr 927 module procedure plshade_impl 928 module procedure plshade_impl_data 929 end interface plshade 930 private :: plshade_impl_0 931 private :: plshade_impl_1 932 private :: plshade_impl_2 933 private :: plshade_impl_tr 934 private :: plshade_impl 935 private :: plshade_impl_data 936 937 interface plshades 938 module procedure plshades_impl_0 939 module procedure plshades_impl_1 940 module procedure plshades_impl_2 941 module procedure plshades_impl_tr 942 module procedure plshades_impl 943 module procedure plshades_impl_data 944 end interface plshades 945 private :: plshades_impl_0 946 private :: plshades_impl_1 947 private :: plshades_impl_2 948 private :: plshades_impl_tr 949 private :: plshades_impl 950 private :: plshades_impl_data 951 952 interface plsmaj 953 module procedure plsmaj_impl 954 end interface plsmaj 955 private :: plsmaj_impl 956 957 interface plsmin 958 module procedure plsmin_impl 959 end interface plsmin 960 private :: plsmin_impl 961 962 interface plspage 963 module procedure plspage_impl 964 end interface plspage 965 private :: plspage_impl 966 967 interface plssym 968 module procedure plssym_impl 969 end interface plssym 970 private :: plssym_impl 971 972 interface plstring3 973 module procedure plstring3_impl 974 end interface plstring3 975 private :: plstring3_impl 976 977 interface plstring 978 module procedure plstring_impl 979 end interface plstring 980 private :: plstring_impl 981 982 interface plstripa 983 module procedure plstripa_impl 984 end interface plstripa 985 private :: plstripa_impl 986 987 interface plstripc 988 module procedure plstripc_impl 989 end interface plstripc 990 private :: plstripc_impl 991 992 interface plsurf3d 993 module procedure plsurf3d_impl 994 end interface plsurf3d 995 private :: plsurf3d_impl 996 997 interface plsurf3dl 998 module procedure plsurf3dl_impl 999 end interface plsurf3dl 1000 private :: plsurf3dl_impl 1001 1002 interface plsvpa 1003 module procedure plsvpa_impl 1004 end interface plsvpa 1005 private :: plsvpa_impl 1006 1007 ! Another variant defined in the plplot module. 1008 interface plsvect 1009 module procedure plsvect_impl 1010 end interface plsvect 1011 private :: plsvect_impl 1012 1013 interface plsym 1014 module procedure plsym_impl 1015 end interface plsym 1016 private :: plsym_impl 1017 1018 interface plvasp 1019 module procedure plvasp_impl 1020 end interface plvasp 1021 private :: plvasp_impl 1022 1023 interface plvect 1024 module procedure plvect_impl_0 1025 module procedure plvect_impl_1 1026 module procedure plvect_impl_2 1027 module procedure plvect_impl_tr 1028 module procedure plvect_impl 1029 module procedure plvect_impl_data 1030 end interface plvect 1031 private :: plvect_impl_0 1032 private :: plvect_impl_1 1033 private :: plvect_impl_2 1034 private :: plvect_impl_tr 1035 private :: plvect_impl 1036 private :: plvect_impl_data 1037 1038 interface plvpas 1039 module procedure plvpas_impl 1040 end interface plvpas 1041 private :: plvpas_impl 1042 1043 interface plvpor 1044 module procedure plvpor_impl 1045 end interface plvpor 1046 private :: plvpor_impl 1047 1048 interface plw3d 1049 module procedure plw3d_impl 1050 end interface plw3d 1051 private :: plw3d_impl 1052 1053 interface plwidth 1054 module procedure plwidth_impl 1055 end interface plwidth 1056 private :: plwidth_impl 1057 1058 interface plwind 1059 module procedure plwind_impl 1060 end interface plwind 1061 private :: plwind_impl 1062 1063contains 1064 1065 ! Private utility routine that depends on real precision: 1066 subroutine matrix_to_c( array, carray, caddress ) 1067 real(kind=wp), dimension(:,:), intent(in) :: array 1068 real(kind=private_plflt), dimension(:,:), allocatable, target, intent(out) :: carray 1069 1070 type(c_ptr), dimension(:), allocatable, intent(out) :: caddress 1071 1072 integer :: i_local 1073 1074 allocate( carray(size(array,2),size(array,1)) ) 1075 allocate( caddress(size(array,1)) ) 1076 1077 carray = transpose( array ) 1078 1079 do i_local = 1,size(array,1) 1080 caddress(i_local) = c_loc(carray(1,i_local)) 1081 enddo 1082 end subroutine matrix_to_c 1083 1084 ! Module procedures: 1085 1086 subroutine pl_setcontlabelparam_impl( offset, size, spacing, active ) 1087 real(kind=wp), intent(in) :: offset, size, spacing 1088 integer, intent(in) :: active 1089 1090 interface 1091 subroutine interface_pl_setcontlabelparam( offset, size, spacing, active) bind(c,name='c_pl_setcontlabelparam') 1092 import :: private_plint, private_plflt 1093 implicit none 1094 integer(kind=private_plint), value, intent(in) :: active 1095 real(kind=private_plflt), value, intent(in) :: offset, size, spacing 1096 end subroutine interface_pl_setcontlabelparam 1097 end interface 1098 1099 call interface_pl_setcontlabelparam( real(offset,kind=private_plflt), real(size,kind=private_plflt), & 1100 real(spacing,kind=private_plflt), int(active,kind=private_plint) ) 1101 end subroutine pl_setcontlabelparam_impl 1102 1103 subroutine plarc_impl( x, y, a, b, angle1, angle2, rotate, fill ) 1104 real(kind=wp), intent(in) :: x, y, a, b, angle1, angle2, rotate 1105 logical, intent(in) :: fill 1106 1107 interface 1108 subroutine interface_plarc( x, y, a, b, angle1, angle2, rotate, fill ) bind(c,name='c_plarc') 1109 import :: private_plbool, private_plflt 1110 implicit none 1111 integer(kind=private_plbool), value, intent(in) :: fill 1112 real(kind=private_plflt), value, intent(in) :: x, y, a, b, angle1, angle2, rotate 1113 end subroutine interface_plarc 1114 end interface 1115 1116 call interface_plarc( real(x,kind=private_plflt), real(y,kind=private_plflt), real(a,kind=private_plflt), & 1117 real(b,kind=private_plflt), real(angle1,kind=private_plflt), real(angle2,kind=private_plflt), & 1118 real(rotate,kind=private_plflt), int(merge(1,0,fill),kind=private_plbool) ) 1119 end subroutine plarc_impl 1120 1121 subroutine plaxes_impl(x0, y0, xopt,xtick,nxsub,yopt,ytick,nysub) 1122 real(kind=wp), intent(in) :: x0, y0, xtick, ytick 1123 integer, intent(in) :: nxsub, nysub 1124 character*(*), intent(in) :: xopt,yopt 1125 1126 interface 1127 subroutine interface_plaxes(x0, y0, xopt,xtick,nxsub,yopt,ytick,nysub) bind(c,name='c_plaxes') 1128 import :: private_plint, private_plflt 1129 implicit none 1130 real(kind=private_plflt), value, intent(in) :: x0, y0, xtick, ytick 1131 integer(kind=private_plint), value, intent(in) :: nxsub, nysub 1132 character(len=1), dimension(*), intent(in) :: xopt, yopt 1133 end subroutine interface_plaxes 1134 end interface 1135 1136 call interface_plaxes( & 1137 real(x0,kind=private_plflt), real(y0,kind=private_plflt), & 1138 trim(xopt)//c_null_char, real(xtick,kind=private_plflt), int(nxsub,kind=private_plint), & 1139 trim(yopt)//c_null_char, real(ytick,kind=private_plflt), int(nysub,kind=private_plint) ) 1140 end subroutine plaxes_impl 1141 1142 subroutine plbin_impl( x, y, center ) 1143 real(kind=wp), dimension(:), intent(in) :: x, y 1144 integer, intent(in) :: center 1145 1146 integer(kind=private_plint) :: sz_local 1147 1148 interface 1149 subroutine interface_plbin( sz, x, y, center ) bind(c,name='c_plbin') 1150 import :: private_plint, private_plflt 1151 implicit none 1152 integer(kind=private_plint), value, intent(in) :: sz, center 1153 real(kind=private_plflt), dimension(*), intent(in) :: x, y 1154 end subroutine interface_plbin 1155 end interface 1156 1157 sz_local = size(x,kind=private_plint) 1158 if( sz_local /= size(y,kind=private_plint) ) then 1159 write(error_unit, "(a)") "Plplot Fortran Warning: plbin: inconsistent sizes for x and y" 1160 end if 1161 call interface_plbin( sz_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 1162 int(center,kind=private_plint) ) 1163 end subroutine plbin_impl 1164 1165 subroutine plbox3_impl(xopt,xlabel,xtick,nxsub,yopt,ylabel,ytick,nysub, & 1166 zopt,zlabel,ztick,nzsub) 1167 1168 real(kind=wp), intent(in) :: xtick, ytick, ztick 1169 character*(*), intent(in) :: xopt, xlabel, yopt, ylabel, zopt, zlabel 1170 integer, intent(in) :: nxsub, nysub, nzsub 1171 1172 interface 1173 subroutine interface_plbox3(xopt,xlabel,xtick,nxsub,yopt,ylabel,ytick,nysub, & 1174 zopt,zlabel,ztick,nzsub) bind(c,name='c_plbox3') 1175 import :: private_plint, private_plflt 1176 implicit none 1177 real(kind=private_plflt), value, intent(in):: xtick, ytick, ztick 1178 integer(kind=private_plint), value, intent(in) :: nxsub, nysub, nzsub 1179 character(len=1), dimension(*), intent(in) :: xopt, yopt, zopt, xlabel, ylabel, zlabel 1180 end subroutine interface_plbox3 1181 end interface 1182 1183 call interface_plbox3( trim(xopt)//c_null_char, trim(xlabel)//c_null_char, real(xtick,kind=private_plflt), & 1184 int(nxsub,kind=private_plint), & 1185 trim(yopt)//c_null_char, trim(ylabel)//c_null_char, real(ytick,kind=private_plflt), & 1186 int(nysub,kind=private_plint), & 1187 trim(zopt)//c_null_char, trim(zlabel)//c_null_char, real(ztick,kind=private_plflt), & 1188 int(nzsub,kind=private_plint) ) 1189 end subroutine plbox3_impl 1190 1191 subroutine plbox_impl(xopt,xtick,nxsub,yopt,ytick,nysub) 1192 real(kind=wp), intent(in) :: xtick, ytick 1193 integer, intent(in) :: nxsub, nysub 1194 character*(*), intent(in) :: xopt,yopt 1195 1196 interface 1197 subroutine interface_plbox(xopt,xtick,nxsub,yopt,ytick,nysub) bind(c,name='c_plbox') 1198 import :: private_plint, private_plflt 1199 implicit none 1200 real(kind=private_plflt), value, intent(in) :: xtick, ytick 1201 integer(kind=private_plint), value, intent(in) :: nxsub, nysub 1202 character(len=1), dimension(*), intent(in) :: xopt, yopt 1203 end subroutine interface_plbox 1204 end interface 1205 1206 call interface_plbox( trim(xopt)//c_null_char, real(xtick,kind=private_plflt), int(nxsub,kind=private_plint), & 1207 trim(yopt)//c_null_char, real(ytick,kind=private_plflt), int(nysub,kind=private_plint) ) 1208 end subroutine plbox_impl 1209 1210 subroutine plbtime_impl( year, month, day, hour, min, sec, ctime ) 1211 real(kind=wp), intent(in) :: ctime 1212 integer, intent(out) :: year, month, day, hour, min 1213 real(kind=wp), intent(out) :: sec 1214 1215 integer(kind=private_plint) :: year_out, month_out, day_out, hour_out, min_out 1216 real(kind=private_plflt) :: sec_out 1217 1218 interface 1219 subroutine interface_plbtime( year, month, day, hour, min, sec, ctime ) bind(c,name='c_plbtime') 1220 import :: private_plint, private_plflt 1221 implicit none 1222 real(kind=private_plflt), value, intent(in) :: ctime 1223 integer(kind=private_plint), intent(out) :: year, month, day, hour, min 1224 real(kind=private_plflt), intent(out) :: sec 1225 end subroutine interface_plbtime 1226 end interface 1227 1228 call interface_plbtime( year_out, month_out, day_out, hour_out, min_out, sec_out, real(ctime, kind=private_plflt)) 1229 year = int(year_out) 1230 month = int(month_out) 1231 day = int(day_out) 1232 hour = int(hour_out) 1233 min = int(min_out) 1234 sec = real(sec_out, kind=wp) 1235 1236 end subroutine plbtime_impl 1237 1238 subroutine plcalc_world_impl( rx, ry, wx, wy, window ) 1239 integer, intent(out) :: window 1240 real(kind=wp), intent(in) :: rx, ry 1241 real(kind=wp), intent(out) :: wx, wy 1242 1243 real(kind=private_plflt) :: wx_out, wy_out 1244 integer(kind=private_plint) window_out 1245 1246 1247 interface 1248 subroutine interface_plcalc_world( rx, ry, wx, wy, window ) bind(c,name='c_plcalc_world') 1249 import :: private_plint, private_plflt 1250 implicit none 1251 integer(kind=private_plint), intent(out) :: window 1252 real(kind=private_plflt), value, intent(in) :: rx, ry 1253 real(kind=private_plflt), intent(out) :: wx, wy 1254 end subroutine interface_plcalc_world 1255 end interface 1256 1257 call interface_plcalc_world( real(rx,kind=private_plflt), real(ry,kind=private_plflt), wx_out, wy_out, window_out ) 1258 window = int(window_out) 1259 wx = real(wx_out, kind=wp) 1260 wy = real(wy_out, kind=wp) 1261 1262 end subroutine plcalc_world_impl 1263 1264 subroutine plcol1_impl( col ) 1265 real(kind=wp), intent(in) :: col 1266 1267 interface 1268 subroutine interface_plcol1( col ) bind(c,name='c_plcol1') 1269 import :: private_plflt 1270 implicit none 1271 real(kind=private_plflt), value, intent(in) :: col 1272 end subroutine interface_plcol1 1273 end interface 1274 1275 call interface_plcol1( real(col,kind=private_plflt) ) 1276 end subroutine plcol1_impl 1277 1278 subroutine plcolorbar_impl( & 1279 colorbar_width, colorbar_height, & 1280 opt, position, x, y, & 1281 x_length, y_length, bg_color, bb_color, bb_style, & 1282 low_cap_color, high_cap_color, & 1283 cont_color, cont_width, & 1284 label_opts, labels, & 1285 axis_opts, ticks, sub_ticks, n_values, values ) 1286 1287 1288 real(kind=wp), intent(in) :: x_length, y_length, x, y, low_cap_color, high_cap_color, cont_width 1289 real(kind=wp), dimension(:, :), intent(in) :: values 1290 integer, intent(in) :: position, opt, bg_color, bb_color, bb_style, cont_color 1291 integer, dimension(:), intent(in) :: label_opts, sub_ticks, n_values 1292 real(kind=wp), dimension(:), intent(in) :: ticks 1293 character(len=*), dimension(:), intent(in) :: labels, axis_opts 1294 real(kind=wp), intent(out) :: colorbar_width, colorbar_height 1295 1296 integer :: n_labels_local, n_axes_local 1297 real(kind=private_plflt) :: colorbar_width_out, colorbar_height_out 1298 real(kind=private_plflt), dimension(:,:), allocatable :: values_c_local 1299 type(c_ptr), dimension(:), allocatable :: values_address_local 1300 character(len=1), dimension(:,:), allocatable :: cstring_labels_local, cstring_axis_opts_local 1301 type(c_ptr), dimension(:), allocatable :: cstring_address_labels_local, cstring_address_axis_opts_local 1302 1303 interface 1304 subroutine interface_plcolorbar( & 1305 colorbar_width, colorbar_height, & 1306 opt, position, x, y, & 1307 x_length, y_length, bg_color, bb_color, bb_style, & 1308 low_cap_color, high_cap_color, & 1309 cont_color, cont_width, & 1310 n_labels, label_opts, labels, & 1311 n_axes, axis_opts, ticks, sub_ticks, n_values, values ) & 1312 bind(c,name='c_plcolorbar') 1313 1314 import :: c_ptr 1315 import :: private_plint, private_plflt 1316 implicit none 1317 1318 real(kind=private_plflt), value, intent(in) :: x_length, y_length, x, y, & 1319 low_cap_color, high_cap_color, cont_width 1320 integer(kind=private_plint), value, intent(in) :: position, opt, bg_color, bb_color, bb_style, cont_color 1321 integer(kind=private_plint), value, intent(in) :: n_labels, n_axes 1322 real(kind=private_plflt), dimension(*), intent(in) :: ticks 1323 integer(kind=private_plint), dimension(*), intent(in) :: label_opts, sub_ticks, n_values 1324 type(c_ptr), dimension(*), intent(in) :: values 1325 1326 type(c_ptr), dimension(*), intent(in) :: labels, axis_opts 1327 real(kind=private_plflt), intent(out) :: colorbar_width, colorbar_height 1328 1329 end subroutine interface_plcolorbar 1330 end interface 1331 1332 1333 ! Determine number of label entries and demand consistent 1334 ! array sizes. 1335 1336 n_labels_local = size(label_opts) 1337 if( n_labels_local /= size(labels) ) then 1338 write(error_unit, "(a)") "Plplot Fortran Warning: plcolorbar: inconsistent sizes for the following arrays:" 1339 write(error_unit, "(a)") "label_opts" 1340 write(error_unit, "(a)") "labels" 1341 end if 1342 1343 n_axes_local = size(axis_opts) 1344 if( & 1345 n_axes_local /= size(ticks) .or. & 1346 n_axes_local /= size(sub_ticks) .or. & 1347 n_axes_local /= size(n_values) .or. & 1348 n_axes_local /= size(values,1) & 1349 ) then 1350 write(error_unit, "(a)") "Plplot Fortran Warning: plcolorbar: inconsistent sizes for the following arrays:" 1351 write(error_unit, "(a)") "axis_opts" 1352 write(error_unit, "(a)") "ticks" 1353 write(error_unit, "(a)") "sub_ticks" 1354 write(error_unit, "(a)") "n_values" 1355 write(error_unit, "(a)") "first dimension of values" 1356 end if 1357 1358 if(maxval(n_values) > size(values,2) ) then 1359 write(error_unit, "(a)") "Plplot Fortran Severe Warning: plcolorbar: maximum of n_values > second dimension of values" 1360 return 1361 end if 1362 1363 call matrix_to_c( values, values_c_local, values_address_local ) 1364 1365 call character_array_to_c( cstring_labels_local, cstring_address_labels_local, labels ) 1366 call character_array_to_c( cstring_axis_opts_local, cstring_address_axis_opts_local, axis_opts ) 1367 1368 call interface_plcolorbar( & 1369 colorbar_width_out, colorbar_height_out, & 1370 int(opt,kind=private_plint), int(position,kind=private_plint), & 1371 real(x,kind=private_plflt), real(y,kind=private_plflt), & 1372 real(x_length,kind=private_plflt), real(y_length,kind=private_plflt), & 1373 int(bg_color,kind=private_plint), & 1374 int(bb_color,kind=private_plint), int(bb_style,kind=private_plint), & 1375 real(low_cap_color,kind=private_plflt), real(high_cap_color,kind=private_plflt), & 1376 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 1377 int(n_labels_local, kind=private_plint), int(label_opts, kind=private_plint), & 1378 cstring_address_labels_local, & 1379 int(n_axes_local, kind=private_plint), & 1380 cstring_address_axis_opts_local, real(ticks, kind=private_plflt), int(sub_ticks, kind=private_plint), & 1381 int(n_values, kind=private_plint), values_address_local & 1382 ) 1383 colorbar_width = real(colorbar_width_out, kind=wp) 1384 colorbar_height = real(colorbar_height_out, kind=wp) 1385 1386 end subroutine plcolorbar_impl 1387 1388 subroutine plconfigtime_impl( scale, offset1, offset2, ccontrol, ifbtime_offset, year, month, day, hour, min, sec ) 1389 integer, intent(in) :: ccontrol, year, month, day, hour, min 1390 logical, intent(in) :: ifbtime_offset 1391 real(kind=wp), intent(in) :: scale, offset1, offset2, sec 1392 1393 interface 1394 subroutine interface_plconfigtime( scale, offset1, offset2, ccontrol, ifbtime_offset, & 1395 year, month, day, hour, min, sec) bind(c,name='c_plconfigtime') 1396 import :: private_plint, private_plbool, private_plflt 1397 implicit none 1398 integer(kind=private_plint), value, intent(in) :: ccontrol, year, month, day, hour, min 1399 integer(kind=private_plbool), value, intent(in) :: ifbtime_offset 1400 real(kind=private_plflt), value, intent(in) :: scale, offset1, offset2, sec 1401 end subroutine interface_plconfigtime 1402 end interface 1403 1404 call interface_plconfigtime( & 1405 real(scale, kind=private_plflt), real(offset1, kind=private_plflt), real(offset2, kind=private_plflt), & 1406 int(ccontrol, kind=private_plint), int(merge(1,0,ifbtime_offset),kind=private_plbool), & 1407 int(year, kind=private_plint), int(month, kind=private_plint), int(day, kind=private_plint), & 1408 int(hour, kind=private_plint), int(min, kind=private_plint), real(sec, kind=private_plflt) ) 1409 end subroutine plconfigtime_impl 1410 1411 subroutine plcont_impl_0( z, kx, lx, ky, ly, clevel ) 1412 integer, intent(in) :: kx, lx, ky, ly 1413 real(kind=wp), dimension(:,:), intent(in) :: z 1414 real(kind=wp), dimension(:), intent(in) :: clevel 1415 1416 real(kind=private_plflt), dimension(:,:), allocatable, target :: z_in 1417 type(PLfGrid), target :: fgrid_local 1418 1419 allocate( z_in(size(z,1),size(z,2)) ) 1420 z_in = z 1421 fgrid_local%f = c_loc(z_in) 1422 fgrid_local%nx = size(z_in,1) 1423 fgrid_local%ny = size(z_in,2) 1424 1425 call interface_plfcont( interface_plf2evalr, c_loc(fgrid_local), size(z,1,kind=private_plint), & 1426 size(z,2,kind=private_plint), kx, lx, ky, ly, real(clevel, kind=private_plflt), & 1427 size(clevel,kind=private_plint), interface_pltr0, c_null_ptr ) 1428 deallocate(z_in) 1429 end subroutine plcont_impl_0 1430 1431 subroutine plcont_impl_1( z, kx, lx, ky, ly, clevel, xg, yg ) 1432 integer, intent(in) :: kx, lx, ky, ly 1433 real(kind=wp), dimension(:,:), intent(in) :: z 1434 real(kind=wp), dimension(:), intent(in) :: clevel 1435 real(kind=wp), dimension(:), intent(in) :: xg, yg 1436 1437 integer(kind=private_plint) :: nx_in, ny_in 1438 real(kind=private_plflt), dimension(:,:), allocatable, target :: z_in 1439 real(kind=private_plflt), dimension(:), allocatable, target :: xg_in, yg_in 1440 type(PLfGrid), target :: fgrid_local 1441 type(PLcGrid), target :: cgrid_local 1442 1443 nx_in = size(z,1, kind=private_plint) 1444 ny_in = size(z,2, kind=private_plint) 1445 if(nx_in /= size(xg, kind=private_plint) .or. ny_in /= size(yg, kind=private_plint) ) then 1446 write(error_unit, "(a)") "Plplot Fortran Warning: plcont: inconsistent sizes for z, xg, and/or yg" 1447 end if 1448 1449 allocate( z_in(nx_in, ny_in) ) 1450 z_in = z 1451 fgrid_local%f = c_loc(z_in) 1452 fgrid_local%nx = nx_in 1453 fgrid_local%ny = ny_in 1454 1455 allocate( xg_in(nx_in), yg_in(ny_in) ) 1456 xg_in = xg 1457 yg_in = yg 1458 cgrid_local%nx = nx_in 1459 cgrid_local%ny = ny_in 1460 cgrid_local%xg = c_loc(xg_in) 1461 cgrid_local%yg = c_loc(yg_in) 1462 1463 call interface_plfcont( interface_plf2evalr, c_loc(fgrid_local), nx_in, ny_in, & 1464 kx, lx, ky, ly, real(clevel, kind=private_plflt), size(clevel,kind=private_plint), & 1465 interface_pltr1, c_loc(cgrid_local) ) 1466 end subroutine plcont_impl_1 1467 1468 subroutine plcont_impl_2( z, kx, lx, ky, ly, clevel, xg, yg ) 1469 integer, intent(in) :: kx, lx, ky, ly 1470 real(kind=wp), dimension(:,:), intent(in) :: z 1471 real(kind=wp), dimension(:), intent(in) :: clevel 1472 real(kind=wp), dimension(:,:), intent(in) :: xg, yg 1473 1474 integer(kind=private_plint) :: nx_in, ny_in 1475 real(kind=private_plflt), dimension(:,:), allocatable, target :: z_in 1476 real(kind=private_plflt), dimension(:,:), allocatable, target :: xg_in, yg_in 1477 type(PLfGrid), target :: fgrid_local 1478 type(PLcGrid), target :: cgrid_local 1479 1480 nx_in = size(z,1, kind=private_plint) 1481 ny_in = size(z,2, kind=private_plint) 1482 if( & 1483 nx_in /= size(xg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) .or. & 1484 nx_in /= size(yg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) ) then 1485 write(error_unit, "(a)") "Plplot Fortran Warning: plcont: inconsistent sizes for z, xg and/or yg" 1486 end if 1487 1488 allocate( z_in(nx_in, ny_in) ) 1489 z_in = z 1490 fgrid_local%f = c_loc(z_in) 1491 fgrid_local%nx = nx_in 1492 fgrid_local%ny = ny_in 1493 1494 allocate( xg_in(nx_in,ny_in), yg_in(nx_in,ny_in) ) 1495 xg_in = xg 1496 yg_in = yg 1497 1498 cgrid_local%nx = nx_in 1499 cgrid_local%ny = ny_in 1500 cgrid_local%xg = c_loc(xg_in) 1501 cgrid_local%yg = c_loc(yg_in) 1502 1503 call interface_plfcont( interface_plf2evalr, c_loc(fgrid_local), nx_in, ny_in, & 1504 kx, lx, ky, ly, real(clevel, kind=private_plflt), size(clevel,kind=private_plint), & 1505 interface_pltr2f, c_loc(cgrid_local) ) 1506 end subroutine plcont_impl_2 1507 1508 subroutine plcont_impl_tr( z, kx, lx, ky, ly, clevel, tr ) 1509 integer, intent(in) :: kx, lx, ky, ly 1510 real(kind=wp), dimension(:,:), intent(in) :: z 1511 real(kind=wp), dimension(:), intent(in) :: clevel 1512 real(kind=wp), dimension(:), intent(in) :: tr 1513 1514 real(kind=private_plflt), dimension(6), target :: tr_in 1515 real(kind=private_plflt), dimension(:,:), allocatable, target :: z_in 1516 type(PLfGrid), target :: fgrid_local 1517 1518 allocate( z_in(size(z,1),size(z,2)) ) 1519 z_in = z 1520 fgrid_local%f = c_loc(z_in) 1521 fgrid_local%nx = size(z,1) 1522 fgrid_local%ny = size(z,2) 1523 1524 tr_in = tr(1:6) 1525 1526 call interface_plfcont( interface_plf2evalr, c_loc(fgrid_local), size(z,1,kind=private_plint), & 1527 size(z,2,kind=private_plint), kx, lx, ky, ly, real(clevel, kind=private_plflt), & 1528 size(clevel,kind=private_plint), plplot_private_pltr, c_loc(tr_in) ) 1529 end subroutine plcont_impl_tr 1530 1531 subroutine plcont_impl( z, kx, lx, ky, ly, clevel, proc ) 1532 integer, intent(in) :: kx, lx, ky, ly 1533 real(kind=wp), dimension(:,:), intent(in) :: z 1534 real(kind=wp), dimension(:), intent(in) :: clevel 1535 procedure(pltransform_proc) :: proc 1536 1537 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 1538 type(c_ptr), dimension(:), allocatable :: z_address_local 1539 1540 call matrix_to_c( z, z_c_local, z_address_local ) 1541 pltransform => proc 1542 1543 call interface_plcont( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), & 1544 kx, lx, ky, ly, real(clevel, kind=private_plflt), size(clevel,kind=private_plint), & 1545 pltransformf2c, c_null_ptr ) 1546 end subroutine plcont_impl 1547 1548 subroutine plcont_impl_data( z, kx, lx, ky, ly, clevel, proc, data ) 1549 integer, intent(in) :: kx, lx, ky, ly 1550 real(kind=wp), dimension(:,:), intent(in) :: z 1551 real(kind=wp), dimension(:), intent(in) :: clevel 1552 procedure(pltransform_proc_data) :: proc 1553 type(c_ptr), intent(in) :: data 1554 1555 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 1556 type(c_ptr), dimension(:), allocatable :: z_address_local 1557 1558 call matrix_to_c( z, z_c_local, z_address_local ) 1559 pltransform_data => proc 1560 1561 call interface_plcont( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), & 1562 kx, lx, ky, ly, real(clevel, kind=private_plflt), size(clevel,kind=private_plint), & 1563 pltransformf2c_data, data ) 1564 end subroutine plcont_impl_data 1565 1566 subroutine plctime_impl( year, month, day, hour, min, sec, ctime ) 1567 integer, intent(in) :: year, month, day, hour, min 1568 real(kind=wp), intent(in) :: sec 1569 real(kind=wp), intent(out) :: ctime 1570 1571 real(kind=private_plflt) :: ctime_out 1572 1573 interface 1574 subroutine interface_plctime( year, month, day, hour, min, sec, ctime ) bind(c,name='c_plctime') 1575 import :: private_plint, private_plflt 1576 implicit none 1577 integer(kind=private_plint), value, intent(in) :: year, month, day, hour, min 1578 real(kind=private_plflt), value, intent(in) :: sec 1579 real(kind=private_plflt), intent(out) :: ctime 1580 end subroutine interface_plctime 1581 end interface 1582 1583 call interface_plctime( & 1584 int(year, kind=private_plint), int(month, kind=private_plint), int(day, kind=private_plint), & 1585 int(hour, kind=private_plint), int(min, kind=private_plint), real(sec, kind=private_plflt), ctime_out ) 1586 ! Transform output real values. 1587 ctime = real(ctime_out, kind=wp) 1588 1589 end subroutine plctime_impl 1590 1591 subroutine plenv0_impl( xmin, xmax, ymin, ymax, just, axis ) 1592 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 1593 integer, intent(in) :: just, axis 1594 1595 interface 1596 subroutine interface_plenv0( xmin, xmax, ymin, ymax, just, axis ) bind(c, name='c_plenv0') 1597 import :: private_plint, private_plflt 1598 implicit none 1599 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 1600 integer(kind=private_plint), value, intent(in) :: just, axis 1601 end subroutine interface_plenv0 1602 end interface 1603 1604 call interface_plenv0( real(xmin,private_plflt), real(xmax,private_plflt), & 1605 real(ymin,private_plflt), real(ymax,private_plflt), & 1606 int(just,private_plint), int(axis,private_plint) ) 1607 end subroutine plenv0_impl 1608 1609 subroutine plenv_impl( xmin, xmax, ymin, ymax, just, axis ) 1610 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 1611 integer, intent(in) :: just, axis 1612 1613 interface 1614 subroutine interface_plenv( xmin, xmax, ymin, ymax, just, axis ) bind(c, name='c_plenv') 1615 import :: private_plint, private_plflt 1616 implicit none 1617 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 1618 integer(kind=private_plint), value, intent(in) :: just, axis 1619 end subroutine interface_plenv 1620 end interface 1621 1622 call interface_plenv( real(xmin,private_plflt), real(xmax,private_plflt), & 1623 real(ymin,private_plflt), real(ymax,private_plflt), & 1624 int(just,private_plint), int(axis,private_plint) ) 1625 end subroutine plenv_impl 1626 1627 subroutine plerrx_impl( xmin, xmax, y ) 1628 real(kind=wp), dimension(:), intent(in) :: xmin, xmax, y 1629 1630 integer(kind=private_plint) :: n_local 1631 1632 interface 1633 subroutine interface_plerrx( n, xmin, xmax, y ) bind( c, name='c_plerrx') 1634 import :: private_plint, private_plflt 1635 implicit none 1636 integer(kind=private_plint), value, intent(in) :: n 1637 real(kind=private_plflt), dimension(*), intent(in) :: xmin, xmax, y 1638 end subroutine interface_plerrx 1639 end interface 1640 1641 n_local = size(y,kind=private_plint) 1642 if( n_local /= size(xmin, kind=private_plint) .or. n_local /= size(xmax, kind=private_plint) ) then 1643 write(error_unit, "(a)") "Plplot Fortran Warning: plerrx: inconsistent sizes for xmin, xmax, and/or y" 1644 end if 1645 1646 call interface_plerrx( n_local, real(xmin,private_plflt), real(xmax,private_plflt), real(y,private_plflt) ) 1647 end subroutine plerrx_impl 1648 1649 subroutine plerry_impl( x, ymin, ymax ) 1650 real(kind=wp), dimension(:), intent(in) :: x, ymin, ymax 1651 1652 integer(kind=private_plint) n_local 1653 1654 interface 1655 subroutine interface_plerry( n, x, ymin, ymax ) bind( c, name='c_plerry') 1656 import :: private_plint, private_plflt 1657 implicit none 1658 integer(kind=private_plint), value, intent(in) :: n 1659 real(kind=private_plflt), dimension(*), intent(in) :: x, ymin, ymax 1660 end subroutine interface_plerry 1661 end interface 1662 1663 n_local = size(x,kind=private_plint) 1664 if( n_local /= size(ymin, kind=private_plint) .or. n_local /= size(ymax, kind=private_plint) ) then 1665 write(error_unit, "(a)") "Plplot Fortran Warning: plerry: inconsistent sizes for x, ymin, and/or ymax" 1666 end if 1667 1668 call interface_plerry( n_local, real(x,private_plflt), real(ymin,private_plflt), real(ymax,private_plflt) ) 1669 end subroutine plerry_impl 1670 1671 subroutine plfill3_impl( x, y, z ) 1672 real(kind=wp), dimension(:), intent(in) :: x, y, z 1673 1674 integer(kind=private_plint) :: n_local 1675 1676 interface 1677 subroutine interface_plfill3( n, x, y, z ) bind( c, name='c_plfill3') 1678 import :: private_plint, private_plflt 1679 implicit none 1680 integer(kind=private_plint), value, intent(in) :: n 1681 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z 1682 end subroutine interface_plfill3 1683 end interface 1684 1685 n_local = size(x,kind=private_plint) 1686 if( n_local /= size(y, kind=private_plint) .or. n_local /= size(z, kind=private_plint) ) then 1687 write(error_unit, "(a)") "Plplot Fortran Warning: plfill3: inconsistent sizes for x, y, and/or z" 1688 end if 1689 1690 call interface_plfill3( n_local, & 1691 real(x,private_plflt), real(y,private_plflt) , real(z,private_plflt) ) 1692 end subroutine plfill3_impl 1693 1694 subroutine plfill_impl( x, y ) 1695 real(kind=wp), dimension(:), intent(in) :: x, y 1696 1697 integer(kind=private_plint) :: n_local 1698 1699 n_local = size(x,kind=private_plint) 1700 if( n_local /= size(y, kind=private_plint) ) then 1701 write(error_unit, "(a)") "Plplot Fortran Warning: plfill: inconsistent sizes for x and y" 1702 end if 1703 1704 call interface_plfill( n_local, real(x,private_plflt), real(y,private_plflt) ) 1705 end subroutine plfill_impl 1706 1707 subroutine plgchr_impl( chrdef, chrht ) 1708 real(kind=wp), intent(out) :: chrdef, chrht 1709 1710 real(kind=private_plflt) :: chrdef_out, chrht_out 1711 1712 interface 1713 subroutine interface_plgchr( chrdef, chrht ) bind(c,name='c_plgchr') 1714 import :: private_plflt 1715 implicit none 1716 real(kind=private_plflt), intent(out) :: chrdef, chrht 1717 end subroutine interface_plgchr 1718 end interface 1719 1720 call interface_plgchr( chrdef_out, chrht_out ) 1721 chrdef = real(chrdef_out, kind=wp) 1722 chrht = real(chrht_out, kind=wp) 1723 1724 end subroutine plgchr_impl 1725 1726 subroutine plgcmap1_range_impl( min_color, max_color ) 1727 real(kind=wp), intent(out) :: min_color, max_color 1728 1729 real(kind=private_plflt) :: min_color_out, max_color_out 1730 1731 interface 1732 subroutine interface_plgcmap1_range( min_color, max_color ) bind(c,name='c_plgcmap1_range') 1733 import :: private_plflt 1734 implicit none 1735 real(kind=private_plflt), intent(out) :: min_color, max_color 1736 end subroutine interface_plgcmap1_range 1737 end interface 1738 1739 call interface_plgcmap1_range( min_color_out, max_color_out ) 1740 min_color = real(min_color_out, kind=wp) 1741 max_color = real(max_color_out, kind=wp) 1742 1743 end subroutine plgcmap1_range_impl 1744 1745 subroutine plgcol0a_impl( icol, r, g, b, a ) 1746 integer, intent(in) :: icol 1747 integer, intent(out) :: r, g, b 1748 real(kind=wp), intent(out) :: a 1749 1750 integer(kind=private_plint) :: r_out, g_out, b_out 1751 real(kind=private_plflt) :: a_out 1752 1753 interface 1754 subroutine interface_plgcol0a( icol, r, g, b, a ) bind(c,name='c_plgcol0a') 1755 import :: private_plint, private_plflt 1756 implicit none 1757 integer(kind=private_plint), value, intent(in) :: icol 1758 integer(kind=private_plint), intent(out) :: r, g, b 1759 real(kind=private_plflt), intent(out) :: a 1760 end subroutine interface_plgcol0a 1761 end interface 1762 1763 call interface_plgcol0a( int(icol,kind=private_plint), r_out, g_out, b_out, a_out ) 1764 r = int(r_out) 1765 g = int(g_out) 1766 b = int(b_out) 1767 a = real(a_out, kind=private_plflt) 1768 end subroutine plgcol0a_impl 1769 1770 subroutine plgcolbga_impl( r, g, b, a ) 1771 integer, intent(out) :: r, g, b 1772 real(kind=wp), intent(out) :: a 1773 1774 integer(kind=private_plint) :: r_out, g_out, b_out 1775 real(kind=private_plflt) :: a_out 1776 1777 interface 1778 subroutine interface_plgcolbga( r, g, b, a ) bind(c,name='c_plgcolbga') 1779 import :: private_plint, private_plflt 1780 implicit none 1781 integer(kind=private_plint), intent(out) :: r, g, b 1782 real(kind=private_plflt), intent(out) :: a 1783 end subroutine interface_plgcolbga 1784 end interface 1785 1786 call interface_plgcolbga( r_out, g_out, b_out, a_out ) 1787 r = int(r_out) 1788 g = int(g_out) 1789 b = int(b_out) 1790 a = real(a_out, kind=private_plflt) 1791 end subroutine plgcolbga_impl 1792 1793 subroutine plgdidev_impl( mar, aspect, jx, jy ) 1794 real(kind=wp), intent(out) :: mar, aspect, jx, jy 1795 1796 real(kind=private_plflt) :: mar_out, aspect_out, jx_out, jy_out 1797 1798 interface 1799 subroutine interface_plgdidev( mar, aspect, jx, jy ) bind(c,name='c_plgdidev') 1800 import :: private_plflt 1801 implicit none 1802 real(kind=private_plflt), intent(out) :: mar, aspect, jx, jy 1803 end subroutine interface_plgdidev 1804 end interface 1805 1806 call interface_plgdidev( mar_out, aspect_out, jx_out, jy_out ) 1807 mar = real(mar_out, kind=wp) 1808 aspect = real(aspect_out, kind=wp) 1809 jx = real(jx_out, kind=wp) 1810 jy = real(jy_out, kind=wp) 1811 end subroutine plgdidev_impl 1812 1813 subroutine plgdiori_impl( rot ) 1814 real(kind=wp), intent(out) :: rot 1815 1816 real(kind=private_plflt) :: rot_out 1817 1818 interface 1819 subroutine interface_plgdiori( rot ) bind(c,name='c_plgdiori') 1820 import :: private_plflt 1821 implicit none 1822 real(kind=private_plflt), intent(out) :: rot 1823 end subroutine interface_plgdiori 1824 end interface 1825 1826 call interface_plgdiori( rot_out ) 1827 rot = real(rot_out, kind=wp) 1828 end subroutine plgdiori_impl 1829 1830 subroutine plgdiplt_impl( xmin, xmax, ymin, ymax ) 1831 real(kind=wp), intent(out) :: xmin, xmax, ymin, ymax 1832 1833 real(kind=private_plflt) :: xmin_out, xmax_out, ymin_out, ymax_out 1834 1835 interface 1836 subroutine interface_plgdiplt( xmin, xmax, ymin, ymax ) bind(c,name='c_plgdiplt') 1837 import :: private_plflt 1838 implicit none 1839 real(kind=private_plflt), intent(out) :: xmin, xmax, ymin, ymax 1840 end subroutine interface_plgdiplt 1841 end interface 1842 1843 call interface_plgdiplt( xmin_out, xmax_out, ymin_out, ymax_out ) 1844 xmin = real(xmin_out, kind=wp) 1845 xmax = real(xmax_out, kind=wp) 1846 ymin = real(ymin_out, kind=wp) 1847 ymax = real(ymax_out, kind=wp) 1848 end subroutine plgdiplt_impl 1849 1850 subroutine plgpage_impl( xpmm, ypmm, xwid, ywid, xoff, yoff ) 1851 integer, intent(out) :: xwid, ywid, xoff, yoff 1852 real(kind=wp), intent(out) :: xpmm, ypmm 1853 1854 integer(kind=private_plint) :: xwid_out, ywid_out, xoff_out, yoff_out 1855 real(kind=private_plflt) :: xpmm_out, ypmm_out 1856 1857 interface 1858 subroutine interface_plgpage( xpmm, ypmm, xwid, ywid, xoff, yoff ) bind(c,name='c_plgpage') 1859 import :: private_plint, private_plflt 1860 implicit none 1861 integer(kind=private_plint), intent(out) :: xwid, ywid, xoff, yoff 1862 real(kind=private_plflt), intent(out) :: xpmm, ypmm 1863 end subroutine interface_plgpage 1864 end interface 1865 1866 call interface_plgpage( xpmm_out, ypmm_out, xwid_out, ywid_out, xoff_out, yoff_out ) 1867 xwid = int(xwid_out) 1868 ywid = int(ywid_out) 1869 xoff = int(xoff_out) 1870 yoff = int(yoff_out) 1871 xpmm = real(xpmm_out, kind=wp) 1872 ypmm = real(ypmm_out, kind=wp) 1873 end subroutine plgpage_impl 1874 1875 subroutine plgradient_impl( x, y, angle ) 1876 real(kind=wp), dimension(:), intent(in) :: x, y 1877 real(kind=wp), intent(in) :: angle 1878 1879 integer(kind=private_plint) :: sz_local 1880 1881 interface 1882 subroutine interface_plgradient( sz, x, y, angle ) bind(c,name='c_plgradient') 1883 import :: private_plint, private_plflt 1884 implicit none 1885 integer(kind=private_plint), value, intent(in) :: sz 1886 real(kind=private_plflt), dimension(*), intent(in) :: x, y 1887 real(kind=private_plflt), value, intent(in) :: angle 1888 end subroutine interface_plgradient 1889 end interface 1890 1891 sz_local = size(x,kind=private_plint) 1892 if( sz_local /= size(y, kind=private_plint) ) then 1893 write(error_unit, "(a)") "Plplot Fortran Warning: plgradient: inconsistent sizes for x and y" 1894 end if 1895 1896 call interface_plgradient( sz_local, & 1897 real(x,kind=private_plflt), real(y,kind=private_plflt), & 1898 real(angle,kind=private_plflt) ) 1899 end subroutine plgradient_impl 1900 1901 subroutine plgriddata_impl( x, y, z, xg, yg, zg, type, data ) 1902 integer, intent(in) :: type 1903 real(kind=wp), intent(in) :: data 1904 real(kind=wp), dimension(:), intent(in) :: x, y, z, xg, yg 1905 real(kind=wp), dimension(:, :), intent(out) :: zg 1906 1907 real(kind=private_plflt), dimension(:,:), allocatable, target :: transpose_local 1908 type(c_ptr), dimension(:), allocatable :: transpose_address_local 1909 integer(kind=private_plint) :: npts_local, nptsx_local, nptsy_local 1910 integer :: i_local 1911 1912 interface 1913 subroutine interface_plgriddata( x, y, z, npts, & 1914 xg, nptsx, yg, nptsy, zg, type, data ) bind(c,name='c_plgriddata') 1915 import :: c_ptr 1916 import :: private_plint, private_plflt 1917 implicit none 1918 integer(kind=private_plint), value, intent(in) :: npts, nptsx, nptsy, type 1919 real(kind=private_plflt), value, intent(in) :: data 1920 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z, xg, yg 1921 type(c_ptr), dimension(*), intent(out) :: zg 1922 end subroutine interface_plgriddata 1923 end interface 1924 1925 npts_local = size(x, kind=private_plint) 1926 1927 if( & 1928 npts_local /= size(y, kind=private_plint) .or. & 1929 npts_local /= size(z, kind=private_plint) ) then 1930 write(error_unit, "(a)") "Plplot Fortran Warning: plgriddata: inconsistent sizes for x, y, and/or z" 1931 end if 1932 1933 nptsx_local = size(xg, kind=private_plint) 1934 nptsy_local = size(yg, kind=private_plint) 1935 1936 if( & 1937 nptsx_local /= size(zg, 1, kind=private_plint) .or. & 1938 nptsy_local /= size(zg, 2, kind=private_plint) ) then 1939 write(error_unit, "(a)") & 1940 "Plplot Fortran Warning: plgriddata: inconsistent sizes for "// & 1941 "xg and first dimension of zg or yg and second dimension of zg" 1942 end if 1943 1944 ! Prepare array areas to be written to by C version of plgriddata 1945 ! following relevant parts of code in matrix_to_c. 1946 allocate( transpose_local(nptsy_local, nptsx_local) ) 1947 allocate( transpose_address_local(nptsx_local) ) 1948 do i_local = 1, nptsx_local 1949 transpose_address_local(i_local) = c_loc(transpose_local(1,i_local)) 1950 enddo 1951 1952 call interface_plgriddata( & 1953 real(x,kind=private_plflt), real(y,kind=private_plflt), real(z,kind=private_plflt), npts_local, & 1954 real(xg,kind=private_plflt), nptsx_local, real(yg,kind=private_plflt), nptsy_local, & 1955 transpose_address_local, int(type, kind=private_plint), real(data, kind=private_plflt) ) 1956 1957 zg = real(transpose(transpose_local), kind=wp) 1958 deallocate(transpose_local, transpose_address_local) 1959 end subroutine plgriddata_impl 1960 1961 subroutine plgspa_impl( xmin, xmax, ymin, ymax ) 1962 real(kind=wp), intent(out) :: xmin, xmax, ymin, ymax 1963 1964 real(kind=private_plflt) :: xmin_out, xmax_out, ymin_out, ymax_out 1965 1966 interface 1967 subroutine interface_plgspa( xmin, xmax, ymin, ymax ) bind(c,name='c_plgspa') 1968 import :: private_plflt 1969 implicit none 1970 real(kind=private_plflt), intent(out) :: xmin, xmax, ymin, ymax 1971 end subroutine interface_plgspa 1972 end interface 1973 1974 call interface_plgspa( xmin_out, xmax_out, ymin_out, ymax_out ) 1975 xmin = real(xmin_out, kind=private_plflt) 1976 xmax = real(xmax_out, kind=private_plflt) 1977 ymin = real(ymin_out, kind=private_plflt) 1978 ymax = real(ymax_out, kind=private_plflt) 1979 end subroutine plgspa_impl 1980 1981 subroutine plgvpd_impl( xmin, xmax, ymin, ymax ) 1982 real(kind=wp), intent(out) :: xmin, xmax, ymin, ymax 1983 1984 real(kind=private_plflt) :: xmin_out, xmax_out, ymin_out, ymax_out 1985 1986 interface 1987 subroutine interface_plgvpd( xmin, xmax, ymin, ymax ) bind(c,name='c_plgvpd') 1988 import :: private_plflt 1989 implicit none 1990 real(kind=private_plflt), intent(out) :: xmin, xmax, ymin, ymax 1991 end subroutine interface_plgvpd 1992 end interface 1993 1994 call interface_plgvpd( xmin_out, xmax_out, ymin_out, ymax_out ) 1995 xmin = real(xmin_out, kind=private_plflt) 1996 xmax = real(xmax_out, kind=private_plflt) 1997 ymin = real(ymin_out, kind=private_plflt) 1998 ymax = real(ymax_out, kind=private_plflt) 1999 end subroutine plgvpd_impl 2000 2001 subroutine plgvpw_impl( xmin, xmax, ymin, ymax ) 2002 real(kind=wp), intent(out) :: xmin, xmax, ymin, ymax 2003 2004 real(kind=private_plflt) :: xmin_out, xmax_out, ymin_out, ymax_out 2005 interface 2006 subroutine interface_plgvpw( xmin, xmax, ymin, ymax ) bind(c,name='c_plgvpw') 2007 import :: private_plflt 2008 implicit none 2009 real(kind=private_plflt), intent(out) :: xmin, xmax, ymin, ymax 2010 end subroutine interface_plgvpw 2011 end interface 2012 2013 call interface_plgvpw( xmin_out, xmax_out, ymin_out, ymax_out ) 2014 xmin = real(xmin_out, kind=private_plflt) 2015 xmax = real(xmax_out, kind=private_plflt) 2016 ymin = real(ymin_out, kind=private_plflt) 2017 ymax = real(ymax_out, kind=private_plflt) 2018 end subroutine plgvpw_impl 2019 2020 subroutine plhist_impl( data, datmin, datmax, nbin, oldwin ) 2021 real(kind=wp), dimension(:), intent(in) :: data 2022 real(kind=wp), intent(in) :: datmin, datmax 2023 integer, intent(in) :: nbin, oldwin 2024 2025 interface 2026 subroutine interface_plhist( n, data, datmin, datmax, nbin, oldwin ) bind(c,name='c_plhist') 2027 import :: private_plint, private_plflt 2028 implicit none 2029 real(kind=private_plflt), dimension(*), intent(in) :: data 2030 real(kind=private_plflt), value, intent(in) :: datmin, datmax 2031 integer(kind=private_plint), value, intent(in) :: n, nbin, oldwin 2032 end subroutine interface_plhist 2033 end interface 2034 2035 call interface_plhist( size(data,kind=private_plint), real(data,kind=private_plflt), & 2036 real(datmin,kind=private_plflt), real(datmax,kind=private_plflt), & 2037 int(nbin,kind=private_plint), int(oldwin,kind=private_plint) ) 2038 end subroutine plhist_impl 2039 2040 subroutine plhlsrgb_impl( h, l, s, r, g, b ) 2041 real(kind=wp), intent(in) :: h, l, s 2042 real(kind=wp), intent(out) :: r, g, b 2043 2044 real(kind=private_plflt) :: r_out, g_out, b_out 2045 2046 interface 2047 subroutine interface_plhlsrgb( h, l, s, r, g, b ) bind(c,name='c_plhlsrgb') 2048 import :: private_plflt 2049 implicit none 2050 real(kind=private_plflt), value, intent(in) :: h, l, s 2051 real(kind=private_plflt), intent(out) :: r, g, b 2052 end subroutine interface_plhlsrgb 2053 end interface 2054 2055 call interface_plhlsrgb( real(h,kind=private_plflt), real(l,kind=private_plflt), real(s,kind=private_plflt), & 2056 r_out, g_out, b_out ) 2057 r = real(r_out, kind=wp) 2058 g = real(g_out, kind=wp) 2059 b = real(b_out, kind=wp) 2060 end subroutine plhlsrgb_impl 2061 2062 subroutine plimage_impl( idata, xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax ) 2063 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax 2064 real(kind=wp), dimension(:, :), intent(in) :: idata 2065 2066 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2067 type(c_ptr), dimension(:), allocatable :: idata_address_local 2068 2069 interface 2070 subroutine interface_plimage( idata, nx, ny, & 2071 xmin, xmax, ymin, ymax, & 2072 zmin, zmax, Dxmin, Dxmax, Dymin, Dymax ) bind(c,name='c_plimage') 2073 import :: c_ptr 2074 import :: private_plint, private_plflt 2075 implicit none 2076 integer(kind=private_plint), value, intent(in) :: nx, ny 2077 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax 2078 type(c_ptr), dimension(*), intent(in) :: idata 2079 end subroutine interface_plimage 2080 end interface 2081 2082 call matrix_to_c( idata, idata_local, idata_address_local ) 2083 2084 call interface_plimage( & 2085 idata_address_local, size(idata, 1, kind=private_plint), size(idata, 2, kind=private_plint), & 2086 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2087 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2088 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2089 real(Dxmin, kind=private_plflt), real(Dxmax, kind=private_plflt), & 2090 real(Dymin, kind=private_plflt), real(Dymax, kind=private_plflt) & 2091 ) 2092 end subroutine plimage_impl 2093 2094 subroutine plimagefr_impl_1( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, xg, yg ) 2095 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2096 real(kind=wp), dimension(:, :), intent(in) :: idata 2097 real(kind=wp), dimension(:), intent(in) :: xg, yg 2098 2099 integer(kind=private_plint) :: nx_in, ny_in 2100 real(kind=private_plflt), dimension(:), allocatable, target :: xg_in, yg_in 2101 type(PLcGrid), target :: cgrid_local 2102 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2103 type(c_ptr), dimension(:), allocatable :: idata_address_local 2104 2105 nx_in = size(idata,1, kind=private_plint) 2106 ny_in = size(idata,2, kind=private_plint) 2107 if(nx_in + 1 /= size(xg, kind=private_plint) .or. ny_in + 1 /= size(yg, kind=private_plint) ) then 2108 write(error_unit, "(a)") "Plplot Fortran Warning: plimagefr: inconsistent sizes for idata, xg, and/or yg" 2109 end if 2110 2111 allocate( xg_in(nx_in+1), yg_in(ny_in+1) ) 2112 xg_in = xg 2113 yg_in = yg 2114 cgrid_local%nx = nx_in + 1 2115 cgrid_local%ny = ny_in + 1 2116 cgrid_local%xg = c_loc(xg_in) 2117 cgrid_local%yg = c_loc(yg_in) 2118 2119 call matrix_to_c( idata, idata_local, idata_address_local ) 2120 2121 call interface_plimagefr( & 2122 idata_address_local, nx_in, ny_in, & 2123 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2124 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2125 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2126 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt), & 2127 interface_pltr1, c_loc(cgrid_local) ) 2128 end subroutine plimagefr_impl_1 2129 2130 subroutine plimagefr_impl_2( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, xg, yg ) 2131 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2132 real(kind=wp), dimension(:, :), intent(in) :: idata 2133 real(kind=wp), dimension(:, :), intent(in) :: xg, yg 2134 2135 integer(kind=private_plint) :: nx_in, ny_in 2136 real(kind=private_plflt), dimension(:, :), allocatable, target :: xg_in, yg_in 2137 type(PLcGrid), target :: cgrid_local 2138 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2139 type(c_ptr), dimension(:), allocatable :: idata_address_local 2140 2141 nx_in = size(idata,1, kind=private_plint) 2142 ny_in = size(idata,2, kind=private_plint) 2143 if( & 2144 nx_in + 1 /= size(xg, 1, kind=private_plint) .or. ny_in + 1 /= size(xg, 2, kind=private_plint) .or. & 2145 nx_in + 1 /= size(yg, 1, kind=private_plint) .or. ny_in + 1 /= size(xg, 2, kind=private_plint) ) then 2146 write(error_unit, "(a)") "Plplot Fortran Warning: plimagefr: inconsistent sizes for idata, xg and/or yg" 2147 end if 2148 2149 allocate( xg_in(nx_in+1,ny_in+1), yg_in(nx_in+1,ny_in+1) ) 2150 xg_in = xg 2151 yg_in = yg 2152 cgrid_local%nx = nx_in + 1 2153 cgrid_local%ny = ny_in + 1 2154 cgrid_local%xg = c_loc(xg_in) 2155 cgrid_local%yg = c_loc(yg_in) 2156 2157 call matrix_to_c( idata, idata_local, idata_address_local ) 2158 2159 call interface_plimagefr( & 2160 idata_address_local, nx_in, ny_in, & 2161 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2162 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2163 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2164 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt), & 2165 interface_pltr2f, c_loc(cgrid_local) ) 2166 end subroutine plimagefr_impl_2 2167 2168 ! Uses NULL C callback and NULL associated data (which has a special meaning at 2169 ! the C level). 2170 subroutine plimagefr_impl_null( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax ) 2171 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2172 real(kind=wp), dimension(:, :), intent(in) :: idata 2173 2174 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2175 type(c_ptr), dimension(:), allocatable :: idata_address_local 2176 2177 call matrix_to_c( idata, idata_local, idata_address_local ) 2178 2179 call interface_plimagefr_null( & 2180 idata_address_local, & 2181 size(idata, 1, kind=private_plint), size(idata, 2, kind=private_plint), & 2182 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2183 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2184 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2185 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt) ) 2186 end subroutine plimagefr_impl_null 2187 2188 subroutine plimagefr_impl_tr( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, tr ) 2189 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2190 real(kind=wp), dimension(:, :), intent(in) :: idata 2191 real(kind=wp), dimension(:), intent(in) :: tr 2192 2193 integer(kind=private_plint) :: nx_in, ny_in 2194 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2195 type(c_ptr), dimension(:), allocatable :: idata_address_local 2196 real(kind=private_plflt), dimension(6), target :: tr_in 2197 2198 nx_in = size(idata,1, kind=private_plint) 2199 ny_in = size(idata,2, kind=private_plint) 2200 2201 call matrix_to_c( idata, idata_local, idata_address_local ) 2202 tr_in = tr(1:6) 2203 2204 call interface_plimagefr( & 2205 idata_address_local, nx_in, ny_in, & 2206 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2207 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2208 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2209 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt), & 2210 plplot_private_pltr, c_loc(tr_in) ) 2211 end subroutine plimagefr_impl_tr 2212 2213 subroutine plimagefr_impl( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, proc ) 2214 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2215 real(kind=wp), dimension(:, :), intent(in) :: idata 2216 procedure(pltransform_proc) :: proc 2217 2218 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2219 type(c_ptr), dimension(:), allocatable :: idata_address_local 2220 2221 call matrix_to_c( idata, idata_local, idata_address_local ) 2222 pltransform => proc 2223 2224 call interface_plimagefr( & 2225 idata_address_local, & 2226 size(idata, 1, kind=private_plint), size(idata, 2, kind=private_plint), & 2227 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2228 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2229 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2230 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt), & 2231 pltransformf2c, c_null_ptr ) 2232 end subroutine plimagefr_impl 2233 2234 subroutine plimagefr_impl_data( idata, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, proc, data ) 2235 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax 2236 real(kind=wp), dimension(:, :), intent(in) :: idata 2237 procedure(pltransform_proc_data) :: proc 2238 type(c_ptr), intent(in) :: data 2239 2240 real(kind=private_plflt), dimension(:,:), allocatable :: idata_local 2241 type(c_ptr), dimension(:), allocatable :: idata_address_local 2242 2243 call matrix_to_c( idata, idata_local, idata_address_local ) 2244 pltransform_data => proc 2245 2246 call interface_plimagefr( & 2247 idata_address_local, & 2248 size(idata, 1, kind=private_plint), size(idata, 2, kind=private_plint), & 2249 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), & 2250 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 2251 real(zmin, kind=private_plflt), real(zmax, kind=private_plflt), & 2252 real(valuemin, kind=private_plflt), real(valuemax, kind=private_plflt), & 2253 pltransformf2c_data, data ) 2254 end subroutine plimagefr_impl_data 2255 2256 subroutine pljoin_impl( x1, y1, x2, y2 ) 2257 real(kind=wp), intent(in) :: x1, y1, x2, y2 2258 2259 interface 2260 subroutine interface_pljoin( x1, y1, x2, y2 ) bind(c,name='c_pljoin') 2261 import :: private_plflt 2262 implicit none 2263 real(kind=private_plflt), value, intent(in) :: x1, y1, x2, y2 2264 end subroutine interface_pljoin 2265 end interface 2266 2267 call interface_pljoin( real(x1,kind=private_plflt), real(y1,kind=private_plflt), & 2268 real(x2,kind=private_plflt), real(y2,kind=private_plflt) ) 2269 end subroutine pljoin_impl 2270 2271 subroutine pllegend_impl( & 2272 legend_width, legend_height, & 2273 opt, position, x, y, & 2274 plot_width, bg_color, bb_color, bb_style, & 2275 nrow, ncolumn, opt_array, & 2276 text_offset, text_scale, text_spacing, & 2277 text_justification, text_colors, text, & 2278 box_colors, box_patterns, box_scales, & 2279 box_line_widths, & 2280 line_colors, line_styles, line_widths, & 2281 symbol_colors, symbol_scales, & 2282 symbol_numbers, symbols ) 2283 2284 real(kind=wp), intent(in) :: plot_width, x, y 2285 real(kind=wp), intent(in) :: text_offset, text_scale, text_spacing, text_justification 2286 integer, intent(in) :: position, opt, bg_color, bb_color, bb_style 2287 integer, intent(in) :: nrow, ncolumn 2288 real(kind=wp), intent(out) :: legend_width, legend_height 2289 2290 character(len=*), dimension(:), intent(in) :: text, symbols 2291 2292 integer, dimension(:), intent(in) :: opt_array, text_colors, box_colors 2293 integer, dimension(:), intent(in) :: box_patterns 2294 real(kind=wp), dimension(:), intent(in) :: box_line_widths 2295 integer, dimension(:), intent(in) :: line_colors, line_styles 2296 real(kind=wp), dimension(:), intent(in) :: line_widths 2297 integer, dimension(:), intent(in) :: symbol_colors, symbol_numbers 2298 real(kind=wp), dimension(:), intent(in) :: box_scales, symbol_scales 2299 2300 integer(kind=private_plint) :: nlegend_local 2301 real(kind=private_plflt) :: legend_width_out, legend_height_out 2302 character(len=1), dimension(:,:), allocatable :: cstring_text_local, cstring_symbols_local 2303 type(c_ptr), dimension(:), allocatable :: cstring_address_text_local, cstring_address_symbols_local 2304 2305 interface 2306 subroutine interface_pllegend( & 2307 legend_width, legend_height, & 2308 opt, position, x, y, & 2309 plot_width, bg_color, bb_color, bb_style, & 2310 nrow, ncolumn, nlegend, opt_array, & 2311 text_offset, text_scale, text_spacing, & 2312 text_justification, text_colors, text, & 2313 box_colors, box_patterns, box_scales, & 2314 box_line_widths, & 2315 line_colors, line_styles, line_widths, & 2316 symbol_colors, symbol_scales, & 2317 symbol_numbers, symbols ) & 2318 bind(c,name='c_pllegend') 2319 2320 import :: c_ptr 2321 import :: private_plint, private_plflt 2322 implicit none 2323 2324 real(kind=private_plflt), value, intent(in) :: plot_width, x, y 2325 real(kind=private_plflt), value, intent(in) :: text_offset, text_scale, text_spacing, text_justification 2326 integer(kind=private_plint), value, intent(in) :: position, opt, bg_color, bb_color, bb_style 2327 integer(kind=private_plint), value, intent(in) :: nrow, ncolumn, nlegend 2328 2329 type(c_ptr), dimension(*), intent(in) :: text, symbols 2330 2331 integer(kind=private_plint), dimension(*), intent(in) :: opt_array, text_colors, box_colors 2332 integer(kind=private_plint), dimension(*), intent(in) :: box_patterns 2333 real(kind=private_plflt), dimension(*), intent(in) :: box_line_widths 2334 integer(kind=private_plint), dimension(*), intent(in) :: line_colors, line_styles 2335 real(kind=private_plflt), dimension(*), intent(in) :: line_widths 2336 integer(kind=private_plint), dimension(*), intent(in) :: symbol_colors, symbol_numbers 2337 real(kind=private_plflt), dimension(*), intent(in) :: box_scales, symbol_scales 2338 real(kind=private_plflt), intent(out) :: legend_width, legend_height 2339 end subroutine interface_pllegend 2340 end interface 2341 2342 2343 ! Determine number of legend entries and demand consistent 2344 ! array sizes. 2345 2346 nlegend_local = size(opt_array) 2347 if( & 2348 nlegend_local /= size(text_colors) .or. & 2349 nlegend_local /= size(text) .or. & 2350 nlegend_local /= size(box_colors) .or. & 2351 nlegend_local /= size(box_patterns) .or. & 2352 nlegend_local /= size(box_scales) .or. & 2353 nlegend_local /= size(box_line_widths) .or. & 2354 nlegend_local /= size(line_colors) .or. & 2355 nlegend_local /= size(line_styles) .or. & 2356 nlegend_local /= size(line_widths) .or. & 2357 nlegend_local /= size(symbol_colors) .or. & 2358 nlegend_local /= size(symbol_scales) .or. & 2359 nlegend_local /= size(symbol_numbers) .or. & 2360 nlegend_local /= size(symbols) & 2361 ) then 2362 write(error_unit, "(a)") "Plplot Fortran Warning: pllegend: inconsistent sizes for the following arrays:" 2363 write(error_unit, "(a)") "opt_array" 2364 write(error_unit, "(a)") "text_colors" 2365 write(error_unit, "(a)") "text" 2366 write(error_unit, "(a)") "box_colors" 2367 write(error_unit, "(a)") "box_patterns" 2368 write(error_unit, "(a)") "box_scales" 2369 write(error_unit, "(a)") "box_line_widths" 2370 write(error_unit, "(a)") "line_colors" 2371 write(error_unit, "(a)") "line_styles" 2372 write(error_unit, "(a)") "line_widths" 2373 write(error_unit, "(a)") "symbol_colors" 2374 write(error_unit, "(a)") "symbol_scales" 2375 write(error_unit, "(a)") "symbol_numbers" 2376 write(error_unit, "(a)") "symbols" 2377 end if 2378 2379 call character_array_to_c( cstring_text_local, cstring_address_text_local, text ) 2380 call character_array_to_c( cstring_symbols_local, cstring_address_symbols_local, symbols ) 2381 2382 call interface_pllegend( & 2383 legend_width_out, legend_height_out, & 2384 int(opt,kind=private_plint), int(position,kind=private_plint), & 2385 real(x,kind=private_plflt), real(y,kind=private_plflt), & 2386 real(plot_width,kind=private_plflt), int(bg_color,kind=private_plint), & 2387 int(bb_color,kind=private_plint), int(bb_style,kind=private_plint), & 2388 int(nrow,kind=private_plint), int(ncolumn,kind=private_plint), & 2389 int(nlegend_local,kind=private_plint), int(opt_array,kind=private_plint), & 2390 real(text_offset,kind=private_plflt), real(text_scale,kind=private_plflt), & 2391 real(text_spacing,kind=private_plflt), & 2392 real(text_justification,kind=private_plflt), int(text_colors,kind=private_plint), & 2393 cstring_address_text_local, & 2394 int(box_colors,kind=private_plint), int(box_patterns,kind=private_plint), & 2395 real(box_scales,kind=private_plflt), & 2396 real(box_line_widths,kind=private_plflt), & 2397 int(line_colors,kind=private_plint), int(line_styles,kind=private_plint), & 2398 real(line_widths,kind=private_plflt), & 2399 int(symbol_colors,kind=private_plint), real(symbol_scales,kind=private_plflt), & 2400 int(symbol_numbers,kind=private_plint), cstring_address_symbols_local ) 2401 2402 legend_width = real(legend_width_out, kind=wp) 2403 legend_height = real(legend_height_out, kind=wp) 2404 2405 end subroutine pllegend_impl 2406 2407 subroutine pllightsource_impl( x, y, z ) 2408 real(kind=wp), intent(in) :: x, y, z 2409 2410 interface 2411 subroutine interface_pllightsource( x, y, z ) bind(c,name='c_pllightsource') 2412 import :: private_plflt 2413 implicit none 2414 real(kind=private_plflt), value, intent(in) :: x, y, z 2415 end subroutine interface_pllightsource 2416 end interface 2417 2418 call interface_pllightsource( real(x,kind=private_plflt), real(y,kind=private_plflt), real(z,kind=private_plflt) ) 2419 end subroutine pllightsource_impl 2420 2421 subroutine plline3_impl( x, y, z ) 2422 real(kind=wp), dimension(:), intent(in) :: x, y, z 2423 2424 integer(kind=private_plint) :: sz_local 2425 2426 interface 2427 subroutine interface_plline3( sz, x, y, z ) bind(c,name='c_plline3') 2428 import :: private_plint, private_plflt 2429 implicit none 2430 integer(kind=private_plint), value, intent(in) :: sz 2431 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z 2432 end subroutine interface_plline3 2433 end interface 2434 2435 sz_local = size(x,kind=private_plint) 2436 if( sz_local /= size(y, kind=private_plint) .or. sz_local /= size(z, kind=private_plint) ) then 2437 write(error_unit, "(a)") "Plplot Fortran Warning: plline3: inconsistent sizes for x, y, and/or z" 2438 end if 2439 2440 call interface_plline3( sz_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 2441 real(z,kind=private_plflt) ) 2442 end subroutine plline3_impl 2443 2444 subroutine plline_impl( x, y ) 2445 real(kind=wp), dimension(:), intent(in) :: x, y 2446 2447 integer(kind=private_plint) :: sz_local 2448 2449 interface 2450 subroutine interface_plline( sz, x, y ) bind(c,name='c_plline') 2451 import :: private_plint, private_plflt 2452 implicit none 2453 integer(kind=private_plint), value, intent(in) :: sz 2454 real(kind=private_plflt), dimension(*), intent(in) :: x, y 2455 end subroutine interface_plline 2456 end interface 2457 2458 sz_local = size(x,kind=private_plint) 2459 if( sz_local /= size(y, kind=private_plint) ) then 2460 write(error_unit, "(a)") "Plplot Fortran Warning: plline: inconsistent sizes for x and y" 2461 end if 2462 2463 call interface_plline( sz_local, real(x,kind=private_plflt), real(y,kind=private_plflt) ) 2464 end subroutine plline_impl 2465 2466 subroutine plmap_impl( proc, name, minx, maxx, miny, maxy ) 2467 procedure(plmapform_proc) :: proc 2468 character*(*), intent(in) :: name 2469 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2470 2471 type(c_funptr) :: c_funloc_local 2472 2473 plmapform => proc 2474 c_funloc_local = c_funloc(plmapformf2c) 2475 2476 call interface_plmap( c_funloc_local, trim(name)//c_null_char, & 2477 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2478 real(miny, kind=private_plflt), real(maxy, kind=private_plflt) ) 2479 end subroutine plmap_impl 2480 2481 subroutine plmap_impl_null( name, minx, maxx, miny, maxy ) 2482 character*(*), intent(in) :: name 2483 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2484 2485 call interface_plmap( c_null_funptr, trim(name)//c_null_char, & 2486 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2487 real(miny, kind=private_plflt), real(maxy, kind=private_plflt) ) 2488 end subroutine plmap_impl_null 2489 2490 subroutine plmapfill_impl( proc, name, minx, maxx, miny, maxy, plotentries ) 2491 procedure(plmapform_proc) :: proc 2492 character*(*), intent(in) :: name 2493 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2494 integer, dimension(:), optional, target, intent(in) :: plotentries 2495 2496 plmapform => proc 2497 2498 if ( present(plotentries) ) then 2499 call interface_plmapfill( c_funloc(plmapformf2c), trim(name)//c_null_char, & 2500 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2501 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2502 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2503 else 2504 call interface_plmapfill( c_funloc(plmapformf2c), trim(name)//c_null_char, & 2505 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2506 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2507 c_null_ptr, 0_private_plint ) 2508 endif 2509 end subroutine plmapfill_impl 2510 2511 subroutine plmapfill_impl_null( name, minx, maxx, miny, maxy, plotentries ) 2512 character*(*), intent(in) :: name 2513 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2514 integer, dimension(:), optional, target, intent(in) :: plotentries 2515 2516 if ( present(plotentries) ) then 2517 call interface_plmapfill( c_null_funptr, trim(name)//c_null_char, & 2518 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2519 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2520 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2521 else 2522 call interface_plmapfill( c_null_funptr, trim(name)//c_null_char, & 2523 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2524 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2525 c_null_ptr, 0_private_plint ) 2526 endif 2527 end subroutine plmapfill_impl_null 2528 2529 subroutine plmapline_impl( proc, name, minx, maxx, miny, maxy, plotentries ) 2530 procedure(plmapform_proc) :: proc 2531 character*(*), intent(in) :: name 2532 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2533 integer, dimension(:), optional, target, intent(in) :: plotentries 2534 2535 plmapform => proc 2536 2537 if ( present(plotentries) ) then 2538 call interface_plmapline( c_funloc(plmapformf2c), trim(name)//c_null_char, & 2539 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2540 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2541 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2542 else 2543 call interface_plmapline( c_funloc(plmapformf2c), trim(name)//c_null_char, & 2544 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2545 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2546 c_null_ptr, 0_private_plint ) 2547 endif 2548 end subroutine plmapline_impl 2549 2550 subroutine plmapline_impl_null( name, minx, maxx, miny, maxy, plotentries ) 2551 character*(*), intent(in) :: name 2552 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2553 integer, dimension(:), optional, target, intent(in) :: plotentries 2554 2555 if ( present(plotentries) ) then 2556 call interface_plmapline( c_null_funptr, trim(name)//c_null_char, & 2557 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2558 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2559 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2560 else 2561 call interface_plmapline( c_null_funptr, trim(name)//c_null_char, & 2562 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2563 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2564 c_null_ptr, 0_private_plint ) 2565 endif 2566 end subroutine plmapline_impl_null 2567 2568 subroutine plmapstring_impl( proc, name, string, minx, maxx, miny, maxy, plotentries ) 2569 procedure(plmapform_proc) :: proc 2570 character*(*), intent(in) :: name, string 2571 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2572 integer, dimension(:), optional, target, intent(in) :: plotentries 2573 2574 plmapform => proc 2575 2576 if ( present(plotentries) ) then 2577 call interface_plmapstring( c_funloc(plmapformf2c), & 2578 trim(name)//c_null_char, trim(string)//c_null_char, & 2579 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2580 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2581 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2582 else 2583 call interface_plmapstring( c_funloc(plmapformf2c), & 2584 trim(name)//c_null_char, trim(string)//c_null_char, & 2585 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2586 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2587 c_null_ptr, 0_private_plint ) 2588 endif 2589 end subroutine plmapstring_impl 2590 2591 subroutine plmapstring_impl_null( name, string, minx, maxx, miny, maxy, plotentries ) 2592 character*(*), intent(in) :: name, string 2593 real(kind=wp), intent(in) :: minx, maxx, miny, maxy 2594 integer, dimension(:), optional, target, intent(in) :: plotentries 2595 2596 if ( present(plotentries) ) then 2597 call interface_plmapstring( c_null_funptr, & 2598 trim(name)//c_null_char, trim(string)//c_null_char, & 2599 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2600 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2601 c_loc(plotentries), size(plotentries, kind=private_plint) ) 2602 else 2603 call interface_plmapstring( c_null_funptr, & 2604 trim(name)//c_null_char, trim(string)//c_null_char, & 2605 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2606 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2607 c_null_ptr, 0_private_plint ) 2608 endif 2609 end subroutine plmapstring_impl_null 2610 2611 subroutine plmaptex_impl( proc, name, dx, dy, just, text, minx, maxx, miny, maxy, plotentry ) 2612 procedure(plmapform_proc) :: proc 2613 character*(*), intent(in) :: name, text 2614 real(kind=wp), intent(in) :: dx, dy, just, minx, maxx, miny, maxy 2615 integer, intent(in) :: plotentry 2616 2617 plmapform => proc 2618 2619 call interface_plmaptex( c_funloc(plmapformf2c), & 2620 trim(name)//c_null_char, & 2621 real(dx, kind=private_plflt), real(dy, kind=private_plflt), & 2622 real(just, kind=private_plflt), trim(text)//c_null_char, & 2623 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2624 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2625 int(plotentry, kind=private_plint) ) 2626 end subroutine plmaptex_impl 2627 2628 subroutine plmaptex_impl_null( name, dx, dy, just, text, minx, maxx, miny, maxy, plotentry ) 2629 character*(*), intent(in) :: name, text 2630 real(kind=wp), intent(in) :: dx, dy, just, minx, maxx, miny, maxy 2631 integer, intent(in) :: plotentry 2632 2633 call interface_plmaptex( c_null_funptr, & 2634 trim(name)//c_null_char, & 2635 real(dx, kind=private_plflt), real(dy, kind=private_plflt), & 2636 real(just, kind=private_plflt), trim(text)//c_null_char, & 2637 real(minx, kind=private_plflt), real(maxx, kind=private_plflt), & 2638 real(miny, kind=private_plflt), real(maxy, kind=private_plflt), & 2639 int(plotentry, kind=private_plint) ) 2640 end subroutine plmaptex_impl_null 2641 2642 subroutine plmeridians_impl( proc, dlong, dlat, minlong, maxlong, minlat, maxlat ) 2643 procedure(plmapform_proc) :: proc 2644 real(kind=wp), intent(in) :: dlong, dlat, minlong, maxlong, minlat, maxlat 2645 2646 plmapform => proc 2647 2648 call interface_plmeridians( c_funloc(plmapformf2c), & 2649 real(dlong, kind=private_plflt), real(dlat, kind=private_plflt), & 2650 real(minlong, kind=private_plflt), real(maxlong, kind=private_plflt), & 2651 real(minlat, kind=private_plflt), real(maxlat, kind=private_plflt) ) 2652 end subroutine plmeridians_impl 2653 2654 subroutine plmeridians_impl_null( dlong, dlat, minlong, maxlong, minlat, maxlat ) 2655 real(kind=wp), intent(in) :: dlong, dlat, minlong, maxlong, minlat, maxlat 2656 2657 call interface_plmeridians( c_null_funptr, & 2658 real(dlong, kind=private_plflt), real(dlat, kind=private_plflt), & 2659 real(minlong, kind=private_plflt), real(maxlong, kind=private_plflt), & 2660 real(minlat, kind=private_plflt), real(maxlat, kind=private_plflt) ) 2661 end subroutine plmeridians_impl_null 2662 2663 subroutine plmesh_impl( x, y, z, opt ) 2664 integer, intent(in) :: opt 2665 real(kind=wp), dimension(:), intent(in) :: x, y 2666 real(kind=wp), dimension(:,:), intent(in) :: z 2667 2668 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 2669 type(c_ptr), dimension(:), allocatable :: zaddress_local 2670 2671 integer(kind=private_plint) :: nx_local, ny_local 2672 2673 interface 2674 subroutine interface_plmesh( x, y, zaddress, nx, ny, opt ) bind(c,name='c_plmesh') 2675 import :: c_ptr 2676 import :: private_plint, private_plflt 2677 implicit none 2678 integer(kind=private_plint), value, intent(in) :: nx, ny, opt 2679 real(kind=private_plflt), dimension(*), intent(in) :: x, y 2680 type(c_ptr), dimension(*), intent(in) :: zaddress 2681 end subroutine interface_plmesh 2682 end interface 2683 2684 nx_local = size(x,kind=private_plint) 2685 ny_local = size(y,kind=private_plint) 2686 2687 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 2688 write(error_unit, "(a)") "Plplot Fortran Warning: plmesh: inconsistent sizes for x, y, and/or z" 2689 end if 2690 2691 call matrix_to_c( z, zz_local, zaddress_local ) 2692 2693 call interface_plmesh( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 2694 nx_local, ny_local, int(opt,kind=private_plint)) 2695 2696 end subroutine plmesh_impl 2697 2698 subroutine plmeshc_impl( x, y, z, opt, clevel ) 2699 integer, intent(in) :: opt 2700 real(kind=wp), dimension(:), intent(in) :: x, y, clevel 2701 real(kind=wp), dimension(:,:), intent(in) :: z 2702 2703 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 2704 type(c_ptr), dimension(:), allocatable :: zaddress_local 2705 2706 integer(kind=private_plint) :: nx_local, ny_local 2707 2708 interface 2709 subroutine interface_plmeshc( x, y, zaddress, nx, ny, opt, clevel, nlevel ) bind(c,name='c_plmeshc') 2710 import :: c_ptr 2711 import :: private_plint, private_plflt 2712 implicit none 2713 integer(kind=private_plint), value, intent(in) :: nx, ny, opt, nlevel 2714 real(kind=private_plflt), dimension(*), intent(in) :: x, y, clevel 2715 type(c_ptr), dimension(*), intent(in) :: zaddress 2716 end subroutine interface_plmeshc 2717 end interface 2718 2719 nx_local = size(x,kind=private_plint) 2720 ny_local = size(y,kind=private_plint) 2721 2722 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 2723 write(error_unit, "(a)") "Plplot Fortran Warning: plmeshc: inconsistent sizes for x, y, and/or z" 2724 end if 2725 2726 call matrix_to_c( z, zz_local, zaddress_local ) 2727 2728 call interface_plmeshc( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 2729 nx_local, ny_local, int(opt,kind=private_plint), & 2730 real(clevel,kind=private_plflt), size(clevel,kind=private_plint) ) 2731 2732 end subroutine plmeshc_impl 2733 2734 subroutine plmtex3_impl( side, disp, pos, just, text ) 2735 real(kind=wp), intent(in) :: disp, pos, just 2736 character*(*), intent(in) :: side, text 2737 2738 interface 2739 subroutine interface_plmtex3( side, disp, pos, just, text ) bind(c,name='c_plmtex3') 2740 import :: private_plflt 2741 implicit none 2742 character(len=1), dimension(*), intent(in) :: side, text 2743 real(kind=private_plflt), value, intent(in) :: disp, pos, just 2744 end subroutine interface_plmtex3 2745 end interface 2746 2747 call interface_plmtex3( trim(side)//c_null_char, real(disp,kind=private_plflt), real(pos,kind=private_plflt), & 2748 real(just,kind=private_plflt), trim(text)//c_null_char ) 2749 end subroutine plmtex3_impl 2750 2751 subroutine plmtex_impl( side, disp, pos, just, text ) 2752 real(kind=wp), intent(in) :: disp, pos, just 2753 character*(*), intent(in) :: side, text 2754 2755 interface 2756 subroutine interface_plmtex( side, disp, pos, just, text ) bind(c,name='c_plmtex') 2757 import :: private_plflt 2758 implicit none 2759 character(len=1), dimension(*), intent(in) :: side, text 2760 real(kind=private_plflt), value, intent(in) :: disp, pos, just 2761 end subroutine interface_plmtex 2762 end interface 2763 2764 call interface_plmtex( trim(side)//c_null_char, real(disp,kind=private_plflt), real(pos,kind=private_plflt), & 2765 real(just,kind=private_plflt), trim(text)//c_null_char ) 2766 end subroutine plmtex_impl 2767 2768 subroutine plot3d_impl( x, y, z, opt, side) 2769 logical, intent(in) :: side 2770 integer, intent(in) :: opt 2771 real(kind=wp), dimension(:), intent(in) :: x, y 2772 real(kind=wp), dimension(:,:), intent(in) :: z 2773 2774 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 2775 type(c_ptr), dimension(:), allocatable :: zaddress_local 2776 2777 integer(kind=private_plint) :: nx_local, ny_local 2778 2779 interface 2780 subroutine interface_plot3d( x, y, zaddress, nx, ny, opt, side ) bind(c,name='c_plot3d') 2781 import :: c_ptr 2782 import :: private_plint, private_plbool, private_plflt 2783 implicit none 2784 integer(kind=private_plint), value, intent(in) :: nx, ny, opt 2785 integer(kind=private_plbool), value, intent(in) :: side 2786 real(kind=private_plflt), dimension(*), intent(in) :: x, y 2787 type(c_ptr), dimension(*), intent(in) :: zaddress 2788 end subroutine interface_plot3d 2789 end interface 2790 2791 nx_local = size(x,kind=private_plint) 2792 ny_local = size(y,kind=private_plint) 2793 2794 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 2795 write(error_unit, "(a)") "Plplot Fortran Warning: plot3d: inconsistent sizes for x, y, and/or z" 2796 end if 2797 2798 call matrix_to_c( z, zz_local, zaddress_local ) 2799 2800 call interface_plot3d( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 2801 nx_local, ny_local, int(opt,kind=private_plint), & 2802 int(merge(1,0,side),kind=private_plbool) ) 2803 2804 end subroutine plot3d_impl 2805 2806 subroutine plot3dc_impl( x, y, z, opt, clevel ) 2807 integer, intent(in) :: opt 2808 real(kind=wp), dimension(:), intent(in) :: x, y, clevel 2809 real(kind=wp), dimension(:,:), intent(in) :: z 2810 2811 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 2812 type(c_ptr), dimension(:), allocatable :: zaddress_local 2813 2814 integer(kind=private_plint) :: nx_local, ny_local 2815 2816 interface 2817 subroutine interface_plot3dc( x, y, zaddress, nx, ny, opt, clevel, nlevel ) bind(c,name='c_plot3dc') 2818 import :: c_ptr 2819 import :: private_plint, private_plflt 2820 implicit none 2821 integer(kind=private_plint), value, intent(in) :: nx, ny, opt, nlevel 2822 real(kind=private_plflt), dimension(*), intent(in) :: x, y, clevel 2823 type(c_ptr), dimension(*), intent(in) :: zaddress 2824 end subroutine interface_plot3dc 2825 end interface 2826 2827 nx_local = size(x,kind=private_plint) 2828 ny_local = size(y,kind=private_plint) 2829 2830 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 2831 write(error_unit, "(a)") "Plplot Fortran Warning: plot3dc: inconsistent sizes for x, y, and/or z" 2832 end if 2833 2834 call matrix_to_c( z, zz_local, zaddress_local ) 2835 2836 call interface_plot3dc( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 2837 nx_local, ny_local, int(opt,kind=private_plint), & 2838 real(clevel,kind=private_plflt), size(clevel,kind=private_plint) ) 2839 2840 end subroutine plot3dc_impl 2841 2842 subroutine plot3dcl_impl( x, y, z, opt, clevel, indexxmin, indexymin, indexymax ) 2843 integer, intent(in) :: opt 2844 real(kind=wp), dimension(:), intent(in) :: x, y, clevel 2845 real(kind=wp), dimension(:,:), intent(in) :: z 2846 integer, intent(in) :: indexxmin 2847 integer, dimension(:), intent(in) :: indexymin, indexymax 2848 2849 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 2850 type(c_ptr), dimension(:), allocatable :: zaddress_local 2851 2852 integer(kind=private_plint) :: nx_local, ny_local, indexxmax_local 2853 2854 interface 2855 subroutine interface_plot3dcl( x, y, zaddress, nx, ny, opt, clevel, nlevel, & 2856 indexxmin, indexxmax, indexymin, indexymax ) bind(c,name='c_plot3dcl') 2857 import :: c_ptr 2858 import :: private_plint, private_plflt 2859 implicit none 2860 integer(kind=private_plint), value, intent(in) :: nx, ny, opt, nlevel, indexxmin, indexxmax 2861 integer(kind=private_plint), dimension(*), intent(in) :: indexymin, indexymax 2862 real(kind=private_plflt), dimension(*), intent(in) :: x, y, clevel 2863 type(c_ptr), dimension(*), intent(in) :: zaddress 2864 end subroutine interface_plot3dcl 2865 end interface 2866 2867 nx_local = size(x,kind=private_plint) 2868 ny_local = size(y,kind=private_plint) 2869 2870 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 2871 write(error_unit, "(a)") "Plplot Fortran Warning: plot3dcl: inconsistent sizes for x, y, and/or z" 2872 end if 2873 2874 indexxmax_local = size(indexymin) 2875 if( indexxmax_local /= size(indexymax, kind=private_plint) ) then 2876 write(error_unit, "(a)") "Plplot Fortran Warning: plot3dcl: inconsistent sizes for indexymin and indeyxmax" 2877 end if 2878 2879 call matrix_to_c( z, zz_local, zaddress_local ) 2880 2881 call interface_plot3dcl( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 2882 nx_local, ny_local, int(opt,kind=private_plint), & 2883 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 2884 int(indexxmin,kind=private_plint), indexxmax_local, & 2885 int(indexymin,kind=private_plint), int(indexymax,kind=private_plint) ) 2886 2887 end subroutine plot3dcl_impl 2888 2889 subroutine plpath_impl( n, x1, y1, x2, y2 ) 2890 integer, intent(in) :: n 2891 real(kind=wp), intent(in) :: x1, y1, x2, y2 2892 2893 interface 2894 subroutine interface_plpath( n, x1, y1, x2, y2 ) bind(c,name='c_plpath') 2895 import :: private_plint, private_plflt 2896 implicit none 2897 integer(kind=private_plint), value, intent(in) :: n 2898 real(kind=private_plflt), value, intent(in) :: x1, y1, x2, y2 2899 end subroutine interface_plpath 2900 end interface 2901 2902 call interface_plpath( int(n,kind=private_plint), real(x1,kind=private_plflt), & 2903 real(y1,kind=private_plflt), real(x2,kind=private_plflt), real(y2,kind=private_plflt) ) 2904 end subroutine plpath_impl 2905 2906 subroutine plpoin3_impl( x, y, z, code ) 2907 integer, intent(in) :: code 2908 real(kind=wp), dimension(:), intent(in) :: x, y, z 2909 2910 integer(kind=private_plint) :: n_local 2911 2912 interface 2913 subroutine interface_plpoin3( n, x, y, z, code ) bind(c,name='c_plpoin3') 2914 import :: private_plint, private_plflt 2915 implicit none 2916 integer(kind=private_plint), value, intent(in) :: n, code 2917 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z 2918 end subroutine interface_plpoin3 2919 end interface 2920 2921 n_local = size(x,kind=private_plint) 2922 if( n_local /= size(y, kind=private_plint) .or. n_local /= size(z, kind=private_plint) ) then 2923 write(error_unit, "(a)") "Plplot Fortran Warning: plpoin3: inconsistent sizes for x, y, and/or z" 2924 end if 2925 2926 call interface_plpoin3( n_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 2927 real(z,kind=private_plflt), int(code,kind=private_plint) ) 2928 end subroutine plpoin3_impl 2929 2930 subroutine plpoin_impl( x, y, code ) 2931 integer, intent(in) :: code 2932 real(kind=wp), dimension(:), intent(in) :: x, y 2933 2934 integer(kind=private_plint) :: n_local 2935 2936 interface 2937 subroutine interface_plpoin( n, x, y, code ) bind(c,name='c_plpoin') 2938 import :: private_plint, private_plflt 2939 implicit none 2940 integer(kind=private_plint), value, intent(in) :: n, code 2941 real(kind=private_plflt), dimension(*), intent(in) :: x, y 2942 end subroutine interface_plpoin 2943 end interface 2944 2945 n_local = size(x,kind=private_plint) 2946 if( n_local /= size(y, kind=private_plint) ) then 2947 write(error_unit, "(a)") "Plplot Fortran Warning: plpoin: inconsistent sizes for x and y" 2948 end if 2949 2950 call interface_plpoin( n_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 2951 int(code,kind=private_plint) ) 2952 end subroutine plpoin_impl 2953 2954 subroutine plpoly3_impl( x, y, z, draw, ifcc ) 2955 logical, intent(in) :: ifcc 2956 logical, dimension(:), intent(in) :: draw 2957 real(kind=wp), dimension(:), intent(in) :: x, y, z 2958 2959 integer(kind=private_plint) :: n_local 2960 2961 interface 2962 subroutine interface_plpoly3( n, x, y, z, draw, ifcc ) bind(c,name='c_plpoly3') 2963 import :: private_plint, private_plbool, private_plflt 2964 implicit none 2965 integer(kind=private_plint), value, intent(in) :: n 2966 integer(kind=private_plbool), value, intent(in) :: ifcc 2967 integer(kind=private_plbool), dimension(*), intent(in) :: draw 2968 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z 2969 end subroutine interface_plpoly3 2970 end interface 2971 2972 n_local = size(x,kind=private_plint) 2973 if( n_local /= size(y, kind=private_plint) .or. n_local /= size(z, kind=private_plint) .or. & 2974 n_local /= size(draw, kind=private_plint) + 1 ) then 2975 write(error_unit, "(a)") "Plplot Fortran Warning: plpoly3: inconsistent sizes for x, y, z, and/or draw" 2976 end if 2977 2978 call interface_plpoly3( n_local, & 2979 real(x,kind=private_plflt), real(y,kind=private_plflt), real(z,kind=private_plflt), & 2980 int(merge(1,0,draw),kind=private_plbool), int(merge(1,0,ifcc),kind=private_plbool) ) 2981 end subroutine plpoly3_impl 2982 2983 subroutine plptex3_impl( wx, wy, wz, dx, dy, dz, sx, sy, sz, just, text ) 2984 2985 real(kind=wp), intent(in) :: wx, wy, wz, dx, dy, dz, sx, sy, sz, just 2986 character*(*), intent(in) :: text 2987 2988 interface 2989 subroutine interface_plptex3( wx, wy, wz, dx, dy, dz, sx, sy, sz, just, text ) bind(c,name='c_plptex3') 2990 import :: private_plflt 2991 implicit none 2992 character(len=1), dimension(*), intent(in) :: text 2993 real(kind=private_plflt), value, intent(in) :: wx, wy, wz, dx, dy, dz, sx, sy, sz, just 2994 end subroutine interface_plptex3 2995 end interface 2996 2997 call interface_plptex3( real(wx,kind=private_plflt), real(wy,kind=private_plflt), real(wz,kind=private_plflt), & 2998 real(dx,kind=private_plflt), real(dy,kind=private_plflt), real(dz,kind=private_plflt), & 2999 real(sx,kind=private_plflt), real(sy,kind=private_plflt), real(sz,kind=private_plflt), & 3000 real(just,kind=private_plflt), trim(text)//c_null_char ) 3001 3002 end subroutine plptex3_impl 3003 3004 subroutine plptex_impl( x, y, dx, dy, just, text ) 3005 3006 real(kind=wp), intent(in) :: x, y, dx, dy, just 3007 character*(*), intent(in) :: text 3008 3009 interface 3010 subroutine interface_plptex( x, y, dx, dy, just, text ) bind(c,name='c_plptex') 3011 import :: private_plflt 3012 implicit none 3013 character(len=1), dimension(*), intent(in) :: text 3014 real(kind=private_plflt), value, intent(in) :: x, y, dx, dy, just 3015 end subroutine interface_plptex 3016 end interface 3017 3018 call interface_plptex( real(x,kind=private_plflt), real(y,kind=private_plflt), real(dx,kind=private_plflt), & 3019 real(dy,kind=private_plflt), real(just,kind=private_plflt), trim(text)//c_null_char ) 3020 3021 end subroutine plptex_impl 3022 3023 subroutine plrgbhls_impl( r, g, b, h, l, s ) 3024 real(kind=wp), intent(in) :: r, g, b 3025 real(kind=wp), intent(out) :: h, l, s 3026 3027 real(kind=private_plflt) :: h_out, l_out, s_out 3028 3029 interface 3030 subroutine interface_plrgbhls( r, g, b, h, l, s ) bind(c,name='c_plrgbhls') 3031 import :: private_plflt 3032 implicit none 3033 real(kind=private_plflt), value, intent(in) :: r, g, b 3034 real(kind=private_plflt), intent(out) :: h, l, s 3035 end subroutine interface_plrgbhls 3036 end interface 3037 3038 call interface_plrgbhls( real(r,kind=private_plflt), real(g,kind=private_plflt), real(b,kind=private_plflt), & 3039 h_out, l_out, s_out ) 3040 h = real(h_out, kind=wp) 3041 l = real(l_out, kind=wp) 3042 s = real(s_out, kind=wp) 3043 end subroutine plrgbhls_impl 3044 3045 subroutine plschr_impl( chrdef, chrht ) 3046 real(kind=wp), intent(in) :: chrdef, chrht 3047 3048 interface 3049 subroutine interface_plschr( chrdef, chrht ) bind(c,name='c_plschr') 3050 import :: private_plflt 3051 implicit none 3052 real(kind=private_plflt), value, intent(in) :: chrdef, chrht 3053 end subroutine interface_plschr 3054 end interface 3055 3056 call interface_plschr( real(chrdef,kind=private_plflt), real(chrht,kind=private_plflt) ) 3057 end subroutine plschr_impl 3058 3059 subroutine plscmap0a_impl( r, g, b, a ) 3060 integer, dimension(:), intent(in) :: r, g, b 3061 real(kind=wp), dimension(:), intent(in) :: a 3062 3063 integer(kind=private_plint) :: n_local 3064 3065 interface 3066 subroutine interface_plscmap0a( r, g, b, a, n ) bind(c,name='c_plscmap0a') 3067 import :: private_plint, private_plflt 3068 implicit none 3069 integer(kind=private_plint), dimension(*), intent(in) :: r, g, b 3070 real(kind=private_plflt), dimension(*), intent(in) :: a 3071 integer(kind=private_plint), value, intent(in) :: n 3072 end subroutine interface_plscmap0a 3073 end interface 3074 3075 n_local = size(r,kind=private_plint) 3076 if( n_local /= size(g, kind=private_plint) .or. n_local /= size(b, kind=private_plint) .or. & 3077 n_local /= size(a, kind=private_plint) ) then 3078 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap0a: inconsistent sizes for r, g, b, and/or a" 3079 end if 3080 3081 call interface_plscmap0a( int(r,kind=private_plint), int(g,kind=private_plint), int(b,kind=private_plint), & 3082 real(a,kind=private_plflt), n_local ) 3083 end subroutine plscmap0a_impl 3084 3085 subroutine plscmap1_range_impl( chrdef, chrht ) 3086 real(kind=wp), intent(in) :: chrdef, chrht 3087 3088 interface 3089 subroutine interface_plscmap1_range( chrdef, chrht ) bind(c,name='c_plscmap1_range') 3090 import :: private_plflt 3091 implicit none 3092 real(kind=private_plflt), value, intent(in) :: chrdef, chrht 3093 end subroutine interface_plscmap1_range 3094 end interface 3095 3096 call interface_plscmap1_range( real(chrdef,kind=private_plflt), real(chrht,kind=private_plflt) ) 3097 end subroutine plscmap1_range_impl 3098 3099 subroutine plscmap1a_impl( r, g, b, a ) 3100 integer, dimension(:), intent(in) :: r, g, b 3101 real(kind=wp), dimension(:), intent(in) :: a 3102 3103 integer(kind=private_plint) :: n_local 3104 3105 interface 3106 subroutine interface_plscmap1a( r, g, b, a, n ) bind(c,name='c_plscmap1a') 3107 import :: private_plint, private_plflt 3108 implicit none 3109 integer(kind=private_plint), dimension(*), intent(in) :: r, g, b 3110 real(kind=private_plflt), dimension(*), intent(in) :: a 3111 integer(kind=private_plint), value, intent(in) :: n 3112 end subroutine interface_plscmap1a 3113 end interface 3114 3115 n_local = size(r,kind=private_plint) 3116 if( n_local /= size(g, kind=private_plint) .or. n_local /= size(b, kind=private_plint) .or. & 3117 n_local /= size(a, kind=private_plint) ) then 3118 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap1a: inconsistent sizes for r, g, b, and/or a" 3119 end if 3120 3121 call interface_plscmap1a( int(r,kind=private_plint), int(g,kind=private_plint), int(b,kind=private_plint), & 3122 real(a,kind=private_plflt), n_local ) 3123 end subroutine plscmap1a_impl 3124 3125 subroutine plscmap1l_impl( rgbtype, intensity, coord1, coord2, coord3, alt_hue_path) 3126 logical, intent(in) :: rgbtype 3127 real(kind=wp), dimension(:), intent(in) :: intensity, coord1, coord2, coord3 3128 logical, dimension(:), optional, intent(in) :: alt_hue_path 3129 3130 integer(kind=private_plint) :: npts_local 3131 integer(kind=private_plbool), dimension(:), allocatable, target :: ialt_hue_path_local 3132 3133 interface 3134 subroutine interface_plscmap1l( rgbtype, npts, intensity, coord1, coord2, coord3, alt_hue_path ) & 3135 bind(c,name='c_plscmap1l') 3136 import :: c_ptr 3137 import :: private_plint, private_plbool, private_plflt 3138 implicit none 3139 integer(kind=private_plint), value, intent(in) :: npts 3140 integer(kind=private_plbool), value, intent(in) :: rgbtype 3141 real(kind=private_plflt), dimension(*), intent(in) :: intensity, coord1, coord2, coord3 3142 !integer(kind=private_plbool), dimension(*), intent(in) :: alt_hue_path 3143 type(c_ptr), value, intent(in) :: alt_hue_path 3144 end subroutine interface_plscmap1l 3145 end interface 3146 3147 npts_local = size(intensity,kind=private_plint) 3148 if ( present(alt_hue_path) ) then 3149 if( npts_local /= size(coord1, kind=private_plint) .or. & 3150 npts_local /= size(coord2, kind=private_plint) .or. & 3151 npts_local /= size(coord3, kind=private_plint) .or. & 3152 npts_local /= size(alt_hue_path, kind=private_plint) + 1 ) then 3153 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap1l: inconsistent sizes for & 3154 &intensity, coord1, coord2, coord3, and/or alt_hue_path" 3155 end if 3156 allocate( ialt_hue_path_local(size(alt_hue_path)) ) 3157 ialt_hue_path_local = int(merge(1,0,alt_hue_path),kind=private_plbool) 3158 3159 call interface_plscmap1l( int(merge(1,0,rgbtype),kind=private_plbool), npts_local, & 3160 real(intensity,kind=private_plflt), real(coord1,kind=private_plflt), & 3161 real(coord2,kind=private_plflt), real(coord3,kind=private_plflt), & 3162 c_loc(ialt_hue_path_local) ) 3163 deallocate( ialt_hue_path_local ) 3164 else 3165 if( npts_local /= size(coord1, kind=private_plint) .or. & 3166 npts_local /= size(coord2, kind=private_plint) .or. & 3167 npts_local /= size(coord3, kind=private_plint) ) then 3168 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap1l: inconsistent sizes for & 3169 &intensity, coord1, coord2, and/or coord3" 3170 end if 3171 call interface_plscmap1l( int(merge(1,0,rgbtype),kind=private_plbool), npts_local, & 3172 real(intensity,kind=private_plflt), real(coord1,kind=private_plflt), & 3173 real(coord2,kind=private_plflt), real(coord3,kind=private_plflt), & 3174 c_null_ptr ) 3175 endif 3176 end subroutine plscmap1l_impl 3177 3178 subroutine plscmap1la_impl( rgbtype, intensity, coord1, coord2, coord3, alpha, alt_hue_path) 3179 logical, intent(in) :: rgbtype 3180 real(kind=wp), dimension(:), intent(in) :: intensity, coord1, coord2, coord3, alpha 3181 logical, dimension(:), optional, intent(in) :: alt_hue_path 3182 3183 integer(kind=private_plint) :: npts_local 3184 integer(kind=private_plbool), dimension(:), allocatable, target :: ialt_hue_path_local 3185 3186 interface 3187 subroutine interface_plscmap1la( rgbtype, n, intensity, coord1, coord2, coord3, alpha, alt_hue_path ) & 3188 bind(c,name='c_plscmap1la') 3189 import :: c_ptr 3190 import :: private_plint,private_plbool, private_plflt 3191 implicit none 3192 integer(kind=private_plint), value, intent(in) :: n 3193 integer(kind=private_plbool), value, intent(in) :: rgbtype 3194 real(kind=private_plflt), dimension(*), intent(in) :: intensity, coord1, coord2, coord3, alpha 3195 !integer(kind=private_plbool), dimension(*), intent(in) :: alt_hue_path 3196 type(c_ptr), value, intent(in) :: alt_hue_path 3197 end subroutine interface_plscmap1la 3198 end interface 3199 3200 npts_local = size(intensity, kind=private_plint) 3201 if ( present(alt_hue_path) ) then 3202 if( npts_local /= size(coord1, kind=private_plint) .or. & 3203 npts_local /= size(coord2, kind=private_plint) .or. & 3204 npts_local /= size(coord3, kind=private_plint) .or. & 3205 npts_local /= size(alpha, kind=private_plint) .or. & 3206 npts_local /= size(alt_hue_path, kind=private_plint) + 1 ) then 3207 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap1la: inconsistent sizes for & 3208 &intensity, coord1, coord2, coord3, alpha, and/or alt_hue_path" 3209 end if 3210 allocate( ialt_hue_path_local(size(alt_hue_path)) ) 3211 ialt_hue_path_local = int(merge(1,0,alt_hue_path),kind=private_plbool) 3212 3213 call interface_plscmap1la( int(merge(1,0,rgbtype),kind=private_plbool), npts_local, & 3214 real(intensity,kind=private_plflt), real(coord1,kind=private_plflt), & 3215 real(coord2,kind=private_plflt), real(coord3,kind=private_plflt), & 3216 real(alpha,kind=private_plflt), c_loc(ialt_hue_path_local) ) 3217 deallocate(ialt_hue_path_local) 3218 else 3219 if( npts_local /= size(coord1, kind=private_plint) .or. & 3220 npts_local /= size(coord2, kind=private_plint) .or. & 3221 npts_local /= size(coord3, kind=private_plint) .or. & 3222 npts_local /= size(alpha, kind=private_plint) ) then 3223 write(error_unit, "(a)") "Plplot Fortran Warning: plscmap1la: inconsistent sizes for & 3224 &intensity, coord1, coord2, coord3, and/or alpha" 3225 end if 3226 call interface_plscmap1la( int(merge(1,0,rgbtype),kind=private_plbool), npts_local, & 3227 real(intensity,kind=private_plflt), real(coord1,kind=private_plflt), & 3228 real(coord2,kind=private_plflt), real(coord3,kind=private_plflt), & 3229 real(alpha,kind=private_plflt), c_null_ptr ) 3230 endif 3231 end subroutine plscmap1la_impl 3232 3233 subroutine plscol0a_impl( icol, r, g, b, a ) 3234 integer, intent(in) :: icol, r, g, b 3235 real(kind=wp), intent(in) :: a 3236 3237 interface 3238 subroutine interface_plscol0a( icol, r, g, b, a ) bind(c,name='c_plscol0a') 3239 import :: private_plint, private_plflt 3240 implicit none 3241 integer(kind=private_plint), value, intent(in) :: icol, r, g, b 3242 real(kind=private_plflt), value, intent(in) :: a 3243 end subroutine interface_plscol0a 3244 end interface 3245 3246 call interface_plscol0a( int(icol,kind=private_plint), int(r,kind=private_plint), int(g,kind=private_plint), & 3247 int(b,kind=private_plint), real(a,kind=private_plflt) ) 3248 end subroutine plscol0a_impl 3249 3250 subroutine plscolbga_impl( r, g, b, a ) 3251 integer, intent(in) :: r, g, b 3252 real(kind=wp), intent(in) :: a 3253 3254 interface 3255 subroutine interface_plscolbga( r, g, b, a ) bind(c,name='c_plscolbga') 3256 import :: private_plint, private_plflt 3257 implicit none 3258 integer(kind=private_plint), value, intent(in) :: r, g, b 3259 real(kind=private_plflt), value, intent(in) :: a 3260 end subroutine interface_plscolbga 3261 end interface 3262 3263 call interface_plscolbga( int(r,kind=private_plint), int(g,kind=private_plint), & 3264 int(b,kind=private_plint), real(a,kind=private_plflt) ) 3265 end subroutine plscolbga_impl 3266 3267 subroutine plsdidev_impl( mar, aspect, jx, jy ) 3268 real(kind=wp), intent(in) :: mar, aspect, jx, jy 3269 3270 interface 3271 subroutine interface_plsdidev( mar, aspect, jx, jy ) bind(c,name='c_plsdidev') 3272 import :: private_plflt 3273 implicit none 3274 real(kind=private_plflt), value, intent(in) :: mar, aspect, jx, jy 3275 end subroutine interface_plsdidev 3276 end interface 3277 3278 call interface_plsdidev( real(mar,kind=private_plflt), real(aspect,kind=private_plflt), & 3279 real(jx,kind=private_plflt), real(jy,kind=private_plflt) ) 3280 end subroutine plsdidev_impl 3281 3282 subroutine plsdimap_impl( dimxmi, dimxmax, diymin, dimymax, dimxpmm, diypmm ) 3283 real(kind=wp), intent(in) :: dimxmi, dimxmax, diymin, dimymax, dimxpmm, diypmm 3284 3285 interface 3286 subroutine interface_plsdimap( dimxmi, dimxmax, diymin, dimymax, dimxpmm, diypmm ) bind(c,name='c_plsdimap') 3287 import :: private_plflt 3288 implicit none 3289 real(kind=private_plflt), value, intent(in) :: dimxmi, dimxmax, diymin, dimymax, dimxpmm, diypmm 3290 end subroutine interface_plsdimap 3291 end interface 3292 3293 call interface_plsdimap( real(dimxmi,kind=private_plflt), real(dimxmax,kind=private_plflt), & 3294 real(diymin,kind=private_plflt), real(dimymax,kind=private_plflt), & 3295 real(dimxpmm,kind=private_plflt), real(diypmm,kind=private_plflt) ) 3296 end subroutine plsdimap_impl 3297 3298 subroutine plsdiori_impl( rot ) 3299 real(kind=wp), intent(in) :: rot 3300 3301 interface 3302 subroutine interface_plsdiori( rot) bind(c,name='c_plsdiori') 3303 import :: private_plflt 3304 implicit none 3305 real(kind=private_plflt), value, intent(in) :: rot 3306 end subroutine interface_plsdiori 3307 end interface 3308 3309 call interface_plsdiori( real(rot,kind=private_plflt) ) 3310 end subroutine plsdiori_impl 3311 3312 subroutine plsdiplt_impl( xmin, ymin, xmax, ymax ) 3313 real(kind=wp), intent(in) :: xmin, ymin, xmax, ymax 3314 3315 interface 3316 subroutine interface_plsdiplt( xmin, ymin, xmax, ymax ) bind(c,name='c_plsdiplt') 3317 import :: private_plflt 3318 implicit none 3319 real(kind=private_plflt), value, intent(in) :: xmin, ymin, xmax, ymax 3320 end subroutine interface_plsdiplt 3321 end interface 3322 3323 call interface_plsdiplt( & 3324 real(xmin,kind=private_plflt), real(ymin,kind=private_plflt), & 3325 real(xmax,kind=private_plflt), real(ymax,kind=private_plflt) ) 3326 end subroutine plsdiplt_impl 3327 3328 subroutine plsdiplz_impl( xmin, ymin, xmax, ymax ) 3329 real(kind=wp), intent(in) :: xmin, ymin, xmax, ymax 3330 3331 interface 3332 subroutine interface_plsdiplz( xmin, ymin, xmax, ymax ) bind(c,name='c_plsdiplz') 3333 import :: private_plflt 3334 implicit none 3335 real(kind=private_plflt), value, intent(in) :: xmin, ymin, xmax, ymax 3336 end subroutine interface_plsdiplz 3337 end interface 3338 3339 call interface_plsdiplz( & 3340 real(xmin,kind=private_plflt), real(ymin,kind=private_plflt), & 3341 real(xmax,kind=private_plflt), real(ymax,kind=private_plflt) ) 3342 end subroutine plsdiplz_impl 3343 3344 subroutine plshade_impl_0( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3345 min_color, min_width, max_color, max_width, rectangular ) 3346 real(kind=wp), dimension(:,:), intent(in) :: z 3347 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3348 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3349 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3350 integer, intent(in) :: sh_cmap, min_color, max_color 3351 logical, intent(in) :: rectangular 3352 3353 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3354 type(c_ptr), dimension(:), allocatable :: z_address_local 3355 3356 call matrix_to_c( z, z_c_local, z_address_local ) 3357 3358 call interface_plshade_null( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3359 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3360 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3361 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3362 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3363 real(sh_width,kind=private_plflt), & 3364 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3365 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3366 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool) ) 3367 end subroutine plshade_impl_0 3368 3369 subroutine plshade_impl_1( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3370 min_color, min_width, max_color, max_width, rectangular, xg, yg ) 3371 real(kind=wp), dimension(:,:), intent(in) :: z 3372 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3373 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3374 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3375 real(kind=wp), dimension(:), intent(in) :: xg, yg 3376 integer, intent(in) :: sh_cmap, min_color, max_color 3377 logical, intent(in) :: rectangular 3378 3379 integer(kind=private_plint) :: nx_in, ny_in 3380 real(kind=private_plflt), dimension(:), allocatable, target :: xg_in, yg_in 3381 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3382 type(c_ptr), dimension(:), allocatable :: z_address_local 3383 type(PLcGrid), target :: cgrid_local 3384 3385 call matrix_to_c( z, z_c_local, z_address_local ) 3386 3387 nx_in = size(z,1,kind=private_plint) 3388 ny_in = size(z,2,kind=private_plint) 3389 if(nx_in /= size(xg, kind=private_plint) .or. ny_in /= size(yg, kind=private_plint) ) then 3390 write(error_unit, "(a)") "Plplot Fortran Warning: plshade: inconsistent sizes for z, xg, and/or yg" 3391 end if 3392 allocate( xg_in(nx_in), yg_in(ny_in) ) 3393 xg_in = xg 3394 yg_in = yg 3395 cgrid_local%nx = nx_in 3396 cgrid_local%ny = ny_in 3397 cgrid_local%xg = c_loc(xg_in) 3398 cgrid_local%yg = c_loc(yg_in) 3399 3400 call interface_plshade( z_address_local, nx_in, ny_in, c_null_ptr, & 3401 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3402 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3403 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3404 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3405 real(sh_width,kind=private_plflt), & 3406 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3407 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3408 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), & 3409 interface_pltr1, c_loc(cgrid_local) ) 3410 end subroutine plshade_impl_1 3411 3412 subroutine plshade_impl_2( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3413 min_color, min_width, max_color, max_width, rectangular, xg, yg ) 3414 real(kind=wp), dimension(:,:), intent(in) :: z 3415 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3416 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3417 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3418 real(kind=wp), dimension(:,:), intent(in) :: xg, yg 3419 integer, intent(in) :: sh_cmap, min_color, max_color 3420 logical, intent(in) :: rectangular 3421 3422 integer(kind=private_plint) :: nx_in, ny_in 3423 real(kind=private_plflt), dimension(:,:), allocatable, target :: xg_in, yg_in 3424 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3425 type(c_ptr), dimension(:), allocatable :: z_address_local 3426 type(PLcGrid), target :: cgrid_local 3427 3428 call matrix_to_c( z, z_c_local, z_address_local ) 3429 3430 nx_in = size(z,1, kind=private_plint) 3431 ny_in = size(z,2, kind=private_plint) 3432 if( & 3433 nx_in /= size(xg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) .or. & 3434 nx_in /= size(yg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) ) then 3435 write(error_unit, "(a)") "Plplot Fortran Warning: plshade: inconsistent sizes for z, xg and/or yg" 3436 end if 3437 allocate( xg_in(nx_in, ny_in), yg_in(nx_in, ny_in) ) 3438 xg_in = xg 3439 yg_in = yg 3440 cgrid_local%nx = nx_in 3441 cgrid_local%ny = ny_in 3442 cgrid_local%xg = c_loc(xg_in) 3443 cgrid_local%yg = c_loc(yg_in) 3444 3445 call interface_plshade( z_address_local, nx_in, ny_in, c_null_ptr, & 3446 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3447 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3448 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3449 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3450 real(sh_width,kind=private_plflt), & 3451 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3452 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3453 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), & 3454 interface_pltr2f, c_loc(cgrid_local) ) 3455 end subroutine plshade_impl_2 3456 3457 subroutine plshade_impl_tr( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3458 min_color, min_width, max_color, max_width, rectangular, tr ) 3459 real(kind=wp), dimension(:,:), intent(in) :: z 3460 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3461 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3462 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3463 logical, intent(in) :: rectangular 3464 real(kind=wp), dimension(:), intent(in) :: tr 3465 integer, intent(in) :: sh_cmap, min_color, max_color 3466 3467 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3468 type(c_ptr), dimension(:), allocatable :: z_address_local 3469 real(kind=private_plflt), dimension(6), target :: tr_in 3470 3471 call matrix_to_c( z, z_c_local, z_address_local ) 3472 tr_in = tr(1:6) 3473 3474 call interface_plshade( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3475 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3476 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3477 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3478 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3479 real(sh_width,kind=private_plflt), & 3480 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3481 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3482 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), plplot_private_pltr, c_loc(tr_in) ) 3483 end subroutine plshade_impl_tr 3484 3485 subroutine plshade_impl( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3486 min_color, min_width, max_color, max_width, rectangular, proc ) 3487 real(kind=wp), dimension(:,:), intent(in) :: z 3488 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3489 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3490 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3491 integer, intent(in) :: sh_cmap, min_color, max_color 3492 logical, intent(in) :: rectangular 3493 procedure(pltransform_proc) :: proc 3494 3495 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3496 type(c_ptr), dimension(:), allocatable :: z_address_local 3497 3498 call matrix_to_c( z, z_c_local, z_address_local ) 3499 pltransform => proc 3500 3501 call interface_plshade( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3502 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3503 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3504 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3505 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3506 real(sh_width,kind=private_plflt), & 3507 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3508 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3509 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), pltransformf2c, c_null_ptr ) 3510 end subroutine plshade_impl 3511 3512 subroutine plshade_impl_data( z, xmin, xmax, ymin, ymax, shade_min, shade_max, sh_cmap, sh_color, sh_width, & 3513 min_color, min_width, max_color, max_width, rectangular, proc, data ) 3514 real(kind=wp), dimension(:,:), intent(in) :: z 3515 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3516 real(kind=wp), intent(in) :: sh_width, min_width, max_width 3517 real(kind=wp), intent(in) :: shade_min, shade_max, sh_color 3518 integer, intent(in) :: sh_cmap, min_color, max_color 3519 logical, intent(in) :: rectangular 3520 procedure(pltransform_proc_data) :: proc 3521 type(c_ptr), intent(in) :: data 3522 3523 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3524 type(c_ptr), dimension(:), allocatable :: z_address_local 3525 3526 call matrix_to_c( z, z_c_local, z_address_local ) 3527 pltransform_data => proc 3528 3529 call interface_plshade( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3530 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3531 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3532 real(shade_min,kind=private_plflt), real(shade_max,kind=private_plflt), & 3533 int(sh_cmap,kind=private_plint), real(sh_color,kind=private_plflt), & 3534 real(sh_width,kind=private_plflt), & 3535 int(min_color,kind=private_plint), real(min_width,kind=private_plflt), & 3536 int(max_color,kind=private_plint), real(max_width,kind=private_plflt), & 3537 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), pltransformf2c_data, data ) 3538 end subroutine plshade_impl_data 3539 3540 subroutine plshades_impl_0( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3541 rectangular ) 3542 real(kind=wp), dimension(:,:), intent(in) :: z 3543 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3544 real(kind=wp), intent(in) :: fill_width, cont_width 3545 real(kind=wp), dimension(:), intent(in) :: clevel 3546 integer, intent(in) :: cont_color 3547 logical, intent(in) :: rectangular 3548 3549 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3550 type(c_ptr), dimension(:), allocatable :: z_address_local 3551 3552 call matrix_to_c( z, z_c_local, z_address_local ) 3553 3554 call interface_plshades_null( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3555 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3556 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3557 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3558 real(fill_width,kind=private_plflt), & 3559 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3560 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool) ) 3561 end subroutine plshades_impl_0 3562 3563 subroutine plshades_impl_1( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3564 rectangular, xg, yg ) 3565 real(kind=wp), dimension(:,:), intent(in) :: z 3566 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3567 real(kind=wp), intent(in) :: fill_width, cont_width 3568 real(kind=wp), dimension(:), intent(in) :: clevel 3569 integer, intent(in) :: cont_color 3570 logical, intent(in) :: rectangular 3571 real(kind=wp), dimension(:), intent(in) :: xg, yg 3572 3573 integer(kind=private_plint) :: nx_in, ny_in 3574 real(kind=private_plflt), dimension(:), allocatable, target :: xg_in, yg_in 3575 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3576 type(c_ptr), dimension(:), allocatable :: z_address_local 3577 type(PLcGrid), target :: cgrid_local 3578 3579 call matrix_to_c( z, z_c_local, z_address_local ) 3580 3581 nx_in = size(z,1, kind=private_plint) 3582 ny_in = size(z,2, kind=private_plint) 3583 if( & 3584 nx_in /= size(xg, kind=private_plint) .or. ny_in /= size(yg, kind=private_plint) ) then 3585 write(error_unit, "(a)") "Plplot Fortran Warning: plshades: inconsistent sizes for z, xg and/or yg" 3586 end if 3587 allocate( xg_in(nx_in), yg_in(ny_in) ) 3588 xg_in = xg 3589 yg_in = yg 3590 cgrid_local%nx = nx_in 3591 cgrid_local%ny = ny_in 3592 cgrid_local%xg = c_loc(xg_in) 3593 cgrid_local%yg = c_loc(yg_in) 3594 3595 call interface_plshades( z_address_local, nx_in, ny_in, c_null_ptr, & 3596 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3597 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3598 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3599 real(fill_width,kind=private_plflt), & 3600 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3601 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), & 3602 interface_pltr1, c_loc(cgrid_local) ) 3603 end subroutine plshades_impl_1 3604 3605 subroutine plshades_impl_2( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3606 rectangular, xg, yg ) 3607 real(kind=wp), dimension(:,:), intent(in) :: z 3608 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3609 real(kind=wp), intent(in) :: fill_width, cont_width 3610 real(kind=wp), dimension(:), intent(in) :: clevel 3611 integer, intent(in) :: cont_color 3612 logical, intent(in) :: rectangular 3613 real(kind=wp), dimension(:,:), intent(in) :: xg, yg 3614 3615 integer(kind=private_plint) :: nx_in, ny_in 3616 real(kind=private_plflt), dimension(:,:), allocatable, target :: xg_in, yg_in 3617 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3618 type(c_ptr), dimension(:), allocatable :: z_address_local 3619 type(PLcGrid), target :: cgrid_local 3620 3621 call matrix_to_c( z, z_c_local, z_address_local ) 3622 3623 nx_in = size(z,1, kind=private_plint) 3624 ny_in = size(z,2, kind=private_plint) 3625 if( & 3626 nx_in /= size(xg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) .or. & 3627 nx_in /= size(yg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) ) then 3628 write(error_unit, "(a)") "Plplot Fortran Warning: plshades: inconsistent sizes for z, xg and/or yg" 3629 end if 3630 3631 allocate( xg_in(nx_in,ny_in), yg_in(nx_in,ny_in) ) 3632 xg_in = xg 3633 yg_in = yg 3634 cgrid_local%nx = nx_in 3635 cgrid_local%ny = ny_in 3636 cgrid_local%xg = c_loc(xg_in) 3637 cgrid_local%yg = c_loc(yg_in) 3638 3639 call interface_plshades( z_address_local, nx_in, ny_in, c_null_ptr, & 3640 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3641 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3642 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3643 real(fill_width,kind=private_plflt), & 3644 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3645 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), & 3646 interface_pltr2f, c_loc(cgrid_local) ) 3647 end subroutine plshades_impl_2 3648 3649 subroutine plshades_impl_tr( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3650 rectangular, tr ) 3651 real(kind=wp), dimension(:,:), intent(in) :: z 3652 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3653 real(kind=wp), intent(in) :: fill_width, cont_width 3654 real(kind=wp), dimension(:), intent(in) :: clevel 3655 integer, intent(in) :: cont_color 3656 logical, intent(in) :: rectangular 3657 real(kind=wp), dimension(:), intent(in) :: tr 3658 3659 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3660 type(c_ptr), dimension(:), allocatable :: z_address_local 3661 real(kind=private_plflt), dimension(6), target :: tr_in 3662 3663 call matrix_to_c( z, z_c_local, z_address_local ) 3664 tr_in = tr(1:6) 3665 3666 call interface_plshades( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3667 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3668 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3669 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3670 real(fill_width,kind=private_plflt), & 3671 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3672 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), plplot_private_pltr, c_loc(tr_in) ) 3673 end subroutine plshades_impl_tr 3674 3675 subroutine plshades_impl( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3676 rectangular, proc ) 3677 real(kind=wp), dimension(:,:), intent(in) :: z 3678 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3679 real(kind=wp), intent(in) :: fill_width, cont_width 3680 real(kind=wp), dimension(:), intent(in) :: clevel 3681 integer, intent(in) :: cont_color 3682 logical, intent(in) :: rectangular 3683 procedure(pltransform_proc) :: proc 3684 3685 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3686 type(c_ptr), dimension(:), allocatable :: z_address_local 3687 3688 call matrix_to_c( z, z_c_local, z_address_local ) 3689 pltransform => proc 3690 3691 call interface_plshades( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3692 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3693 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3694 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3695 real(fill_width,kind=private_plflt), & 3696 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3697 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), pltransformf2c, c_null_ptr ) 3698 end subroutine plshades_impl 3699 3700 subroutine plshades_impl_data( z, xmin, xmax, ymin, ymax, clevel, fill_width, cont_color, cont_width, & 3701 rectangular, proc, data ) 3702 real(kind=wp), dimension(:,:), intent(in) :: z 3703 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 3704 real(kind=wp), intent(in) :: fill_width, cont_width 3705 real(kind=wp), dimension(:), intent(in) :: clevel 3706 integer, intent(in) :: cont_color 3707 logical, intent(in) :: rectangular 3708 procedure(pltransform_proc_data) :: proc 3709 type(c_ptr), intent(in) :: data 3710 3711 real(kind=private_plflt), dimension(:,:), allocatable :: z_c_local 3712 type(c_ptr), dimension(:), allocatable :: z_address_local 3713 3714 call matrix_to_c( z, z_c_local, z_address_local ) 3715 pltransform_data => proc 3716 3717 call interface_plshades( z_address_local, size(z,1,kind=private_plint), size(z,2,kind=private_plint), c_null_ptr, & 3718 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 3719 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), & 3720 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 3721 real(fill_width,kind=private_plflt), & 3722 int(cont_color,kind=private_plint), real(cont_width,kind=private_plflt), & 3723 interface_plfill, int(merge(1,0,rectangular),kind=private_plbool), pltransformf2c_data, data ) 3724 end subroutine plshades_impl_data 3725 3726 subroutine plsmaj_impl( def, scale ) 3727 real(kind=wp), intent(in) :: def, scale 3728 3729 interface 3730 subroutine interface_plsmaj( def, scale ) bind(c,name='c_plsmaj') 3731 import :: private_plflt 3732 implicit none 3733 real(kind=private_plflt), value, intent(in) :: def, scale 3734 end subroutine interface_plsmaj 3735 end interface 3736 3737 call interface_plsmaj( real(def,kind=private_plflt), real(scale,kind=private_plflt) ) 3738 3739 end subroutine plsmaj_impl 3740 3741 subroutine plsmin_impl( def, scale ) 3742 real(kind=wp), intent(in) :: def, scale 3743 3744 interface 3745 subroutine interface_plsmin( def, scale ) bind(c,name='c_plsmin') 3746 import :: private_plflt 3747 implicit none 3748 real(kind=private_plflt), value, intent(in) :: def, scale 3749 end subroutine interface_plsmin 3750 end interface 3751 3752 call interface_plsmin( real(def,kind=private_plflt), real(scale,kind=private_plflt) ) 3753 3754 end subroutine plsmin_impl 3755 3756 subroutine plspage_impl( xp, yp, xleng, yleng, xoff, yoff ) 3757 integer, intent(in) :: xleng, yleng, xoff, yoff 3758 real(kind=wp), intent(in) :: xp, yp 3759 3760 interface 3761 subroutine interface_plspage( xp, yp, xleng, yleng, xoff, yoff ) bind(c,name='c_plspage') 3762 import :: private_plint, private_plflt 3763 implicit none 3764 integer(kind=private_plint), value, intent(in) :: xleng, yleng, xoff, yoff 3765 real(kind=private_plflt), value, intent(in) :: xp, yp 3766 end subroutine interface_plspage 3767 end interface 3768 3769 call interface_plspage( real(xp,kind=private_plflt), real(yp,kind=private_plflt), & 3770 int(xleng,kind=private_plint), int(yleng,kind=private_plint), & 3771 int(xoff,kind=private_plint), int(yoff,kind=private_plint) ) 3772 3773 end subroutine plspage_impl 3774 3775 subroutine plssym_impl( def, scale ) 3776 3777 real(kind=wp), intent(in) :: def, scale 3778 3779 interface 3780 subroutine interface_plssym( def, scale ) bind(c,name='c_plssym') 3781 import :: private_plflt 3782 implicit none 3783 real(kind=private_plflt), value, intent(in) :: def, scale 3784 end subroutine interface_plssym 3785 end interface 3786 3787 call interface_plssym( real(def,kind=private_plflt), real(scale,kind=private_plflt) ) 3788 end subroutine plssym_impl 3789 3790 subroutine plstring3_impl( x, y, z, string ) 3791 3792 real(kind=wp), dimension (:), intent(in) :: x, y, z 3793 character(len=*), intent(in) :: string 3794 3795 integer(kind=private_plint) :: n_local 3796 3797 interface 3798 subroutine interface_plstring3( n, x, y, z, string ) bind(c,name='c_plstring3') 3799 import :: private_plint, private_plflt 3800 implicit none 3801 integer(kind=private_plint), value, intent(in) :: n 3802 real(kind=private_plflt), dimension(*), intent(in) :: x, y, z 3803 character(len=1), dimension(*), intent(in) :: string 3804 end subroutine interface_plstring3 3805 end interface 3806 3807 n_local = size(x, kind=private_plint) 3808 if(n_local /= size(y, kind=private_plint) .or. n_local /= size(z, kind=private_plint) ) then 3809 write(error_unit, "(a)") "Plplot Fortran Warning: plstring3: inconsistent sizes for x, y, and/or z" 3810 end if 3811 3812 call interface_plstring3( n_local, real(x,kind=private_plflt), real(y,kind=private_plflt), real(z,kind=private_plflt), & 3813 trim(string)//c_null_char ) 3814 end subroutine plstring3_impl 3815 3816 subroutine plstring_impl( x, y, string ) 3817 3818 real(kind=wp), dimension (:), intent(in) :: x, y 3819 character(len=*), intent(in) :: string 3820 3821 integer(kind=private_plint) :: n_local 3822 3823 interface 3824 subroutine interface_plstring( n, x, y, string ) bind(c,name='c_plstring') 3825 import :: private_plint, private_plflt 3826 implicit none 3827 integer(kind=private_plint), value, intent(in) :: n 3828 real(kind=private_plflt), dimension(*), intent(in) :: x, y 3829 character(len=1), dimension(*), intent(in) :: string 3830 end subroutine interface_plstring 3831 end interface 3832 3833 n_local = size(x, kind=private_plint) 3834 if(n_local /= size(y, kind=private_plint) ) then 3835 write(error_unit, "(a)") "Plplot Fortran Warning: plstring: inconsistent sizes for x and y" 3836 end if 3837 3838 call interface_plstring( n_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 3839 trim(string)//c_null_char ) 3840 end subroutine plstring_impl 3841 3842 subroutine plstripa_impl( id, pen, x, y ) 3843 3844 integer, intent(in) :: id, pen 3845 real(kind=wp), intent(in) :: x, y 3846 3847 interface 3848 subroutine interface_plstripa( id, pen, x, y ) bind(c,name='c_plstripa') 3849 import :: private_plint, private_plflt 3850 implicit none 3851 integer(kind=private_plint), value, intent(in) :: id, pen 3852 real(kind=private_plflt), value, intent(in) :: x, y 3853 end subroutine interface_plstripa 3854 end interface 3855 3856 call interface_plstripa( int(id, kind=private_plint), int(pen, kind=private_plint), & 3857 real(x,kind=private_plflt), real(y,kind=private_plflt) ) 3858 end subroutine plstripa_impl 3859 3860 subroutine plstripc_impl( & 3861 id, xspec, yspec, & 3862 xmin, xmax, xjump, ymin, ymax, & 3863 xlpos, ylpos, & 3864 y_ascl, acc, & 3865 colbox, collab, & 3866 colline, styline, legline, & 3867 labx, laby, labtop ) 3868 3869 logical, intent(in) :: y_ascl, acc 3870 integer, intent(in) :: colbox, collab 3871 integer, dimension(:), intent(in) :: colline, styline 3872 real(kind=wp), intent(in) :: xmin, xmax, xjump, ymin, ymax, xlpos, ylpos 3873 character(len=*), intent(in) :: xspec, yspec, labx, laby, labtop 3874 character(len=*), dimension(:), intent(in) :: legline 3875 integer, intent(out) :: id 3876 3877 integer(kind=private_plint) :: id_out, n_pens_local 3878 character(len=1), dimension(:,:), allocatable :: cstring_legline_local 3879 type(c_ptr), dimension(:), allocatable :: cstring_address_legline_local 3880 3881 interface 3882 subroutine interface_plstripc( & 3883 id, xspec, yspec, & 3884 xmin, xmax, xjump, ymin, ymax, & 3885 xlpos, ylpos, & 3886 y_ascl, acc, & 3887 colbox, collab, & 3888 colline, styline, legline, & 3889 labx, laby, labtop ) bind(c,name='c_plstripc') 3890 import :: c_ptr 3891 import :: private_plint, private_plbool, private_plflt 3892 implicit none 3893 integer(kind=private_plint), value, intent(in) :: colbox, collab 3894 integer(kind=private_plint), dimension(*), intent(in) :: colline, styline 3895 integer(kind=private_plbool), value, intent(in) :: y_ascl, acc 3896 real(kind=private_plflt), value, intent(in) :: xmin, xmax, xjump, ymin, ymax, xlpos, ylpos 3897 character(len=1), dimension(*), intent(in) :: xspec, yspec, labx, laby, labtop 3898 type(c_ptr), dimension(*), intent(in) :: legline 3899 integer(kind=private_plint), intent(out) :: id 3900 3901 end subroutine interface_plstripc 3902 end interface 3903 3904 n_pens_local = size(colline, kind=private_plint) 3905 if( & 3906 n_pens_local /= 4 .or. & 3907 n_pens_local /= size(styline, kind=private_plint) .or. & 3908 n_pens_local /= size(legline, kind=private_plint) ) then 3909 write(error_unit, "(a)") "Plplot Fortran Severe Warning: plstripc: sizes of colline, styline, and/or legline are not 4" 3910 return 3911 endif 3912 3913 call character_array_to_c( cstring_legline_local, cstring_address_legline_local, legline ) 3914 3915 call interface_plstripc( & 3916 id_out, trim(xspec)//c_null_char, trim(yspec)//c_null_char, & 3917 real(xmin, kind=private_plflt), real(xmax, kind=private_plflt), real(xjump, kind=private_plflt), & 3918 real(ymin, kind=private_plflt), real(ymax, kind=private_plflt), & 3919 real(xlpos, kind=private_plflt), real(ylpos, kind=private_plflt), & 3920 int(merge(1,0,y_ascl),kind=private_plbool), int(merge(1,0,acc),kind=private_plbool),& 3921 int(colbox, kind=private_plint), int(collab, kind=private_plint), & 3922 int(colline, kind=private_plint), int(styline, kind=private_plint), & 3923 cstring_address_legline_local, & 3924 trim(labx)//c_null_char, trim(laby)//c_null_char, trim(labtop)//c_null_char ) 3925 id = int(id_out, kind=private_plint) 3926 end subroutine plstripc_impl 3927 3928 subroutine plsurf3d_impl( x, y, z, opt, clevel ) 3929 integer, intent(in) :: opt 3930 real(kind=wp), dimension(:), intent(in) :: x, y, clevel 3931 real(kind=wp), dimension(:,:), intent(in) :: z 3932 3933 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 3934 type(c_ptr), dimension(:), allocatable :: zaddress_local 3935 3936 integer(kind=private_plint) :: nx_local, ny_local 3937 3938 interface 3939 subroutine interface_plsurf3d( x, y, zaddress, nx, ny, opt, clevel, nlevel ) bind(c,name='c_plsurf3d') 3940 import :: c_ptr 3941 import :: private_plint, private_plflt 3942 implicit none 3943 integer(kind=private_plint), value, intent(in) :: nx, ny, opt, nlevel 3944 real(kind=private_plflt), dimension(*), intent(in) :: x, y, clevel 3945 type(c_ptr), dimension(*), intent(in) :: zaddress 3946 end subroutine interface_plsurf3d 3947 end interface 3948 3949 nx_local = size(x,kind=private_plint) 3950 ny_local = size(y,kind=private_plint) 3951 3952 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 3953 write(error_unit, "(a)") "Plplot Fortran Warning: plsurf3d: inconsistent sizes for x, y, and/or z" 3954 end if 3955 3956 call matrix_to_c( z, zz_local, zaddress_local ) 3957 3958 call interface_plsurf3d( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 3959 nx_local, ny_local, int(opt,kind=private_plint), & 3960 real(clevel,kind=private_plflt), size(clevel,kind=private_plint) ) 3961 3962 end subroutine plsurf3d_impl 3963 3964 subroutine plsurf3dl_impl( x, y, z, opt, clevel, indexxmin, indexymin, indexymax ) 3965 integer, intent(in) :: opt 3966 real(kind=wp), dimension(:), intent(in) :: x, y, clevel 3967 real(kind=wp), dimension(:,:), intent(in) :: z 3968 integer, intent(in) :: indexxmin 3969 integer, dimension(:), intent(in) :: indexymin, indexymax 3970 3971 real(kind=private_plflt), dimension(:,:), allocatable :: zz_local 3972 type(c_ptr), dimension(:), allocatable :: zaddress_local 3973 3974 integer(kind=private_plint) :: nx_local, ny_local, indexxmax_local 3975 3976 interface 3977 subroutine interface_plsurf3dl( x, y, zaddress, nx, ny, opt, clevel, nlevel, & 3978 indexxmin, indexxmax, indexymin, indexymax ) bind(c,name='c_plsurf3dl') 3979 import :: c_ptr 3980 import :: private_plint, private_plflt 3981 implicit none 3982 integer(kind=private_plint), value, intent(in) :: nx, ny, opt, nlevel, indexxmin, indexxmax 3983 integer(kind=private_plint), dimension(*), intent(in) :: indexymin, indexymax 3984 real(kind=private_plflt), dimension(*), intent(in) :: x, y, clevel 3985 type(c_ptr), dimension(*), intent(in) :: zaddress 3986 end subroutine interface_plsurf3dl 3987 end interface 3988 3989 nx_local = size(x,kind=private_plint) 3990 ny_local = size(y,kind=private_plint) 3991 if( nx_local /= size(z, 1, kind=private_plint) .or. ny_local /= size(z, 2, kind=private_plint) ) then 3992 write(error_unit, "(a)") "Plplot Fortran Warning: plsurf3dl: inconsistent sizes for x, y, and/or z" 3993 end if 3994 3995 indexxmax_local = size(indexymin) 3996 if( indexxmax_local /= size(indexymax, kind=private_plint) ) then 3997 write(error_unit, "(a)") "Plplot Fortran Warning: plsurf3dl: inconsistent sizes for indexymin and indeyxmax" 3998 end if 3999 4000 call matrix_to_c( z, zz_local, zaddress_local ) 4001 4002 call interface_plsurf3dl( real(x,kind=private_plflt), real(y,kind=private_plflt), zaddress_local, & 4003 nx_local, ny_local, int(opt,kind=private_plint), & 4004 real(clevel,kind=private_plflt), size(clevel,kind=private_plint), & 4005 int(indexxmin,kind=private_plint), indexxmax_local, & 4006 int(indexymin,kind=private_plint), int(indexymax,kind=private_plint) ) 4007 4008 end subroutine plsurf3dl_impl 4009 4010 subroutine plsvpa_impl( xmin, xmax, ymin, ymax ) 4011 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 4012 4013 interface 4014 subroutine interface_plsvpa( xmin, xmax, ymin, ymax ) bind(c,name='c_plsvpa') 4015 import :: private_plflt 4016 implicit none 4017 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 4018 end subroutine interface_plsvpa 4019 end interface 4020 4021 call interface_plsvpa( real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 4022 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt) ) 4023 end subroutine plsvpa_impl 4024 4025 ! Another variant defined in the plplot module. 4026 subroutine plsvect_impl( arrowx, arrowy, fill ) 4027 logical, intent(in) :: fill 4028 real(kind=wp), dimension(:), intent(in) :: arrowx, arrowy 4029 4030 integer(kind=private_plint) :: npts_local 4031 4032 interface 4033 subroutine interface_plsvect( arrowx, arrowy, npts, fill ) bind(c,name='c_plsvect') 4034 import :: private_plint, private_plbool, private_plflt 4035 implicit none 4036 integer(kind=private_plint), value, intent(in) :: npts 4037 integer(kind=private_plbool), value, intent(in) :: fill 4038 real(kind=private_plflt), dimension(*), intent(in) :: arrowx, arrowy 4039 end subroutine interface_plsvect 4040 end interface 4041 4042 npts_local = size(arrowx, kind=private_plint) 4043 if(npts_local /= size(arrowy, kind=private_plint) ) then 4044 write(error_unit, "(a)") "Plplot Fortran Warning: plsvect: sizes of arrowx and arrowy are not consistent" 4045 end if 4046 4047 call interface_plsvect( real(arrowx, kind=private_plflt), real(arrowy, kind=private_plflt), & 4048 npts_local, int(merge(1,0,fill), kind=private_plbool) ) 4049 end subroutine plsvect_impl 4050 4051 subroutine plsym_impl( x, y, code ) 4052 integer, intent(in) :: code 4053 real(kind=wp), dimension(:), intent(in) :: x, y 4054 4055 integer(kind=private_plint) :: n_local 4056 4057 interface 4058 subroutine interface_plsym( n, x, y, code ) bind(c,name='c_plsym') 4059 import :: private_plint, private_plflt 4060 implicit none 4061 integer(kind=private_plint), value, intent(in) :: n, code 4062 real(kind=private_plflt), dimension(*), intent(in) :: x, y 4063 end subroutine interface_plsym 4064 end interface 4065 4066 n_local = size(x, kind=private_plint) 4067 if(n_local /= size(y, kind=private_plint) ) then 4068 write(error_unit, "(a)") "Plplot Fortran Warning: plsym: inconsistent sizes for x and y" 4069 end if 4070 4071 call interface_plsym( n_local, real(x,kind=private_plflt), real(y,kind=private_plflt), & 4072 int(code,kind=private_plint) ) 4073 end subroutine plsym_impl 4074 4075 subroutine plvasp_impl( aspect) 4076 real(kind=wp), intent(in) :: aspect 4077 4078 interface 4079 subroutine interface_plvasp( aspect ) bind(c,name='c_plvasp') 4080 import :: private_plflt 4081 implicit none 4082 real(kind=private_plflt), value, intent(in) :: aspect 4083 end subroutine interface_plvasp 4084 end interface 4085 4086 call interface_plvasp( real(aspect,kind=private_plflt) ) 4087 end subroutine plvasp_impl 4088 4089 subroutine plvect_impl_0( u, v, scale ) 4090 real(kind=wp), dimension(:,:), intent(in) :: u, v 4091 real(kind=wp), intent(in) :: scale 4092 4093 integer(kind=private_plint) :: nx_in, ny_in 4094 real(kind=private_plflt), dimension(:,:), allocatable, target :: u_in, v_in 4095 type(PLfGrid), target :: fgrid1, fgrid2 4096 4097 nx_in = size(u,1,kind=private_plint) 4098 ny_in = size(u,2,kind=private_plint) 4099 if( nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4100 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4101 end if 4102 4103 allocate( u_in(nx_in,ny_in) ) 4104 allocate( v_in(nx_in,ny_in) ) 4105 u_in = u 4106 v_in = v 4107 fgrid1%f = c_loc(u_in) 4108 fgrid1%nx = nx_in 4109 fgrid1%ny = ny_in 4110 fgrid2%f = c_loc(v_in) 4111 fgrid2%nx = nx_in 4112 fgrid2%ny = ny_in 4113 4114 call interface_plfvect( interface_plf2evalr, fgrid1, fgrid2, nx_in, ny_in, & 4115 real(scale,kind=private_plflt), interface_pltr0, c_null_ptr ) 4116 end subroutine plvect_impl_0 4117 4118 subroutine plvect_impl_1( u, v, scale, xg, yg ) 4119 real(kind=wp), dimension(:,:), intent(in) :: u, v 4120 real(kind=wp), dimension(:), intent(in) :: xg, yg 4121 real(kind=wp), intent(in) :: scale 4122 4123 integer(kind=private_plint) :: nx_in, ny_in 4124 real(kind=private_plflt), dimension(:), allocatable, target :: xg_in, yg_in 4125 real(kind=private_plflt), dimension(:,:), allocatable, target :: u_in, v_in 4126 type(PLfGrid), target :: fgrid1, fgrid2 4127 type(PLcGrid), target :: cgrid_local 4128 4129 nx_in = size(u,1,kind=private_plint) 4130 ny_in = size(u,2,kind=private_plint) 4131 if(nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4132 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4133 end if 4134 4135 if(nx_in /= size(xg, kind=private_plint) .or. ny_in /= size(yg, kind=private_plint) ) then 4136 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u, xg, and/or yg" 4137 end if 4138 4139 allocate( u_in(nx_in, ny_in) ) 4140 allocate( v_in(nx_in, ny_in) ) 4141 u_in = u 4142 v_in = v 4143 fgrid1%f = c_loc(u_in) 4144 fgrid1%nx = nx_in 4145 fgrid1%ny = ny_in 4146 4147 fgrid2%f = c_loc(v_in) 4148 fgrid2%nx = nx_in 4149 fgrid2%ny = ny_in 4150 4151 allocate( xg_in(nx_in), yg_in(ny_in) ) 4152 xg_in = xg 4153 yg_in = yg 4154 cgrid_local%nx = nx_in 4155 cgrid_local%ny = ny_in 4156 cgrid_local%xg = c_loc(xg_in) 4157 cgrid_local%yg = c_loc(yg_in) 4158 4159 call interface_plfvect( interface_plf2evalr, fgrid1, fgrid2, nx_in, ny_in, & 4160 real(scale,kind=private_plflt), interface_pltr1, c_loc(cgrid_local) ) 4161 end subroutine plvect_impl_1 4162 4163 subroutine plvect_impl_2( u, v, scale, xg, yg ) 4164 real(kind=wp), dimension(:,:), intent(in) :: u, v 4165 real(kind=wp), dimension(:,:), intent(in) :: xg, yg 4166 real(kind=wp), intent(in) :: scale 4167 4168 integer(kind=private_plint) :: nx_in, ny_in 4169 real(kind=private_plflt), dimension(:,:), allocatable, target :: u_in, v_in 4170 real(kind=private_plflt), dimension(:,:), allocatable, target :: xg_in, yg_in 4171 type(PLfGrid), target :: fgrid1, fgrid2 4172 type(PLcGrid), target :: cgrid_local 4173 4174 nx_in = size(u,1,kind=private_plint) 4175 ny_in = size(u,2,kind=private_plint) 4176 if(nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4177 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4178 end if 4179 4180 if( & 4181 nx_in /= size(xg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) .or. & 4182 nx_in /= size(yg, 1, kind=private_plint) .or. ny_in /= size(xg, 2, kind=private_plint) ) then 4183 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u, xg, and/or yg" 4184 end if 4185 4186 allocate( u_in(nx_in, ny_in) ) 4187 allocate( v_in(nx_in, ny_in) ) 4188 u_in = u 4189 v_in = v 4190 fgrid1%f = c_loc(u_in) 4191 fgrid1%nx = nx_in 4192 fgrid1%ny = ny_in 4193 4194 fgrid2%f = c_loc(v_in) 4195 fgrid2%nx = nx_in 4196 fgrid2%ny = ny_in 4197 4198 allocate( xg_in(nx_in, ny_in), yg_in(nx_in, ny_in) ) 4199 xg_in = xg 4200 yg_in = yg 4201 cgrid_local%nx = nx_in 4202 cgrid_local%ny = ny_in 4203 cgrid_local%xg = c_loc(xg_in) 4204 cgrid_local%yg = c_loc(yg_in) 4205 4206 call interface_plfvect( interface_plf2evalr, fgrid1, fgrid2, nx_in, ny_in, & 4207 real(scale,kind=private_plflt), interface_pltr2f, c_loc(cgrid_local) ) 4208 end subroutine plvect_impl_2 4209 4210 subroutine plvect_impl_tr( u, v, scale, tr ) 4211 real(kind=wp), dimension(:,:), intent(in) :: u, v 4212 real(kind=wp), intent(in) :: scale 4213 real(kind=wp), dimension(:), intent(in) :: tr 4214 4215 integer(kind=private_plint) :: nx_in, ny_in 4216 real(kind=private_plflt), dimension(:,:), allocatable, target :: u_in, v_in 4217 real(kind=private_plflt), dimension(6), target :: tr_in 4218 type(PLfGrid), target :: fgrid1, fgrid2 4219 4220 nx_in = size(u,1,kind=private_plint) 4221 ny_in = size(u,2,kind=private_plint) 4222 if(nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4223 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4224 end if 4225 4226 allocate( u_in(nx_in,ny_in) ) 4227 allocate( v_in(nx_in,ny_in) ) 4228 u_in = u 4229 v_in = v 4230 fgrid1%f = c_loc(u_in) 4231 fgrid1%nx = nx_in 4232 fgrid1%ny = ny_in 4233 fgrid2%f = c_loc(v_in) 4234 fgrid2%nx = nx_in 4235 fgrid2%ny = ny_in 4236 4237 tr_in = tr(1:6) 4238 4239 call interface_plfvect( interface_plf2evalr, fgrid1, fgrid2, nx_in, ny_in, & 4240 real(scale,kind=private_plflt), plplot_private_pltr, c_loc(tr_in) ) 4241 end subroutine plvect_impl_tr 4242 4243 subroutine plvect_impl( u, v, scale, proc ) 4244 real(kind=wp), dimension(:,:), intent(in) :: u, v 4245 real(kind=wp), intent(in) :: scale 4246 procedure(pltransform_proc) :: proc 4247 4248 integer(kind=private_plint) :: nx_in, ny_in 4249 real(kind=private_plflt), dimension(:,:), allocatable :: u_local, v_local 4250 type(c_ptr), dimension(:), allocatable :: u_address_local, v_address_local 4251 4252 nx_in = size(u,1,kind=private_plint) 4253 ny_in = size(u,2,kind=private_plint) 4254 if( nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4255 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4256 end if 4257 4258 call matrix_to_c( u, u_local, u_address_local ) 4259 call matrix_to_c( v, v_local, v_address_local ) 4260 pltransform => proc 4261 4262 call interface_plvect( u_address_local, v_address_local, nx_in, ny_in, & 4263 real(scale,kind=private_plflt), pltransformf2c, c_null_ptr ) 4264 end subroutine plvect_impl 4265 4266 subroutine plvect_impl_data( u, v, scale, proc, data ) 4267 real(kind=wp), dimension(:,:), intent(in) :: u, v 4268 real(kind=wp), intent(in) :: scale 4269 procedure(pltransform_proc_data) :: proc 4270 type(c_ptr), intent(in) :: data 4271 4272 integer(kind=private_plint) :: nx_in, ny_in 4273 real(kind=private_plflt), dimension(:,:), allocatable :: u_local, v_local 4274 type(c_ptr), dimension(:), allocatable :: u_address_local, v_address_local 4275 4276 nx_in = size(u,1,kind=private_plint) 4277 ny_in = size(u,2,kind=private_plint) 4278 if( nx_in /= size(v,1,kind=private_plint) .or. ny_in /= size(v,2,kind=private_plint) ) then 4279 write(error_unit, "(a)") "Plplot Fortran Warning: plvect: inconsistent sizes for u and v" 4280 end if 4281 4282 call matrix_to_c( u, u_local, u_address_local ) 4283 call matrix_to_c( v, v_local, v_address_local ) 4284 pltransform_data => proc 4285 4286 call interface_plvect( u_address_local, v_address_local, nx_in, ny_in, & 4287 real(scale,kind=private_plflt), pltransformf2c_data, data ) 4288 end subroutine plvect_impl_data 4289 4290 subroutine plvpas_impl( xmin, xmax, ymin, ymax, aspect ) 4291 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax, aspect 4292 4293 interface 4294 subroutine interface_plvpas( xmin, xmax, ymin, ymax, aspect ) bind(c,name='c_plvpas') 4295 import :: private_plflt 4296 implicit none 4297 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax, aspect 4298 end subroutine interface_plvpas 4299 end interface 4300 4301 call interface_plvpas( real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 4302 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt), real(aspect,kind=private_plflt) ) 4303 end subroutine plvpas_impl 4304 4305 subroutine plvpor_impl( xmin, xmax, ymin, ymax ) 4306 real(kind=wp), intent(in) :: xmin, xmax, ymin, ymax 4307 4308 interface 4309 subroutine interface_plvpor( xmin, xmax, ymin, ymax ) bind(c,name='c_plvpor') 4310 import :: private_plflt 4311 implicit none 4312 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 4313 end subroutine interface_plvpor 4314 end interface 4315 4316 call interface_plvpor( real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 4317 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt) ) 4318 end subroutine plvpor_impl 4319 4320 subroutine plw3d_impl( basex, basey, height, xmin, xmax, ymin, ymax, zmin, zmax, alt, az ) 4321 real(kind=wp), intent(in) :: basex, basey, height, xmin, xmax, ymin, ymax, zmin, zmax, alt, az 4322 4323 interface 4324 subroutine interface_plw3d( basex, basey, height, xmin, xmax, ymin, ymax, zmin, zmax, alt, az ) bind(c,name='c_plw3d') 4325 import :: private_plflt 4326 implicit none 4327 real(kind=private_plflt), value, intent(in) :: basex, basey, height, xmin, xmax, ymin, ymax, zmin, zmax, alt, az 4328 end subroutine interface_plw3d 4329 end interface 4330 4331 call interface_plw3d( real(basex,kind=private_plflt), real(basey,kind=private_plflt), real(height,kind=private_plflt), & 4332 real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), real(ymin,kind=private_plflt), & 4333 real(ymax,kind=private_plflt), real(zmin,kind=private_plflt), real(zmax,kind=private_plflt), & 4334 real(alt,kind=private_plflt), real(az,kind=private_plflt) ) 4335 end subroutine plw3d_impl 4336 4337 subroutine plwidth_impl( width ) 4338 real(kind=wp), intent(in) :: width 4339 4340 interface 4341 subroutine interface_plwidth( width ) bind(c,name='c_plwidth') 4342 import :: private_plflt 4343 implicit none 4344 real(kind=private_plflt), value, intent(in) :: width 4345 end subroutine interface_plwidth 4346 end interface 4347 4348 call interface_plwidth( real(width,kind=private_plflt) ) 4349 end subroutine plwidth_impl 4350 4351 subroutine plwind_impl( xmin, xmax, ymin, ymax ) 4352 real(kind=wp), intent(in):: xmin, xmax, ymin, ymax 4353 4354 interface 4355 subroutine interface_plwind( xmin, xmax, ymin, ymax ) bind(c,name='c_plwind') 4356 import :: private_plflt 4357 implicit none 4358 real(kind=private_plflt), value, intent(in) :: xmin, xmax, ymin, ymax 4359 end subroutine interface_plwind 4360 end interface 4361 4362 call interface_plwind( real(xmin,kind=private_plflt), real(xmax,kind=private_plflt), & 4363 real(ymin,kind=private_plflt), real(ymax,kind=private_plflt) ) 4364 end subroutine plwind_impl 4365