1! { dg-do run } 2! 3! TS 29113 4! 7.2 RANK (A) 5! Description. Rank of a data object. 6! Class. Inquiry function. 7! Argument. 8! A shall be a scalar or array of any type. 9! Result Characteristics. Default integer scalar. 10! Result Value. The result is the rank of A. 11 12module m 13 14 type :: base 15 integer :: a, b 16 end type 17 18 type, extends (base) :: derived 19 integer :: c 20 end type 21end module 22 23program test 24 use m 25 26 ! Define some arrays for testing. 27 type(derived), target :: x1(5) 28 type(derived) :: y1(0:9) 29 type(derived), pointer :: p1(:) 30 type(derived), allocatable :: a1(:) 31 type(derived), target :: x3(2,3,4) 32 type(derived) :: y3(0:1,-3:-1,4) 33 type(derived), pointer :: p3(:,:,:) 34 type(derived), allocatable :: a3(:,:,:) 35 type(derived) :: x 36 37 ! Test the 1-dimensional arrays. 38 if (rank (x1) .ne. 1) stop 201 39 call testit (x1, 1) 40 if (rank (y1) .ne. 1) stop 202 41 call testit (y1, 1) 42 if (rank (p1) .ne. 1) stop 203 43 p1 => x1 44 call testit (p1, 1) 45 if (rank (p1) .ne. 1) stop 204 46 if (rank (a1) .ne. 1) stop 205 47 allocate (a1(5)) 48 if (rank (a1) .ne. 1) stop 206 49 call testit (a1, 1) 50 51 ! Test the multi-dimensional arrays. 52 if (rank (x3) .ne. 3) stop 207 53 call testit (x3, 3) 54 if (rank (y3) .ne. 3) stop 208 55 if (rank (p3) .ne. 3) stop 209 56 p3 => x3 57 call testit (p3, 3) 58 if (rank (p3) .ne. 3) stop 210 59 if (rank (a3) .ne. 3) stop 211 60 allocate (a3(2,3,4)) 61 call testit (a3, 3) 62 if (rank (a3) .ne. 3) stop 212 63 64 ! Test scalars. 65 if (rank (x) .ne. 0) stop 213 66 call testit (x, 0) 67 call test0 (x) 68 if (rank (x1(1)) .ne. 0) stop 215 69 call test0 (x1(1)) 70 71contains 72 73 subroutine testit (a, r) 74 use m 75 class(base) :: a(..) 76 integer :: r 77 78 if (r .ne. rank(a)) stop 101 79 end subroutine 80 81 subroutine test0 (a) 82 use m 83 class(base) :: a(..) 84 if (rank (a) .ne. 0) stop 103 85 call testit (a, 0) 86 end subroutine 87 88end program 89