@@ -17,13 +17,58 @@ subroutine collect_logicalloc(testsuite)
17
17
type (unittest_type), allocatable , intent (out ) :: testsuite(:)
18
18
19
19
testsuite = [ &
20
+ new_unittest(" trueloc-empty" , test_trueloc_empty), &
21
+ new_unittest(" trueloc-all" , test_trueloc_all), &
20
22
new_unittest(" trueloc-where" , test_trueloc_where), &
21
23
new_unittest(" trueloc-merge" , test_trueloc_merge), &
24
+ new_unittest(" falseloc-empty" , test_falseloc_empty), &
25
+ new_unittest(" falseloc-all" , test_falseloc_all), &
22
26
new_unittest(" falseloc-where" , test_falseloc_where), &
23
27
new_unittest(" falseloc-merge" , test_falseloc_merge) &
24
28
]
25
29
end subroutine collect_logicalloc
26
30
31
+ subroutine test_trueloc_empty (error )
32
+ ! > Error handling
33
+ type (error_type), allocatable , intent (out ) :: error
34
+
35
+ integer :: ndim
36
+ real , allocatable :: avec(:), bvec(:)
37
+
38
+ do ndim = 100 , 12000 , 100
39
+ allocate (avec(ndim))
40
+
41
+ call random_number (avec)
42
+
43
+ bvec = avec
44
+ bvec(trueloc(bvec < 0 )) = 0.0
45
+
46
+ call check(error, all (bvec == avec))
47
+ deallocate (avec, bvec)
48
+ if (allocated (error)) exit
49
+ end do
50
+ end subroutine test_trueloc_empty
51
+
52
+ subroutine test_trueloc_all (error )
53
+ ! > Error handling
54
+ type (error_type), allocatable , intent (out ) :: error
55
+
56
+ integer :: ndim
57
+ real , allocatable :: avec(:)
58
+
59
+ do ndim = 100 , 12000 , 100
60
+ allocate (avec(- ndim/ 2 :ndim))
61
+
62
+ call random_number (avec)
63
+
64
+ avec(trueloc(avec > 0 , lbound (avec, 1 ))) = 0.0
65
+
66
+ call check(error, all (avec == 0.0 ))
67
+ deallocate (avec)
68
+ if (allocated (error)) exit
69
+ end do
70
+ end subroutine test_trueloc_all
71
+
27
72
subroutine test_trueloc_where (error )
28
73
! > Error handling
29
74
type (error_type), allocatable , intent (out ) :: error
@@ -74,6 +119,47 @@ subroutine test_trueloc_merge(error)
74
119
end do
75
120
end subroutine test_trueloc_merge
76
121
122
+ subroutine test_falseloc_empty (error )
123
+ ! > Error handling
124
+ type (error_type), allocatable , intent (out ) :: error
125
+
126
+ integer :: ndim
127
+ real , allocatable :: avec(:), bvec(:)
128
+
129
+ do ndim = 100 , 12000 , 100
130
+ allocate (avec(ndim))
131
+
132
+ call random_number (avec)
133
+
134
+ bvec = avec
135
+ bvec(falseloc(bvec > 0 )) = 0.0
136
+
137
+ call check(error, all (bvec == avec))
138
+ deallocate (avec, bvec)
139
+ if (allocated (error)) exit
140
+ end do
141
+ end subroutine test_falseloc_empty
142
+
143
+ subroutine test_falseloc_all (error )
144
+ ! > Error handling
145
+ type (error_type), allocatable , intent (out ) :: error
146
+
147
+ integer :: ndim
148
+ real , allocatable :: avec(:)
149
+
150
+ do ndim = 100 , 12000 , 100
151
+ allocate (avec(- ndim/ 2 :ndim))
152
+
153
+ call random_number (avec)
154
+
155
+ avec(falseloc(avec < 0 , lbound (avec, 1 ))) = 0.0
156
+
157
+ call check(error, all (avec == 0.0 ))
158
+ deallocate (avec)
159
+ if (allocated (error)) exit
160
+ end do
161
+ end subroutine test_falseloc_all
162
+
77
163
subroutine test_falseloc_where (error )
78
164
! > Error handling
79
165
type (error_type), allocatable , intent (out ) :: error
0 commit comments