1! Program to test the MINLOC and MAXLOC intrinsics 2program testmmloc 3 implicit none 4 integer, dimension (3, 3) :: a 5 integer, dimension (3) :: b 6 logical, dimension (3, 3) :: m, tr 7 integer i 8 character(len=10) line 9 10 a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/)); 11 tr = .true. 12 13 b = minloc (a, 1) 14 if (b(1) .ne. 1) call abort 15 if (b(2) .ne. 2) call abort 16 if (b(3) .ne. 3) call abort 17 b = -1 18 write (line, 9000) minloc(a,1) 19 read (line, 9000) b 20 if (b(1) .ne. 1) call abort 21 if (b(2) .ne. 2) call abort 22 if (b(3) .ne. 3) call abort 23 24 m = .true. 25 m(1, 1) = .false. 26 m(1, 2) = .false. 27 b = minloc (a, 1, m) 28 if (b(1) .ne. 2) call abort 29 if (b(2) .ne. 2) call abort 30 if (b(3) .ne. 3) call abort 31 b = minloc (a, 1, m .and. tr) 32 if (b(1) .ne. 2) call abort 33 if (b(2) .ne. 2) call abort 34 if (b(3) .ne. 3) call abort 35 b = -1 36 write (line, 9000) minloc(a, 1, m) 37 read (line, 9000) b 38 if (b(1) .ne. 2) call abort 39 if (b(2) .ne. 2) call abort 40 if (b(3) .ne. 3) call abort 41 42 b(1:2) = minloc(a) 43 if (b(1) .ne. 1) call abort 44 if (b(2) .ne. 1) call abort 45 b = -1 46 write (line, 9000) minloc(a) 47 read (line, 9000) b 48 if (b(1) .ne. 1) call abort 49 if (b(2) .ne. 1) call abort 50 if (b(3) .ne. 0) call abort 51 52 b(1:2) = minloc(a, mask=m) 53 if (b(1) .ne. 2) call abort 54 if (b(2) .ne. 1) call abort 55 b(1:2) = minloc(a, mask=m .and. tr) 56 if (b(1) .ne. 2) call abort 57 if (b(2) .ne. 1) call abort 58 b = -1 59 write (line, 9000) minloc(a, mask=m) 60 read (line, 9000) b 61 if (b(1) .ne. 2) call abort 62 if (b(2) .ne. 1) call abort 63 if (b(3) .ne. 0) call abort 64 65 b = maxloc (a, 1) 66 if (b(1) .ne. 3) call abort 67 if (b(2) .ne. 3) call abort 68 if (b(3) .ne. 1) call abort 69 b = -1 70 write (line, 9000) maxloc(a, 1) 71 read (line, 9000) b 72 if (b(1) .ne. 3) call abort 73 if (b(2) .ne. 3) call abort 74 if (b(3) .ne. 1) call abort 75 76 m = .true. 77 m(1, 2) = .false. 78 m(1, 3) = .false. 79 b = maxloc (a, 1, m) 80 if (b(1) .ne. 3) call abort 81 if (b(2) .ne. 3) call abort 82 if (b(3) .ne. 2) call abort 83 b = maxloc (a, 1, m .and. tr) 84 if (b(1) .ne. 3) call abort 85 if (b(2) .ne. 3) call abort 86 if (b(3) .ne. 2) call abort 87 b = -1 88 write (line, 9000) maxloc(a, 1, m) 89 read (line, 9000) b 90 if (b(1) .ne. 3) call abort 91 if (b(2) .ne. 3) call abort 92 if (b(3) .ne. 2) call abort 93 94 b(1:2) = maxloc(a) 95 if (b(1) .ne. 1) call abort 96 if (b(2) .ne. 3) call abort 97 b = -1 98 write (line, 9000) maxloc(a) 99 read (line, 9000) b 100 if (b(1) .ne. 1) call abort 101 if (b(2) .ne. 3) call abort 102 103 b(1:2) = maxloc(a, mask=m) 104 if (b(1) .ne. 2) call abort 105 if (b(2) .ne. 3) call abort 106 b(1:2) = maxloc(a, mask=m .and. tr) 107 if (b(1) .ne. 2) call abort 108 if (b(2) .ne. 3) call abort 109 b = -1 110 write (line, 9000) maxloc(a, mask=m) 111 read (line, 9000) b 112 if (b(1) .ne. 2) call abort 113 if (b(2) .ne. 3) call abort 114 if (b(3) .ne. 0) call abort 115 1169000 format (3I3) 117end program 118