PartMC  2.2.0
numeric_diff.F90
Go to the documentation of this file.
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