PROGRAM Academic_Standing !----------------------------------------------------------------------- ! Program to determine academic standing of engineering students ! according to two criteria: cumulative hours and cumulative GPA. ! It also counts the total # of students checked and the # found to ! be in good standing, and calculates the average current GPA for all ! students. Variables used are: ! NumStudents : total number of students ! Num_in_Good_Standing : number in good standing ! Response : user response to more-data inquiry ! Sum_of_GPAs : sum of all current GPAs ! ! Input: Response; also several items of student information in ! subroutine CalculateStats ! Output: Student report by subroutine Report and summary statistics ! by subroutine WrapUp !----------------------------------------------------------------------- IMPLICIT NONE INTEGER :: NumStudents = 0, Num_in_Good_Standing = 0 REAL :: Sum_of_GPAs = 0.0 CHARACTER(1) :: Response CALL Inform() ! Repeat the following until no more data DO CALL Process(NumStudents, Num_in_Good_Standing, Sum_of_GPAs) WRITE (*, '(// " ", A)', ADVANCE = "NO") "More (Y or N)? " READ *, Response IF (Response /= "Y") EXIT END DO CALL WrapUp(NumStudents, Num_in_Good_Standing, Sum_of_GPAs) STOP CONTAINS !-Inform-------------------------------------------------------------- SUBROUTINE Inform() PRINT *, "*********** Inform called ***********" RETURN END SUBROUTINE Inform !--Process------------------------------------------------------------ ! Accepts student information, determines academic standing, and ! maintains counts of # processed and # in good standing, and a sum ! of current GPAs. Variables used are: ! NumStudents : total number of students ! Num_in_Good_Standing : number in good standing ! Sum_of_GPAs : sum of all current GPAs ! StudentNumber : student's number ! Class : student's class ! CumulativeHours : student's cumulative hours ! CumulativeGPA : student's cumulative GPA ! CurrentGPA : student's current GPA ! InGoodStanding : indicates whether student is in good ! standing ! ! Accepts: NumStudents, Num_in_Good_Standing, and Sum_of_GPAs ! Returns: Updated values of NumStudents, Num_in_Good_Standing, and ! Sum_of_GPAs !--------------------------------------------------------------------- SUBROUTINE Process(NumStudents, Num_in_Good_Standing, Sum_of_GPAs) INTEGER, INTENT(IN OUT) :: NumStudents, Num_in_Good_Standing REAL, INTENT(IN OUT) :: Sum_of_GPAs REAL :: CumulativeHours, CumulativeGPA, CurrentGPA INTEGER :: StudentNumber, Class LOGICAL :: InGoodStanding CALL CalculateStats(StudentNumber, Class, NumStudents, & CumulativeHours, CumulativeGPA, CurrentGPA, & Sum_of_GPAs) CALL CheckEligibility(Class, CumulativeHours, CumulativeGPA, & InGoodStanding, Num_in_Good_Standing) CALL Report(StudentNumber, Class, CumulativeHours, CurrentGPA, & CumulativeGPA, InGoodStanding) RETURN END SUBROUTINE Process !-WrapUp-------------------------------------------------------------- SUBROUTINE WrapUp(NumStudents, Num_in_Good_Standing, Sum_of_GPAs) INTEGER, INTENT(IN) :: NumStudents, Num_in_Good_Standing REAL, INTENT(IN) :: Sum_of_GPAs PRINT *, "*********** WrapUp called ***********" PRINT *, "Number of Students =", NumStudents PRINT *, "Number in good standing =", Num_in_Good_Standing PRINT *, "Sum of GPAs =", Sum_of_GPAs RETURN END SUBROUTINE WrapUp !-CalculateStats------------------------------------------------------ ! Subroutine to read a student's number, class, cumulative hours, ! and cumulative GPA; then read Hours and Grade for courses taken ! during the current year, and calculate current GPA, update ! cumulative hours, cumulative GPA, and count (NumStudents) of ! students processed. Hours = 0 and Grade = 0 are used to signal the ! end of data for a student. Other local variables used are: ! NewHours : total hours earned during current year ! NewHonorPoints : honor points earned in current year ! OldHonorPoints : honor points earned in past years ! ! Accepts: NumStudents and Sum_of_GPAs ! Input: StudentNumber, Class, CumulativeHours, CumulativeGPA; ! also Hours and Grade for each of several courses ! Returns: StudentNumber, Class, CumulativeHours, CumulativeGPA, ! CurrentGPA and updated values of NumStudents and ! Sum_of_GPAs !--------------------------------------------------------------------- SUBROUTINE CalculateStats(StudentNumber, Class, NumStudents, & CumulativeHours, CumulativeGPA, & CurrentGPA, Sum_of_GPAs) INTEGER, INTENT(IN OUT) :: NumStudents INTEGER, INTENT(OUT) :: StudentNumber, Class REAL, INTENT(IN OUT) :: Sum_of_GPAs REAL, INTENT(OUT) :: CumulativeHours, CumulativeGPA, CurrentGPA REAL :: Hours, Grade, NewHours, NewHonorPoints, OldHonorPoints WRITE (*, '(" ", A)', ADVANCE = "NO") & "Enter student number, class, cum. hours, cum. gpa: " READ *, StudentNumber, Class, CumulativeHours, CumulativeGPA OldHonorPoints = CumulativeHours * CumulativeGPA NewHours = 0.0 NewHonorPoints = 0.0 DO WRITE (*, '(1X, A)', ADVANCE = "NO") "Hours and grade? " READ *, Hours, Grade IF (Hours <= 0.0) EXIT ! Terminate repetition if end-of-data signaled ! Otherwise continue with the following NewHours = NewHours + Hours NewHonorPoints = NewHonorPoints + Hours * Grade END DO IF (NewHours == 0.0) THEN CurrentGPA = 0.0 ELSE CurrentGPA = NewHonorPoints / NewHours END IF CumulativeHours = CumulativeHours + NewHours CumulativeGPA = (OldHonorPoints + NewHonorPoints) / CumulativeHours NumStudents = NumStudents + 1 Sum_of_GPAs = Sum_of_GPAs + CurrentGPA RETURN END SUBROUTINE CalculateStats !-CheckEligibility---------------------------------------------------- ! Subroutine to check academic standing. Two criteria are used: ! cumulative hours and cumulative GPA. Functions HoursCheck and ! GPACheck are used to check these. Class, CumulativeHours, and ! CumulativeGPA are the class, cumulative hours, and cumulative GPA ! for the student being checked. InGoodStanding is true or false ! according to whether or not the student is found to be in good ! standing, and Num_in_Good_Standing is the count of students who ! are in good standing. ! ! Accepts: Class, CumulativeHours, CumulativeGPA, and ! Num_in_Good_Standing ! Returns: InGoodStanding and updated value of Num_in_Good_Standing ! Output: Message indicating an illegal class code !--------------------------------------------------------------------- SUBROUTINE CheckEligibility(Class, CumulativeHours, CumulativeGPA, & InGoodStanding, Num_in_Good_Standing) INTEGER, INTENT(IN) :: Class INTEGER, INTENT(IN OUT) :: Num_in_Good_Standing REAL, INTENT(IN) :: CumulativeHours, CumulativeGPA LOGICAL, INTENT(OUT) :: InGoodStanding IF ((Class < 1) .OR. (Class > 3)) THEN PRINT *, "*** Illegal class code ***" InGoodStanding = .FALSE. ELSE InGoodStanding = HoursCheck(Class, CumulativeHours) .AND. & GPACheck(Class, CumulativeGPA) END IF IF (InGoodStanding) Num_in_Good_Standing = Num_in_Good_Standing + 1 RETURN END SUBROUTINE CheckEligibility !-Report-------------------------------------------------------------- SUBROUTINE Report(StudentNumber, Class, CumulativeHours, & CurrentGPA, CumulativeGPA, InGoodStanding) INTEGER, INTENT(IN) :: StudentNumber, Class REAL, INTENT(IN) :: CumulativeHours, CurrentGPA, CumulativeGPA LOGICAL, INTENT(IN) :: InGoodStanding PRINT *, "*********** Report called ***********" !----- Temporary printout ----- PRINT *, "StudentNumber:", StudentNumber PRINT *, "Class: ", Class PRINT *, "Cum. Hours: ", CumulativeHours PRINT *, "Curr. GPA: ", CurrentGPA PRINT *, "Cum. GPA: ", CumulativeGPA PRINT *, "Good standing: ", InGoodStanding RETURN END SUBROUTINE Report !-HoursCheck---------------------------------------------------------- ! Check cumulative hours (CumulativeHours) of student in Class. Local ! parameters Freshman_Hours, Sophomore_Hours, and Junior_Hours give ! the minimum number of hours required of freshmen, sophomores, and ! juniors, respectively. ! Accepts: Class and CumulativeHours ! Returns: True or false according to whether student has accumulated ! enough hours !--------------------------------------------------------------------- FUNCTION HoursCheck(Class, CumulativeHours) LOGICAL :: HoursCheck INTEGER, INTENT(IN) :: Class REAL, INTENT(IN) :: CumulativeHours REAL, PARAMETER :: Freshman_Hours = 25.0, Sophomore_Hours = 50.0, & Junior_Hours = 85.0 IF (Class == 1) THEN HoursCheck = (CumulativeHours >= Freshman_Hours) ELSE IF (Class == 2) THEN HoursCheck = (CumulativeHours >= Sophomore_Hours) ELSE HoursCheck = (CumulativeHours >= Junior_Hours) END IF RETURN END FUNCTION HoursCheck !-GPACheck------------------------------------------------------------ ! Check cumulative GPA of student in Class. Local parameters ! Freshman_GPA, Sophomore_GPA, and Junior_GPA give give the minimum ! GPA required of freshmen, sophomores, and juniors, respectively. ! ! Accepts: Class and CumulativeGPA ! Returns: True or false according to whether student's GPA is high ! enough !--------------------------------------------------------------------- FUNCTION GPACheck(Class, CumulativeGPA) LOGICAL :: GPACheck INTEGER, INTENT(IN) :: Class REAL, INTENT(IN) :: CumulativeGPA REAL, PARAMETER :: Freshman_GPA = 1.7, Sophomore_GPA = 1.85, & Junior_GPA = 1.95 IF (Class == 1) THEN GPACheck = (CumulativeGPA >= Freshman_GPA) ELSE IF (Class == 2) THEN GPACheck = (CumulativeGPA >= Sophomore_GPA) ELSE GPACheck = (CumulativeGPA >= Junior_GPA) END IF RETURN END FUNCTION GPACheck END PROGRAM Academic_Standing