1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
program where_10
implicit none
real, parameter :: zero = 0.0
integer :: i
real :: first_array(1, 4)
integer :: second_array(2, 4)
logical :: third_array(2, 4)
real :: first_output(1, 4)
integer :: second_output(2, 4)
logical :: third_output(2, 4)
first_array = reshape([0.0, 1.0, 0.0, 1.0], [1, 4])
second_array = reshape([1, 2, 0, 4, 5, 0, 7, 0], [2, 4])
third_array = reshape([.false., .true., .true., .true., .false., .true., .false., .true.], [2, 4])
where (first_array(1, :) == zero)
first_array(1, :) = 2.0
end where
print *, first_array
first_output = reshape([2.0, 1.0, 2.0, 1.0], [1, 4])
if (all(first_array /= first_output)) error stop
where (second_array(:, 4) /= 0)
second_array(:, 4) = 22
end where
print *, second_array
second_output = reshape([1, 2, 0, 4, 5, 0, 22, 0], [2, 4])
if (all(second_array /= second_output)) error stop
i = 1
where (first_array(i, :) > 1.0)
first_array(i, :) = 22.0
end where
print *, first_array
first_output = reshape([22.0, 1.0, 22.0, 1.0], [1, 4])
if (all(first_array /= first_output)) error stop
where (third_array(2, :))
second_array(2, :) = 1
end where
print *, second_array
second_output = reshape([1, 1, 0, 1, 5, 1, 22, 1], [2, 4])
if (all(second_array /= second_output)) error stop
where (third_array(2, :) .neqv. .false.)
third_array(2, :) = .false.
end where
print *, third_array
third_output = reshape([.false., .false., .true., .false., .false., .false., .false., .false.], [2, 4])
if (all(third_array .neqv. third_output)) error stop
! Assignment like:
! first_array(1, :) = first_array(1, :) + 1
! is currently not supported inside the `WHERE` clause.
!
! Uncomment after supporting the above:
!
! where (first_array(1, :) > 1.0)
! first_array(1, :) = first_array(1, :) + 1
! end where
!
! print *, first_array
! first_output = reshape([3.0, 1.0, 3.0, 1.0], [1, 4])
! if (all(first_array /= first_output)) error stop
!
! =========================================================
!
! Array section expressions like second_array(:, :)
! is currently not supported inside `WHERE` clause.
!
! Uncomment after supporting the above:
!
! where (second_array(:, :) /= 0)
! second_array(:, :) = 10
! end where
!
! print *, second_array
! second_output = reshape([10, 10, 0, 10, 10, 0, 10, 0], [2, 4])
! if (all(second_array /= second_output)) error stop
end program where_10
|
