!
PROGRAM P54
!
IMPLICIT NONE
CHARACTER (LEN=3) :: MONTH(12)
INTEGER :: I,J,K,UNITS(12),UQ(4),NCARS,MAXS,MINS
REAL :: SALES(12),SQ(4),TOTALS,SBIG,SMIN
REAL :: NAVE,TAVE
!
!
PRINT *, 'This is Program >> P54 - Array Max, Min, Average'
!
! Tell program where data for READ * is coming from
OPEN(UNIT=5, FILE='P54.DAT') ! UNIT=5 is the default input
!
!
L1: DO I=1,12
READ 202,MONTH(I),UNITS(I),SALES(I)
END DO L1
202 FORMAT(A3,I7,F5.1)
!
NCARS=UNITS(1)
TOTALS=SALES(1)
SBIG=TOTALS ! Set biggest to the first one
SMIN=TOTALS ! Set smallest to the first one
MINS=1
MAXS=1
!
! Loop through the arrays and find max and min
! and totals
L2: DO I=2,12
NCARS=NCARS+UNITS(I)
TOTALS=TOTALS+SALES(I)
IF(SALES(I) > SBIG)THEN
SBIG=SALES(I)
MAXS=I ! Remember position of biggest
ELSE IF(SALES(I) < SMIN)THEN
SMIN=SALES(I)
MINS=I ! Remember position of smallest
END IF
END DO L2
!
! Form the totals by quarter
!
I=0
L3: DO J=1,4
UQ(J)=0
SQ(J)=0
LOOP: DO K=1,3
I=I+1
UQ(J)=UQ(J)+UNITS(I)
SQ(J)=SQ(J)+SALES(I)
END DO LOOP
END DO L3
!
! OUTPUT ORIGINAL DATA + RESULTS
!
PRINT 501
501 FORMAT(//'MONTH UNIT', &
' SALES M$'/)
L4: DO K=1,12
PRINT 503,MONTH(K),UNITS(K),SALES(K)
END DO L4
503 FORMAT(' ',A3,I6,F6.1)
PRINT 504,NCARS,TOTALS
504 FORMAT(/' TOTALS',I5,F6.1)
NAVE=NCARS/12
TAVE=TOTALS/12.0
PRINT 505,NAVE,TAVE
505 FORMAT(/' AVE.',F5.1,F6.1)
PRINT 506,SBIG,SMIN ! Biggest and smallest values and
PRINT 507,MONTH(MAXS),MONTH(MINS) ! corresponding months
506 FORMAT(/' BEST/WORST-',2F7.1)
507 FORMAT(/' OCCURED IN ',2(' ',A3))
PRINT 530,UQ
PRINT 531,SQ
530 FORMAT(/' CARS SOLD BY QUARTER',4I8)
531 FORMAT(' SALES BY QUARTER ',4F8.1)
STOP
END PROGRAM P54
DATA:
JAN 672 3.4 FEB 609 3.2 MAR 715 3.7 APR 803 4.2 MAY 810 4.8 JUN 831 5.1 JUL 829 5.1 AUG 727 5.1 SEP 780 4.3 OCT 703 3.9 NOV 791 4.2 DEC 783 3.6OUTPUT:
+--------------------------------------------------+
| 32-bit Power for Lahey Computer Systems |
| Phar Lap's 386|DOS-Extender(tm) Version 7.0 |
| Copyright (C) 1986-94 Phar Lap Software, Inc. |
| Available Memory = 14880 Kb |
+--------------------------------------------------+
This is Program >> P54 - Array Max, Min, Average
ONTH UNIT SALES M$
JAN 672 3.4
FEB 609 3.2
MAR 715 3.7
APR 803 4.2
MAY 810 4.8
JUN 831 5.1
JUL 829 5.1
AUG 727 5.1
SEP 780 4.3
OCT 703 3.9
NOV 791 4.2
DEC 783 3.6
TOTALS 9053 50.6
AVE.754.0 4.2
BEST/WORST- 5.1 3.2
OCCURED IN JUN FEB
CARS SOLD BY QUARTER 1996 2444 2336 2277
SALES BY QUARTER 10.3 14.1 14.5 11.7
{$G256}
{$P512}
{$D+}
PROGRAM p54 (input, output);
VAR
month : ARRAY[1..12] OF string[3];
units : ARRAY[1..12] OF INTEGER;
sales : ARRAY[1..12] OF REAL;
uq : ARRAY[1..4] OF INTEGER;
dq : ARRAY[1..4] OF REAL;
i, cars, mins, maxs, j, k, iave : INTEGER;
totals, big, min, ave : REAL;
BEGIN
FOR i := 1 TO 12 DO
readln (month[i], units[i], sales[i]);
cars := units[1];
totals := sales[1];
big := totals;
min := totals;
mins := 1;
maxs := 1;
FOR i := 2 TO 12 DO
BEGIN
cars := cars + units[i];
totals := totals + sales[i];
IF (sales[i] > big) THEN
BEGIN
big := sales[i];
maxs := i
END { end if }
ELSE
IF (sales[i] < min) THEN
BEGIN
min := sales[i];
mins := i
END { end if }
END; { end for }
i := 0;
FOR j := 1 TO 4 DO
BEGIN
uq[j] := 0;
dq[j] := 0;
FOR k := 1 TO 3 DO
BEGIN
i := i + 1;
uq[j] := uq[j] + units[i];
dq[j] := dq[j] + sales[i]
END { end for }
END; { end for }
{
output original data and results
}
writeln ( ^l );
writeln ( ' month unit sales m$' );
FOR k := 1 TO 12 DO
writeln ( ' ':3, month[k], units[k]:6, sales[k]:6:1 );
writeln ;
writeln ( 'totals', cars:5, totals:6:1 );
iave := cars DIV 12;
ave := totals/12.0;
writeln;
writeln ( 'ave.', iave:7, ave:6:1 );
writeln;
writeln ( 'best/worst-', big:5:1, min:5:1 );
writeln;
writeln ( 'occurred in', ' ':2, month[maxs], ' ':2, month[mins] );
writeln;
writeln ( 'cars sold by quarter', uq[1]:5, uq[2]:5, uq[3]:5, uq[4]:5 );
writeln ( 'sales by quarter ',
dq[1]:5:1, dq[2]:5:1, dq[3]:5:1, dq[4]:5:1 )
END.
DATA:
jan 672 3.4 feb 609 3.2 mar 715 3.7 apr 803 4.2 may 810 4.8 jun 831 5.1 jul 829 5.1 aug 727 5.1 sep 780 4.3 oct 703 3.9 nov 791 4.2 dec 783 3.6
Last modified: 22/07/97