PartMC 2.1.4
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 are
00022 !> different</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 2 if an error occurred
00033 program numeric_diff
00034 
00035   integer, parameter :: dp = kind(0.d0)
00036   integer, parameter :: unit1 = 40
00037   integer, parameter :: unit2 = 41
00038 
00039   character(len=1000) :: filename1, filename2, tmp
00040   real(kind=dp) :: abs_tol, rel_tol
00041   integer :: ios
00042 
00043   character(len=1000) :: word1, word2
00044   logical :: eol1, eol2, eof1, eof2
00045   real(kind=dp) :: value1, value2, norm1, norm2, abs_error, rel_error
00046   integer :: row, col
00047   integer :: min_row, max_row, min_col, max_col
00048 
00049   ! process commandline arguments
00050   if ((command_argument_count() < 2) .or. (command_argument_count() > 8)) then
00051      write(6,*) 'Usage: numeric_diff <filename1> <filename2> [abs_tol]' &
00052           // ' [rel_tol] [min_row] [max_row] [min_col] [max_col]'
00053      write(6,*) 'Setting tolerances or min/max values to 0 disables' &
00054           // ' that check.'
00055      write(6,*) 'If both tolerances are 0 then just print the differences.'
00056      write(6,*) 'All parameters default to 0 if not specified.'
00057      stop 2
00058   endif
00059   call get_command_argument(1, filename1)
00060   call get_command_argument(2, filename2)
00061   abs_tol = 0d0
00062   if (command_argument_count() >= 3) then
00063      call get_command_argument(3, tmp)
00064      abs_tol = string_to_real(tmp)
00065   end if
00066   rel_tol = 0d0
00067   if (command_argument_count() >= 3) then
00068      call get_command_argument(4, tmp)
00069      rel_tol = string_to_real(tmp)
00070   end if
00071   min_row = 0
00072   if (command_argument_count() >= 5) then
00073      call get_command_argument(5, tmp)
00074      min_row = string_to_integer(tmp)
00075   end if
00076   max_row = 0
00077   if (command_argument_count() >= 6) then
00078      call get_command_argument(6, tmp)
00079      max_row = string_to_integer(tmp)
00080   end if
00081   min_col = 0
00082   if (command_argument_count() >= 7) then
00083      call get_command_argument(7, tmp)
00084      min_col = string_to_integer(tmp)
00085   end if
00086   max_col = 0
00087   if (command_argument_count() >= 8) then
00088      call get_command_argument(8, tmp)
00089      max_col = string_to_integer(tmp)
00090   end if
00091 
00092   ! open files
00093   open(unit=unit1, status='old', file=filename1, iostat=ios)
00094   if (ios /= 0) then
00095      write(0,'(a,a,a,i4)') 'ERROR: unable to open file ', &
00096           trim(filename1), ' for reading: ', ios
00097      stop 2
00098   end if
00099 
00100   open(unit=unit2, status='old', file=filename2, iostat=ios)
00101   if (ios /= 0) then
00102      write(0,'(a,a,a,i4)') 'ERROR: unable to open file ', &
00103           trim(filename2), ' for reading: ', ios
00104      stop 2
00105   end if
00106 
00107   ! read data and compute norms
00108   eof1 = .false.
00109   row = 1
00110   col = 1
00111   norm1 = 0d0
00112   norm2 = 0d0
00113   abs_error = 0d0
00114   do while (.not. eof1)
00115      call read_word_raw(unit1, word1, eol1, eof1)
00116      call read_word_raw(unit2, word2, eol2, eof2)
00117      if (((len(word1) > 0) .and. (len(word2) == 0)) &
00118           .or. ((len(word1) > 0) .and. (len(word2) == 0)) &
00119           .or. (eol1 .and. (.not. eol2)) &
00120           .or. ((.not. eol1) .and. eol2) &
00121           .or. (eof1 .and. (.not. eof2)) &
00122           .or. ((.not. eof1) .and. eof2)) then
00123         write(*,'(a,i8,i8)') 'different shape at', row, col
00124         stop 1
00125      end if
00126      if (len(word1) > 0) then
00127         value1 = string_to_real(word1)
00128         value2 = string_to_real(word2)
00129         if (((min_row == 0) .or. (row >= min_row)) &
00130              .and. ((max_row == 0) .or. (row <= max_row)) &
00131              .and. ((min_col == 0) .or. (col >= min_col)) &
00132              .and. ((max_col == 0) .or. (col <= max_col))) then
00133              norm1 = norm1 + value1**2
00134              norm2 = norm2 + value2**2
00135              abs_error = abs_error + (value1 - value2)**2
00136           end if
00137         if (eol1) then
00138            row = row + 1
00139            col = 1
00140         else
00141            col = col + 1
00142         end if
00143      end if
00144   end do
00145   norm1 = sqrt(norm1)
00146   norm2 = sqrt(norm2)
00147   abs_error = sqrt(abs_error)
00148   rel_error = abs_error / (norm1 + norm2)
00149   
00150   ! check equivalence
00151   if ((abs_tol == 0d0) .and. (rel_tol == 0d0)) then
00152      write(*,'(e12.3,e12.3)') abs_error, rel_error
00153   elseif (((abs_tol == 0d0) .or. (abs_error < abs_tol)) &
00154        .and. ((rel_tol == 0d0) .or. (rel_error < rel_tol))) then
00155      write(*,*) 'files match within the given tolerances'
00156   else
00157      write(*,'(a,e12.3,e12.3)') 'files are different', abs_error, rel_error
00158      stop 1
00159   end if
00160 
00161 contains
00162 
00163 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00164 
00165   !> Convert a string to a real.
00166   real(kind=dp) function string_to_real(string)
00167 
00168     !> String to convert.
00169     character(len=*), intent(in) :: string
00170     
00171     real(kind=dp) :: val
00172     integer :: ios
00173 
00174     read(string, '(e40.0)', iostat=ios) val
00175     if (ios /= 0) then
00176        write(0,'(a,a,a,i3)') 'Error converting ', trim(string), &
00177             ' to real: IOSTAT = ', ios
00178        stop 2
00179     end if
00180     string_to_real = val
00181 
00182   end function string_to_real
00183 
00184 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00185 
00186   !> Convert a string to an integer.
00187   integer function string_to_integer(string)
00188 
00189     !> String to convert.
00190     character(len=*), intent(in) :: string
00191     
00192     integer :: val
00193     integer :: ios
00194 
00195     read(string, '(i20)', iostat=ios) val
00196     if (ios /= 0) then
00197        write(0,'(a,a,a,i3)') 'Error converting ', trim(string), &
00198             ' to integer: IOSTAT = ', ios
00199        stop 1
00200     end if
00201     string_to_integer = val
00202 
00203   end function string_to_integer
00204 
00205 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00206 
00207   !> Expand all tabs in a line into single spaces (one tab makes one
00208   !> space).
00209   subroutine inout_tabs_to_spaces(line)
00210 
00211     !> Complete input line.
00212     character(len=*), intent(inout) :: line
00213 
00214     integer i
00215 
00216     do i = 1,len(line)
00217        if (ichar(line(i:i)) == 9) then
00218           line(i:i) = ' '
00219        end if
00220     end do
00221 
00222   end subroutine inout_tabs_to_spaces
00223 
00224 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00225 
00226   !> Read a single character from a file, signaling if we have hit EOL
00227   !> or EOF. If EOL or EOF are true then the character value should be
00228   !> ignored. A file containing a single line with a single character
00229   !> on it will first return the character with EOL and EOF both
00230   !> false, then will return with EOL true but EOF false, and finally
00231   !> will return with EOL false and EOF true.
00232   subroutine read_char_raw(unit, char, eol, eof)
00233 
00234     !> Unit number to read from.
00235     integer, intent(in) :: unit
00236     !> Character read.
00237     character, intent(out) :: char
00238     !> True if at EOL (end of line).
00239     logical, intent(out) :: eol
00240     !> True if at EOF (end of file).
00241     logical, intent(out) :: eof
00242 
00243     integer :: ios, n_read
00244     character(len=1) :: read_char
00245 
00246     eol = .false.
00247     eof = .false.
00248     char = " " ! shut up uninitialized variable warnings
00249     read_char = "" ! needed for pgf95 for reading blank lines
00250     read(unit=unit, fmt='(a)', advance='no', end=100, eor=110, &
00251          iostat=ios) read_char
00252     if (ios /= 0) then
00253        write(0,*) 'ERROR: reading file: IOSTAT = ', ios
00254        stop 2
00255     end if
00256     ! only reach here if we didn't hit end-of-record (end-of-line) in
00257     ! the above read
00258     char = read_char
00259     goto 120
00260 
00261 100 eof = .true. ! goto here if end-of-file was encountered immediately
00262     goto 120
00263 
00264 110 eol = .true. ! goto here if end-of-record, meaning end-of-line
00265 
00266 120 return
00267     
00268   end subroutine read_char_raw
00269 
00270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00271 
00272   !> Read a white-space delimited word from a file, signaling if we
00273   !> have EOL or EOF. If EOL or EOF are true then the word will still
00274   !> be meaningful data. If there was no data to be read then
00275   !> len(word) will be 0.
00276   subroutine read_word_raw(unit, word, eol, eof)
00277 
00278     !> Unit number to read from.
00279     integer, intent(in) :: unit
00280     !> Word read.
00281     character(len=*), intent(out) :: word
00282     !> True if at EOL (end of line).
00283     logical, intent(out) :: eol
00284     !> True if at EOF (end of file).
00285     logical, intent(out) :: eof
00286 
00287     integer :: i
00288     character :: char
00289 
00290     word = ""
00291 
00292     ! skip over spaces
00293     call read_char_raw(unit, char, eol, eof)
00294     do while (((ichar(char) == 9) .or. (ichar(char) == 32)) &
00295          .and. (.not. eol) .and. (.not. eof))
00296        call read_char_raw(unit, char, eol, eof)
00297     end do
00298     if (eol .or. eof) return
00299     
00300     ! char is now the first word character
00301     i = 1
00302     word(i:i) = char
00303     call read_char_raw(unit, char, eol, eof)
00304     do while ((ichar(char) /= 9) .and. (ichar(char) /= 32) &
00305          .and. (.not. eol) .and. (.not. eof))
00306        i = i + 1
00307        word(i:i) = char
00308        call read_char_raw(unit, char, eol, eof)
00309     end do
00310 
00311   end subroutine read_word_raw
00312 
00313 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00314 
00315 #ifdef DEFINE_LOCAL_COMMAND_ARGUMENT
00316   integer function command_argument_count()
00317     command_argument_count = iargc()
00318   end function command_argument_count
00319   subroutine get_command_argument(i, arg)
00320     integer, intent(in) :: i
00321     character(len=*), intent(out) :: arg
00322     call getarg(i, arg)
00323   end subroutine get_command_argument
00324 #endif
00325 
00326 end program numeric_diff