1! Really test where inside forall with temporary 2program evil_where 3 implicit none 4 type t 5 logical valid 6 integer :: s 7 integer, dimension(:), pointer :: p 8 end type 9 type (t), dimension (5) :: v 10 integer i 11 12 allocate (v(1)%p(2)) 13 allocate (v(2)%p(8)) 14 v(3)%p => NULL() 15 allocate (v(4)%p(8)) 16 allocate (v(5)%p(2)) 17 18 v(:)%valid = (/.true., .true., .false., .true., .true./) 19 v(:)%s = (/1, 8, 999, 6, 2/) 20 v(1)%p(:) = (/9, 10/) 21 v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/) 22 v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/) 23 v(5)%p(:) = (/11, 12/) 24 25 forall (i=1:5,v(i)%valid) 26 where (v(i)%p(1:v(i)%s).gt.4) 27 v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s) 28 end where 29 end forall 30 31 if (any(v(1)%p(:) .ne. (/11, 10/))) call abort 32 if (any(v(2)%p(:) .ne. (/1, 2, 3, 4, 17, 18, 19, 20/))) call abort 33 if (any(v(4)%p(:) .ne. (/1, 2, 3, 4, 5, 6, 19, 20/))) call abort 34 if (any(v(5)%p(:) .ne. (/9, 10/))) call abort 35 36 v(1)%p(:) = (/9, 10/) 37 v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/) 38 v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/) 39 v(5)%p(:) = (/11, 12/) 40 41 forall (i=1:5,v(i)%valid) 42 where (v(i)%p(1:v(i)%s).le.4) 43 v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s) 44 end where 45 end forall 46 47 if (any(v(1)%p(:) .ne. (/9, 10/))) call abort 48 if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 5, 6, 7, 8/))) call abort 49 if (any(v(4)%p(:) .ne. (/13, 14, 15, 16, 17, 18, 19, 20/))) call abort 50 if (any(v(5)%p(:) .ne. (/11, 12/))) call abort 51 52 ! I should really free the memory I've allocated. 53end program 54