PartMC  2.3.0
numeric_diff.F90
Go to the documentation of this file.
1 ! Copyright (C) 2009-2012 Matthew West
2 ! Licensed under the GNU General Public License version 2 or (at your
3 ! option) any later version. See the file COPYING for details.
4 
5 !> \file
6 !> The numeric_diff program.
7 
8 !> Compare two files containing numerical arrays and check whether they
9 !> are the same as each other, to within the specified tolerance.
10 !>
11 !> If the arrays in the two files are of different sizes then they are
12 !> automatically different. Otherwise the are the same if
13 !> \f[ | A_1 - A_2 |_2 < \verb+abs_tol+ \f]
14 !> and
15 !> \f[ \frac{| A_1 - A_2 |_2}{| A_1 |_2 + | A_2 |_2}
16 !> < \verb+rel_tol+ \f]
17 !> and are otherwise different. Setting \c abs_tol or \c rel_tol to zero
18 !> skips the corresponding test.
19 !>
20 !> If the files are the same then "<tt>files match within the given
21 !> tolerances</tt>" is printed on stdout, otherwise "<tt>files
22 !> differ</tt>" is printed, followed by the absolute and relative
23 !> differences, as above, or a message describing the difference. The
24 !> files will be reported as different if they have a different
25 !> pattern of end-of-lines and end-of-files, or if they have
26 !> whitespace in different places (amount of whitespace is
27 !> irrelevant).
28 !>
29 !> The exit status of the program is:
30 !> \li 0 if the files are the same
31 !> \li 1 if the files are different
32 !> \li 3 if an error occurred
33 program numeric_diff
34 
35  use pmc_util
36  use pmc_mpi
37  use getopt_m
38 
39  integer, parameter :: by_array = 1
40  integer, parameter :: by_row = 2
41  integer, parameter :: by_col = 3
42  integer, parameter :: by_elem = 4
43 
44  integer, parameter :: norm_one = 1
45  integer, parameter :: norm_two = 2
46  integer, parameter :: norm_sup = 3
47 
48  character(len=PMC_MAX_FILENAME_LEN) :: filename1, filename2
49  integer :: by, norm, min_row, max_row, min_col, max_col, n_row, n_col
50  real(kind=dp) :: abs_tol, rel_tol
51  real(kind=dp), allocatable, target, dimension(:,:) :: data1, data2
52  real(kind=dp), allocatable, dimension(:,:) :: diff, norm1, abs_err, rel_err
53  real(kind=dp), pointer, dimension(:,:) :: use_data1, use_data2
54  type(option_s) :: opts(9)
55 
56  call pmc_mpi_init()
57 
58  opts(1) = option_s("help", .false., 'h')
59  opts(2) = option_s("abs-tol", .true., 't')
60  opts(3) = option_s("rel-tol", .true., 'T')
61  opts(4) = option_s("min-row", .true., 'r')
62  opts(5) = option_s("max-row", .true., 'R')
63  opts(6) = option_s("min-col", .true., 'c')
64  opts(7) = option_s("max-col", .true., 'C')
65  opts(8) = option_s("by", .true., 'b')
66  opts(9) = option_s("norm", .true., 'n')
67 
68  abs_tol = 0d0
69  rel_tol = 0d0
70  min_row = 0
71  max_row = 0
72  min_col = 0
73  max_col = 0
74  by = by_array
75  norm = norm_two
76 
77  do
78  select case(getopt("ht:T:r:R:c:C:pP", opts))
79  case(char(0))
80  exit
81  case('h')
82  call print_help()
83  stop
84  case('t')
85  abs_tol = string_to_real(optarg)
86  case('T')
87  rel_tol = string_to_real(optarg)
88  case('r')
89  min_row = string_to_integer(optarg)
90  case('R')
91  max_row = string_to_integer(optarg)
92  case('c')
93  min_col = string_to_integer(optarg)
94  case('C')
95  max_col = string_to_integer(optarg)
96  case('b')
97  select case(optarg)
98  case('array')
99  by = by_array
100  case('row')
101  by = by_row
102  case('col')
103  by = by_col
104  case('elem')
105  by = by_elem
106  case default
107  call die_msg(526174645, "unknown --by argument: " // trim(optarg))
108  end select
109  case('n')
110  select case(optarg)
111  case('one')
112  norm = norm_one
113  case('two')
114  norm = norm_two
115  case('sup')
116  norm = norm_sup
117  case default
118  call die_msg(568020730, "unknown --norm argument: " // trim(optarg))
119  end select
120  case( '?' )
121  call die_msg(141541134, 'unknown option')
122  case default
123  call die_msg(816884701, 'unhandled option: ' // trim(optopt))
124  end select
125  end do
126 
127  if (optind /= command_argument_count() - 1) then
128  call print_help()
129  call die_msg(142676480, &
130  'expected exactly two non-option prefix arguments')
131  end if
132 
133  call get_command_argument(optind, filename1)
134  call get_command_argument(optind + 1, filename2)
135 
136  allocate(data1(0,0))
137  allocate(data2(0,0))
138  call loadtxt(filename1, data1)
139  call loadtxt(filename2, data2)
140 
141  if (min_row <= 0) then
142  min_row = 1
143  end if
144  if (max_row <= 0) then
145  call assert_msg(266216891, size(data1, 1) == size(data2, 1), &
146  "number of rows differs between input files")
147  max_row = size(data1, 1)
148  else
149  call assert_msg(136425118, max_row <= size(data1, 1), &
150  "max-row exceeds the number of rows in " // trim(filename1))
151  call assert_msg(279083405, max_row <= size(data2, 1), &
152  "max-row exceeds the number of rows in " // trim(filename2))
153  end if
154 
155  if (min_col <= 0) then
156  min_col = 1
157  end if
158  if (max_col <= 0) then
159  call assert_msg(148743161, size(data1, 2) == size(data2, 2), &
160  "number of columns differs between input files")
161  max_col = size(data1, 2)
162  else
163  call assert_msg(884008689, max_col <= size(data1, 2), &
164  "max-col exceeds the number of columns in " // trim(filename1))
165  call assert_msg(553561214, max_col <= size(data2, 2), &
166  "max-col exceeds the number of columns in " // trim(filename2))
167  end if
168 
169  use_data1 => data1(min_row:max_row, min_col:max_col)
170  use_data2 => data2(min_row:max_row, min_col:max_col)
171 
172  n_row = max_row - min_row + 1
173  n_col = max_col - min_col + 1
174  allocate(diff(n_row, n_col))
175  diff = use_data1 - use_data2
176 
177  select case(by)
178  case(by_array)
179  allocate(norm1(1, 1))
180  allocate(abs_err(1, 1))
181  select case(norm)
182  case(norm_one)
183  norm1(1, 1) = sum(abs(use_data1))
184  abs_err(1, 1) = sum(abs(diff))
185  case(norm_two)
186  norm1(1, 1) = sqrt(sum(use_data1**2))
187  abs_err(1, 1) = sqrt(sum(diff**2))
188  case(norm_sup)
189  norm1(1, 1) = maxval(abs(use_data1))
190  abs_err(1, 1) = maxval(abs(diff))
191  case default
192  call die(644692127)
193  end select
194  case(by_row)
195  allocate(norm1(size(diff, 1), 1))
196  allocate(abs_err(size(diff, 1), 1))
197  select case(norm)
198  case(norm_one)
199  norm1(:, 1) = sum(abs(use_data1), 2)
200  abs_err(:, 1) = sum(abs(diff), 2)
201  case(norm_two)
202  norm1(:, 1) = sqrt(sum(use_data1**2, 2))
203  abs_err(:, 1) = sqrt(sum(diff**2, 2))
204  case(norm_sup)
205  norm1(:, 1) = maxval(abs(use_data1), 2)
206  abs_err(:, 1) = maxval(abs(diff), 2)
207  case default
208  call die(698913943)
209  end select
210  case(by_col)
211  allocate(norm1(1, size(diff, 2)))
212  allocate(abs_err(1, size(diff, 2)))
213  select case(norm)
214  case(norm_one)
215  norm1(1, :) = sum(abs(use_data1), 1)
216  abs_err(1, :) = sum(abs(diff), 1)
217  case(norm_two)
218  norm1(1, :) = sqrt(sum(use_data1**2, 1))
219  abs_err(1, :) = sqrt(sum(diff**2, 1))
220  case(norm_sup)
221  norm1(1, :) = maxval(abs(use_data1), 1)
222  abs_err(1, :) = maxval(abs(diff), 1)
223  case default
224  call die(351454435)
225  end select
226  case(by_elem)
227  allocate(norm1(size(diff, 1), size(diff, 2)))
228  allocate(abs_err(size(diff, 1), size(diff, 2)))
229  norm1(:, :) = abs(use_data1)
230  abs_err(:, :) = abs(diff)
231  case default
232  call die(681575403)
233  end select
234 
235  allocate(rel_err(size(abs_err, 1), size(abs_err, 2)))
236  where (norm1 > 0d0)
237  rel_err = abs_err / norm1
238  elsewhere
239  rel_err = 0d0
240  end where
241 
242  if ((abs_tol <= 0d0) .and. (rel_tol <= 0d0)) then
243  call print_errors(abs_err, rel_err)
244  elseif (((abs_tol <= 0d0) .or. all(abs_err < abs_tol)) &
245  .and. ((rel_tol <= 0d0) .or. all(rel_err < rel_tol))) then
246  write(*,'(a)') 'files match within the given relative tolerance'
247  else
248  write(*,'(a)') 'files differ'
249  call print_errors(abs_err, rel_err)
250  stop 1
251  end if
252 
253  deallocate(data1)
254  deallocate(data2)
255  deallocate(diff)
256  deallocate(norm1)
257  deallocate(abs_err)
258  deallocate(rel_err)
259 
260  call pmc_mpi_finalize()
261 
262 contains
263 
264 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
265 
266  subroutine print_help()
267 
268  write(*,'(a)') 'Usage: numeric_diff [options] <reference_file> <test_file>'
269  write(*,'(a)') ''
270  write(*,'(a)') 'options are:'
271  write(*,'(a)') ' -h, --help Print this help message.'
272  write(*,'(a)') ' -t, --abs-tol <N> Absolute error tolerance.'
273  write(*,'(a)') ' -T, --rel-tol <N> Relative error tolerance.'
274  write(*,'(a)') ' -r, --min-row <N> Minimum row number of data to use.'
275  write(*,'(a)') ' -R, --max-row <N> Maximum row number of data to use.'
276  write(*,'(a)') ' -c, --min-col <N> Minimum column number of data to ' &
277  // 'use.'
278  write(*,'(a)') ' -C, --max-col <N> Maximum column number of data to ' &
279  // 'use.'
280  write(*,'(a)') ' -b, --by <S> Compute error by <S>. <S> is one ' &
281  // 'of "array", "row",'
282  write(*,'(a)') ' "col", or "elem". Default: "array".'
283  write(*,'(a)') ' -n, --norm <S> Compute error with norm <S>. <S> ' &
284  // 'is one of "one",'
285  write(*,'(a)') ' "two", or "sup". Default: "two".'
286  write(*,'(a)') ''
287  write(*,'(a)') 'Examples:'
288  write(*,'(a)') ' numeric_diff --rel-tol 1e-3 ref_data.txt test_data.txt'
289  write(*,'(a)') ' numeric_diff --by col --rel-tol 1e-6 --min-col 2 ' &
290  // 'ref_data.txt test_data.txt'
291  write(*,'(a)') ''
292 
293  end subroutine print_help
294 
295 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
296 
297  subroutine print_errors(abs_err, rel_err)
298 
299  !> Absolute errors.
300  real(kind=dp) :: abs_err(:,:)
301  !> Relative errors.
302  real(kind=dp) :: rel_err(:,:)
303 
304  integer :: i_row, i_col
305  character(len=3) :: advance
306 
307  call assert(434301862, (size(abs_err, 1) == size(rel_err, 1)) &
308  .and. (size(abs_err, 2) == size(rel_err, 2)))
309 
310  if ((size(abs_err, 1) == 1) .and. (size(abs_err, 2) <= 5)) then
311  advance = 'no'
312  else
313  advance = 'yes'
314  end if
315 
316  write(*,'(a)', advance=advance) 'absolute error: '
317  do i_row = 1,size(abs_err, 1)
318  do i_col = 1,size(abs_err, 2)
319  write(*, '(e12.3)', advance='no') abs_err(i_row, i_col)
320  end do
321  write(*,'(a)') ''
322  end do
323  write(*,'(a)', advance=advance) 'relative error: '
324  do i_row = 1,size(abs_err, 1)
325  do i_col = 1,size(abs_err, 2)
326  write(*, '(e12.3)', advance='no') rel_err(i_row, i_col)
327  end do
328  write(*,'(a)') ''
329  end do
330 
331  if ((size(abs_err, 1) > 1) .or. (size(abs_err, 2) > 1)) then
332  write(*, '(a,e12.3)') 'maximum absolute error: ', maxval(abs_err)
333  write(*, '(a,e12.3)') 'maximum relative error: ', maxval(rel_err)
334  end if
335 
336  end subroutine print_errors
337 
338 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
339 
340 end program numeric_diff
subroutine die_msg(code, error_msg)
Error immediately.
Definition: util.F90:133
character function getopt(optstring, longopts)
Definition: getopt.F90:131
subroutine print_errors(abs_err, rel_err)
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition: util.F90:76
subroutine pmc_mpi_finalize()
Shut down MPI.
Definition: mpi.F90:88
subroutine pmc_mpi_init()
Initialize MPI.
Definition: mpi.F90:55
integer function string_to_integer(string)
Convert a string to an integer.
Definition: util.F90:665
Common utility subroutines.
Definition: util.F90:9
Wrapper functions for MPI.
Definition: mpi.F90:13
program numeric_diff
Compare two files containing numerical arrays and check whether they are the same as each other...
subroutine die(code)
Error immediately.
Definition: util.F90:121
subroutine print_help()
subroutine loadtxt(filename, data)
Load a real array from a text file.
Definition: util.F90:1292
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition: util.F90:102
real(kind=dp) function string_to_real(string)
Convert a string to a real.