PartMC
2.1.5
|
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