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_average program. 00007 00008 !> Compute the mean of a sequence of files containing numerical arrays, 00009 !> all of the same size. 00010 program numeric_average 00011 00012 integer, parameter :: dp = kind(0.d0) 00013 integer, parameter :: MAX_INPUT_FILES = 10000 00014 integer, parameter :: out_unit = 40 00015 integer, parameter :: in_unit_start = 41 00016 00017 character(len=1000) :: filename 00018 integer :: ios 00019 character(len=1000) :: word1, word2 00020 logical :: eol1, eol2, eof1, eof2 00021 real(kind=dp) :: total 00022 integer :: row, col, i_file, n_file 00023 integer :: in_units(MAX_INPUT_FILES) 00024 00025 ! process commandline arguments 00026 if (command_argument_count() < 2) then 00027 write(6,*) 'Usage: numeric_average <out_filename>' & 00028 // ' <in_filename_1> ... <in_filename_N>' 00029 stop 2 00030 endif 00031 n_file = command_argument_count() - 1 00032 if (n_file > MAX_INPUT_FILES) then 00033 write(0,*) 'ERROR: Too many input files' 00034 stop 1 00035 end if 00036 call get_command_argument(1, filename) 00037 write(*,*) "averaging output: ", trim(filename) 00038 open(unit=out_unit, file=filename, iostat=ios) 00039 if (ios /= 0) then 00040 write(0,'(a,a,a,i4)') 'ERROR: unable to open file ', & 00041 trim(filename), ' for writing: ', ios 00042 stop 1 00043 end if 00044 do i_file = 1,n_file 00045 call get_command_argument(i_file + 1, filename) 00046 in_units(i_file) = in_unit_start + i_file - 1 00047 write(*,*) "averaging input: ", trim(filename) 00048 open(unit=in_units(i_file), status='old', file=filename, iostat=ios) 00049 if (ios /= 0) then 00050 write(0,'(a,a,a,i4)') 'ERROR: unable to open file ', & 00051 trim(filename), ' for reading: ', ios 00052 stop 2 00053 end if 00054 end do 00055 00056 ! read data and compute average 00057 eof1 = .false. 00058 row = 1 00059 col = 1 00060 do while (.not. eof1) 00061 total = 0d0 00062 call read_word_raw(in_units(1), word1, eol1, eof1) 00063 if (len(word1) > 0) then 00064 total = string_to_real(word1) 00065 end if 00066 do i_file = 2,n_file 00067 call read_word_raw(in_units(i_file), word2, eol2, eof2) 00068 if (((len(word1) > 0) .and. (len(word2) == 0)) & 00069 .or. ((len(word1) > 0) .and. (len(word2) == 0)) & 00070 .or. (eol1 .and. (.not. eol2)) & 00071 .or. ((.not. eol1) .and. eol2) & 00072 .or. (eof1 .and. (.not. eof2)) & 00073 .or. ((.not. eof1) .and. eof2)) then 00074 write(*,'(a,i8,i8,i8)') 'different shape at row/col/file:', & 00075 row, col, i_file 00076 stop 1 00077 end if 00078 if (len(word1) > 0) then 00079 total = total + string_to_real(word2) 00080 end if 00081 end do 00082 if (len(word1) > 0) then 00083 if (eol1) then 00084 row = row + 1 00085 col = 1 00086 else 00087 col = col + 1 00088 end if 00089 if (.not. eof1) then 00090 write(out_unit,'(e30.15e3)', advance='no') & 00091 (total / real(n_file, kind=dp)) 00092 if (eol1) write(out_unit, '(a)') '' 00093 end if 00094 end if 00095 end do 00096 00097 close(out_unit) 00098 do i_file = 1,n_file 00099 close(in_units(i_file)) 00100 end do 00101 00102 contains 00103 00104 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00105 00106 !> Convert a string to a real. 00107 real(kind=dp) function string_to_real(string) 00108 00109 !> String to convert. 00110 character(len=*), intent(in) :: string 00111 00112 real(kind=dp) :: val 00113 integer :: ios 00114 00115 read(string, '(e40.0)', iostat=ios) val 00116 if (ios /= 0) then 00117 write(0,'(a,a,a,i3)') 'Error converting ', trim(string), & 00118 ' to real: IOSTAT = ', ios 00119 stop 2 00120 end if 00121 string_to_real = val 00122 00123 end function string_to_real 00124 00125 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00126 00127 !> Expand all tabs in a line into single spaces (one tab makes one 00128 !> space). 00129 subroutine inout_tabs_to_spaces(line) 00130 00131 !> Complete input line. 00132 character(len=*), intent(inout) :: line 00133 00134 integer i 00135 00136 do i = 1,len(line) 00137 if (ichar(line(i:i)) == 9) then 00138 line(i:i) = ' ' 00139 end if 00140 end do 00141 00142 end subroutine inout_tabs_to_spaces 00143 00144 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00145 00146 !> Read a single character from a file, signaling if we have hit EOL 00147 !> or EOF. If EOL or EOF are true then the character value should be 00148 !> ignored. A file containing a single line with a single character 00149 !> on it will first return the character with EOL and EOF both 00150 !> false, then will return with EOL true but EOF false, and finally 00151 !> will return with EOL false and EOF true. 00152 subroutine read_char_raw(unit, char, eol, eof) 00153 00154 !> Unit number to read from. 00155 integer, intent(in) :: unit 00156 !> Character read. 00157 character, intent(out) :: char 00158 !> True if at EOL (end of line). 00159 logical, intent(out) :: eol 00160 !> True if at EOF (end of file). 00161 logical, intent(out) :: eof 00162 00163 integer :: ios, n_read 00164 character(len=1) :: read_char 00165 00166 eol = .false. 00167 eof = .false. 00168 char = " " ! shut up uninitialized variable warnings 00169 read_char = "" ! needed for pgf95 for reading blank lines 00170 read(unit=unit, fmt='(a)', advance='no', end=100, eor=110, & 00171 iostat=ios) read_char 00172 if (ios /= 0) then 00173 write(0,*) 'ERROR: reading file: IOSTAT = ', ios 00174 stop 2 00175 end if 00176 ! only reach here if we didn't hit end-of-record (end-of-line) in 00177 ! the above read 00178 char = read_char 00179 goto 120 00180 00181 100 eof = .true. ! goto here if end-of-file was encountered immediately 00182 goto 120 00183 00184 110 eol = .true. ! goto here if end-of-record, meaning end-of-line 00185 00186 120 return 00187 00188 end subroutine read_char_raw 00189 00190 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00191 00192 !> Read a white-space delimited word from a file, signaling if we 00193 !> have EOL or EOF. If EOL or EOF are true then the word will still 00194 !> be meaningful data. If there was no data to be read then 00195 !> len(word) will be 0. 00196 subroutine read_word_raw(unit, word, eol, eof) 00197 00198 !> Unit number to read from. 00199 integer, intent(in) :: unit 00200 !> Word read. 00201 character(len=*), intent(out) :: word 00202 !> True if at EOL (end of line). 00203 logical, intent(out) :: eol 00204 !> True if at EOF (end of file). 00205 logical, intent(out) :: eof 00206 00207 integer :: i 00208 character :: char 00209 00210 word = "" 00211 00212 ! skip over spaces 00213 call read_char_raw(unit, char, eol, eof) 00214 do while (((ichar(char) == 9) .or. (ichar(char) == 32)) & 00215 .and. (.not. eol) .and. (.not. eof)) 00216 call read_char_raw(unit, char, eol, eof) 00217 end do 00218 if (eol .or. eof) return 00219 00220 ! char is now the first word character 00221 i = 1 00222 word(i:i) = char 00223 call read_char_raw(unit, char, eol, eof) 00224 do while ((ichar(char) /= 9) .and. (ichar(char) /= 32) & 00225 .and. (.not. eol) .and. (.not. eof)) 00226 i = i + 1 00227 word(i:i) = char 00228 call read_char_raw(unit, char, eol, eof) 00229 end do 00230 00231 end subroutine read_word_raw 00232 00233 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 00234 00235 #ifdef DEFINE_LOCAL_COMMAND_ARGUMENT 00236 integer function command_argument_count() 00237 command_argument_count = iargc() 00238 end function command_argument_count 00239 subroutine get_command_argument(i, arg) 00240 integer, intent(in) :: i 00241 character(len=*), intent(out) :: arg 00242 call getarg(i, arg) 00243 end subroutine get_command_argument 00244 #endif 00245 00246 end program numeric_average