1! Using two spaces between dg-do and run is a hack to keep gfortran-dg-runtest 2! from cycling through optimization options for this expensive test. 3! { dg-do run } 4! { dg-options "-O3 -fcray-pointer -fbounds-check -fno-inline" } 5! { dg-timeout-factor 4 } 6! 7! Series of routines for testing a Cray pointer implementation 8! 9! Note: Some of the test cases violate Fortran's alias rules; 10! the "-fno-inline option" for now prevents failures. 11! 12program craytest 13 common /errors/errors(400) 14 common /foo/foo ! To prevent optimizations 15 integer foo 16 integer i 17 logical errors 18 errors = .false. 19 foo = 0 20 call ptr1 21 call ptr2 22 call ptr3 23 call ptr4 24 call ptr5 25 call ptr6 26 call ptr7 27 call ptr8 28 call ptr9(9,10,11) 29 call ptr10(9,10,11) 30 call ptr11(9,10,11) 31 call ptr12(9,10,11) 32 call ptr13(9,10) 33 call parmtest 34! NOTE: Tests 1 through 12 were removed from this file 35! and placed in loc_1.f90, so we start at 13 36 do i=13,400 37 if (errors(i)) then 38! print *,"Test",i,"failed." 39 call abort() 40 endif 41 end do 42 if (foo.eq.0) then 43! print *,"Test did not run correctly." 44 call abort() 45 endif 46end program craytest 47 48! ptr1 through ptr13 that Cray pointees are correctly used with 49! a variety of declaration styles 50subroutine ptr1 51 common /errors/errors(400) 52 logical :: errors, intne, realne, chne, ch8ne 53 integer :: i,j,k 54 integer, parameter :: n = 9 55 integer, parameter :: m = 10 56 integer, parameter :: o = 11 57 integer itarg1 (n) 58 integer itarg2 (m,n) 59 integer itarg3 (o,m,n) 60 real rtarg1(n) 61 real rtarg2(m,n) 62 real rtarg3(o,m,n) 63 character chtarg1(n) 64 character chtarg2(m,n) 65 character chtarg3(o,m,n) 66 character*8 ch8targ1(n) 67 character*8 ch8targ2(m,n) 68 character*8 ch8targ3(o,m,n) 69 type drvd 70 real r1 71 integer i1 72 integer i2(5) 73 end type drvd 74 type(drvd) dtarg1(n) 75 type(drvd) dtarg2(m,n) 76 type(drvd) dtarg3(o,m,n) 77 78 type(drvd) dpte1(n) 79 type(drvd) dpte2(m,n) 80 type(drvd) dpte3(o,m,n) 81 integer ipte1 (n) 82 integer ipte2 (m,n) 83 integer ipte3 (o,m,n) 84 real rpte1(n) 85 real rpte2(m,n) 86 real rpte3(o,m,n) 87 character chpte1(n) 88 character chpte2(m,n) 89 character chpte3(o,m,n) 90 character*8 ch8pte1(n) 91 character*8 ch8pte2(m,n) 92 character*8 ch8pte3(o,m,n) 93 94 pointer(iptr1,dpte1) 95 pointer(iptr2,dpte2) 96 pointer(iptr3,dpte3) 97 pointer(iptr4,ipte1) 98 pointer(iptr5,ipte2) 99 pointer(iptr6,ipte3) 100 pointer(iptr7,rpte1) 101 pointer(iptr8,rpte2) 102 pointer(iptr9,rpte3) 103 pointer(iptr10,chpte1) 104 pointer(iptr11,chpte2) 105 pointer(iptr12,chpte3) 106 pointer(iptr13,ch8pte1) 107 pointer(iptr14,ch8pte2) 108 pointer(iptr15,ch8pte3) 109 110 iptr1 = loc(dtarg1) 111 iptr2 = loc(dtarg2) 112 iptr3 = loc(dtarg3) 113 iptr4 = loc(itarg1) 114 iptr5 = loc(itarg2) 115 iptr6 = loc(itarg3) 116 iptr7 = loc(rtarg1) 117 iptr8 = loc(rtarg2) 118 iptr9 = loc(rtarg3) 119 iptr10= loc(chtarg1) 120 iptr11= loc(chtarg2) 121 iptr12= loc(chtarg3) 122 iptr13= loc(ch8targ1) 123 iptr14= loc(ch8targ2) 124 iptr15= loc(ch8targ3) 125 126 127 do, i=1,n 128 dpte1(i)%i1=i 129 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 130 ! Error #13 131 errors(13) = .true. 132 endif 133 134 dtarg1(i)%i1=2*dpte1(i)%i1 135 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 136 ! Error #14 137 errors(14) = .true. 138 endif 139 140 ipte1(i) = i 141 if (intne(ipte1(i), itarg1(i))) then 142 ! Error #15 143 errors(15) = .true. 144 endif 145 146 itarg1(i) = -ipte1(i) 147 if (intne(ipte1(i), itarg1(i))) then 148 ! Error #16 149 errors(16) = .true. 150 endif 151 152 rpte1(i) = i * 5.0 153 if (realne(rpte1(i), rtarg1(i))) then 154 ! Error #17 155 errors(17) = .true. 156 endif 157 158 rtarg1(i) = i * (-5.0) 159 if (realne(rpte1(i), rtarg1(i))) then 160 ! Error #18 161 errors(18) = .true. 162 endif 163 164 chpte1(i) = 'a' 165 if (chne(chpte1(i), chtarg1(i))) then 166 ! Error #19 167 errors(19) = .true. 168 endif 169 170 chtarg1(i) = 'z' 171 if (chne(chpte1(i), chtarg1(i))) then 172 ! Error #20 173 errors(20) = .true. 174 endif 175 176 ch8pte1(i) = 'aaaaaaaa' 177 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 178 ! Error #21 179 errors(21) = .true. 180 endif 181 182 ch8targ1(i) = 'zzzzzzzz' 183 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 184 ! Error #22 185 errors(22) = .true. 186 endif 187 188 do, j=1,m 189 dpte2(j,i)%r1=1.0 190 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 191 ! Error #23 192 errors(23) = .true. 193 endif 194 195 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 196 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 197 ! Error #24 198 errors(24) = .true. 199 endif 200 201 ipte2(j,i) = i 202 if (intne(ipte2(j,i), itarg2(j,i))) then 203 ! Error #25 204 errors(25) = .true. 205 endif 206 207 itarg2(j,i) = -ipte2(j,i) 208 if (intne(ipte2(j,i), itarg2(j,i))) then 209 ! Error #26 210 errors(26) = .true. 211 endif 212 213 rpte2(j,i) = i * (-2.0) 214 if (realne(rpte2(j,i), rtarg2(j,i))) then 215 ! Error #27 216 errors(27) = .true. 217 endif 218 219 rtarg2(j,i) = i * (-3.0) 220 if (realne(rpte2(j,i), rtarg2(j,i))) then 221 ! Error #28 222 errors(28) = .true. 223 endif 224 225 chpte2(j,i) = 'a' 226 if (chne(chpte2(j,i), chtarg2(j,i))) then 227 ! Error #29 228 errors(29) = .true. 229 endif 230 231 chtarg2(j,i) = 'z' 232 if (chne(chpte2(j,i), chtarg2(j,i))) then 233 ! Error #30 234 errors(30) = .true. 235 endif 236 237 ch8pte2(j,i) = 'aaaaaaaa' 238 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 239 ! Error #31 240 errors(31) = .true. 241 endif 242 243 ch8targ2(j,i) = 'zzzzzzzz' 244 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 245 ! Error #32 246 errors(32) = .true. 247 endif 248 do k=1,o 249 dpte3(k,j,i)%i2(1+mod(i,5))=i 250 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 251 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 252 ! Error #33 253 errors(33) = .true. 254 endif 255 256 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 257 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 258 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 259 ! Error #34 260 errors(34) = .true. 261 endif 262 263 ipte3(k,j,i) = i 264 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 265 ! Error #35 266 errors(35) = .true. 267 endif 268 269 itarg3(k,j,i) = -ipte3(k,j,i) 270 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 271 ! Error #36 272 errors(36) = .true. 273 endif 274 275 rpte3(k,j,i) = i * 2.0 276 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 277 ! Error #37 278 errors(37) = .true. 279 endif 280 281 rtarg3(k,j,i) = i * 3.0 282 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 283 ! Error #38 284 errors(38) = .true. 285 endif 286 287 chpte3(k,j,i) = 'a' 288 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 289 ! Error #39 290 errors(39) = .true. 291 endif 292 293 chtarg3(k,j,i) = 'z' 294 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 295 ! Error #40 296 errors(40) = .true. 297 endif 298 299 ch8pte3(k,j,i) = 'aaaaaaaa' 300 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 301 ! Error #41 302 errors(41) = .true. 303 endif 304 305 ch8targ3(k,j,i) = 'zzzzzzzz' 306 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 307 ! Error #42 308 errors(42) = .true. 309 endif 310 end do 311 end do 312 end do 313 314 rtarg3 = .5 315 ! Vector syntax 316 do, i=1,n 317 ipte3 = i 318 rpte3 = rpte3+1 319 do, j=1,m 320 do k=1,o 321 if (intne(itarg3(k,j,i), i)) then 322 ! Error #43 323 errors(43) = .true. 324 endif 325 326 if (realne(rtarg3(k,j,i), i+.5)) then 327 ! Error #44 328 errors(44) = .true. 329 endif 330 end do 331 end do 332 end do 333 334end subroutine ptr1 335 336 337subroutine ptr2 338 common /errors/errors(400) 339 logical :: errors, intne, realne, chne, ch8ne 340 integer :: i,j,k 341 integer, parameter :: n = 9 342 integer, parameter :: m = 10 343 integer, parameter :: o = 11 344 integer itarg1 (n) 345 integer itarg2 (m,n) 346 integer itarg3 (o,m,n) 347 real rtarg1(n) 348 real rtarg2(m,n) 349 real rtarg3(o,m,n) 350 character chtarg1(n) 351 character chtarg2(m,n) 352 character chtarg3(o,m,n) 353 character*8 ch8targ1(n) 354 character*8 ch8targ2(m,n) 355 character*8 ch8targ3(o,m,n) 356 type drvd 357 real r1 358 integer i1 359 integer i2(5) 360 end type drvd 361 type(drvd) dtarg1(n) 362 type(drvd) dtarg2(m,n) 363 type(drvd) dtarg3(o,m,n) 364 365 type(drvd) dpte1 366 type(drvd) dpte2 367 type(drvd) dpte3 368 integer ipte1 369 integer ipte2 370 integer ipte3 371 real rpte1 372 real rpte2 373 real rpte3 374 character chpte1 375 character chpte2 376 character chpte3 377 character*8 ch8pte1 378 character*8 ch8pte2 379 character*8 ch8pte3 380 381 pointer(iptr1,dpte1(n)) 382 pointer(iptr2,dpte2(m,n)) 383 pointer(iptr3,dpte3(o,m,n)) 384 pointer(iptr4,ipte1(n)) 385 pointer(iptr5,ipte2 (m,n)) 386 pointer(iptr6,ipte3(o,m,n)) 387 pointer(iptr7,rpte1(n)) 388 pointer(iptr8,rpte2(m,n)) 389 pointer(iptr9,rpte3(o,m,n)) 390 pointer(iptr10,chpte1(n)) 391 pointer(iptr11,chpte2(m,n)) 392 pointer(iptr12,chpte3(o,m,n)) 393 pointer(iptr13,ch8pte1(n)) 394 pointer(iptr14,ch8pte2(m,n)) 395 pointer(iptr15,ch8pte3(o,m,n)) 396 397 iptr1 = loc(dtarg1) 398 iptr2 = loc(dtarg2) 399 iptr3 = loc(dtarg3) 400 iptr4 = loc(itarg1) 401 iptr5 = loc(itarg2) 402 iptr6 = loc(itarg3) 403 iptr7 = loc(rtarg1) 404 iptr8 = loc(rtarg2) 405 iptr9 = loc(rtarg3) 406 iptr10= loc(chtarg1) 407 iptr11= loc(chtarg2) 408 iptr12= loc(chtarg3) 409 iptr13= loc(ch8targ1) 410 iptr14= loc(ch8targ2) 411 iptr15= loc(ch8targ3) 412 413 do, i=1,n 414 dpte1(i)%i1=i 415 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 416 ! Error #45 417 errors(45) = .true. 418 endif 419 420 dtarg1(i)%i1=2*dpte1(i)%i1 421 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 422 ! Error #46 423 errors(46) = .true. 424 endif 425 426 ipte1(i) = i 427 if (intne(ipte1(i), itarg1(i))) then 428 ! Error #47 429 errors(47) = .true. 430 endif 431 432 itarg1(i) = -ipte1(i) 433 if (intne(ipte1(i), itarg1(i))) then 434 ! Error #48 435 errors(48) = .true. 436 endif 437 438 rpte1(i) = i * 5.0 439 if (realne(rpte1(i), rtarg1(i))) then 440 ! Error #49 441 errors(49) = .true. 442 endif 443 444 rtarg1(i) = i * (-5.0) 445 if (realne(rpte1(i), rtarg1(i))) then 446 ! Error #50 447 errors(50) = .true. 448 endif 449 450 chpte1(i) = 'a' 451 if (chne(chpte1(i), chtarg1(i))) then 452 ! Error #51 453 errors(51) = .true. 454 endif 455 456 chtarg1(i) = 'z' 457 if (chne(chpte1(i), chtarg1(i))) then 458 ! Error #52 459 errors(52) = .true. 460 endif 461 462 ch8pte1(i) = 'aaaaaaaa' 463 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 464 ! Error #53 465 errors(53) = .true. 466 endif 467 468 ch8targ1(i) = 'zzzzzzzz' 469 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 470 ! Error #54 471 errors(54) = .true. 472 endif 473 474 do, j=1,m 475 dpte2(j,i)%r1=1.0 476 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 477 ! Error #55 478 errors(55) = .true. 479 endif 480 481 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 482 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 483 ! Error #56 484 errors(56) = .true. 485 endif 486 487 ipte2(j,i) = i 488 if (intne(ipte2(j,i), itarg2(j,i))) then 489 ! Error #57 490 errors(57) = .true. 491 endif 492 493 itarg2(j,i) = -ipte2(j,i) 494 if (intne(ipte2(j,i), itarg2(j,i))) then 495 ! Error #58 496 errors(58) = .true. 497 endif 498 499 rpte2(j,i) = i * (-2.0) 500 if (realne(rpte2(j,i), rtarg2(j,i))) then 501 ! Error #59 502 errors(59) = .true. 503 endif 504 505 rtarg2(j,i) = i * (-3.0) 506 if (realne(rpte2(j,i), rtarg2(j,i))) then 507 ! Error #60 508 errors(60) = .true. 509 endif 510 511 chpte2(j,i) = 'a' 512 if (chne(chpte2(j,i), chtarg2(j,i))) then 513 ! Error #61 514 errors(61) = .true. 515 endif 516 517 chtarg2(j,i) = 'z' 518 if (chne(chpte2(j,i), chtarg2(j,i))) then 519 ! Error #62 520 errors(62) = .true. 521 endif 522 523 ch8pte2(j,i) = 'aaaaaaaa' 524 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 525 ! Error #63 526 errors(63) = .true. 527 endif 528 529 ch8targ2(j,i) = 'zzzzzzzz' 530 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 531 ! Error #64 532 errors(64) = .true. 533 endif 534 do k=1,o 535 dpte3(k,j,i)%i2(1+mod(i,5))=i 536 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then 537 ! Error #65 538 errors(65) = .true. 539 endif 540 541 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 542 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then 543 ! Error #66 544 errors(66) = .true. 545 endif 546 547 ipte3(k,j,i) = i 548 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 549 ! Error #67 550 errors(67) = .true. 551 endif 552 553 itarg3(k,j,i) = -ipte3(k,j,i) 554 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 555 ! Error #68 556 errors(68) = .true. 557 endif 558 559 rpte3(k,j,i) = i * 2.0 560 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 561 ! Error #69 562 errors(69) = .true. 563 endif 564 565 rtarg3(k,j,i) = i * 3.0 566 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 567 ! Error #70 568 errors(70) = .true. 569 endif 570 571 chpte3(k,j,i) = 'a' 572 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 573 ! Error #71 574 errors(71) = .true. 575 endif 576 577 chtarg3(k,j,i) = 'z' 578 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 579 ! Error #72 580 errors(72) = .true. 581 endif 582 583 ch8pte3(k,j,i) = 'aaaaaaaa' 584 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 585 ! Error #73 586 errors(73) = .true. 587 endif 588 589 ch8targ3(k,j,i) = 'zzzzzzzz' 590 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 591 ! Error #74 592 errors(74) = .true. 593 endif 594 end do 595 end do 596 end do 597 598 rtarg3 = .5 599 ! Vector syntax 600 do, i=1,n 601 ipte3 = i 602 rpte3 = rpte3+1 603 do, j=1,m 604 do k=1,o 605 if (intne(itarg3(k,j,i), i)) then 606 ! Error #75 607 errors(75) = .true. 608 endif 609 610 if (realne(rtarg3(k,j,i), i+.5)) then 611 ! Error #76 612 errors(76) = .true. 613 endif 614 end do 615 end do 616 end do 617end subroutine ptr2 618 619subroutine ptr3 620 common /errors/errors(400) 621 logical :: errors, intne, realne, chne, ch8ne 622 integer :: i,j,k 623 integer, parameter :: n = 9 624 integer, parameter :: m = 10 625 integer, parameter :: o = 11 626 integer itarg1 (n) 627 integer itarg2 (m,n) 628 integer itarg3 (o,m,n) 629 real rtarg1(n) 630 real rtarg2(m,n) 631 real rtarg3(o,m,n) 632 character chtarg1(n) 633 character chtarg2(m,n) 634 character chtarg3(o,m,n) 635 character*8 ch8targ1(n) 636 character*8 ch8targ2(m,n) 637 character*8 ch8targ3(o,m,n) 638 type drvd 639 real r1 640 integer i1 641 integer i2(5) 642 end type drvd 643 type(drvd) dtarg1(n) 644 type(drvd) dtarg2(m,n) 645 type(drvd) dtarg3(o,m,n) 646 647 pointer(iptr1,dpte1(n)) 648 pointer(iptr2,dpte2(m,n)) 649 pointer(iptr3,dpte3(o,m,n)) 650 pointer(iptr4,ipte1(n)) 651 pointer(iptr5,ipte2 (m,n)) 652 pointer(iptr6,ipte3(o,m,n)) 653 pointer(iptr7,rpte1(n)) 654 pointer(iptr8,rpte2(m,n)) 655 pointer(iptr9,rpte3(o,m,n)) 656 pointer(iptr10,chpte1(n)) 657 pointer(iptr11,chpte2(m,n)) 658 pointer(iptr12,chpte3(o,m,n)) 659 pointer(iptr13,ch8pte1(n)) 660 pointer(iptr14,ch8pte2(m,n)) 661 pointer(iptr15,ch8pte3(o,m,n)) 662 663 type(drvd) dpte1 664 type(drvd) dpte2 665 type(drvd) dpte3 666 integer ipte1 667 integer ipte2 668 integer ipte3 669 real rpte1 670 real rpte2 671 real rpte3 672 character chpte1 673 character chpte2 674 character chpte3 675 character*8 ch8pte1 676 character*8 ch8pte2 677 character*8 ch8pte3 678 679 iptr1 = loc(dtarg1) 680 iptr2 = loc(dtarg2) 681 iptr3 = loc(dtarg3) 682 iptr4 = loc(itarg1) 683 iptr5 = loc(itarg2) 684 iptr6 = loc(itarg3) 685 iptr7 = loc(rtarg1) 686 iptr8 = loc(rtarg2) 687 iptr9 = loc(rtarg3) 688 iptr10= loc(chtarg1) 689 iptr11= loc(chtarg2) 690 iptr12= loc(chtarg3) 691 iptr13= loc(ch8targ1) 692 iptr14= loc(ch8targ2) 693 iptr15= loc(ch8targ3) 694 695 do, i=1,n 696 dpte1(i)%i1=i 697 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 698 ! Error #77 699 errors(77) = .true. 700 endif 701 702 dtarg1(i)%i1=2*dpte1(i)%i1 703 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 704 ! Error #78 705 errors(78) = .true. 706 endif 707 708 ipte1(i) = i 709 if (intne(ipte1(i), itarg1(i))) then 710 ! Error #79 711 errors(79) = .true. 712 endif 713 714 itarg1(i) = -ipte1(i) 715 if (intne(ipte1(i), itarg1(i))) then 716 ! Error #80 717 errors(80) = .true. 718 endif 719 720 rpte1(i) = i * 5.0 721 if (realne(rpte1(i), rtarg1(i))) then 722 ! Error #81 723 errors(81) = .true. 724 endif 725 726 rtarg1(i) = i * (-5.0) 727 if (realne(rpte1(i), rtarg1(i))) then 728 ! Error #82 729 errors(82) = .true. 730 endif 731 732 chpte1(i) = 'a' 733 if (chne(chpte1(i), chtarg1(i))) then 734 ! Error #83 735 errors(83) = .true. 736 endif 737 738 chtarg1(i) = 'z' 739 if (chne(chpte1(i), chtarg1(i))) then 740 ! Error #84 741 errors(84) = .true. 742 endif 743 744 ch8pte1(i) = 'aaaaaaaa' 745 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 746 ! Error #85 747 errors(85) = .true. 748 endif 749 750 ch8targ1(i) = 'zzzzzzzz' 751 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 752 ! Error #86 753 errors(86) = .true. 754 endif 755 756 do, j=1,m 757 dpte2(j,i)%r1=1.0 758 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 759 ! Error #87 760 errors(87) = .true. 761 endif 762 763 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 764 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 765 ! Error #88 766 errors(88) = .true. 767 endif 768 769 ipte2(j,i) = i 770 if (intne(ipte2(j,i), itarg2(j,i))) then 771 ! Error #89 772 errors(89) = .true. 773 endif 774 775 itarg2(j,i) = -ipte2(j,i) 776 if (intne(ipte2(j,i), itarg2(j,i))) then 777 ! Error #90 778 errors(90) = .true. 779 endif 780 781 rpte2(j,i) = i * (-2.0) 782 if (realne(rpte2(j,i), rtarg2(j,i))) then 783 ! Error #91 784 errors(91) = .true. 785 endif 786 787 rtarg2(j,i) = i * (-3.0) 788 if (realne(rpte2(j,i), rtarg2(j,i))) then 789 ! Error #92 790 errors(92) = .true. 791 endif 792 793 chpte2(j,i) = 'a' 794 if (chne(chpte2(j,i), chtarg2(j,i))) then 795 ! Error #93 796 errors(93) = .true. 797 endif 798 799 chtarg2(j,i) = 'z' 800 if (chne(chpte2(j,i), chtarg2(j,i))) then 801 ! Error #94 802 errors(94) = .true. 803 endif 804 805 ch8pte2(j,i) = 'aaaaaaaa' 806 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 807 ! Error #95 808 errors(95) = .true. 809 endif 810 811 ch8targ2(j,i) = 'zzzzzzzz' 812 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 813 ! Error #96 814 errors(96) = .true. 815 endif 816 do k=1,o 817 dpte3(k,j,i)%i2(1+mod(i,5))=i 818 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 819 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 820 ! Error #97 821 errors(97) = .true. 822 endif 823 824 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 825 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 826 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 827 ! Error #98 828 errors(98) = .true. 829 endif 830 831 ipte3(k,j,i) = i 832 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 833 ! Error #99 834 errors(99) = .true. 835 endif 836 837 itarg3(k,j,i) = -ipte3(k,j,i) 838 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 839 ! Error #100 840 errors(100) = .true. 841 endif 842 843 rpte3(k,j,i) = i * 2.0 844 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 845 ! Error #101 846 errors(101) = .true. 847 endif 848 849 rtarg3(k,j,i) = i * 3.0 850 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 851 ! Error #102 852 errors(102) = .true. 853 endif 854 855 chpte3(k,j,i) = 'a' 856 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 857 ! Error #103 858 errors(103) = .true. 859 endif 860 861 chtarg3(k,j,i) = 'z' 862 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 863 ! Error #104 864 errors(104) = .true. 865 endif 866 867 ch8pte3(k,j,i) = 'aaaaaaaa' 868 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 869 ! Error #105 870 errors(105) = .true. 871 endif 872 873 ch8targ3(k,j,i) = 'zzzzzzzz' 874 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 875 ! Error #106 876 errors(106) = .true. 877 endif 878 end do 879 end do 880 end do 881 882 rtarg3 = .5 883 ! Vector syntax 884 do, i=1,n 885 ipte3 = i 886 rpte3 = rpte3+1 887 do, j=1,m 888 do k=1,o 889 if (intne(itarg3(k,j,i), i)) then 890 ! Error #107 891 errors(107) = .true. 892 endif 893 894 if (realne(rtarg3(k,j,i), i+.5)) then 895 ! Error #108 896 errors(108) = .true. 897 endif 898 end do 899 end do 900 end do 901end subroutine ptr3 902 903subroutine ptr4 904 common /errors/errors(400) 905 logical :: errors, intne, realne, chne, ch8ne 906 integer :: i,j,k 907 integer, parameter :: n = 9 908 integer, parameter :: m = 10 909 integer, parameter :: o = 11 910 integer itarg1 (n) 911 integer itarg2 (m,n) 912 integer itarg3 (o,m,n) 913 real rtarg1(n) 914 real rtarg2(m,n) 915 real rtarg3(o,m,n) 916 character chtarg1(n) 917 character chtarg2(m,n) 918 character chtarg3(o,m,n) 919 character*8 ch8targ1(n) 920 character*8 ch8targ2(m,n) 921 character*8 ch8targ3(o,m,n) 922 type drvd 923 real r1 924 integer i1 925 integer i2(5) 926 end type drvd 927 type(drvd) dtarg1(n) 928 type(drvd) dtarg2(m,n) 929 type(drvd) dtarg3(o,m,n) 930 931 pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3) 932 pointer (iptr4,ipte1), (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1) 933 pointer(iptr8,rpte2) 934 pointer(iptr9,rpte3),(iptr10,chpte1) 935 pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1) 936 pointer(iptr14,ch8pte2) 937 pointer(iptr15,ch8pte3) 938 939 type(drvd) dpte1(n) 940 type(drvd) dpte2(m,n) 941 type(drvd) dpte3(o,m,n) 942 integer ipte1 (n) 943 integer ipte2 (m,n) 944 integer ipte3 (o,m,n) 945 real rpte1(n) 946 real rpte2(m,n) 947 real rpte3(o,m,n) 948 character chpte1(n) 949 character chpte2(m,n) 950 character chpte3(o,m,n) 951 character*8 ch8pte1(n) 952 character*8 ch8pte2(m,n) 953 character*8 ch8pte3(o,m,n) 954 955 iptr1 = loc(dtarg1) 956 iptr2 = loc(dtarg2) 957 iptr3 = loc(dtarg3) 958 iptr4 = loc(itarg1) 959 iptr5 = loc(itarg2) 960 iptr6 = loc(itarg3) 961 iptr7 = loc(rtarg1) 962 iptr8 = loc(rtarg2) 963 iptr9 = loc(rtarg3) 964 iptr10= loc(chtarg1) 965 iptr11= loc(chtarg2) 966 iptr12= loc(chtarg3) 967 iptr13= loc(ch8targ1) 968 iptr14= loc(ch8targ2) 969 iptr15= loc(ch8targ3) 970 971 972 do, i=1,n 973 dpte1(i)%i1=i 974 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 975 ! Error #109 976 errors(109) = .true. 977 endif 978 979 dtarg1(i)%i1=2*dpte1(i)%i1 980 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 981 ! Error #110 982 errors(110) = .true. 983 endif 984 985 ipte1(i) = i 986 if (intne(ipte1(i), itarg1(i))) then 987 ! Error #111 988 errors(111) = .true. 989 endif 990 991 itarg1(i) = -ipte1(i) 992 if (intne(ipte1(i), itarg1(i))) then 993 ! Error #112 994 errors(112) = .true. 995 endif 996 997 rpte1(i) = i * 5.0 998 if (realne(rpte1(i), rtarg1(i))) then 999 ! Error #113 1000 errors(113) = .true. 1001 endif 1002 1003 rtarg1(i) = i * (-5.0) 1004 if (realne(rpte1(i), rtarg1(i))) then 1005 ! Error #114 1006 errors(114) = .true. 1007 endif 1008 1009 chpte1(i) = 'a' 1010 if (chne(chpte1(i), chtarg1(i))) then 1011 ! Error #115 1012 errors(115) = .true. 1013 endif 1014 1015 chtarg1(i) = 'z' 1016 if (chne(chpte1(i), chtarg1(i))) then 1017 ! Error #116 1018 errors(116) = .true. 1019 endif 1020 1021 ch8pte1(i) = 'aaaaaaaa' 1022 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1023 ! Error #117 1024 errors(117) = .true. 1025 endif 1026 1027 ch8targ1(i) = 'zzzzzzzz' 1028 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1029 ! Error #118 1030 errors(118) = .true. 1031 endif 1032 1033 do, j=1,m 1034 dpte2(j,i)%r1=1.0 1035 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1036 ! Error #119 1037 errors(119) = .true. 1038 endif 1039 1040 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 1041 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1042 ! Error #120 1043 errors(120) = .true. 1044 endif 1045 1046 ipte2(j,i) = i 1047 if (intne(ipte2(j,i), itarg2(j,i))) then 1048 ! Error #121 1049 errors(121) = .true. 1050 endif 1051 1052 itarg2(j,i) = -ipte2(j,i) 1053 if (intne(ipte2(j,i), itarg2(j,i))) then 1054 ! Error #122 1055 errors(122) = .true. 1056 endif 1057 1058 rpte2(j,i) = i * (-2.0) 1059 if (realne(rpte2(j,i), rtarg2(j,i))) then 1060 ! Error #123 1061 errors(123) = .true. 1062 endif 1063 1064 rtarg2(j,i) = i * (-3.0) 1065 if (realne(rpte2(j,i), rtarg2(j,i))) then 1066 ! Error #124 1067 errors(124) = .true. 1068 endif 1069 1070 chpte2(j,i) = 'a' 1071 if (chne(chpte2(j,i), chtarg2(j,i))) then 1072 ! Error #125 1073 errors(125) = .true. 1074 endif 1075 1076 chtarg2(j,i) = 'z' 1077 if (chne(chpte2(j,i), chtarg2(j,i))) then 1078 ! Error #126 1079 errors(126) = .true. 1080 endif 1081 1082 ch8pte2(j,i) = 'aaaaaaaa' 1083 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1084 ! Error #127 1085 errors(127) = .true. 1086 endif 1087 1088 ch8targ2(j,i) = 'zzzzzzzz' 1089 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1090 ! Error #128 1091 errors(128) = .true. 1092 endif 1093 do k=1,o 1094 dpte3(k,j,i)%i2(1+mod(i,5))=i 1095 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1096 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1097 ! Error #129 1098 errors(129) = .true. 1099 endif 1100 1101 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 1102 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1103 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1104 ! Error #130 1105 errors(130) = .true. 1106 endif 1107 1108 ipte3(k,j,i) = i 1109 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1110 ! Error #131 1111 errors(131) = .true. 1112 endif 1113 1114 itarg3(k,j,i) = -ipte3(k,j,i) 1115 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1116 ! Error #132 1117 errors(132) = .true. 1118 endif 1119 1120 rpte3(k,j,i) = i * 2.0 1121 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1122 ! Error #133 1123 errors(133) = .true. 1124 endif 1125 1126 rtarg3(k,j,i) = i * 3.0 1127 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1128 ! Error #134 1129 errors(134) = .true. 1130 endif 1131 1132 chpte3(k,j,i) = 'a' 1133 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1134 ! Error #135 1135 errors(135) = .true. 1136 endif 1137 1138 chtarg3(k,j,i) = 'z' 1139 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1140 ! Error #136 1141 errors(136) = .true. 1142 endif 1143 1144 ch8pte3(k,j,i) = 'aaaaaaaa' 1145 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1146 ! Error #137 1147 errors(137) = .true. 1148 endif 1149 1150 ch8targ3(k,j,i) = 'zzzzzzzz' 1151 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1152 ! Error #138 1153 errors(138) = .true. 1154 endif 1155 end do 1156 end do 1157 end do 1158 1159 rtarg3 = .5 1160 ! Vector syntax 1161 do, i=1,n 1162 ipte3 = i 1163 rpte3 = rpte3+1 1164 do, j=1,m 1165 do k=1,o 1166 if (intne(itarg3(k,j,i), i)) then 1167 ! Error #139 1168 errors(139) = .true. 1169 endif 1170 1171 if (realne(rtarg3(k,j,i), i+.5)) then 1172 ! Error #140 1173 errors(140) = .true. 1174 endif 1175 end do 1176 end do 1177 end do 1178 1179end subroutine ptr4 1180 1181subroutine ptr5 1182 common /errors/errors(400) 1183 logical :: errors, intne, realne, chne, ch8ne 1184 integer :: i,j,k 1185 integer, parameter :: n = 9 1186 integer, parameter :: m = 10 1187 integer, parameter :: o = 11 1188 integer itarg1 (n) 1189 integer itarg2 (m,n) 1190 integer itarg3 (o,m,n) 1191 real rtarg1(n) 1192 real rtarg2(m,n) 1193 real rtarg3(o,m,n) 1194 character chtarg1(n) 1195 character chtarg2(m,n) 1196 character chtarg3(o,m,n) 1197 character*8 ch8targ1(n) 1198 character*8 ch8targ2(m,n) 1199 character*8 ch8targ3(o,m,n) 1200 type drvd 1201 real r1 1202 integer i1 1203 integer i2(5) 1204 end type drvd 1205 type(drvd) dtarg1(n) 1206 type(drvd) dtarg2(m,n) 1207 type(drvd) dtarg3(o,m,n) 1208 1209 type(drvd) dpte1(*) 1210 type(drvd) dpte2(m,*) 1211 type(drvd) dpte3(o,m,*) 1212 integer ipte1 (*) 1213 integer ipte2 (m,*) 1214 integer ipte3 (o,m,*) 1215 real rpte1(*) 1216 real rpte2(m,*) 1217 real rpte3(o,m,*) 1218 character chpte1(*) 1219 character chpte2(m,*) 1220 character chpte3(o,m,*) 1221 character*8 ch8pte1(*) 1222 character*8 ch8pte2(m,*) 1223 character*8 ch8pte3(o,m,*) 1224 1225 pointer(iptr1,dpte1) 1226 pointer(iptr2,dpte2) 1227 pointer(iptr3,dpte3) 1228 pointer(iptr4,ipte1) 1229 pointer(iptr5,ipte2) 1230 pointer(iptr6,ipte3) 1231 pointer(iptr7,rpte1) 1232 pointer(iptr8,rpte2) 1233 pointer(iptr9,rpte3) 1234 pointer(iptr10,chpte1) 1235 pointer(iptr11,chpte2) 1236 pointer(iptr12,chpte3) 1237 pointer(iptr13,ch8pte1) 1238 pointer(iptr14,ch8pte2) 1239 pointer(iptr15,ch8pte3) 1240 1241 iptr1 = loc(dtarg1) 1242 iptr2 = loc(dtarg2) 1243 iptr3 = loc(dtarg3) 1244 iptr4 = loc(itarg1) 1245 iptr5 = loc(itarg2) 1246 iptr6 = loc(itarg3) 1247 iptr7 = loc(rtarg1) 1248 iptr8 = loc(rtarg2) 1249 iptr9 = loc(rtarg3) 1250 iptr10= loc(chtarg1) 1251 iptr11= loc(chtarg2) 1252 iptr12= loc(chtarg3) 1253 iptr13= loc(ch8targ1) 1254 iptr14= loc(ch8targ2) 1255 iptr15= loc(ch8targ3) 1256 1257 1258 do, i=1,n 1259 dpte1(i)%i1=i 1260 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1261 ! Error #141 1262 errors(141) = .true. 1263 endif 1264 1265 dtarg1(i)%i1=2*dpte1(i)%i1 1266 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1267 ! Error #142 1268 errors(142) = .true. 1269 endif 1270 1271 ipte1(i) = i 1272 if (intne(ipte1(i), itarg1(i))) then 1273 ! Error #143 1274 errors(143) = .true. 1275 endif 1276 1277 itarg1(i) = -ipte1(i) 1278 if (intne(ipte1(i), itarg1(i))) then 1279 ! Error #144 1280 errors(144) = .true. 1281 endif 1282 1283 rpte1(i) = i * 5.0 1284 if (realne(rpte1(i), rtarg1(i))) then 1285 ! Error #145 1286 errors(145) = .true. 1287 endif 1288 1289 rtarg1(i) = i * (-5.0) 1290 if (realne(rpte1(i), rtarg1(i))) then 1291 ! Error #146 1292 errors(146) = .true. 1293 endif 1294 1295 chpte1(i) = 'a' 1296 if (chne(chpte1(i), chtarg1(i))) then 1297 ! Error #147 1298 errors(147) = .true. 1299 endif 1300 1301 chtarg1(i) = 'z' 1302 if (chne(chpte1(i), chtarg1(i))) then 1303 ! Error #148 1304 errors(148) = .true. 1305 endif 1306 1307 ch8pte1(i) = 'aaaaaaaa' 1308 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1309 ! Error #149 1310 errors(149) = .true. 1311 endif 1312 1313 ch8targ1(i) = 'zzzzzzzz' 1314 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1315 ! Error #150 1316 errors(150) = .true. 1317 endif 1318 1319 do, j=1,m 1320 dpte2(j,i)%r1=1.0 1321 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1322 ! Error #151 1323 errors(151) = .true. 1324 endif 1325 1326 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 1327 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1328 ! Error #152 1329 errors(152) = .true. 1330 endif 1331 1332 ipte2(j,i) = i 1333 if (intne(ipte2(j,i), itarg2(j,i))) then 1334 ! Error #153 1335 errors(153) = .true. 1336 endif 1337 1338 itarg2(j,i) = -ipte2(j,i) 1339 if (intne(ipte2(j,i), itarg2(j,i))) then 1340 ! Error #154 1341 errors(154) = .true. 1342 endif 1343 1344 rpte2(j,i) = i * (-2.0) 1345 if (realne(rpte2(j,i), rtarg2(j,i))) then 1346 ! Error #155 1347 errors(155) = .true. 1348 endif 1349 1350 rtarg2(j,i) = i * (-3.0) 1351 if (realne(rpte2(j,i), rtarg2(j,i))) then 1352 ! Error #156 1353 errors(156) = .true. 1354 endif 1355 1356 chpte2(j,i) = 'a' 1357 if (chne(chpte2(j,i), chtarg2(j,i))) then 1358 ! Error #157 1359 errors(157) = .true. 1360 endif 1361 1362 chtarg2(j,i) = 'z' 1363 if (chne(chpte2(j,i), chtarg2(j,i))) then 1364 ! Error #158 1365 errors(158) = .true. 1366 endif 1367 1368 ch8pte2(j,i) = 'aaaaaaaa' 1369 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1370 ! Error #159 1371 errors(159) = .true. 1372 endif 1373 1374 ch8targ2(j,i) = 'zzzzzzzz' 1375 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1376 ! Error #160 1377 errors(160) = .true. 1378 endif 1379 do k=1,o 1380 dpte3(k,j,i)%i2(1+mod(i,5))=i 1381 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1382 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1383 ! Error #161 1384 errors(161) = .true. 1385 endif 1386 1387 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 1388 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1389 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1390 ! Error #162 1391 errors(162) = .true. 1392 endif 1393 1394 ipte3(k,j,i) = i 1395 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1396 ! Error #163 1397 errors(163) = .true. 1398 endif 1399 1400 itarg3(k,j,i) = -ipte3(k,j,i) 1401 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1402 ! Error #164 1403 errors(164) = .true. 1404 endif 1405 1406 rpte3(k,j,i) = i * 2.0 1407 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1408 ! Error #165 1409 errors(165) = .true. 1410 endif 1411 1412 rtarg3(k,j,i) = i * 3.0 1413 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1414 ! Error #166 1415 errors(166) = .true. 1416 endif 1417 1418 chpte3(k,j,i) = 'a' 1419 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1420 ! Error #167 1421 errors(167) = .true. 1422 endif 1423 1424 chtarg3(k,j,i) = 'z' 1425 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1426 ! Error #168 1427 errors(168) = .true. 1428 endif 1429 1430 ch8pte3(k,j,i) = 'aaaaaaaa' 1431 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1432 ! Error #169 1433 errors(169) = .true. 1434 endif 1435 1436 ch8targ3(k,j,i) = 'zzzzzzzz' 1437 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1438 ! Error #170 1439 errors(170) = .true. 1440 endif 1441 end do 1442 end do 1443 end do 1444 1445end subroutine ptr5 1446 1447 1448subroutine ptr6 1449 common /errors/errors(400) 1450 logical :: errors, intne, realne, chne, ch8ne 1451 integer :: i,j,k 1452 integer, parameter :: n = 9 1453 integer, parameter :: m = 10 1454 integer, parameter :: o = 11 1455 integer itarg1 (n) 1456 integer itarg2 (m,n) 1457 integer itarg3 (o,m,n) 1458 real rtarg1(n) 1459 real rtarg2(m,n) 1460 real rtarg3(o,m,n) 1461 character chtarg1(n) 1462 character chtarg2(m,n) 1463 character chtarg3(o,m,n) 1464 character*8 ch8targ1(n) 1465 character*8 ch8targ2(m,n) 1466 character*8 ch8targ3(o,m,n) 1467 type drvd 1468 real r1 1469 integer i1 1470 integer i2(5) 1471 end type drvd 1472 type(drvd) dtarg1(n) 1473 type(drvd) dtarg2(m,n) 1474 type(drvd) dtarg3(o,m,n) 1475 1476 type(drvd) dpte1 1477 type(drvd) dpte2 1478 type(drvd) dpte3 1479 integer ipte1 1480 integer ipte2 1481 integer ipte3 1482 real rpte1 1483 real rpte2 1484 real rpte3 1485 character chpte1 1486 character chpte2 1487 character chpte3 1488 character*8 ch8pte1 1489 character*8 ch8pte2 1490 character*8 ch8pte3 1491 1492 pointer(iptr1,dpte1(*)) 1493 pointer(iptr2,dpte2(m,*)) 1494 pointer(iptr3,dpte3(o,m,*)) 1495 pointer(iptr4,ipte1(*)) 1496 pointer(iptr5,ipte2 (m,*)) 1497 pointer(iptr6,ipte3(o,m,*)) 1498 pointer(iptr7,rpte1(*)) 1499 pointer(iptr8,rpte2(m,*)) 1500 pointer(iptr9,rpte3(o,m,*)) 1501 pointer(iptr10,chpte1(*)) 1502 pointer(iptr11,chpte2(m,*)) 1503 pointer(iptr12,chpte3(o,m,*)) 1504 pointer(iptr13,ch8pte1(*)) 1505 pointer(iptr14,ch8pte2(m,*)) 1506 pointer(iptr15,ch8pte3(o,m,*)) 1507 1508 iptr1 = loc(dtarg1) 1509 iptr2 = loc(dtarg2) 1510 iptr3 = loc(dtarg3) 1511 iptr4 = loc(itarg1) 1512 iptr5 = loc(itarg2) 1513 iptr6 = loc(itarg3) 1514 iptr7 = loc(rtarg1) 1515 iptr8 = loc(rtarg2) 1516 iptr9 = loc(rtarg3) 1517 iptr10= loc(chtarg1) 1518 iptr11= loc(chtarg2) 1519 iptr12= loc(chtarg3) 1520 iptr13= loc(ch8targ1) 1521 iptr14= loc(ch8targ2) 1522 iptr15= loc(ch8targ3) 1523 1524 do, i=1,n 1525 dpte1(i)%i1=i 1526 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1527 ! Error #171 1528 errors(171) = .true. 1529 endif 1530 1531 dtarg1(i)%i1=2*dpte1(i)%i1 1532 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1533 ! Error #172 1534 errors(172) = .true. 1535 endif 1536 1537 ipte1(i) = i 1538 if (intne(ipte1(i), itarg1(i))) then 1539 ! Error #173 1540 errors(173) = .true. 1541 endif 1542 1543 itarg1(i) = -ipte1(i) 1544 if (intne(ipte1(i), itarg1(i))) then 1545 ! Error #174 1546 errors(174) = .true. 1547 endif 1548 1549 rpte1(i) = i * 5.0 1550 if (realne(rpte1(i), rtarg1(i))) then 1551 ! Error #175 1552 errors(175) = .true. 1553 endif 1554 1555 rtarg1(i) = i * (-5.0) 1556 if (realne(rpte1(i), rtarg1(i))) then 1557 ! Error #176 1558 errors(176) = .true. 1559 endif 1560 1561 chpte1(i) = 'a' 1562 if (chne(chpte1(i), chtarg1(i))) then 1563 ! Error #177 1564 errors(177) = .true. 1565 endif 1566 1567 chtarg1(i) = 'z' 1568 if (chne(chpte1(i), chtarg1(i))) then 1569 ! Error #178 1570 errors(178) = .true. 1571 endif 1572 1573 ch8pte1(i) = 'aaaaaaaa' 1574 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1575 ! Error #179 1576 errors(179) = .true. 1577 endif 1578 1579 ch8targ1(i) = 'zzzzzzzz' 1580 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1581 ! Error #180 1582 errors(180) = .true. 1583 endif 1584 1585 do, j=1,m 1586 dpte2(j,i)%r1=1.0 1587 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1588 ! Error #181 1589 errors(181) = .true. 1590 endif 1591 1592 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 1593 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1594 ! Error #182 1595 errors(182) = .true. 1596 endif 1597 1598 ipte2(j,i) = i 1599 if (intne(ipte2(j,i), itarg2(j,i))) then 1600 ! Error #183 1601 errors(183) = .true. 1602 endif 1603 1604 itarg2(j,i) = -ipte2(j,i) 1605 if (intne(ipte2(j,i), itarg2(j,i))) then 1606 ! Error #184 1607 errors(184) = .true. 1608 endif 1609 1610 rpte2(j,i) = i * (-2.0) 1611 if (realne(rpte2(j,i), rtarg2(j,i))) then 1612 ! Error #185 1613 errors(185) = .true. 1614 endif 1615 1616 rtarg2(j,i) = i * (-3.0) 1617 if (realne(rpte2(j,i), rtarg2(j,i))) then 1618 ! Error #186 1619 errors(186) = .true. 1620 endif 1621 1622 chpte2(j,i) = 'a' 1623 if (chne(chpte2(j,i), chtarg2(j,i))) then 1624 ! Error #187 1625 errors(187) = .true. 1626 endif 1627 1628 chtarg2(j,i) = 'z' 1629 if (chne(chpte2(j,i), chtarg2(j,i))) then 1630 ! Error #188 1631 errors(188) = .true. 1632 endif 1633 1634 ch8pte2(j,i) = 'aaaaaaaa' 1635 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1636 ! Error #189 1637 errors(189) = .true. 1638 endif 1639 1640 ch8targ2(j,i) = 'zzzzzzzz' 1641 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1642 ! Error #190 1643 errors(190) = .true. 1644 endif 1645 do k=1,o 1646 dpte3(k,j,i)%i2(1+mod(i,5))=i 1647 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1648 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1649 ! Error #191 1650 errors(191) = .true. 1651 endif 1652 1653 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 1654 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1655 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1656 ! Error #192 1657 errors(192) = .true. 1658 endif 1659 1660 ipte3(k,j,i) = i 1661 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1662 ! Error #193 1663 errors(193) = .true. 1664 endif 1665 1666 itarg3(k,j,i) = -ipte3(k,j,i) 1667 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1668 ! Error #194 1669 errors(194) = .true. 1670 endif 1671 1672 rpte3(k,j,i) = i * 2.0 1673 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1674 ! Error #195 1675 errors(195) = .true. 1676 endif 1677 1678 rtarg3(k,j,i) = i * 3.0 1679 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1680 ! Error #196 1681 errors(196) = .true. 1682 endif 1683 1684 chpte3(k,j,i) = 'a' 1685 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1686 ! Error #197 1687 errors(197) = .true. 1688 endif 1689 1690 chtarg3(k,j,i) = 'z' 1691 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1692 ! Error #198 1693 errors(198) = .true. 1694 endif 1695 1696 ch8pte3(k,j,i) = 'aaaaaaaa' 1697 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1698 ! Error #199 1699 errors(199) = .true. 1700 endif 1701 1702 ch8targ3(k,j,i) = 'zzzzzzzz' 1703 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1704 ! Error #200 1705 errors(200) = .true. 1706 endif 1707 end do 1708 end do 1709 end do 1710 1711end subroutine ptr6 1712 1713subroutine ptr7 1714 common /errors/errors(400) 1715 logical :: errors, intne, realne, chne, ch8ne 1716 integer :: i,j,k 1717 integer, parameter :: n = 9 1718 integer, parameter :: m = 10 1719 integer, parameter :: o = 11 1720 integer itarg1 (n) 1721 integer itarg2 (m,n) 1722 integer itarg3 (o,m,n) 1723 real rtarg1(n) 1724 real rtarg2(m,n) 1725 real rtarg3(o,m,n) 1726 character chtarg1(n) 1727 character chtarg2(m,n) 1728 character chtarg3(o,m,n) 1729 character*8 ch8targ1(n) 1730 character*8 ch8targ2(m,n) 1731 character*8 ch8targ3(o,m,n) 1732 type drvd 1733 real r1 1734 integer i1 1735 integer i2(5) 1736 end type drvd 1737 type(drvd) dtarg1(n) 1738 type(drvd) dtarg2(m,n) 1739 type(drvd) dtarg3(o,m,n) 1740 1741 pointer(iptr1,dpte1(*)) 1742 pointer(iptr2,dpte2(m,*)) 1743 pointer(iptr3,dpte3(o,m,*)) 1744 pointer(iptr4,ipte1(*)) 1745 pointer(iptr5,ipte2 (m,*)) 1746 pointer(iptr6,ipte3(o,m,*)) 1747 pointer(iptr7,rpte1(*)) 1748 pointer(iptr8,rpte2(m,*)) 1749 pointer(iptr9,rpte3(o,m,*)) 1750 pointer(iptr10,chpte1(*)) 1751 pointer(iptr11,chpte2(m,*)) 1752 pointer(iptr12,chpte3(o,m,*)) 1753 pointer(iptr13,ch8pte1(*)) 1754 pointer(iptr14,ch8pte2(m,*)) 1755 pointer(iptr15,ch8pte3(o,m,*)) 1756 1757 type(drvd) dpte1 1758 type(drvd) dpte2 1759 type(drvd) dpte3 1760 integer ipte1 1761 integer ipte2 1762 integer ipte3 1763 real rpte1 1764 real rpte2 1765 real rpte3 1766 character chpte1 1767 character chpte2 1768 character chpte3 1769 character*8 ch8pte1 1770 character*8 ch8pte2 1771 character*8 ch8pte3 1772 1773 iptr1 = loc(dtarg1) 1774 iptr2 = loc(dtarg2) 1775 iptr3 = loc(dtarg3) 1776 iptr4 = loc(itarg1) 1777 iptr5 = loc(itarg2) 1778 iptr6 = loc(itarg3) 1779 iptr7 = loc(rtarg1) 1780 iptr8 = loc(rtarg2) 1781 iptr9 = loc(rtarg3) 1782 iptr10= loc(chtarg1) 1783 iptr11= loc(chtarg2) 1784 iptr12= loc(chtarg3) 1785 iptr13= loc(ch8targ1) 1786 iptr14= loc(ch8targ2) 1787 iptr15= loc(ch8targ3) 1788 1789 do, i=1,n 1790 dpte1(i)%i1=i 1791 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1792 ! Error #201 1793 errors(201) = .true. 1794 endif 1795 1796 dtarg1(i)%i1=2*dpte1(i)%i1 1797 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 1798 ! Error #202 1799 errors(202) = .true. 1800 endif 1801 1802 ipte1(i) = i 1803 if (intne(ipte1(i), itarg1(i))) then 1804 ! Error #203 1805 errors(203) = .true. 1806 endif 1807 1808 itarg1(i) = -ipte1(i) 1809 if (intne(ipte1(i), itarg1(i))) then 1810 ! Error #204 1811 errors(204) = .true. 1812 endif 1813 1814 rpte1(i) = i * 5.0 1815 if (realne(rpte1(i), rtarg1(i))) then 1816 ! Error #205 1817 errors(205) = .true. 1818 endif 1819 1820 rtarg1(i) = i * (-5.0) 1821 if (realne(rpte1(i), rtarg1(i))) then 1822 ! Error #206 1823 errors(206) = .true. 1824 endif 1825 1826 chpte1(i) = 'a' 1827 if (chne(chpte1(i), chtarg1(i))) then 1828 ! Error #207 1829 errors(207) = .true. 1830 endif 1831 1832 chtarg1(i) = 'z' 1833 if (chne(chpte1(i), chtarg1(i))) then 1834 ! Error #208 1835 errors(208) = .true. 1836 endif 1837 1838 ch8pte1(i) = 'aaaaaaaa' 1839 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1840 ! Error #209 1841 errors(209) = .true. 1842 endif 1843 1844 ch8targ1(i) = 'zzzzzzzz' 1845 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 1846 ! Error #210 1847 errors(210) = .true. 1848 endif 1849 1850 do, j=1,m 1851 dpte2(j,i)%r1=1.0 1852 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1853 ! Error #211 1854 errors(211) = .true. 1855 endif 1856 1857 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 1858 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 1859 ! Error #212 1860 errors(212) = .true. 1861 endif 1862 1863 ipte2(j,i) = i 1864 if (intne(ipte2(j,i), itarg2(j,i))) then 1865 ! Error #213 1866 errors(213) = .true. 1867 endif 1868 1869 itarg2(j,i) = -ipte2(j,i) 1870 if (intne(ipte2(j,i), itarg2(j,i))) then 1871 ! Error #214 1872 errors(214) = .true. 1873 endif 1874 1875 rpte2(j,i) = i * (-2.0) 1876 if (realne(rpte2(j,i), rtarg2(j,i))) then 1877 ! Error #215 1878 errors(215) = .true. 1879 endif 1880 1881 rtarg2(j,i) = i * (-3.0) 1882 if (realne(rpte2(j,i), rtarg2(j,i))) then 1883 ! Error #216 1884 errors(216) = .true. 1885 endif 1886 1887 chpte2(j,i) = 'a' 1888 if (chne(chpte2(j,i), chtarg2(j,i))) then 1889 ! Error #217 1890 errors(217) = .true. 1891 endif 1892 1893 chtarg2(j,i) = 'z' 1894 if (chne(chpte2(j,i), chtarg2(j,i))) then 1895 ! Error #218 1896 errors(218) = .true. 1897 endif 1898 1899 ch8pte2(j,i) = 'aaaaaaaa' 1900 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1901 ! Error #219 1902 errors(219) = .true. 1903 endif 1904 1905 ch8targ2(j,i) = 'zzzzzzzz' 1906 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 1907 ! Error #220 1908 errors(220) = .true. 1909 endif 1910 do k=1,o 1911 dpte3(k,j,i)%i2(1+mod(i,5))=i 1912 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1913 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1914 ! Error #221 1915 errors(221) = .true. 1916 endif 1917 1918 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 1919 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 1920 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 1921 ! Error #222 1922 errors(222) = .true. 1923 endif 1924 1925 ipte3(k,j,i) = i 1926 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1927 ! Error #223 1928 errors(223) = .true. 1929 endif 1930 1931 itarg3(k,j,i) = -ipte3(k,j,i) 1932 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 1933 ! Error #224 1934 errors(224) = .true. 1935 endif 1936 1937 rpte3(k,j,i) = i * 2.0 1938 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1939 ! Error #225 1940 errors(225) = .true. 1941 endif 1942 1943 rtarg3(k,j,i) = i * 3.0 1944 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 1945 ! Error #226 1946 errors(226) = .true. 1947 endif 1948 1949 chpte3(k,j,i) = 'a' 1950 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1951 ! Error #227 1952 errors(227) = .true. 1953 endif 1954 1955 chtarg3(k,j,i) = 'z' 1956 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 1957 ! Error #228 1958 errors(228) = .true. 1959 endif 1960 1961 ch8pte3(k,j,i) = 'aaaaaaaa' 1962 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1963 ! Error #229 1964 errors(229) = .true. 1965 endif 1966 1967 ch8targ3(k,j,i) = 'zzzzzzzz' 1968 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 1969 ! Error #230 1970 errors(230) = .true. 1971 endif 1972 end do 1973 end do 1974 end do 1975 1976end subroutine ptr7 1977 1978subroutine ptr8 1979 common /errors/errors(400) 1980 logical :: errors, intne, realne, chne, ch8ne 1981 integer :: i,j,k 1982 integer, parameter :: n = 9 1983 integer, parameter :: m = 10 1984 integer, parameter :: o = 11 1985 integer itarg1 (n) 1986 integer itarg2 (m,n) 1987 integer itarg3 (o,m,n) 1988 real rtarg1(n) 1989 real rtarg2(m,n) 1990 real rtarg3(o,m,n) 1991 character chtarg1(n) 1992 character chtarg2(m,n) 1993 character chtarg3(o,m,n) 1994 character*8 ch8targ1(n) 1995 character*8 ch8targ2(m,n) 1996 character*8 ch8targ3(o,m,n) 1997 type drvd 1998 real r1 1999 integer i1 2000 integer i2(5) 2001 end type drvd 2002 type(drvd) dtarg1(n) 2003 type(drvd) dtarg2(m,n) 2004 type(drvd) dtarg3(o,m,n) 2005 2006 pointer(iptr1,dpte1) 2007 pointer(iptr2,dpte2) 2008 pointer(iptr3,dpte3) 2009 pointer(iptr4,ipte1) 2010 pointer(iptr5,ipte2) 2011 pointer(iptr6,ipte3) 2012 pointer(iptr7,rpte1) 2013 pointer(iptr8,rpte2) 2014 pointer(iptr9,rpte3) 2015 pointer(iptr10,chpte1) 2016 pointer(iptr11,chpte2) 2017 pointer(iptr12,chpte3) 2018 pointer(iptr13,ch8pte1) 2019 pointer(iptr14,ch8pte2) 2020 pointer(iptr15,ch8pte3) 2021 2022 type(drvd) dpte1(*) 2023 type(drvd) dpte2(m,*) 2024 type(drvd) dpte3(o,m,*) 2025 integer ipte1 (*) 2026 integer ipte2 (m,*) 2027 integer ipte3 (o,m,*) 2028 real rpte1(*) 2029 real rpte2(m,*) 2030 real rpte3(o,m,*) 2031 character chpte1(*) 2032 character chpte2(m,*) 2033 character chpte3(o,m,*) 2034 character*8 ch8pte1(*) 2035 character*8 ch8pte2(m,*) 2036 character*8 ch8pte3(o,m,*) 2037 2038 iptr1 = loc(dtarg1) 2039 iptr2 = loc(dtarg2) 2040 iptr3 = loc(dtarg3) 2041 iptr4 = loc(itarg1) 2042 iptr5 = loc(itarg2) 2043 iptr6 = loc(itarg3) 2044 iptr7 = loc(rtarg1) 2045 iptr8 = loc(rtarg2) 2046 iptr9 = loc(rtarg3) 2047 iptr10= loc(chtarg1) 2048 iptr11= loc(chtarg2) 2049 iptr12= loc(chtarg3) 2050 iptr13= loc(ch8targ1) 2051 iptr14= loc(ch8targ2) 2052 iptr15= loc(ch8targ3) 2053 2054 2055 do, i=1,n 2056 dpte1(i)%i1=i 2057 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2058 ! Error #231 2059 errors(231) = .true. 2060 endif 2061 2062 dtarg1(i)%i1=2*dpte1(i)%i1 2063 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2064 ! Error #232 2065 errors(232) = .true. 2066 endif 2067 2068 ipte1(i) = i 2069 if (intne(ipte1(i), itarg1(i))) then 2070 ! Error #233 2071 errors(233) = .true. 2072 endif 2073 2074 itarg1(i) = -ipte1(i) 2075 if (intne(ipte1(i), itarg1(i))) then 2076 ! Error #234 2077 errors(234) = .true. 2078 endif 2079 2080 rpte1(i) = i * 5.0 2081 if (realne(rpte1(i), rtarg1(i))) then 2082 ! Error #235 2083 errors(235) = .true. 2084 endif 2085 2086 rtarg1(i) = i * (-5.0) 2087 if (realne(rpte1(i), rtarg1(i))) then 2088 ! Error #236 2089 errors(236) = .true. 2090 endif 2091 2092 chpte1(i) = 'a' 2093 if (chne(chpte1(i), chtarg1(i))) then 2094 ! Error #237 2095 errors(237) = .true. 2096 endif 2097 2098 chtarg1(i) = 'z' 2099 if (chne(chpte1(i), chtarg1(i))) then 2100 ! Error #238 2101 errors(238) = .true. 2102 endif 2103 2104 ch8pte1(i) = 'aaaaaaaa' 2105 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2106 ! Error #239 2107 errors(239) = .true. 2108 endif 2109 2110 ch8targ1(i) = 'zzzzzzzz' 2111 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2112 ! Error #240 2113 errors(240) = .true. 2114 endif 2115 2116 do, j=1,m 2117 dpte2(j,i)%r1=1.0 2118 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2119 ! Error #241 2120 errors(241) = .true. 2121 endif 2122 2123 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 2124 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2125 ! Error #242 2126 errors(242) = .true. 2127 endif 2128 2129 ipte2(j,i) = i 2130 if (intne(ipte2(j,i), itarg2(j,i))) then 2131 ! Error #243 2132 errors(243) = .true. 2133 endif 2134 2135 itarg2(j,i) = -ipte2(j,i) 2136 if (intne(ipte2(j,i), itarg2(j,i))) then 2137 ! Error #244 2138 errors(244) = .true. 2139 endif 2140 2141 rpte2(j,i) = i * (-2.0) 2142 if (realne(rpte2(j,i), rtarg2(j,i))) then 2143 ! Error #245 2144 errors(245) = .true. 2145 endif 2146 2147 rtarg2(j,i) = i * (-3.0) 2148 if (realne(rpte2(j,i), rtarg2(j,i))) then 2149 ! Error #246 2150 errors(246) = .true. 2151 endif 2152 2153 chpte2(j,i) = 'a' 2154 if (chne(chpte2(j,i), chtarg2(j,i))) then 2155 ! Error #247 2156 errors(247) = .true. 2157 endif 2158 2159 chtarg2(j,i) = 'z' 2160 if (chne(chpte2(j,i), chtarg2(j,i))) then 2161 ! Error #248 2162 errors(248) = .true. 2163 endif 2164 2165 ch8pte2(j,i) = 'aaaaaaaa' 2166 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2167 ! Error #249 2168 errors(249) = .true. 2169 endif 2170 2171 ch8targ2(j,i) = 'zzzzzzzz' 2172 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2173 ! Error #250 2174 errors(250) = .true. 2175 endif 2176 do k=1,o 2177 dpte3(k,j,i)%i2(1+mod(i,5))=i 2178 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2179 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2180 ! Error #251 2181 errors(251) = .true. 2182 endif 2183 2184 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 2185 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2186 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2187 ! Error #252 2188 errors(252) = .true. 2189 endif 2190 2191 ipte3(k,j,i) = i 2192 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2193 ! Error #253 2194 errors(253) = .true. 2195 endif 2196 2197 itarg3(k,j,i) = -ipte3(k,j,i) 2198 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2199 ! Error #254 2200 errors(254) = .true. 2201 endif 2202 2203 rpte3(k,j,i) = i * 2.0 2204 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2205 ! Error #255 2206 errors(255) = .true. 2207 endif 2208 2209 rtarg3(k,j,i) = i * 3.0 2210 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2211 ! Error #256 2212 errors(256) = .true. 2213 endif 2214 2215 chpte3(k,j,i) = 'a' 2216 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2217 ! Error #257 2218 errors(257) = .true. 2219 endif 2220 2221 chtarg3(k,j,i) = 'z' 2222 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2223 ! Error #258 2224 errors(258) = .true. 2225 endif 2226 2227 ch8pte3(k,j,i) = 'aaaaaaaa' 2228 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2229 ! Error #259 2230 errors(259) = .true. 2231 endif 2232 2233 ch8targ3(k,j,i) = 'zzzzzzzz' 2234 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2235 ! Error #260 2236 errors(260) = .true. 2237 endif 2238 end do 2239 end do 2240 end do 2241end subroutine ptr8 2242 2243 2244subroutine ptr9(nnn,mmm,ooo) 2245 common /errors/errors(400) 2246 logical :: errors, intne, realne, chne, ch8ne 2247 integer :: i,j,k 2248 integer :: nnn,mmm,ooo 2249 integer, parameter :: n = 9 2250 integer, parameter :: m = 10 2251 integer, parameter :: o = 11 2252 integer itarg1 (n) 2253 integer itarg2 (m,n) 2254 integer itarg3 (o,m,n) 2255 real rtarg1(n) 2256 real rtarg2(m,n) 2257 real rtarg3(o,m,n) 2258 character chtarg1(n) 2259 character chtarg2(m,n) 2260 character chtarg3(o,m,n) 2261 character*8 ch8targ1(n) 2262 character*8 ch8targ2(m,n) 2263 character*8 ch8targ3(o,m,n) 2264 type drvd 2265 real r1 2266 integer i1 2267 integer i2(5) 2268 end type drvd 2269 type(drvd) dtarg1(n) 2270 type(drvd) dtarg2(m,n) 2271 type(drvd) dtarg3(o,m,n) 2272 2273 type(drvd) dpte1(nnn) 2274 type(drvd) dpte2(mmm,nnn) 2275 type(drvd) dpte3(ooo,mmm,nnn) 2276 integer ipte1 (nnn) 2277 integer ipte2 (mmm,nnn) 2278 integer ipte3 (ooo,mmm,nnn) 2279 real rpte1(nnn) 2280 real rpte2(mmm,nnn) 2281 real rpte3(ooo,mmm,nnn) 2282 character chpte1(nnn) 2283 character chpte2(mmm,nnn) 2284 character chpte3(ooo,mmm,nnn) 2285 character*8 ch8pte1(nnn) 2286 character*8 ch8pte2(mmm,nnn) 2287 character*8 ch8pte3(ooo,mmm,nnn) 2288 2289 pointer(iptr1,dpte1) 2290 pointer(iptr2,dpte2) 2291 pointer(iptr3,dpte3) 2292 pointer(iptr4,ipte1) 2293 pointer(iptr5,ipte2) 2294 pointer(iptr6,ipte3) 2295 pointer(iptr7,rpte1) 2296 pointer(iptr8,rpte2) 2297 pointer(iptr9,rpte3) 2298 pointer(iptr10,chpte1) 2299 pointer(iptr11,chpte2) 2300 pointer(iptr12,chpte3) 2301 pointer(iptr13,ch8pte1) 2302 pointer(iptr14,ch8pte2) 2303 pointer(iptr15,ch8pte3) 2304 2305 iptr1 = loc(dtarg1) 2306 iptr2 = loc(dtarg2) 2307 iptr3 = loc(dtarg3) 2308 iptr4 = loc(itarg1) 2309 iptr5 = loc(itarg2) 2310 iptr6 = loc(itarg3) 2311 iptr7 = loc(rtarg1) 2312 iptr8 = loc(rtarg2) 2313 iptr9 = loc(rtarg3) 2314 iptr10= loc(chtarg1) 2315 iptr11= loc(chtarg2) 2316 iptr12= loc(chtarg3) 2317 iptr13= loc(ch8targ1) 2318 iptr14= loc(ch8targ2) 2319 iptr15= loc(ch8targ3) 2320 2321 2322 do, i=1,n 2323 dpte1(i)%i1=i 2324 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2325 ! Error #261 2326 errors(261) = .true. 2327 endif 2328 2329 dtarg1(i)%i1=2*dpte1(i)%i1 2330 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2331 ! Error #262 2332 errors(262) = .true. 2333 endif 2334 2335 ipte1(i) = i 2336 if (intne(ipte1(i), itarg1(i))) then 2337 ! Error #263 2338 errors(263) = .true. 2339 endif 2340 2341 itarg1(i) = -ipte1(i) 2342 if (intne(ipte1(i), itarg1(i))) then 2343 ! Error #264 2344 errors(264) = .true. 2345 endif 2346 2347 rpte1(i) = i * 5.0 2348 if (realne(rpte1(i), rtarg1(i))) then 2349 ! Error #265 2350 errors(265) = .true. 2351 endif 2352 2353 rtarg1(i) = i * (-5.0) 2354 if (realne(rpte1(i), rtarg1(i))) then 2355 ! Error #266 2356 errors(266) = .true. 2357 endif 2358 2359 chpte1(i) = 'a' 2360 if (chne(chpte1(i), chtarg1(i))) then 2361 ! Error #267 2362 errors(267) = .true. 2363 endif 2364 2365 chtarg1(i) = 'z' 2366 if (chne(chpte1(i), chtarg1(i))) then 2367 ! Error #268 2368 errors(268) = .true. 2369 endif 2370 2371 ch8pte1(i) = 'aaaaaaaa' 2372 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2373 ! Error #269 2374 errors(269) = .true. 2375 endif 2376 2377 ch8targ1(i) = 'zzzzzzzz' 2378 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2379 ! Error #270 2380 errors(270) = .true. 2381 endif 2382 2383 do, j=1,m 2384 dpte2(j,i)%r1=1.0 2385 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2386 ! Error #271 2387 errors(271) = .true. 2388 endif 2389 2390 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 2391 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2392 ! Error #272 2393 errors(272) = .true. 2394 endif 2395 2396 ipte2(j,i) = i 2397 if (intne(ipte2(j,i), itarg2(j,i))) then 2398 ! Error #273 2399 errors(273) = .true. 2400 endif 2401 2402 itarg2(j,i) = -ipte2(j,i) 2403 if (intne(ipte2(j,i), itarg2(j,i))) then 2404 ! Error #274 2405 errors(274) = .true. 2406 endif 2407 2408 rpte2(j,i) = i * (-2.0) 2409 if (realne(rpte2(j,i), rtarg2(j,i))) then 2410 ! Error #275 2411 errors(275) = .true. 2412 endif 2413 2414 rtarg2(j,i) = i * (-3.0) 2415 if (realne(rpte2(j,i), rtarg2(j,i))) then 2416 ! Error #276 2417 errors(276) = .true. 2418 endif 2419 2420 chpte2(j,i) = 'a' 2421 if (chne(chpte2(j,i), chtarg2(j,i))) then 2422 ! Error #277 2423 errors(277) = .true. 2424 endif 2425 2426 chtarg2(j,i) = 'z' 2427 if (chne(chpte2(j,i), chtarg2(j,i))) then 2428 ! Error #278 2429 errors(278) = .true. 2430 endif 2431 2432 ch8pte2(j,i) = 'aaaaaaaa' 2433 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2434 ! Error #279 2435 errors(279) = .true. 2436 endif 2437 2438 ch8targ2(j,i) = 'zzzzzzzz' 2439 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2440 ! Error #280 2441 errors(280) = .true. 2442 endif 2443 do k=1,o 2444 dpte3(k,j,i)%i2(1+mod(i,5))=i 2445 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2446 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2447 ! Error #281 2448 errors(281) = .true. 2449 endif 2450 2451 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 2452 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2453 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2454 ! Error #282 2455 errors(282) = .true. 2456 endif 2457 2458 ipte3(k,j,i) = i 2459 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2460 ! Error #283 2461 errors(283) = .true. 2462 endif 2463 2464 itarg3(k,j,i) = -ipte3(k,j,i) 2465 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2466 ! Error #284 2467 errors(284) = .true. 2468 endif 2469 2470 rpte3(k,j,i) = i * 2.0 2471 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2472 ! Error #285 2473 errors(285) = .true. 2474 endif 2475 2476 rtarg3(k,j,i) = i * 3.0 2477 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2478 ! Error #286 2479 errors(286) = .true. 2480 endif 2481 2482 chpte3(k,j,i) = 'a' 2483 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2484 ! Error #287 2485 errors(287) = .true. 2486 endif 2487 2488 chtarg3(k,j,i) = 'z' 2489 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2490 ! Error #288 2491 errors(288) = .true. 2492 endif 2493 2494 ch8pte3(k,j,i) = 'aaaaaaaa' 2495 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2496 ! Error #289 2497 errors(289) = .true. 2498 endif 2499 2500 ch8targ3(k,j,i) = 'zzzzzzzz' 2501 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2502 ! Error #290 2503 errors(290) = .true. 2504 endif 2505 end do 2506 end do 2507 end do 2508 2509 rtarg3 = .5 2510 ! Vector syntax 2511 do, i=1,n 2512 ipte3 = i 2513 rpte3 = rpte3+1 2514 do, j=1,m 2515 do k=1,o 2516 if (intne(itarg3(k,j,i), i)) then 2517 ! Error #291 2518 errors(291) = .true. 2519 endif 2520 2521 if (realne(rtarg3(k,j,i), i+.5)) then 2522 ! Error #292 2523 errors(292) = .true. 2524 endif 2525 end do 2526 end do 2527 end do 2528 2529end subroutine ptr9 2530 2531subroutine ptr10(nnn,mmm,ooo) 2532 common /errors/errors(400) 2533 logical :: errors, intne, realne, chne, ch8ne 2534 integer :: i,j,k 2535 integer :: nnn,mmm,ooo 2536 integer, parameter :: n = 9 2537 integer, parameter :: m = 10 2538 integer, parameter :: o = 11 2539 integer itarg1 (n) 2540 integer itarg2 (m,n) 2541 integer itarg3 (o,m,n) 2542 real rtarg1(n) 2543 real rtarg2(m,n) 2544 real rtarg3(o,m,n) 2545 character chtarg1(n) 2546 character chtarg2(m,n) 2547 character chtarg3(o,m,n) 2548 character*8 ch8targ1(n) 2549 character*8 ch8targ2(m,n) 2550 character*8 ch8targ3(o,m,n) 2551 type drvd 2552 real r1 2553 integer i1 2554 integer i2(5) 2555 end type drvd 2556 type(drvd) dtarg1(n) 2557 type(drvd) dtarg2(m,n) 2558 type(drvd) dtarg3(o,m,n) 2559 2560 type(drvd) dpte1 2561 type(drvd) dpte2 2562 type(drvd) dpte3 2563 integer ipte1 2564 integer ipte2 2565 integer ipte3 2566 real rpte1 2567 real rpte2 2568 real rpte3 2569 character chpte1 2570 character chpte2 2571 character chpte3 2572 character*8 ch8pte1 2573 character*8 ch8pte2 2574 character*8 ch8pte3 2575 2576 pointer(iptr1,dpte1(nnn)) 2577 pointer(iptr2,dpte2(mmm,nnn)) 2578 pointer(iptr3,dpte3(ooo,mmm,nnn)) 2579 pointer(iptr4,ipte1(nnn)) 2580 pointer(iptr5,ipte2 (mmm,nnn)) 2581 pointer(iptr6,ipte3(ooo,mmm,nnn)) 2582 pointer(iptr7,rpte1(nnn)) 2583 pointer(iptr8,rpte2(mmm,nnn)) 2584 pointer(iptr9,rpte3(ooo,mmm,nnn)) 2585 pointer(iptr10,chpte1(nnn)) 2586 pointer(iptr11,chpte2(mmm,nnn)) 2587 pointer(iptr12,chpte3(ooo,mmm,nnn)) 2588 pointer(iptr13,ch8pte1(nnn)) 2589 pointer(iptr14,ch8pte2(mmm,nnn)) 2590 pointer(iptr15,ch8pte3(ooo,mmm,nnn)) 2591 2592 iptr1 = loc(dtarg1) 2593 iptr2 = loc(dtarg2) 2594 iptr3 = loc(dtarg3) 2595 iptr4 = loc(itarg1) 2596 iptr5 = loc(itarg2) 2597 iptr6 = loc(itarg3) 2598 iptr7 = loc(rtarg1) 2599 iptr8 = loc(rtarg2) 2600 iptr9 = loc(rtarg3) 2601 iptr10= loc(chtarg1) 2602 iptr11= loc(chtarg2) 2603 iptr12= loc(chtarg3) 2604 iptr13= loc(ch8targ1) 2605 iptr14= loc(ch8targ2) 2606 iptr15= loc(ch8targ3) 2607 2608 do, i=1,n 2609 dpte1(i)%i1=i 2610 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2611 ! Error #293 2612 errors(293) = .true. 2613 endif 2614 2615 dtarg1(i)%i1=2*dpte1(i)%i1 2616 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2617 ! Error #294 2618 errors(294) = .true. 2619 endif 2620 2621 ipte1(i) = i 2622 if (intne(ipte1(i), itarg1(i))) then 2623 ! Error #295 2624 errors(295) = .true. 2625 endif 2626 2627 itarg1(i) = -ipte1(i) 2628 if (intne(ipte1(i), itarg1(i))) then 2629 ! Error #296 2630 errors(296) = .true. 2631 endif 2632 2633 rpte1(i) = i * 5.0 2634 if (realne(rpte1(i), rtarg1(i))) then 2635 ! Error #297 2636 errors(297) = .true. 2637 endif 2638 2639 rtarg1(i) = i * (-5.0) 2640 if (realne(rpte1(i), rtarg1(i))) then 2641 ! Error #298 2642 errors(298) = .true. 2643 endif 2644 2645 chpte1(i) = 'a' 2646 if (chne(chpte1(i), chtarg1(i))) then 2647 ! Error #299 2648 errors(299) = .true. 2649 endif 2650 2651 chtarg1(i) = 'z' 2652 if (chne(chpte1(i), chtarg1(i))) then 2653 ! Error #300 2654 errors(300) = .true. 2655 endif 2656 2657 ch8pte1(i) = 'aaaaaaaa' 2658 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2659 ! Error #301 2660 errors(301) = .true. 2661 endif 2662 2663 ch8targ1(i) = 'zzzzzzzz' 2664 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2665 ! Error #302 2666 errors(302) = .true. 2667 endif 2668 2669 do, j=1,m 2670 dpte2(j,i)%r1=1.0 2671 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2672 ! Error #303 2673 errors(303) = .true. 2674 endif 2675 2676 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 2677 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2678 ! Error #304 2679 errors(304) = .true. 2680 endif 2681 2682 ipte2(j,i) = i 2683 if (intne(ipte2(j,i), itarg2(j,i))) then 2684 ! Error #305 2685 errors(305) = .true. 2686 endif 2687 2688 itarg2(j,i) = -ipte2(j,i) 2689 if (intne(ipte2(j,i), itarg2(j,i))) then 2690 ! Error #306 2691 errors(306) = .true. 2692 endif 2693 2694 rpte2(j,i) = i * (-2.0) 2695 if (realne(rpte2(j,i), rtarg2(j,i))) then 2696 ! Error #307 2697 errors(307) = .true. 2698 endif 2699 2700 rtarg2(j,i) = i * (-3.0) 2701 if (realne(rpte2(j,i), rtarg2(j,i))) then 2702 ! Error #308 2703 errors(308) = .true. 2704 endif 2705 2706 chpte2(j,i) = 'a' 2707 if (chne(chpte2(j,i), chtarg2(j,i))) then 2708 ! Error #309 2709 errors(309) = .true. 2710 endif 2711 2712 chtarg2(j,i) = 'z' 2713 if (chne(chpte2(j,i), chtarg2(j,i))) then 2714 ! Error #310 2715 errors(310) = .true. 2716 endif 2717 2718 ch8pte2(j,i) = 'aaaaaaaa' 2719 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2720 ! Error #311 2721 errors(311) = .true. 2722 endif 2723 2724 ch8targ2(j,i) = 'zzzzzzzz' 2725 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 2726 ! Error #312 2727 errors(312) = .true. 2728 endif 2729 do k=1,o 2730 dpte3(k,j,i)%i2(1+mod(i,5))=i 2731 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2732 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2733 ! Error #313 2734 errors(313) = .true. 2735 endif 2736 2737 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 2738 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 2739 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 2740 ! Error #314 2741 errors(314) = .true. 2742 endif 2743 2744 ipte3(k,j,i) = i 2745 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2746 ! Error #315 2747 errors(315) = .true. 2748 endif 2749 2750 itarg3(k,j,i) = -ipte3(k,j,i) 2751 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 2752 ! Error #316 2753 errors(316) = .true. 2754 endif 2755 2756 rpte3(k,j,i) = i * 2.0 2757 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2758 ! Error #317 2759 errors(317) = .true. 2760 endif 2761 2762 rtarg3(k,j,i) = i * 3.0 2763 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 2764 ! Error #318 2765 errors(318) = .true. 2766 endif 2767 2768 chpte3(k,j,i) = 'a' 2769 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2770 ! Error #319 2771 errors(319) = .true. 2772 endif 2773 2774 chtarg3(k,j,i) = 'z' 2775 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 2776 ! Error #320 2777 errors(320) = .true. 2778 endif 2779 2780 ch8pte3(k,j,i) = 'aaaaaaaa' 2781 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2782 ! Error #321 2783 errors(321) = .true. 2784 endif 2785 2786 ch8targ3(k,j,i) = 'zzzzzzzz' 2787 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 2788 ! Error #322 2789 errors(322) = .true. 2790 endif 2791 end do 2792 end do 2793 end do 2794 2795 rtarg3 = .5 2796 ! Vector syntax 2797 do, i=1,n 2798 ipte3 = i 2799 rpte3 = rpte3+1 2800 do, j=1,m 2801 do k=1,o 2802 if (intne(itarg3(k,j,i), i)) then 2803 ! Error #323 2804 errors(323) = .true. 2805 endif 2806 2807 if (realne(rtarg3(k,j,i), i+.5)) then 2808 ! Error #324 2809 errors(324) = .true. 2810 endif 2811 end do 2812 end do 2813 end do 2814end subroutine ptr10 2815 2816subroutine ptr11(nnn,mmm,ooo) 2817 common /errors/errors(400) 2818 logical :: errors, intne, realne, chne, ch8ne 2819 integer :: i,j,k 2820 integer :: nnn,mmm,ooo 2821 integer, parameter :: n = 9 2822 integer, parameter :: m = 10 2823 integer, parameter :: o = 11 2824 integer itarg1 (n) 2825 integer itarg2 (m,n) 2826 integer itarg3 (o,m,n) 2827 real rtarg1(n) 2828 real rtarg2(m,n) 2829 real rtarg3(o,m,n) 2830 character chtarg1(n) 2831 character chtarg2(m,n) 2832 character chtarg3(o,m,n) 2833 character*8 ch8targ1(n) 2834 character*8 ch8targ2(m,n) 2835 character*8 ch8targ3(o,m,n) 2836 type drvd 2837 real r1 2838 integer i1 2839 integer i2(5) 2840 end type drvd 2841 type(drvd) dtarg1(n) 2842 type(drvd) dtarg2(m,n) 2843 type(drvd) dtarg3(o,m,n) 2844 2845 pointer(iptr1,dpte1(nnn)) 2846 pointer(iptr2,dpte2(mmm,nnn)) 2847 pointer(iptr3,dpte3(ooo,mmm,nnn)) 2848 pointer(iptr4,ipte1(nnn)) 2849 pointer(iptr5,ipte2 (mmm,nnn)) 2850 pointer(iptr6,ipte3(ooo,mmm,nnn)) 2851 pointer(iptr7,rpte1(nnn)) 2852 pointer(iptr8,rpte2(mmm,nnn)) 2853 pointer(iptr9,rpte3(ooo,mmm,nnn)) 2854 pointer(iptr10,chpte1(nnn)) 2855 pointer(iptr11,chpte2(mmm,nnn)) 2856 pointer(iptr12,chpte3(ooo,mmm,nnn)) 2857 pointer(iptr13,ch8pte1(nnn)) 2858 pointer(iptr14,ch8pte2(mmm,nnn)) 2859 pointer(iptr15,ch8pte3(ooo,mmm,nnn)) 2860 2861 type(drvd) dpte1 2862 type(drvd) dpte2 2863 type(drvd) dpte3 2864 integer ipte1 2865 integer ipte2 2866 integer ipte3 2867 real rpte1 2868 real rpte2 2869 real rpte3 2870 character chpte1 2871 character chpte2 2872 character chpte3 2873 character*8 ch8pte1 2874 character*8 ch8pte2 2875 character*8 ch8pte3 2876 2877 iptr1 = loc(dtarg1) 2878 iptr2 = loc(dtarg2) 2879 iptr3 = loc(dtarg3) 2880 iptr4 = loc(itarg1) 2881 iptr5 = loc(itarg2) 2882 iptr6 = loc(itarg3) 2883 iptr7 = loc(rtarg1) 2884 iptr8 = loc(rtarg2) 2885 iptr9 = loc(rtarg3) 2886 iptr10= loc(chtarg1) 2887 iptr11= loc(chtarg2) 2888 iptr12= loc(chtarg3) 2889 iptr13= loc(ch8targ1) 2890 iptr14= loc(ch8targ2) 2891 iptr15= loc(ch8targ3) 2892 2893 do, i=1,n 2894 dpte1(i)%i1=i 2895 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2896 ! Error #325 2897 errors(325) = .true. 2898 endif 2899 2900 dtarg1(i)%i1=2*dpte1(i)%i1 2901 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 2902 ! Error #326 2903 errors(326) = .true. 2904 endif 2905 2906 ipte1(i) = i 2907 if (intne(ipte1(i), itarg1(i))) then 2908 ! Error #327 2909 errors(327) = .true. 2910 endif 2911 2912 itarg1(i) = -ipte1(i) 2913 if (intne(ipte1(i), itarg1(i))) then 2914 ! Error #328 2915 errors(328) = .true. 2916 endif 2917 2918 rpte1(i) = i * 5.0 2919 if (realne(rpte1(i), rtarg1(i))) then 2920 ! Error #329 2921 errors(329) = .true. 2922 endif 2923 2924 rtarg1(i) = i * (-5.0) 2925 if (realne(rpte1(i), rtarg1(i))) then 2926 ! Error #330 2927 errors(330) = .true. 2928 endif 2929 2930 chpte1(i) = 'a' 2931 if (chne(chpte1(i), chtarg1(i))) then 2932 ! Error #331 2933 errors(331) = .true. 2934 endif 2935 2936 chtarg1(i) = 'z' 2937 if (chne(chpte1(i), chtarg1(i))) then 2938 ! Error #332 2939 errors(332) = .true. 2940 endif 2941 2942 ch8pte1(i) = 'aaaaaaaa' 2943 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2944 ! Error #333 2945 errors(333) = .true. 2946 endif 2947 2948 ch8targ1(i) = 'zzzzzzzz' 2949 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 2950 ! Error #334 2951 errors(334) = .true. 2952 endif 2953 2954 do, j=1,m 2955 dpte2(j,i)%r1=1.0 2956 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2957 ! Error #335 2958 errors(335) = .true. 2959 endif 2960 2961 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 2962 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 2963 ! Error #336 2964 errors(336) = .true. 2965 endif 2966 2967 ipte2(j,i) = i 2968 if (intne(ipte2(j,i), itarg2(j,i))) then 2969 ! Error #337 2970 errors(337) = .true. 2971 endif 2972 2973 itarg2(j,i) = -ipte2(j,i) 2974 if (intne(ipte2(j,i), itarg2(j,i))) then 2975 ! Error #338 2976 errors(338) = .true. 2977 endif 2978 2979 rpte2(j,i) = i * (-2.0) 2980 if (realne(rpte2(j,i), rtarg2(j,i))) then 2981 ! Error #339 2982 errors(339) = .true. 2983 endif 2984 2985 rtarg2(j,i) = i * (-3.0) 2986 if (realne(rpte2(j,i), rtarg2(j,i))) then 2987 ! Error #340 2988 errors(340) = .true. 2989 endif 2990 2991 chpte2(j,i) = 'a' 2992 if (chne(chpte2(j,i), chtarg2(j,i))) then 2993 ! Error #341 2994 errors(341) = .true. 2995 endif 2996 2997 chtarg2(j,i) = 'z' 2998 if (chne(chpte2(j,i), chtarg2(j,i))) then 2999 ! Error #342 3000 errors(342) = .true. 3001 endif 3002 3003 ch8pte2(j,i) = 'aaaaaaaa' 3004 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 3005 ! Error #343 3006 errors(343) = .true. 3007 endif 3008 3009 ch8targ2(j,i) = 'zzzzzzzz' 3010 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 3011 ! Error #344 3012 errors(344) = .true. 3013 endif 3014 do k=1,o 3015 dpte3(k,j,i)%i2(1+mod(i,5))=i 3016 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 3017 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 3018 ! Error #345 3019 errors(345) = .true. 3020 endif 3021 3022 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 3023 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 3024 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 3025 ! Error #346 3026 errors(346) = .true. 3027 endif 3028 3029 ipte3(k,j,i) = i 3030 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 3031 ! Error #347 3032 errors(347) = .true. 3033 endif 3034 3035 itarg3(k,j,i) = -ipte3(k,j,i) 3036 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 3037 ! Error #348 3038 errors(348) = .true. 3039 endif 3040 3041 rpte3(k,j,i) = i * 2.0 3042 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 3043 ! Error #349 3044 errors(349) = .true. 3045 endif 3046 3047 rtarg3(k,j,i) = i * 3.0 3048 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 3049 ! Error #350 3050 errors(350) = .true. 3051 endif 3052 3053 chpte3(k,j,i) = 'a' 3054 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 3055 ! Error #351 3056 errors(351) = .true. 3057 endif 3058 3059 chtarg3(k,j,i) = 'z' 3060 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 3061 ! Error #352 3062 errors(352) = .true. 3063 endif 3064 3065 ch8pte3(k,j,i) = 'aaaaaaaa' 3066 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 3067 ! Error #353 3068 errors(353) = .true. 3069 endif 3070 3071 ch8targ3(k,j,i) = 'zzzzzzzz' 3072 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 3073 ! Error #354 3074 errors(354) = .true. 3075 endif 3076 end do 3077 end do 3078 end do 3079 3080 rtarg3 = .5 3081 ! Vector syntax 3082 do, i=1,n 3083 ipte3 = i 3084 rpte3 = rpte3+1 3085 do, j=1,m 3086 do k=1,o 3087 if (intne(itarg3(k,j,i), i)) then 3088 ! Error #355 3089 errors(355) = .true. 3090 endif 3091 3092 if (realne(rtarg3(k,j,i), i+.5)) then 3093 ! Error #356 3094 errors(356) = .true. 3095 endif 3096 end do 3097 end do 3098 end do 3099end subroutine ptr11 3100 3101subroutine ptr12(nnn,mmm,ooo) 3102 common /errors/errors(400) 3103 logical :: errors, intne, realne, chne, ch8ne 3104 integer :: i,j,k 3105 integer :: nnn,mmm,ooo 3106 integer, parameter :: n = 9 3107 integer, parameter :: m = 10 3108 integer, parameter :: o = 11 3109 integer itarg1 (n) 3110 integer itarg2 (m,n) 3111 integer itarg3 (o,m,n) 3112 real rtarg1(n) 3113 real rtarg2(m,n) 3114 real rtarg3(o,m,n) 3115 character chtarg1(n) 3116 character chtarg2(m,n) 3117 character chtarg3(o,m,n) 3118 character*8 ch8targ1(n) 3119 character*8 ch8targ2(m,n) 3120 character*8 ch8targ3(o,m,n) 3121 type drvd 3122 real r1 3123 integer i1 3124 integer i2(5) 3125 end type drvd 3126 type(drvd) dtarg1(n) 3127 type(drvd) dtarg2(m,n) 3128 type(drvd) dtarg3(o,m,n) 3129 3130 pointer(iptr1,dpte1) 3131 pointer(iptr2,dpte2) 3132 pointer(iptr3,dpte3) 3133 pointer(iptr4,ipte1) 3134 pointer(iptr5,ipte2) 3135 pointer(iptr6,ipte3) 3136 pointer(iptr7,rpte1) 3137 pointer(iptr8,rpte2) 3138 pointer(iptr9,rpte3) 3139 pointer(iptr10,chpte1) 3140 pointer(iptr11,chpte2) 3141 pointer(iptr12,chpte3) 3142 pointer(iptr13,ch8pte1) 3143 pointer(iptr14,ch8pte2) 3144 pointer(iptr15,ch8pte3) 3145 3146 type(drvd) dpte1(nnn) 3147 type(drvd) dpte2(mmm,nnn) 3148 type(drvd) dpte3(ooo,mmm,nnn) 3149 integer ipte1 (nnn) 3150 integer ipte2 (mmm,nnn) 3151 integer ipte3 (ooo,mmm,nnn) 3152 real rpte1(nnn) 3153 real rpte2(mmm,nnn) 3154 real rpte3(ooo,mmm,nnn) 3155 character chpte1(nnn) 3156 character chpte2(mmm,nnn) 3157 character chpte3(ooo,mmm,nnn) 3158 character*8 ch8pte1(nnn) 3159 character*8 ch8pte2(mmm,nnn) 3160 character*8 ch8pte3(ooo,mmm,nnn) 3161 3162 iptr1 = loc(dtarg1) 3163 iptr2 = loc(dtarg2) 3164 iptr3 = loc(dtarg3) 3165 iptr4 = loc(itarg1) 3166 iptr5 = loc(itarg2) 3167 iptr6 = loc(itarg3) 3168 iptr7 = loc(rtarg1) 3169 iptr8 = loc(rtarg2) 3170 iptr9 = loc(rtarg3) 3171 iptr10= loc(chtarg1) 3172 iptr11= loc(chtarg2) 3173 iptr12= loc(chtarg3) 3174 iptr13= loc(ch8targ1) 3175 iptr14= loc(ch8targ2) 3176 iptr15= loc(ch8targ3) 3177 3178 3179 do, i=1,n 3180 dpte1(i)%i1=i 3181 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 3182 ! Error #357 3183 errors(357) = .true. 3184 endif 3185 3186 dtarg1(i)%i1=2*dpte1(i)%i1 3187 if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then 3188 ! Error #358 3189 errors(358) = .true. 3190 endif 3191 3192 ipte1(i) = i 3193 if (intne(ipte1(i), itarg1(i))) then 3194 ! Error #359 3195 errors(359) = .true. 3196 endif 3197 3198 itarg1(i) = -ipte1(i) 3199 if (intne(ipte1(i), itarg1(i))) then 3200 ! Error #360 3201 errors(360) = .true. 3202 endif 3203 3204 rpte1(i) = i * 5.0 3205 if (realne(rpte1(i), rtarg1(i))) then 3206 ! Error #361 3207 errors(361) = .true. 3208 endif 3209 3210 rtarg1(i) = i * (-5.0) 3211 if (realne(rpte1(i), rtarg1(i))) then 3212 ! Error #362 3213 errors(362) = .true. 3214 endif 3215 3216 chpte1(i) = 'a' 3217 if (chne(chpte1(i), chtarg1(i))) then 3218 ! Error #363 3219 errors(363) = .true. 3220 endif 3221 3222 chtarg1(i) = 'z' 3223 if (chne(chpte1(i), chtarg1(i))) then 3224 ! Error #364 3225 errors(364) = .true. 3226 endif 3227 3228 ch8pte1(i) = 'aaaaaaaa' 3229 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 3230 ! Error #365 3231 errors(365) = .true. 3232 endif 3233 3234 ch8targ1(i) = 'zzzzzzzz' 3235 if (ch8ne(ch8pte1(i), ch8targ1(i))) then 3236 ! Error #366 3237 errors(366) = .true. 3238 endif 3239 3240 do, j=1,m 3241 dpte2(j,i)%r1=1.0 3242 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 3243 ! Error #367 3244 errors(367) = .true. 3245 endif 3246 3247 dtarg2(j,i)%r1=2*dpte2(j,i)%r1 3248 if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then 3249 ! Error #368 3250 errors(368) = .true. 3251 endif 3252 3253 ipte2(j,i) = i 3254 if (intne(ipte2(j,i), itarg2(j,i))) then 3255 ! Error #369 3256 errors(369) = .true. 3257 endif 3258 3259 itarg2(j,i) = -ipte2(j,i) 3260 if (intne(ipte2(j,i), itarg2(j,i))) then 3261 ! Error #370 3262 errors(370) = .true. 3263 endif 3264 3265 rpte2(j,i) = i * (-2.0) 3266 if (realne(rpte2(j,i), rtarg2(j,i))) then 3267 ! Error #371 3268 errors(371) = .true. 3269 endif 3270 3271 rtarg2(j,i) = i * (-3.0) 3272 if (realne(rpte2(j,i), rtarg2(j,i))) then 3273 ! Error #372 3274 errors(372) = .true. 3275 endif 3276 3277 chpte2(j,i) = 'a' 3278 if (chne(chpte2(j,i), chtarg2(j,i))) then 3279 ! Error #373 3280 errors(373) = .true. 3281 endif 3282 3283 chtarg2(j,i) = 'z' 3284 if (chne(chpte2(j,i), chtarg2(j,i))) then 3285 ! Error #374 3286 errors(374) = .true. 3287 endif 3288 3289 ch8pte2(j,i) = 'aaaaaaaa' 3290 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 3291 ! Error #375 3292 errors(375) = .true. 3293 endif 3294 3295 ch8targ2(j,i) = 'zzzzzzzz' 3296 if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then 3297 ! Error #376 3298 errors(376) = .true. 3299 endif 3300 do k=1,o 3301 dpte3(k,j,i)%i2(1+mod(i,5))=i 3302 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 3303 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 3304 ! Error #377 3305 errors(377) = .true. 3306 endif 3307 3308 dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5)) 3309 if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), & 3310 dtarg3(k,j,i)%i2(1+mod(i,5)))) then 3311 ! Error #378 3312 errors(378) = .true. 3313 endif 3314 3315 ipte3(k,j,i) = i 3316 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 3317 ! Error #379 3318 errors(379) = .true. 3319 endif 3320 3321 itarg3(k,j,i) = -ipte3(k,j,i) 3322 if (intne(ipte3(k,j,i), itarg3(k,j,i))) then 3323 ! Error #380 3324 errors(380) = .true. 3325 endif 3326 3327 rpte3(k,j,i) = i * 2.0 3328 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 3329 ! Error #381 3330 errors(381) = .true. 3331 endif 3332 3333 rtarg3(k,j,i) = i * 3.0 3334 if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then 3335 ! Error #382 3336 errors(382) = .true. 3337 endif 3338 3339 chpte3(k,j,i) = 'a' 3340 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 3341 ! Error #383 3342 errors(383) = .true. 3343 endif 3344 3345 chtarg3(k,j,i) = 'z' 3346 if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then 3347 ! Error #384 3348 errors(384) = .true. 3349 endif 3350 3351 ch8pte3(k,j,i) = 'aaaaaaaa' 3352 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 3353 ! Error #385 3354 errors(385) = .true. 3355 endif 3356 3357 ch8targ3(k,j,i) = 'zzzzzzzz' 3358 if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then 3359 ! Error #386 3360 errors(386) = .true. 3361 endif 3362 end do 3363 end do 3364 end do 3365 3366 rtarg3 = .5 3367 ! Vector syntax 3368 do, i=1,n 3369 ipte3 = i 3370 rpte3 = rpte3+1 3371 do, j=1,m 3372 do k=1,o 3373 if (intne(itarg3(k,j,i), i)) then 3374 ! Error #387 3375 errors(387) = .true. 3376 endif 3377 3378 if (realne(rtarg3(k,j,i), i+.5)) then 3379 ! Error #388 3380 errors(388) = .true. 3381 endif 3382 end do 3383 end do 3384 end do 3385 3386end subroutine ptr12 3387 3388! Misc 3389subroutine ptr13(nnn,mmm) 3390 common /errors/errors(400) 3391 logical :: errors, intne, realne, chne, ch8ne 3392 integer :: nnn,mmm 3393 integer :: i,j 3394 integer, parameter :: n = 9 3395 integer, parameter :: m = 10 3396 integer itarg1 (n) 3397 integer itarg2 (m,n) 3398 real rtarg1(n) 3399 real rtarg2(m,n) 3400 3401 integer ipte1 3402 integer ipte2 3403 real rpte1 3404 real rpte2 3405 3406 dimension ipte1(n) 3407 dimension rpte2(mmm,nnn) 3408 3409 pointer(iptr4,ipte1) 3410 pointer(iptr5,ipte2) 3411 pointer(iptr7,rpte1) 3412 pointer(iptr8,rpte2) 3413 3414 dimension ipte2(mmm,nnn) 3415 dimension rpte1(n) 3416 3417 iptr4 = loc(itarg1) 3418 iptr5 = loc(itarg2) 3419 iptr7 = loc(rtarg1) 3420 iptr8 = loc(rtarg2) 3421 3422 do, i=1,n 3423 ipte1(i) = i 3424 if (intne(ipte1(i), itarg1(i))) then 3425 ! Error #389 3426 errors(389) = .true. 3427 endif 3428 3429 itarg1(i) = -ipte1(i) 3430 if (intne(ipte1(i), itarg1(i))) then 3431 ! Error #390 3432 errors(390) = .true. 3433 endif 3434 3435 rpte1(i) = i * 5.0 3436 if (realne(rpte1(i), rtarg1(i))) then 3437 ! Error #391 3438 errors(391) = .true. 3439 endif 3440 3441 rtarg1(i) = i * (-5.0) 3442 if (realne(rpte1(i), rtarg1(i))) then 3443 ! Error #392 3444 errors(392) = .true. 3445 endif 3446 3447 do, j=1,m 3448 ipte2(j,i) = i 3449 if (intne(ipte2(j,i), itarg2(j,i))) then 3450 ! Error #393 3451 errors(393) = .true. 3452 endif 3453 3454 itarg2(j,i) = -ipte2(j,i) 3455 if (intne(ipte2(j,i), itarg2(j,i))) then 3456 ! Error #394 3457 errors(394) = .true. 3458 endif 3459 3460 rpte2(j,i) = i * (-2.0) 3461 if (realne(rpte2(j,i), rtarg2(j,i))) then 3462 ! Error #395 3463 errors(395) = .true. 3464 endif 3465 3466 rtarg2(j,i) = i * (-3.0) 3467 if (realne(rpte2(j,i), rtarg2(j,i))) then 3468 ! Error #396 3469 errors(396) = .true. 3470 endif 3471 3472 end do 3473 end do 3474end subroutine ptr13 3475 3476 3477! Test the passing of pointers and pointees as parameters 3478subroutine parmtest 3479 integer, parameter :: n = 12 3480 integer, parameter :: m = 13 3481 integer iarray(m,n) 3482 pointer (ipt,iptee) 3483 integer iptee (m,n) 3484 3485 ipt = loc(iarray) 3486 ! write(*,*) "loc(iarray)",loc(iarray) 3487 call parmptr(ipt,iarray,n,m) 3488 ! write(*,*) "loc(iptee)",loc(iptee) 3489 call parmpte(iptee,iarray,n,m) 3490end subroutine parmtest 3491 3492subroutine parmptr(ipointer,intarr,n,m) 3493 common /errors/errors(400) 3494 logical :: errors, intne 3495 integer :: n,m,i,j 3496 integer intarr(m,n) 3497 pointer (ipointer,newpte) 3498 integer newpte(m,n) 3499 ! write(*,*) "loc(newpte)",loc(newpte) 3500 ! write(*,*) "loc(intarr)",loc(intarr) 3501 ! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1)) 3502 ! newpte(1,1) = 101 3503 ! write(*,*) "newpte(1,1)=",newpte(1,1) 3504 ! write(*,*) "intarr(1,1)=",intarr(1,1) 3505 do, i=1,n 3506 do, j=1,m 3507 newpte(j,i) = i 3508 if (intne(newpte(j,i),intarr(j,i))) then 3509 ! Error #397 3510 errors(397) = .true. 3511 endif 3512 3513 call donothing(newpte(j,i),intarr(j,i)) 3514 intarr(j,i) = -newpte(j,i) 3515 if (intne(newpte(j,i),intarr(j,i))) then 3516 ! Error #398 3517 errors(398) = .true. 3518 endif 3519 end do 3520 end do 3521end subroutine parmptr 3522 3523subroutine parmpte(pointee,intarr,n,m) 3524 common /errors/errors(400) 3525 logical :: errors, intne 3526 integer :: n,m,i,j 3527 integer pointee (m,n) 3528 integer intarr (m,n) 3529 ! write(*,*) "loc(pointee)",loc(pointee) 3530 ! write(*,*) "loc(intarr)",loc(intarr) 3531 ! write(*,*) "loc(pointee(1,1))",loc(pointee(1,1)) 3532 ! pointee(1,1) = 99 3533 ! write(*,*) "pointee(1,1)=",pointee(1,1) 3534 ! write(*,*) "intarr(1,1)=",intarr(1,1) 3535 3536 do, i=1,n 3537 do, j=1,m 3538 pointee(j,i) = i 3539 if (intne(pointee(j,i),intarr(j,i))) then 3540 ! Error #399 3541 errors(399) = .true. 3542 endif 3543 3544 intarr(j,i) = 2*pointee(j,i) 3545 call donothing(pointee(j,i),intarr(j,i)) 3546 if (intne(pointee(j,i),intarr(j,i))) then 3547 ! Error #400 3548 errors(400) = .true. 3549 endif 3550 end do 3551 end do 3552end subroutine parmpte 3553 3554! Separate function calls to break Cray pointer-indifferent optimization 3555logical function intne(ii,jj) 3556 integer :: i,j 3557 common /foo/foo 3558 integer foo 3559 foo = foo + 1 3560 intne = ii.ne.jj 3561 if (intne) then 3562 write (*,*) ii," doesn't equal ",jj 3563 endif 3564end function intne 3565 3566logical function realne(r1,r2) 3567 real :: r1, r2 3568 common /foo/foo 3569 integer foo 3570 foo = foo + 1 3571 realne = r1.ne.r2 3572 if (realne) then 3573 write (*,*) r1," doesn't equal ",r2 3574 endif 3575end function realne 3576 3577logical function chne(ch1,ch2) 3578 character :: ch1, ch2 3579 common /foo/foo 3580 integer foo 3581 foo = foo + 1 3582 chne = ch1.ne.ch2 3583 if (chne) then 3584 write (*,*) ch1," doesn't equal ",ch2 3585 endif 3586end function chne 3587 3588logical function ch8ne(ch1,ch2) 3589 character*8 :: ch1, ch2 3590 common /foo/foo 3591 integer foo 3592 foo = foo + 1 3593 ch8ne = ch1.ne.ch2 3594 if (ch8ne) then 3595 write (*,*) ch1," doesn't equal ",ch2 3596 endif 3597end function ch8ne 3598 3599subroutine donothing(ii,jj) 3600 common/foo/foo 3601 integer :: ii,jj,foo 3602 if (foo.le.1) then 3603 foo = 1 3604 else 3605 foo = foo - 1 3606 endif 3607 if (foo.eq.0) then 3608 ii = -1 3609 jj = 1 3610! print *,"Test did not run correctly" 3611 call abort() 3612 endif 3613end subroutine donothing 3614 3615