1! { dg-do run } 2! Test maxloc for strings for different code paths 3 4program main 5 implicit none 6 integer, parameter :: n=4 7 character(len=4), dimension(n,n) :: c 8 integer, dimension(n,n) :: a 9 integer, dimension(2) :: res1, res2 10 real, dimension(n,n) :: r 11 logical, dimension(n,n) :: amask 12 logical(kind=8) :: smask 13 integer :: i,j 14 integer, dimension(n) :: q1, q2 15 character(len=4,kind=4), dimension(n,n) :: c4 16 character(len=4), dimension(n*n) :: e 17 integer, dimension(n*n) :: f 18 logical, dimension(n*n) :: cmask 19 20 call random_number (r) 21 a = int(r*100) 22 do j=1,n 23 do i=1,n 24 write (unit=c(i,j),fmt='(I4.4)') a(i,j) 25 write (unit=c4(i,j),fmt='(I4.4)') a(i,j) 26 end do 27 end do 28 res1 = maxloc(c) 29 res2 = maxloc(a) 30 31 if (any(res1 /= res2)) STOP 1 32 res1 = maxloc(c4) 33 if (any(res1 /= res2)) STOP 2 34 35 amask = a < 50 36 res1 = maxloc(c,mask=amask) 37 res2 = maxloc(a,mask=amask) 38 39 if (any(res1 /= res2)) STOP 3 40 41 amask = .false. 42 res1 = maxloc(c,mask=amask) 43 if (any(res1 /= 0)) STOP 4 44 45 amask(2,3) = .true. 46 res1 = maxloc(c,mask=amask) 47 if (any(res1 /= [2,3])) STOP 5 48 49 res1 = maxloc(c,mask=.false.) 50 if (any(res1 /= 0)) STOP 6 51 52 res2 = maxloc(a) 53 res1 = maxloc(c,mask=.true.) 54 if (any(res1 /= res2)) STOP 7 55 56 q1 = maxloc(c, dim=1) 57 q2 = maxloc(a, dim=1) 58 if (any(q1 /= q2)) STOP 8 59 60 q1 = maxloc(c, dim=2) 61 q2 = maxloc(a, dim=2) 62 if (any(q1 /= q2)) STOP 9 63 64 q1 = maxloc(c, dim=1, mask=amask) 65 q2 = maxloc(a, dim=1, mask=amask) 66 if (any(q1 /= q2)) STOP 10 67 68 q1 = maxloc(c, dim=2, mask=amask) 69 q2 = maxloc(a, dim=2, mask=amask) 70 if (any(q1 /= q2)) STOP 11 71 72 amask = a < 50 73 74 q1 = maxloc(c, dim=1, mask=amask) 75 q2 = maxloc(a, dim=1, mask=amask) 76 if (any(q1 /= q2)) STOP 12 77 78 q1 = maxloc(c, dim=2, mask=amask) 79 q2 = maxloc(a, dim=2, mask=amask) 80 if (any(q1 /= q2)) STOP 13 81 82 e = reshape(c, shape(e)) 83 f = reshape(a, shape(f)) 84 if (maxloc(e,dim=1) /= maxloc(f,dim=1)) STOP 14 85 86 cmask = .false. 87 if (maxloc(e,dim=1,mask=cmask) /= 0) STOP 15 88 89 cmask = f > 50 90 if ( maxloc(e, dim=1, mask=cmask) /= maxloc (f, dim=1, mask=cmask)) STOP 16 91end program main 92