Example 6.4

FORTRAN Version

!
      PROGRAM P67
!
      IMPLICIT NONE
      CHARACTER (LEN=3) :: MONTH(12)
      INTEGER :: UNITS(12),MSTART,J,K
      REAL :: SALES(12),SAVE,MEANU
!
      INTERFACE
      SUBROUTINE AVERAGE(MSTART,UNITS,SALES,MEANU,SAVE)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: MSTART
      INTEGER, INTENT(IN OUT) :: UNITS(:)
      REAL, INTENT(IN OUT) :: SALES(:),MEANU,SAVE
      END SUBROUTINE AVERAGE
      END INTERFACE
!
!
      PRINT *, 'This is Program >> P67  - Average Program'
!
!     Tell program where data for  READ   is coming from
      OPEN(UNIT=5, FILE='P67.DAT')      ! UNIT=5 is the default input
!
!
      PRINT 99
 99   FORMAT(/' AVERAGE PROGRAM 2'/)
L1:   DO K=1,12
         READ 27,MONTH(K),UNITS(K),SALES(K)
         PRINT 28,MONTH(K),UNITS(K),SALES(K)
      END DO L1
 27   FORMAT(A3,I7,F5.1)
 28   FORMAT(' ',A3,I7,F6.1)
!
!     DATA HAS BEEN READ, STORED AND PRINTED
!     NOW USE SUBROUTINE
!     ONCE FOR EACH QUARTER
!
L2:   DO J=1,4
         MSTART=3*(J-1)+1
         CALL AVERAGE(MSTART,UNITS,SALES,MEANU,SAVE)
         PRINT 78,MEANU,SAVE,J
      END DO L2
 78   FORMAT(/' MEAN',F7.1,F6.1,'  QUARTER #',I1)
      STOP
      END PROGRAM P67
!
      SUBROUTINE AVERAGE(MSTART,UNITS,SALES,MEANU,SAVE)
!     Size of the arrays below can be 1 or N or *
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: MSTART
      INTEGER, INTENT(IN OUT) :: UNITS(:)      
      REAL, INTENT(IN OUT) :: SALES(:),MEANU,SAVE
      INTEGER :: K,NCARS
      REAL :: DOLLARS
      NCARS=0
      DOLLARS=0
L1:   DO K=MSTART,MSTART+2
         NCARS=NCARS+UNITS(K)
         DOLLARS=DOLLARS+SALES(K)
      END DO L1
!     Calculate averages
      MEANU=NCARS/3.0
      SAVE=DOLLARS/3.0
      RETURN
      END SUBROUTINE AVERAGE

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

              +--------------------------------------------------+
              |     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 >> P67  - Average Program

AVERAGE PROGRAM 2

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

MEAN  665.3   3.4  QUARTER #1

MEAN  814.7   4.7  QUARTER #2

MEAN  778.7   4.8  QUARTER #3

MEAN  759.0   3.9  QUARTER #4

Pascal Version

{$G256}
{$P512}
{$D+}
PROGRAM p67 (input, output);
TYPE
  char_array = ARRAY[1..12] OF string[3];
  int_array = ARRAY[1..12] OF INTEGER;
  real_array = ARRAY[1..12] OF REAL;
VAR
  month : char_array;
  units : int_array;
  sales : real_array;
  k, start, meanu, j : INTEGER;
  save : REAL;

PROCEDURE average ( n, start : INTEGER;
                    units : int_array;
                    sales : real_array;
                    VAR iave : INTEGER;
                    VAR ave : REAL );
VAR
  cars, k, j : INTEGER;
  dollars : REAL;
BEGIN
  cars := 0;
  dollars := 0;
  j := start + n - 1;
  FOR k := start TO j DO
    BEGIN
      cars := cars + units[k];
      dollars := dollars + sales[k]
    END; { end for }
  iave := cars DIV n;
  ave := dollars/n
END;

BEGIN
  writeln ( ^l );
  writeln ( 'Average Program 2' );
  writeln;
  FOR k := 1 TO 12 DO
    BEGIN
      readln ( month[k], units[k], sales[k] );
      writeln ( ' ', month[k], units[k]:7, sales[k]:6:1 )
    END; { end for }
  {
       Data has been read, stored and printed
       Now use procedure once for each quarter
  }
  FOR j := 1 TO 4 DO
    BEGIN
      start := 3 * ( j - 1 ) + 1;
      average ( 3, start, units, sales, meanu, save );
      writeln;
      writeln ( 'mean', meanu:7, save:6:1, '  quarter #', j:1 )
    END { end for }
END.

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