
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
