PartMC
2.2.1
|
00001 ! Copyright (C) 2009-2011 Matthew West 00002 ! Licensed under the GNU General Public License version 2 or (at your 00003 ! option) any later version. See the file COPYING for details. 00004 00005 !> \file 00006 !> The numeric_diff program. 00007 00008 !> Compare two files containing numerical arrays and check whether they 00009 !> are the same as each other, to within the specified tolerance. 00010 !> 00011 !> If the arrays in the two files are of different sizes then they are 00012 !> automatically different. Otherwise the are the same if 00013 !> \f[ | A_1 - A_2 |_2 < \verb+abs_tol+ \f] 00014 !> and 00015 !> \f[ \frac{| A_1 - A_2 |_2}{| A_1 |_2 + | A_2 |_2} 00016 !> < \verb+rel_tol+ \f] 00017 !> and are otherwise different. Setting \c abs_tol or \c rel_tol to zero 00018 !> skips the corresponding test. 00019 !> 00020 !> If the files are the same then "<tt>files match within the given 00021 !> tolerances</tt>" is printed on stdout, otherwise "<tt>files 00022 !> differ</tt>" is printed, followed by the absolute and relative 00023 !> differences, as above, or a message describing the difference. The 00024 !> files will be reported as different if they have a different 00025 !> pattern of end-of-lines and end-of-files, or if they have 00026 !> whitespace in different places (amount of whitespace is 00027 !> irrelevant). 00028 !> 00029 !> The exit status of the program is: 00030 !> \li 0 if the files are the same 00031 !> \li 1 if the files are different 00032 !> \li 3 if an error occurred 00033 program numeric_diff 00034 00035 use pmc_util 00036 use pmc_mpi 00037 use getopt_m 00038 00039 integer, parameter :: BY_ARRAY = 1 00040 integer, parameter :: BY_ROW = 2 00041 integer, parameter :: BY_COL = 3 00042 integer, parameter :: BY_ELEM = 4 00043 00044 integer, parameter :: NORM_ONE = 1 00045 integer, parameter :: NORM_TWO = 2 00046 integer, parameter :: NORM_SUP = 3 00047 00048 character(len=PMC_MAX_FILENAME_LEN) :: filename1, filename2 00049 integer :: by, norm, min_row, max_row, min_col, max_col, n_row, n_col 00050 real(kind=dp) :: abs_tol, rel_tol 00051 real(kind=dp), allocatable, target, dimension(:,:) :: data1, data2 00052 real(kind=dp), allocatable, dimension(:,:) :: diff, norm1, abs_err, rel_err 00053 real(kind=dp), pointer, dimension(:,:) :: use_data1, use_data2 00054 type(option_s) :: opts(9) 00055 00056 call pmc_mpi_init() 00057 00058 opts(1) = option_s("help", .false., 'h') 00059 opts(2) = option_s("abs-tol", .true., 't') 00060 opts(3) = option_s("rel-tol", .true., 'T') 00061 opts(4) = option_s("min-row", .true., 'r') 00062 opts(5) = option_s("max-row", .true., 'R') 00063 opts(6) = option_s("min-col", .true., 'c') 00064 opts(7) = option_s("max-col", .true., 'C') 00065 opts(8) = option_s("by", .true., 'b') 00066 opts(9) = option_s("norm", .true., 'n') 00067 00068 abs_tol = 0d0 00069 rel_tol = 0d0 00070 min_row = 0 00071 max_row = 0 00072 min_col = 0 00073 max_col = 0 00074 by = BY_ARRAY 00075 norm = NORM_TWO 00076 00077 do 00078 select case(getopt("ht:T:r:R:c:C:pP", opts)) 00079 case(char(0)) 00080 exit 00081 case('h') 00082 call print_help() 00083 stop 00084 case('t') 00085 abs_tol = string_to_real(optarg) 00086 case('T') 00087 rel_tol = string_to_real(optarg) 00088 case('r') 00089 min_row = string_to_integer(optarg) 00090 case('R') 00091 max_row = string_to_integer(optarg) 00092 case('c') 00093 min_col = string_to_integer(optarg) 00094 case('C') 00095 max_col = string_to_integer(optarg) 00096 case('b') 00097 select case(optarg) 00098 case('array') 00099 by = BY_ARRAY 00100 case('row') 00101 by = BY_ROW 00102 case('col') 00103 by = BY_COL 00104 case('elem') 00105 by = BY_ELEM 00106 case default 00107 call die_msg(526174645, "unknown --by argument: " // trim(optarg)) 00108 end select 00109 case('n') 00110 select case(optarg) 00111 case('one') 00112 norm = NORM_ONE 00113 case('two') 00114 norm = NORM_TWO 00115 case('sup') 00116 norm = NORM_SUP 00117 case default 00118 call die_msg(568020730, "unknown --norm argument: " // trim(optarg)) 00119 end select 00120 case( '?' ) 00121 call die_msg(141541134, 'unknown option') 00122 case default 00123 call die_msg(816884701, 'unhandled option: ' // trim(optopt)) 00124 end select 00125 end do 00126 00127 if (optind /= command_argument_count() - 1) then 00128 call print_help() 00129 call die_msg(142676480, & 00130 'expected exactly two non-option prefix arguments') 00131 end if 00132 00133 call get_command_argument(optind, filename1) 00134 call get_command_argument(optind + 1, filename2) 00135 00136 allocate(data1(0,0)) 00137 allocate(data2(0,0)) 00138 call loadtxt(filename1, data1) 00139 call loadtxt(filename2, data2) 00140 00141 if (min_row <= 0) then 00142 min_row = 1 00143 end if 00144 if (max_row <= 0) then 00145 call assert_msg(266216891, size(data1, 1) == size(data2, 1), & 00146 "number of rows differs between input files") 00147 max_row = size(data1, 1) 00148 else 00149 call assert_msg(136425118, max_row <= size(data1, 1), & 00150 "max-row exceeds the number of rows in " // trim(filename1)) 00151 call assert_msg(279083405, max_row <= size(data2, 1), & 00152 "max-row exceeds the number of rows in " // trim(filename2)) 00153 end if 00154 00155 if (min_col <= 0) then 00156 min_col = 1 00157 end if 00158 if (max_col <= 0) then 00159 call assert_msg(148743161, size(data1, 2) == size(data2, 2), & 00160 "number of columns differs between input files") 00161 max_col = size(data1, 2) 00162 else 00163 call assert_msg(884008689, max_col <= size(data1, 2), & 00164 "max-col exceeds the number of columns in " // trim(filename1)) 00165 call assert_msg(553561214, max_col <= size(data2, 2), & 00166 "max-col exceeds the number of columns in " // trim(filename2)) 00167 end if 00168 00169 use_data1 => data1(min_row:max_row, min_col:max_col) 00170 use_data2 => data2(min_row:max_row, min_col:max_col) 00171 00172 n_row = max_row - min_row + 1 00173 n_col = max_col - min_col + 1 00174 allocate(diff(n_row, n_col)) 00175 diff = use_data1 - use_data2 00176 00177 select case(by) 00178 case(BY_ARRAY) 00179 allocate(norm1(1, 1)) 00180 allocate(abs_err(1, 1)) 00181 select case(norm) 00182 case(NORM_ONE) 00183 norm1(1, 1) = sum(abs(use_data1)) 00184 abs_err(1, 1) = sum(abs(diff)) 00185 case(NORM_TWO) 00186 norm1(1, 1) = sqrt(sum(use_data1**2)) 00187 abs_err(1, 1) = sqrt(sum(diff**2)) 00188 case(NORM_SUP) 00189 norm1(1, 1) = maxval(abs(use_data1)) 00190 abs_err(1, 1) = maxval(abs(diff)) 00191 case default 00192 call die(644692127) 00193 end select 00194 case(BY_ROW) 00195 allocate(norm1(size(diff, 1), 1)) 00196 allocate(abs_err(size(diff, 1), 1)) 00197 select case(norm) 00198 case(NORM_ONE) 00199 norm1(:, 1) = sum(abs(use_data1), 2) 00200 abs_err(:, 1) = sum(abs(diff), 2) 00201 case(NORM_TWO) 00202 norm1(:, 1) = sqrt(sum(use_data1**2, 2)) 00203 abs_err(:, 1) = sqrt(sum(diff**2, 2)) 00204 case(NORM_SUP) 00205 norm1(:, 1) = maxval(abs(use_data1), 2) 00206 abs_err(:, 1) = maxval(abs(diff), 2) 00207 case default 00208 call die(698913943) 00209 end select 00210 case(BY_COL) 00211 allocate(norm1(1, size(diff, 2))) 00212 allocate(abs_err(1, size(diff, 2))) 00213 select case(norm) 00214 case(NORM_ONE) 00215 norm1(1, :) = sum(abs(use_data1), 1) 00216 abs_err(1, :) = sum(abs(diff), 1) 00217 case(NORM_TWO) 00218 norm1(1, :) = sqrt(sum(use_data1**2, 1)) 00219 abs_err(1, :) = sqrt(sum(diff**2, 1)) 00220 case(NORM_SUP) 00221 norm1(1, :) = maxval(abs(use_data1), 1) 00222 abs_err(1, :) = maxval(abs(diff), 1) 00223 case default 00224 call die(351454435) 00225 end select 00226 case(BY_ELEM) 00227 allocate(norm1(size(diff, 1), size(diff, 2))) 00228 allocate(abs_err(size(diff, 1), size(diff, 2))) 00229 norm1(:, :) = abs(use_data1) 00230 abs_err(:, :) = abs(diff) 00231 case default 00232 call die(681575403) 00233 end select 00234 00235 allocate(rel_err(size(abs_err, 1), size(abs_err, 2))) 00236 where (norm1 > 0d0) 00237 rel_err = abs_err / norm1 00238 elsewhere 00239 rel_err = 0d0 00240 end where 00241 00242 if ((abs_tol <= 0d0) .and. (rel_tol <= 0d0)) then 00243 call print_errors(abs_err, rel_err) 00244 elseif (((abs_tol <= 0) .or. all(abs_err < abs_tol)) & 00245 .and. ((rel_tol <= 0) .or. all(rel_err < rel_tol))) then 00246 write(*,'(a)') 'files match within the given relative tolerance' 00247 else 00248 write(*,'(a)') 'files differ' 00249 call print_errors(abs_err, rel_err) 00250 stop 1 00251 end if 00252 00253 deallocate(data1) 00254 deallocate(data2) 00255 deallocate(diff) 00256 deallocate(norm1) 00257 deallocate(abs_err) 00258 deallocate(rel_err) 00259 00260 call pmc_mpi_finalize() 00261 00262 contains 00263 00264 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00265 00266 subroutine print_help() 00267 00268 write(*,'(a)') 'Usage: numeric_diff [options] <reference_file> <test_file>' 00269 write(*,'(a)') '' 00270 write(*,'(a)') 'options are:' 00271 write(*,'(a)') ' -h, --help Print this help message.' 00272 write(*,'(a)') ' -t, --abs-tol <N> Absolute error tolerance.' 00273 write(*,'(a)') ' -T, --rel-tol <N> Relative error tolerance.' 00274 write(*,'(a)') ' -r, --min-row <N> Minimum row number of data to use.' 00275 write(*,'(a)') ' -R, --max-row <N> Maximum row number of data to use.' 00276 write(*,'(a)') ' -c, --min-col <N> Minimum column number of data to use.' 00277 write(*,'(a)') ' -C, --max-col <N> Maximum column number of data to use.' 00278 write(*,'(a)') ' -b, --by <S> Compute error by <S>. <S> is one of "array", "row",' 00279 write(*,'(a)') ' "col", or "elem". Default: "array".' 00280 write(*,'(a)') ' -n, --norm <S> Compute error with norm <S>. <S> is one of "one",' 00281 write(*,'(a)') ' "two", or "sup". Default: "two".' 00282 write(*,'(a)') '' 00283 write(*,'(a)') 'Examples:' 00284 write(*,'(a)') ' numeric_diff --rel-tol 1e-3 ref_data.txt test_data.txt' 00285 write(*,'(a)') ' numeric_diff --by col --rel-tol 1e-6 --min-col 2 ref_data.txt test_data.txt' 00286 write(*,'(a)') '' 00287 00288 end subroutine print_help 00289 00290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00291 00292 subroutine print_errors(abs_err, rel_err) 00293 00294 !> Absolute errors. 00295 real(kind=dp) :: abs_err(:,:) 00296 !> Relative errors. 00297 real(kind=dp) :: rel_err(:,:) 00298 00299 integer :: i_row, i_col 00300 character(len=3) :: advance 00301 00302 call assert(434301862, (size(abs_err, 1) == size(rel_err, 1)) & 00303 .and. (size(abs_err, 2) == size(rel_err, 2))) 00304 00305 if ((size(abs_err, 1) == 1) .and. (size(abs_err, 2) <= 5)) then 00306 advance = 'no' 00307 else 00308 advance = 'yes' 00309 end if 00310 00311 write(*,'(a)', advance=advance) 'absolute error: ' 00312 do i_row = 1,size(abs_err, 1) 00313 do i_col = 1,size(abs_err, 2) 00314 write(*, '(e12.3)', advance='no') abs_err(i_row, i_col) 00315 end do 00316 write(*,'(a)') '' 00317 end do 00318 write(*,'(a)', advance=advance) 'relative error: ' 00319 do i_row = 1,size(abs_err, 1) 00320 do i_col = 1,size(abs_err, 2) 00321 write(*, '(e12.3)', advance='no') rel_err(i_row, i_col) 00322 end do 00323 write(*,'(a)') '' 00324 end do 00325 00326 if ((size(abs_err, 1) > 1) .or. (size(abs_err, 2) > 1)) then 00327 write(*, '(a,e12.3)') 'maximum absolute error: ', maxval(abs_err) 00328 write(*, '(a,e12.3)') 'maximum relative error: ', maxval(rel_err) 00329 end if 00330 00331 end subroutine print_errors 00332 00333 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00334 00335 end program numeric_diff