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