program survey_sum ! !******************************************************************************* ! !! SURVEY_SUM sums the survey data by answer item. ! ! ! Modified: ! ! 06 December 2001 ! ! Author: ! ! John Burkardt ! implicit none ! integer, parameter :: survey_items = 53 integer, parameter :: survey_questions = 12 ! character ( len = 80 ) answer_text(survey_items) integer i integer ios integer j integer k integer percent(survey_items) integer question_start(survey_questions) character ( len = 80 ) question_text(survey_questions) integer survey_num integer total(survey_items) integer value(survey_items) ! call timestamp ( ) write ( *, * ) ' ' write ( *, * ) 'SURVEY_SUM' write ( *, * ) ' For each answer item in a survey, add up the' write ( *, * ) ' answers, which are presumably each 0 or 1.' survey_num = 0 total(1:survey_items) = 0 ! ! Read the raw scores. ! open ( unit = 1, file = 'survey_raw.txt', status = 'old' ) do read ( 1, '(55i1)', iostat = ios ) value(1:survey_items) if ( ios /= 0 ) then exit end if survey_num = survey_num + 1 total(1:survey_items) = total(1:survey_items) + value(1:survey_items) end do close ( unit = 1 ) ! ! Read the question offset and text. ! open ( unit = 1, file = 'survey_question.txt', status = 'old' ) do i = 1, survey_questions read ( 1, * ) question_start(i) read ( 1, '(a)' ) question_text(i) end do close ( unit = 1 ) ! ! Read the answer text. ! open ( unit = 1, file = 'survey_answer.txt', status = 'old' ) do i = 1, survey_items read ( 1, '(a)' ) answer_text(i) end do close ( unit = 1 ) write ( *, * ) ' ' write ( *, * ) ' The number of survey forms was ', survey_num percent(1:survey_items) = nint ( & ( real ( total(1:survey_items) ) * 100.0 ) / survey_num ) ! ! Write the sums. ! open ( unit = 1, file = 'survey_sum.txt', status = 'replace' ) write ( 1, '(a)' ) 'MATH142 Fall 2001' write ( 1, '(a)' ) ' ' write ( 1, '(a)' ) 'Summary of survey results' write ( 1, '(a,i4)' ) 'Number of surveys returned = ', survey_num write ( 1, '(a)' ) ' ' k = 1 do j = 1, survey_items if ( k <= survey_questions ) then if ( question_start(k) <= j ) then write ( 1, '(a)' ) ' ' write ( 1, '(a)' ) ' ' write ( 1, '(a)' ) trim ( question_text(k) ) write ( 1, '(a)' ) ' ' k = k + 1 end if end if write ( 1, '(i4,i4,a1,2x,a)' ) total(j), percent(j), '%', & trim ( answer_text(j) ) end do close ( unit = 1 ) write ( *, * ) ' ' write ( *, * ) 'SURVEY_SUM' write ( *, * ) ' Normal end of execution' stop end subroutine timestamp ( ) ! !******************************************************************************* ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! ! Example: ! ! May 31 2001 9:45:54.872 AM ! ! Modified: ! ! 31 May 2001 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none ! character ( len = 8 ) ampm integer d character ( len = 8 ) date integer h integer m integer mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer n integer s character ( len = 10 ) time integer values(8) integer y character ( len = 5 ) zone ! call date_and_time ( date, time, zone, values ) y = values(1) m = values(2) d = values(3) h = values(5) n = values(6) s = values(7) mm = values(8) if ( h < 12 ) then ampm = 'AM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end