module file_date private integer, parameter, public :: name_len = 40 integer, parameter, public :: month_len = 9 public :: get_file_name, check_with_user, check_file_name, count_files, & get_month_year, pause contains subroutine get_file_name(file_name) ! Get input file name from command line if present ! Otherwise prompt user to enter file name use utilities, only : io_status_check character (len=name_len), intent(out) :: file_name integer :: ios if (command_argument_count() >= 1) then call get_command_argument(1, file_name) else write(unit=*, fmt="(a)", advance="no", iostat=ios) "What is the file name? " call io_status_check(ios, "Error writing prompt to screen") read(unit=*, fmt="(a)", iostat=ios) file_name call io_status_check(ios, "Error reading file name") end if end subroutine get_file_name subroutine check_with_user(prompt, response, proceed) ! Get user's response to question in prompt string ! If response matches response string, either upper or lower case, ! return .true. in proceed, otherwise return .false. ! Read response from command line or prompt user and read it ! from keyboard use utilities character (len=*), intent(in) :: prompt character (len=*), intent(in) :: response logical, intent(out) :: proceed integer :: ios character (len=len(response)) :: ans if (command_argument_count() >= 1) then call get_command_argument(1, ans) else write(unit=*, fmt="(/,a)", advance="no", iostat=ios) prompt call io_status_check(ios, "Error writing prompt to screen") read(unit=*, fmt="(a)", iostat=ios) ans call io_status_check(ios, "Error reading user response") end if proceed = (ans == to_upper(response, len(response))) .or. & (ans == to_lower(response, len(response))) end subroutine check_with_user subroutine check_file_name(file_name) ! Check if given file name matches template for HTML input files, mthyy_0n_x.HTM ! If not return name in template form, assuming first 5 characters are mthyy use utilities, only : to_lower character (len=*), intent(inout) :: file_name character (len=*), parameter :: template = "_00_b.HTM" if (len_trim(file_name) /= 14) then file_name = file_name(:5)//template else if ((index(file_name, "_0") /= 6) .or. (file_name(9:9) /= "_") .or. & (index(to_lower(file_name, 14), ".htm") /= 11)) then file_name = file_name(:5)//template end if end subroutine check_file_name subroutine count_files(file_name, count) ! Count number of files in current directory with names matching template supplied ! in file_name ! Names assumed to be of form a..annb..b.ext where nn is 00 in template and from ! 01 to 99 in files use utilities, only : io_status_check character (len=*), intent(in) :: file_name integer, intent(out) :: count integer :: count_pos, ios logical :: exists character (len=len(file_name)) :: test_name count = 0 count_pos = index(file_name, "00") if (count_pos > 0) then test_name = file_name do count = count + 1 if (count > 99) then count = count - 1 exit end if write(unit=test_name(7:8), fmt="(i2.2)", iostat=ios) count call io_status_check(ios, "Error on internal write in count_files") inquire(file=test_name, exist=exists, iostat=ios) call io_status_check(ios, "Error in inquire for "//test_name) if (.not.exists) then count = count - 1 exit end if end do end if end subroutine count_files subroutine get_month_year(file_name, month, month_num, year) ! Assuming file name starts with mthyy..., return full month name, ! its number, 1 - 12, and 4 digit year use utilities character (len=*), intent(in) :: file_name character (len=month_len), intent(out) :: month integer, intent(out) :: month_num integer, intent(out) :: year integer :: yy, ios character (len=*), parameter :: short_months = "janfebmaraprmayjunjulaugsepoctnovdec" month_num = index(short_months, to_lower(file_name(:3), 3)) if (month_num == 0) then print "(/,a)", "Error reading month in get_month_year" stop end if month_num = month_num / 3 + 1 month = months(month_num) read(unit=file_name(4:5), fmt=*, iostat=ios) yy call io_status_check(ios, "Error on internal read in get_month_year") year = 1900 + yy if (yy < 50) year = year + 100 end subroutine get_month_year subroutine pause(prompt) ! Provide a pause in program execution by prompting user and waiting ! until they press the Return/Enter key use utilities character (len=*), intent(in) :: prompt integer :: ios character (len=1) :: ans write(unit=*, fmt="(/,a)", advance="no", iostat=ios) prompt call io_status_check(ios, "Error writing prompt to screen") read(unit=*, fmt="(a)", iostat=ios) ans call io_status_check(ios, "Error reading user response") end subroutine pause end module file_date