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