1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX! 3!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 4#include <petsc/finclude/petscsys.h> 5 subroutine F90Array1dCreateScalar(array, start, len1, ptr) 6 use, intrinsic :: ISO_C_binding 7 implicit none 8 PetscInt start, len1 9 PetscScalar, target :: & 10 & array(start:start + len1 - 1) 11 PetscScalar, pointer :: ptr(:) 12 13 ptr => array 14 end subroutine 15 16 subroutine F90Array1dCreateReal(array, start, len1, ptr) 17 use, intrinsic :: ISO_C_binding 18 implicit none 19 PetscInt start, len1 20 PetscReal, target :: & 21 & array(start:start + len1 - 1) 22 PetscReal, pointer :: ptr(:) 23 24 ptr => array 25 end subroutine 26 27 subroutine F90Array1dCreateInt(array, start, len1, ptr) 28 use, intrinsic :: ISO_C_binding 29 implicit none 30 PetscInt start, len1 31 PetscInt, target :: & 32 & array(start:start + len1 - 1) 33 PetscInt, pointer :: ptr(:) 34 35 ptr => array 36 end subroutine 37 38 subroutine F90Array1dCreateMPIInt(array, start, len1, ptr) 39 use, intrinsic :: ISO_C_binding 40 implicit none 41 PetscInt start, len1 42 PetscMPIInt, target :: & 43 & array(start:start + len1 - 1) 44 PetscMPIInt, pointer :: ptr(:) 45 46 ptr => array 47 end subroutine 48 49 subroutine F90Array1dCreateFortranAddr(array, start, len1, ptr) 50 use, intrinsic :: ISO_C_binding 51 implicit none 52 PetscInt start, len1 53 PetscFortranAddr, target :: & 54 & array(start:start + len1 - 1) 55 PetscFortranAddr, pointer :: ptr(:) 56 57 ptr => array 58 end subroutine 59 60!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 61 subroutine F90Array1dAccessScalar(ptr, address) 62 use, intrinsic :: ISO_C_binding 63 implicit none 64 PetscScalar, pointer :: ptr(:) 65 PetscFortranAddr address 66 PetscInt start 67 68 if (associated(ptr) .eqv. .false.) then 69 address = 0 70 else 71 start = lbound(ptr, 1) 72 call F90Array1dGetAddrScalar(ptr(start), address) 73 end if 74 end subroutine 75 76 subroutine F90Array1dAccessReal(ptr, address) 77 use, intrinsic :: ISO_C_binding 78 implicit none 79 PetscReal, pointer :: ptr(:) 80 PetscFortranAddr address 81 PetscInt start 82 83 if (associated(ptr) .eqv. .false.) then 84 address = 0 85 else 86 start = lbound(ptr, 1) 87 call F90Array1dGetAddrReal(ptr(start), address) 88 end if 89 end subroutine 90 91 subroutine F90Array1dAccessInt(ptr, address) 92 use, intrinsic :: ISO_C_binding 93 implicit none 94 PetscInt, pointer :: ptr(:) 95 PetscFortranAddr address 96 PetscInt start 97 98 if (associated(ptr) .eqv. .false.) then 99 address = 0 100 else 101 start = lbound(ptr, 1) 102 call F90Array1dGetAddrInt(ptr(start), address) 103 end if 104 end subroutine 105 106 subroutine F90Array1dAccessMPIInt(ptr, address) 107 use, intrinsic :: ISO_C_binding 108 implicit none 109 PetscMPIInt, pointer :: ptr(:) 110 PetscFortranAddr address 111 PetscInt start 112 113 if (associated(ptr) .eqv. .false.) then 114 address = 0 115 else 116 start = lbound(ptr, 1) 117 call F90Array1dGetAddrMPIInt(ptr(start), address) 118 end if 119 end subroutine 120 121 subroutine F90Array1dAccessFortranAddr(ptr, address) 122 use, intrinsic :: ISO_C_binding 123 implicit none 124 PetscFortranAddr, pointer :: ptr(:) 125 PetscFortranAddr address 126 PetscInt start 127 128 if (associated(ptr) .eqv. .false.) then 129 address = 0 130 else 131 start = lbound(ptr, 1) 132 call F90Array1dGetAddrFortranAddr(ptr(start), address) 133 end if 134 end subroutine 135 136!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 137 subroutine F90Array1dDestroyScalar(ptr) 138 use, intrinsic :: ISO_C_binding 139 implicit none 140 PetscScalar, pointer :: ptr(:) 141 142 nullify (ptr) 143 end subroutine 144 145 subroutine F90Array1dDestroyReal(ptr) 146 use, intrinsic :: ISO_C_binding 147 implicit none 148 PetscReal, pointer :: ptr(:) 149 150 nullify (ptr) 151 end subroutine 152 153 subroutine F90Array1dDestroyInt(ptr) 154 use, intrinsic :: ISO_C_binding 155 implicit none 156 PetscInt, pointer :: ptr(:) 157 158 nullify (ptr) 159 end subroutine 160 161 subroutine F90Array1dDestroyMPIInt(ptr) 162 use, intrinsic :: ISO_C_binding 163 implicit none 164 PetscMPIInt, pointer :: ptr(:) 165 166 nullify (ptr) 167 end subroutine 168 169 subroutine F90Array1dDestroyFortranAddr(ptr) 170 use, intrinsic :: ISO_C_binding 171 implicit none 172 PetscFortranAddr, pointer :: ptr(:) 173 174 nullify (ptr) 175 end subroutine 176!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 177!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX! 178!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 179 subroutine F90Array2dCreateScalar(array, start1, len1, & 180 & start2, len2, ptr) 181 use, intrinsic :: ISO_C_binding 182 implicit none 183 PetscInt start1, len1 184 PetscInt start2, len2 185 PetscScalar, target :: & 186 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1) 187 PetscScalar, pointer :: ptr(:, :) 188 189 ptr => array 190 end subroutine 191 192 subroutine F90Array2dCreateReal(array, start1, len1, & 193 & start2, len2, ptr) 194 use, intrinsic :: ISO_C_binding 195 implicit none 196 PetscInt start1, len1 197 PetscInt start2, len2 198 PetscReal, target :: & 199 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1) 200 PetscReal, pointer :: ptr(:, :) 201 202 ptr => array 203 end subroutine 204 205 subroutine F90Array2dCreateInt(array, start1, len1, & 206 & start2, len2, ptr) 207 use, intrinsic :: ISO_C_binding 208 implicit none 209 PetscInt start1, len1 210 PetscInt start2, len2 211 PetscInt, target :: & 212 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1) 213 PetscInt, pointer :: ptr(:, :) 214 215 ptr => array 216 end subroutine 217 218 subroutine F90Array2dCreateFortranAddr(array, start1, len1, & 219 & start2, len2, ptr) 220 use, intrinsic :: ISO_C_binding 221 implicit none 222 PetscInt start1, len1 223 PetscInt start2, len2 224 PetscFortranAddr, target :: & 225 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1) 226 PetscFortranAddr, pointer :: ptr(:, :) 227 228 ptr => array 229 end subroutine 230 231!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 232 subroutine F90Array2dAccessScalar(ptr, address) 233 use, intrinsic :: ISO_C_binding 234 implicit none 235 PetscScalar, pointer :: ptr(:, :) 236 PetscFortranAddr address 237 PetscInt start1, start2 238 239 start1 = lbound(ptr, 1) 240 start2 = lbound(ptr, 2) 241 call F90Array2dGetAddrScalar(ptr(start1, start2), address) 242 end subroutine 243 244 subroutine F90Array2dAccessReal(ptr, address) 245 use, intrinsic :: ISO_C_binding 246 implicit none 247 PetscReal, pointer :: ptr(:, :) 248 PetscFortranAddr address 249 PetscInt start1, start2 250 251 start1 = lbound(ptr, 1) 252 start2 = lbound(ptr, 2) 253 call F90Array2dGetAddrReal(ptr(start1, start2), address) 254 end subroutine 255 256 subroutine F90Array2dAccessInt(ptr, address) 257 use, intrinsic :: ISO_C_binding 258 implicit none 259 PetscInt, pointer :: ptr(:, :) 260 PetscFortranAddr address 261 PetscInt start1, start2 262 263 start1 = lbound(ptr, 1) 264 start2 = lbound(ptr, 2) 265 call F90Array2dGetAddrInt(ptr(start1, start2), address) 266 end subroutine 267 268 subroutine F90Array2dAccessFortranAddr(ptr, address) 269 use, intrinsic :: ISO_C_binding 270 implicit none 271 PetscFortranAddr, pointer :: ptr(:, :) 272 PetscFortranAddr address 273 PetscInt start1, start2 274 275 start1 = lbound(ptr, 1) 276 start2 = lbound(ptr, 2) 277 call F90Array2dGetAddrFortranAddr(ptr(start1, start2), address) 278 end subroutine 279 280!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 281 subroutine F90Array2dDestroyScalar(ptr) 282 use, intrinsic :: ISO_C_binding 283 implicit none 284 PetscScalar, pointer :: ptr(:, :) 285 286 nullify (ptr) 287 end subroutine 288 289 subroutine F90Array2dDestroyReal(ptr) 290 use, intrinsic :: ISO_C_binding 291 implicit none 292 PetscReal, pointer :: ptr(:, :) 293 294 nullify (ptr) 295 end subroutine 296 297 subroutine F90Array2dDestroyInt(ptr) 298 use, intrinsic :: ISO_C_binding 299 implicit none 300 PetscInt, pointer :: ptr(:, :) 301 302 nullify (ptr) 303 end subroutine 304 305 subroutine F90Array2dDestroyFortranAddr(ptr) 306 use, intrinsic :: ISO_C_binding 307 implicit none 308 PetscFortranAddr, pointer :: ptr(:, :) 309 310 nullify (ptr) 311 end subroutine 312!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 313!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX! 314!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 315 subroutine F90Array3dCreateScalar(array, start1, len1, & 316 & start2, len2, start3, len3, ptr) 317 use, intrinsic :: ISO_C_binding 318 implicit none 319 PetscInt start1, len1 320 PetscInt start2, len2 321 PetscInt start3, len3 322 PetscScalar, target :: & 323 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 324 & start3:start3 + len3 - 1) 325 PetscScalar, pointer :: ptr(:, :, :) 326 327 ptr => array 328 end subroutine 329 330 subroutine F90Array3dCreateReal(array, start1, len1, & 331 & start2, len2, start3, len3, ptr) 332 use, intrinsic :: ISO_C_binding 333 implicit none 334 PetscInt start1, len1 335 PetscInt start2, len2 336 PetscInt start3, len3 337 PetscReal, target :: & 338 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 339 & start3:start3 + len3 - 1) 340 PetscReal, pointer :: ptr(:, :, :) 341 342 ptr => array 343 end subroutine 344 345 subroutine F90Array3dCreateInt(array, start1, len1, & 346 & start2, len2, start3, len3, ptr) 347 use, intrinsic :: ISO_C_binding 348 implicit none 349 PetscInt start1, len1 350 PetscInt start2, len2 351 PetscInt start3, len3 352 PetscInt, target :: & 353 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 354 & start3:start3 + len3 - 1) 355 PetscInt, pointer :: ptr(:, :, :) 356 357 ptr => array 358 end subroutine 359 360 subroutine F90Array3dCreateFortranAddr(array, start1, len1, & 361 & start2, len2, start3, len3, ptr) 362 use, intrinsic :: ISO_C_binding 363 implicit none 364 PetscInt start1, len1 365 PetscInt start2, len2 366 PetscInt start3, len3 367 PetscFortranAddr, target :: & 368 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 369 & start3:start3 + len3 - 1) 370 PetscFortranAddr, pointer :: ptr(:, :, :) 371 372 ptr => array 373 end subroutine 374 375!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 376 subroutine F90Array3dAccessScalar(ptr, address) 377 use, intrinsic :: ISO_C_binding 378 implicit none 379 PetscScalar, pointer :: ptr(:, :, :) 380 PetscFortranAddr address 381 PetscInt start1, start2, start3 382 383 start1 = lbound(ptr, 1) 384 start2 = lbound(ptr, 2) 385 start3 = lbound(ptr, 3) 386 call F90Array3dGetAddrScalar(ptr(start1, start2, start3), address) 387 end subroutine 388 389 subroutine F90Array3dAccessReal(ptr, address) 390 use, intrinsic :: ISO_C_binding 391 implicit none 392 PetscReal, pointer :: ptr(:, :, :) 393 PetscFortranAddr address 394 PetscInt start1, start2, start3 395 396 start1 = lbound(ptr, 1) 397 start2 = lbound(ptr, 2) 398 start3 = lbound(ptr, 3) 399 call F90Array3dGetAddrReal(ptr(start1, start2, start3), address) 400 end subroutine 401 402 subroutine F90Array3dAccessInt(ptr, address) 403 use, intrinsic :: ISO_C_binding 404 implicit none 405 PetscInt, pointer :: ptr(:, :, :) 406 PetscFortranAddr address 407 PetscInt start1, start2, start3 408 409 start1 = lbound(ptr, 1) 410 start2 = lbound(ptr, 2) 411 start3 = lbound(ptr, 3) 412 call F90Array3dGetAddrInt(ptr(start1, start2, start3), address) 413 end subroutine 414 415 subroutine F90Array3dAccessFortranAddr(ptr, address) 416 use, intrinsic :: ISO_C_binding 417 implicit none 418 PetscFortranAddr, pointer :: ptr(:, :, :) 419 PetscFortranAddr address 420 PetscInt start1, start2, start3 421 422 start1 = lbound(ptr, 1) 423 start2 = lbound(ptr, 2) 424 start3 = lbound(ptr, 3) 425 call F90Array3dGetAddrFortranAddr(ptr(start1, start2, start3), & 426 & address) 427 end subroutine 428 429!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 430 subroutine F90Array3dDestroyScalar(ptr) 431 use, intrinsic :: ISO_C_binding 432 implicit none 433 PetscScalar, pointer :: ptr(:, :, :) 434 435 nullify (ptr) 436 end subroutine 437 438 subroutine F90Array3dDestroyReal(ptr) 439 use, intrinsic :: ISO_C_binding 440 implicit none 441 PetscReal, pointer :: ptr(:, :, :) 442 443 nullify (ptr) 444 end subroutine 445 446 subroutine F90Array3dDestroyInt(ptr) 447 use, intrinsic :: ISO_C_binding 448 implicit none 449 PetscInt, pointer :: ptr(:, :, :) 450 451 nullify (ptr) 452 end subroutine 453 454 subroutine F90Array3dDestroyFortranAddr(ptr) 455 use, intrinsic :: ISO_C_binding 456 implicit none 457 PetscFortranAddr, pointer :: ptr(:, :, :) 458 459 nullify (ptr) 460 end subroutine 461 462!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 463 subroutine F90Array4dCreateScalar(array, start1, len1, & 464 & start2, len2, start3, len3, start4, len4, ptr) 465 use, intrinsic :: ISO_C_binding 466 implicit none 467 PetscInt start1, len1 468 PetscInt start2, len2 469 PetscInt start3, len3 470 PetscInt start4, len4 471 PetscScalar, target :: & 472 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 473 & start3:start3 + len3 - 1, start4:start4 + len4 - 1) 474 PetscScalar, pointer :: ptr(:, :, :, :) 475 476 ptr => array 477 end subroutine 478 479 subroutine F90Array4dCreateReal(array, start1, len1, & 480 & start2, len2, start3, len3, start4, len4, ptr) 481 use, intrinsic :: ISO_C_binding 482 implicit none 483 PetscInt start1, len1 484 PetscInt start2, len2 485 PetscInt start3, len3 486 PetscInt start4, len4 487 PetscReal, target :: & 488 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 489 & start3:start3 + len3 - 1, start4:start4 + len4 - 1) 490 PetscReal, pointer :: ptr(:, :, :, :) 491 492 ptr => array 493 end subroutine 494 495 subroutine F90Array4dCreateInt(array, start1, len1, & 496 & start2, len2, start3, len3, start4, len4, ptr) 497 use, intrinsic :: ISO_C_binding 498 implicit none 499 PetscInt start1, len1 500 PetscInt start2, len2 501 PetscInt start3, len3 502 PetscInt start4, len4 503 PetscInt, target :: & 504 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 505 & start3:start3 + len3 - 1, start4:start4 + len4 - 1) 506 PetscInt, pointer :: ptr(:, :, :, :) 507 508 ptr => array 509 end subroutine 510 511 subroutine F90Array4dCreateFortranAddr(array, start1, len1, & 512 & start2, len2, start3, len3, start4, len4, ptr) 513 use, intrinsic :: ISO_C_binding 514 implicit none 515 PetscInt start1, len1 516 PetscInt start2, len2 517 PetscInt start3, len3 518 PetscInt start4, len4 519 PetscFortranAddr, target :: & 520 & array(start1:start1 + len1 - 1, start2:start2 + len2 - 1, & 521 & start3:start3 + len3 - 1, start4:start4 + len4 - 1) 522 PetscFortranAddr, pointer :: ptr(:, :, :, :) 523 524 ptr => array 525 end subroutine 526 527 subroutine F90Array4dAccessScalar(ptr, address) 528 use, intrinsic :: ISO_C_binding 529 implicit none 530 PetscScalar, pointer :: ptr(:, :, :, :) 531 PetscFortranAddr address 532 PetscInt start1, start2, start3, start4 533 534 start1 = lbound(ptr, 1) 535 start2 = lbound(ptr, 2) 536 start3 = lbound(ptr, 3) 537 start4 = lbound(ptr, 4) 538 call F90Array4dGetAddrScalar(ptr(start1, start2, start3, start4), & 539 & address) 540 end subroutine 541 542 subroutine F90Array4dAccessReal(ptr, address) 543 use, intrinsic :: ISO_C_binding 544 implicit none 545 PetscReal, pointer :: ptr(:, :, :, :) 546 PetscFortranAddr address 547 PetscInt start1, start2, start3, start4 548 549 start1 = lbound(ptr, 1) 550 start2 = lbound(ptr, 2) 551 start3 = lbound(ptr, 3) 552 start4 = lbound(ptr, 4) 553 call F90Array4dGetAddrReal(ptr(start1, start2, start3, start4), & 554 & address) 555 end subroutine 556 557 subroutine F90Array4dAccessInt(ptr, address) 558 use, intrinsic :: ISO_C_binding 559 implicit none 560 PetscInt, pointer :: ptr(:, :, :, :) 561 PetscFortranAddr address 562 PetscInt start1, start2, start3, start4 563 564 start1 = lbound(ptr, 1) 565 start2 = lbound(ptr, 2) 566 start3 = lbound(ptr, 3) 567 start4 = lbound(ptr, 4) 568 call F90Array4dGetAddrInt(ptr(start1, start2, start3, start4), & 569 & address) 570 end subroutine 571 572 subroutine F90Array4dAccessFortranAddr(ptr, address) 573 use, intrinsic :: ISO_C_binding 574 implicit none 575 PetscScalar, pointer :: ptr(:, :, :, :) 576 PetscFortranAddr address 577 PetscFortranAddr start1, start2, start3, start4 578 579 start1 = lbound(ptr, 1) 580 start2 = lbound(ptr, 2) 581 start3 = lbound(ptr, 3) 582 start4 = lbound(ptr, 4) 583 call F90Array4dGetAddrFortranAddr(ptr(start1, start2, start3, & 584 & start4), address) 585 end subroutine 586 587 subroutine F90Array4dDestroyScalar(ptr) 588 use, intrinsic :: ISO_C_binding 589 implicit none 590 PetscScalar, pointer :: ptr(:, :, :, :) 591 592 nullify (ptr) 593 end subroutine 594 595 subroutine F90Array4dDestroyReal(ptr) 596 use, intrinsic :: ISO_C_binding 597 implicit none 598 PetscReal, pointer :: ptr(:, :, :, :) 599 600 nullify (ptr) 601 end subroutine 602 603 subroutine F90Array4dDestroyInt(ptr) 604 use, intrinsic :: ISO_C_binding 605 implicit none 606 PetscInt, pointer :: ptr(:, :, :, :) 607 608 nullify (ptr) 609 end subroutine 610 611 subroutine F90Array4dDestroyFortranAddr(ptr) 612 use, intrinsic :: ISO_C_binding 613 implicit none 614 PetscFortranAddr, pointer :: ptr(:, :, :, :) 615 616 nullify (ptr) 617 end subroutine 618 619!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 620!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX! 621!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 622