C DIMENSION STATEMENT MUST INCLUDE AN INTEGER SIZE

C FORTRAN ARRAYS ARE STATIC - SIZE CAN'T BE CHANGED MID-STREAM

C ARRAY DECLARATIONS MUST PRECEDE EXECUTABLE CODE

DIMENSION IPOS(30), INEG(30)

NUMPOS = 0

NUMNEG = 0

NUMERR = 0

NUMZER = 0

C SUBROUTINE DOES NOT HAVE TO HAVE A PARAMETER LIST

CALL INTRO

C THIS WRITE STATEMENT WILL JUST PRINT WHAT'S IN QUOTES IN FORMAT

WRITE (6,2)

2 FORMAT (1X, ' Here are the numbers you entered ')

C WHEN THERE IS NO MORE DATA TO BE READ, THE READ WILL FAIL

C WHEN THE READ FAILS, CONTROL TRANSFERS TO STATEMENT 15

C IF THE DATA IS ERRONEOUS (WRONG TYPE) READ FAILS AND

C CONTROL TRANSFERS TO STATEMENT 27

3 READ (5, 12, END = 15, ERR = 27) NUMBER

C IF READ WAS SUCCESSFUL, VALUE PICKED UP WILL BE PRINTED

12 FORMAT (I20)

WRITE (6, 13) NUMBER

13 FORMAT (1X, I20)

C ARITHMETIC IF STATEMENT - IF VALUE OF NUMBER IS

C LESS THAN 0, CONTROL TRANSFERS TO STATEMENT 20

C EQUAL TO 0, CONTROL TRANSFERS TO STATEMENT 21

C GREATER THAN 0, CONTROL TRANSFERS TO STATEMENT 22

IF (NUMBER) 20, 21, 22

20 NUMNEG = NUMNEG + 1

INEG(NUMNEG) = NUMBER

GOTO 3

21 NUMZER = NUMZER + 1

GOTO 3

C Insert test for out of range heren

22 IF (NUMBER .GT. 99999) CALL OUTRAN

IF (NUMBER .LT. -99999) CALL OUTRAN

NUMPOS = NUMPOS + 1

IPOS (NUMPOS) = NUMBER

GOTO 3

27 NUMERR = NUMERR + 1

CALL ERRMSG

GOTO 3

15 POSAVG = GETAVG (IPOS, NUMPOS)

AVGNEG = GETAVG (INEG, NUMNEG)

WRITE (6, 18)

C PUT THE HEADING FOR THE DATA HERE SO THAT THE SAME

C SUBROUTINE CAN BE USED FOR DIFFERENT SETS OF NUMBERS

18 FORMAT (1X, ' Here are the positive numbers you entered ')

CALL PRINT (IPOS, NUMPOS)

WRITE (6, 19)

19 FORMAT (1X, ' Here are the negative numbers you entered ')

CALL PRINT (INEG, NUMNEG)

CALL RESULT (NUMPOS, NUMNEG, POSAVG, AVGNEG, NUMZER, NUMERR)

STOP

END

FUNCTION GETAVG (IPN , IPNNUM)

C IPN IS THE ARRAY IPNNUM IS ITS SIZE

C NOTE THAT THE ARRAY HAS TO BE DIMENSIONED INSIDE THE

C FUNCTION. NOTE TOO THAT A PORTION OF THE ARRAY CAN BE

C PASSED IN (IN THIS CASE THE PORTION THAT HAS DATA)

DIMENSION IPN(IPNNUM)

SUM = 0.0

DO 30 I = 1, IPNNUM

SUM = IPN(I) + SUM

30 CONTINUE

GETAVG = SUM / FLOAT(IPNNUM)

RETURN

END

SUBROUTINE ERRMSG

WRITE (6,31)

31 FORMAT (1X, ' The value you entered was not an integer ')

WRITE (6, 32)

32 FORMAT (1X, ' It was counted but otherwise ignored ')

RETURN

END

SUBROUTINE OUTRAN

WRITE (6,91)

91 FORMAT (1X, ' The value you entered was an integer ')

WRITE (6, 92)

92 FORMAT (1X, ' but it was out of range (>99999 or < -99999')

RETURN

END

SUBROUTINE RESULT (NPOS, NNEG, PAVG, AVGN, NZER, NERR)

WRITE (6, 40) NPOS

40 FORMAT (1X, ' The number of positive #s processed is ', I10)

WRITE (6, 41) NNEG

41 FORMAT (1X, ' The number of negative #s processed is ', I10)

WRITE (6, 42) PAVG

42 FORMAT (1X, ' The average of the positive #s is ', F10.2)

WRITE (6, 43) AVGN

43 FORMAT (1X, ' The average of the negative #s is ', F10.2)

WRITE (6, 44) NZER

44 FORMAT (1X, ' The number of zeros entered is ', I10)

WRITE (6, 45) NERR

45 FORMAT (1X, ' The number of errors encountered is ', I10)

RETURN

END

SUBROUTINE INTRO

WRITE (6, 50)

WRITE (6, 51)

WRITE (6, 52)

WRITE (6, 53)

WRITE (6, 54)

WRITE (6, 55)

WRITE (6, 56)

WRITE (6, 57)

C ERROR IS FREQUENTLY IN LINE PRECEDING ONE INDICATED

WRITE (6, 58)

WRITE (6, 59)

WRITE (6, 60)

C CAN YOU USE THE SAME LABEL IN DIFFERENT SUBROUTINES?

50 FORMAT (1X, ' This program will process integer values ')

51 FORMAT (1X, ' between -100000 and 100000 ')

52 FORMAT (1X, ' It will count the number of positive #s ')

53 FORMAT (1X, ' It will count the number of negative #s ')

54 FORMAT (1X, ' It will count the number of zeroes')

55 FORMAT (1X, ' It will count the number of out of range #s ')

56 FORMAT (1X, ' It will count the number of data errors')

57 FORMAT (1X, ' It will echo the data as it is input and ')

58 FORMAT (1X, ' again at the program end. ')

59 FORMAT (1X, ' All of the counts will also be printed')

60 FORMAT (1X, ' The program will end when it runs out of data ')

RETURN

END

SUBROUTINE PRINT (IARRAY, ISIZE)

DIMENSION IARRAY(ISIZE)

ITEMP = ISIZE / 3

DO 62 I = 1, ISIZE - 3, 3

WRITE (6, 61) IARRAY(I), IARRAY(I+1), IARRAY(I+2)

61 FORMAT (1X, I20, I20, I20)

62 CONTINUE

ITEMP = ISIZE - 3 * ITEMP

C COMPUTED GO TO - SIMILAR TO JAVA SWITCH STATEMENT

C GOES TO STATEMENT 101 IF ITEMP EQUALS 1 (PRINTS 1 MORE VALUE)

C GOES TO STATEMENT 102 IF ITEMP EQUALS 2 (PRINTS 2 MORE VALUES)

C PRINTS 3 MORE VALUES IF ITEMP = 0

C ITEMP CAN ONLY EQUAL 0,1 OR 2

GOTO (101,102) ITEMP

WRITE (6, 106)IARRAY (I), IARRAY(I+1), IARRAY(I+2)

GOTO 107

101 WRITE (6,104) IARRAY (I)

GOTO 107

102 WRITE (6, 105)IARRAY (I), IARRAY(I+1)

104 FORMAT (1X, I20)

105 FORMAT (1X, I20, I20)

106 FORMAT (1X, I20, I20, I20)

107 RETURN

END