PROGRAM Processing_Failure_Times_2 !----------------------------------------------------------------------- ! Program to read a list of failure times, calculate the mean time to ! failure, and then print a list of failure times that are greater ! than the mean. An allocatable array is used to store the failure ! times. Identifiers used are: ! FailureTime : one-dimensional array of failure times ! NumTimes : size of the array ! I : subscript ! Sum : sum of failure times ! Mean_Time_to_Failure : mean of the failure times ! ! Input: A list of NumTimes failure times ! Output: Mean_Time_to_Failure and a list of failure times greater ! than Mean_Time_to_Failure !----------------------------------------------------------------------- IMPLICIT NONE REAL, DIMENSION(:), ALLOCATABLE :: FailureTime INTEGER :: NumTimes, I REAL :: Sum, Mean_Time_to_Failure ! Get the number of failure times and allocate an array ! with that many elements to store the failure times WRITE (*, '(1X, A)', ADVANCE = "NO") & "How many failure times are to be processed? " READ *, NumTimes ALLOCATE(FailureTime(NumTimes)) ! Read the failure times and store them in array FailureTime PRINT *, "Enter the ", NumTimes, "failure times, as many per line & &as desired" READ *, FailureTime ! Calculate the mean time to failure Sum = 0.0 DO I = 1, NumTimes Sum = Sum + FailureTime(I) END DO Mean_Time_to_Failure = Sum / REAL(NumTimes) PRINT '(/ 1X, "Mean time to failure =", F6.1)', Mean_Time_to_Failure ! Print list of failure times greater than the mean PRINT * PRINT *, "List of failure times greater than the mean:" DO I = 1, NumTimes IF (FailureTime(I) > Mean_Time_to_Failure) & PRINT '(1X, F9.1)', FailureTime(I) END DO ! Deallocate the array of failure times DEALLOCATE(FailureTime) END PROGRAM Processing_Failure_Times_2