PartMC 2.1.3
numeric_average.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_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