!********o*********o*********o*********o*********o*********o*********o** ! This program simulates how many pushups the Nittany Lion might have to ! do during a football game, based on the scoring patterns of the team ! during the 1994 regular season. ! ! Every time the Penn State football team scores, the Nittany Lion does ! one pushup for every point on the scoreboard. For example, if they ! kick a field goal, he does three pushups. If they then add a ! touchdown, he does ten more pushups. ! ! The model used for this simulation is that a game is a series of ! events. Each event can be a field goal, touchdown, or end of game. ! The probability of each type of event depends upon the most recent ! event (this is called a markov chain). Note that this is not a ! realistic model for football games, primarily because it ignores the ! fact that there's a game clock. ! ! During the actual 1994 season, the team averaged 47.8 points per game ! and the lion averaged 208.4 pushups. The following table shows the ! scoring breakdown. ! ! opponent | scoring sequence | tot ! -------------+---------------------------------------------+---- ! Minnesota | 7 14 21 28 35 42 49 56 | 56 ! (pushups) | 7 21 42 70 105 147 196 252 | 252 ! -------------+---------------------------------------------+---- ! Southern Cal | 7 14 21 28 35 38 | 38 ! (pushups) | 7 21 42 70 105 143 | 143 ! -------------+---------------------------------------------+---- ! Iowa | 7 14 21 28 35 42 45 48 55 61 | 61 ! (pushups) | 7 21 42 70 105 147 192 240 295 356 | 356 ! -------------+---------------------------------------------+---- ! Rutgers | 7 13 19 27 34 41 48 55 | 55 ! (pushups) | 7 20 39 66 100 141 189 244 | 244 ! -------------+---------------------------------------------+---- ! Temple | 7 14 21 27 34 41 48 | 48 ! (pushups) | 7 21 42 69 103 144 192 | 192 ! -------------+---------------------------------------------+---- ! Michigan | 3 10 13 16 24 31 | 31 ! (pushups) | 3 13 26 42 66 97 | 97 ! -------------+---------------------------------------------+---- ! Ohio St | 7 14 21 28 35 42 49 56 63 | 63 ! (pushups) | 7 21 42 70 105 147 196 252 315 | 315 ! -------------+---------------------------------------------+---- ! Indiana | 7 14 17 20 28 35 | 35 ! (pushups) | 7 21 38 58 86 121 | 121 ! -------------+---------------------------------------------+---- ! Illinois | 7 14 21 28 35 | 35 ! (pushups) | 7 21 42 70 105 | 105 ! -------------+---------------------------------------------+---- ! Northwestern | 7 14 17 24 31 38 45 | 45 ! (pushups) | 7 21 38 62 93 131 176 | 176 ! -------------+---------------------------------------------+---- ! Michigan St | 7 14 21 24 31 38 45 52 59 | 59 ! (pushups) | 7 21 42 66 97 135 180 232 291 | 291 ! -------------+---------------------------------------------+---- ! ! Inputs ! (none) ! ! Outputs ! A summary of scoring and pushups in each simulated game (if enabled). ! The average number of pushups under this model. !--------------------- ! Author: Bob Harris ! Class: CMPSC 201F ! Section: 1234 ! Date Due: 12 Nov 2003 !********o*********o*********o*********o*********o*********o*********o** program livinginthepast implicit none logical, parameter :: showGames = .true. integer, parameter :: games = 11 integer :: game integer :: gamePoints,totalPoints integer :: gamePushups,totalPushups ! 'seed' the pseudo-random number generator, using the system clock ! to give us a seed value (see the subroutine description for more ! details) call SetSeedFromSystemClock ! intialize our sum variables totalPoints = 0 totalPushups = 0 ! simulate the desired number of games do game=1,games call SimulateOneGame (showGames, gamePoints, gamePushups) totalPoints = totalPoints + gamePoints totalPushups = totalPushups + gamePushups end do ! report the results print *, "average points over ",games," games is ", & real(totalPoints)/games print *, "average pushups over ",games," games is ", & real(totalPushups)/games contains !----------------------------------------------------------------------- ! SimulateOneGame-- ! Run one game simulation, and report the number of pushups. !--------------------- ! Arguments ! showit: .true. => show a summary of the game ! .false. => don't ! score: Place to return the number of points scored. ! pushups: Place to return the number of pushups pushed up. !----------------------------------------------------------------------- subroutine SimulateOneGame (showit, score, pushups) logical, intent(in) :: showit integer, intent(out) :: score integer, intent(out) :: pushups real :: r ! a 'random' number (0<=r<1) integer, parameter :: startOfGame = 1 ! the different states integer, parameter :: touchdown = 2 integer, parameter :: fieldGoal = 3 integer, parameter :: endOfGame = 4 integer :: state ! current state of simulation integer :: event ! latest event (and next state) character(2) :: eventName ! name corresponding to the event integer :: points ! number of points for this event !---------- ! initialize the state of the simulation !---------- ! initialize state and tracking variables state = startOfGame score = 0 pushups = 0 ! print game summary header (if desired) if (showit) then print *, "rand event score pushups" print *, "----- ----- ----- -------" end if !---------- ! run the simulation !---------- do !---------- ! determine the next event !---------- ! get the next number in the pseudo-random sequence; see Nyhoff & ! Leestma page A47; the subroutine RANDOM_NUMBER will place the ! number in r; That number will be in the range 0 <= r < 1 call RANDOM_NUMBER(r) ! use the random number to determine which event happens next; this ! depends on which state we are already in select case (state) case (startOfGame) if (r < 1/11.0) then ! 1 of 11 games began with a event = fieldGoal ! ... field goal else ! all remaining games began with event = touchdown ! ... a touchdown end if case (touchdown) if (r < 10/71.0) then ! 10 of 71 touchdowns were followed event = endOfGame ! ... by the end of the game else if (r < 16/71.0) then ! 6 of 71 touchdowns were followed event = fieldGoal ! ... by a field goal else ! all remaining touchdowns were event = touchdown ! ... followed by another end if case (fieldGoal) if (r < 1/10.0) then ! 1 of 10 field goals was followed event = endOfGame ! ... by the end of the game else if (r < 4/10.0) then ! 3 of 10 field goals were followed event = fieldGoal ! ... by another else ! all remaining field goals were event = touchdown ! ... followed by a touchdown end if case default print *, "Hmmm.... I seem to be confused." print *, "I wouldn't trust these results if I were you." exit end select !---------- ! if the game's over, get out of here !---------- if (event == endOfGame) then ! finish game summary (if desired) if (showit) then print '(1X,F5.3,4X,A)', r, "(game over)" print * end if ! exit the simulation loop exit end if !---------- ! update the simulation state !---------- ! determine characteristics of the latest event select case (event) case (touchdown) eventName = "TD" points = 7 ! (assume all extra points are kicked) case (fieldGoal) eventName = "FG" points = 3 end select ! add points for the latest event score = score + points pushups = pushups + score ! print game summary line (if desired) if (showit) then print '(1X,F5.3,A6,I6,I8)', r, eventName, score, pushups end if ! set latest event as the current state, and go back for more state = event end do end subroutine SimulateOneGame !----------------------------------------------------------------------- ! SetSeedFromSystemClock-- ! Seed the random number generator in a way that it will be different ! (nearly) every time. ! ! This routine was posted on the web by someone calling herself "Dr. ! Chaos", Sep/23/2003 (the name of the posted routine is iseedfromair). ! The post was part of the discussion thread at ! http://dbforums.com/arch/132/2003/9/935300 ! in which the discussion topic centered on how it came to pass that ! the fortran standard allows a compiler implementation in which the ! intrinsic subroutine random_seed uses the same seed every time. ! ! Caveat: it really only uses 101 different seed values. !----------------------------------------------------------------------- subroutine SetSeedFromSystemClock real :: r integer :: seed, count, countrate, countmax integer :: i, iters integer :: maxr = HUGE(0) - 1 call random_seed call system_clock(count,countrate,countmax) iters = mod(count,101) do i=1,iters+1 call random_number(r) end do end subroutine SetSeedFromSystemClock end program livinginthepast