PROGRAM maxmin ! ! Filename: maxmin.f90 ! ! Author: Br. David Carlson ! ! Date: March 30, 2004 ! Updated: March 23, 2012 ! ! This program prompts the user for the number of integers to be read in ! and then prompts for each integer. The program finds where the maximum and ! minimum occur, and then prints the original list of integers with the word ! maximum next to the largest and the word minimum next to the smallest. ! (Should there be a tie for the maximum or minimum, the program finds ! the location of the first one. If all of the numbers are the same, ! it marks the first one as the maximum and minimum.) IMPLICIT NONE INTEGER, PARAMETER::MaxSize = 16 INTEGER, DIMENSION(MaxSize)::item INTEGER::Count, k, IndexMax, IndexMin, Max, Min WRITE (*, *) 'Enter the number of items to be processed' READ (*, *) Count IF (Count > MaxSize ) THEN WRITE (*, *) 'Too many numbers for this program to handle' ELSE IF (Count < 1) THEN WRITE (*, *) 'You must use at least 1 data item.' ELSE ! Enter the data: DO k = 1, Count WRITE (*, *) 'Enter an integer' READ (*, *) item(k) END DO ! Find the max and min (assumed to be first item until know better): IndexMax = 1 IndexMin = 1 Max = item(1) Min = item(1) DO k = 2, Count IF (item(k) > Max) THEN IndexMax = k Max = item(k) ELSE IF (item(k) < Min) THEN IndexMin = k Min = item(k) END IF END DO ! Produce the output: WRITE (*, *) WRITE (*, *) 'Table of results:' DO k = 1, count IF ((k == IndexMax) .AND. (k == IndexMin)) THEN WRITE (*, 100) item(k), 'Maximum and minimum' ELSE IF (k == IndexMax) THEN WRITE (*, 100) item(k), 'Maximum' ELSE IF (k == IndexMin) THEN WRITE (*, 100) item(k), 'Minimum' ELSE WRITE (*, 200) item(k) END IF END DO END IF 100 FORMAT (' ', T5, I6, 3X, A) 200 FORMAT (' ', T5, I6) END PROGRAM