1! RUN: %S/test_errors.sh %s %t %flang_fc1 2! REQUIRES: shell 3 4!Shape analysis related tests for SELECT RANK Construct(R1148) 5program select_rank 6 implicit none 7 integer, dimension(2,3):: arr_pass 8 call check(arr_pass) 9 10contains 11 subroutine check(arr) 12 implicit none 13 integer :: arr(..) 14 INTEGER :: j 15 select rank (arr) 16 rank(2) 17 j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(arr)) == 2)) !arr is dummy 18 end select 19 end subroutine 20 subroutine check2(arr) 21 implicit none 22 integer :: arr(..) 23 INTEGER :: j 24 integer,dimension(-1:10, 20:30) :: brr 25 26 select rank (arr) 27 rank(2) 28 j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(brr)) == 2)) !brr is local to subroutine 29 end select 30 end subroutine 31 subroutine checK3(arr) 32 implicit none 33 integer :: arr(..) 34 INTEGER :: j,I,n=5,m=5 35 integer,dimension(-1:10, 20:30) :: brr 36 integer :: array(2) = [10,20] 37 REAL, DIMENSION(5, 5) :: A 38 select rank (arr) 39 rank(2) 40 FORALL (i=1:n,j=1:m,RANK(arr).EQ.SIZE(SHAPE(brr))) & 41 A(i,j) = 1/A(i,j) 42 end select 43 end subroutine 44 subroutine check4(arr) 45 implicit none 46 integer :: arr(..) 47 REAL, DIMENSION(2,3) :: A 48 REAL, DIMENSION(0:1,0:2) :: B 49 INTEGER :: j 50 select rank (arr) 51 rank(2) 52 A = B !will assign to only same shape after analysing in any order. 53 end select 54 end subroutine 55 subroutine check5(arr) 56 implicit none 57 integer :: arr(..) 58 INTEGER :: j 59 select rank (arr) 60 rank(2) 61 j = LOC(arr(1,2)) 62 end select 63 end subroutine 64end program 65