      PROGRAM INVEN
**MAIN******************************************************************
* This program accepts an order from the terminal, searches an inven-  *
* tory file to see if the item ordered is in stock, updates the file,  *
* and displays an out-of-stock message and reorder message when        *
* necessary.  The search of the inventory file uses an index of item   *
* numbers.  This index is read into main memory from an unformatted    *
* file.  Identifiers used are:                                         *
*     LIMIT   :  upper limit on the number of items in inventory file  *
*     LREC    :  length of records in inventory file                   *
*     INUNIT  :  unit number of INFILE                                 *
*     INDEX   :  array of item numbers (INDEX(0) = # of items)         *
*     RESPON  :  response from user (Y or N) re more orders to process *
*                                                                      *
* Input:  RESPON                                                       *
* Output: User prompts                                                 *
************************************************************************

      INTEGER LREC, LIMIT
      PARAMETER (LIMIT = 1000, LREC = 58)
      CHARACTER*1 RESPON
      INTEGER INUNIT, INDEX(0:LIMIT)

      CALL INIT (INUNIT, INDEX, LIMIT, LREC)

* Repeat the following until there are no more transactions

 10       CONTINUE
          CALL TRANS(INUNIT, INDEX, LIMIT)
          PRINT *, 'MORE TRANSACTIONS (Y OR N)'
          READ '(A)', RESPON
      IF (RESPON .EQ. 'Y') GO TO 10

      END


**INIT******************************************************************
* This subroutine opens the inventory file and the index file and con- *
* structs the array INDEX of item numbers.  Variables used:            *
*     INUNIT, INDEX, LIMIT, LREC as in MAIN                            *
*     INFILE          :  name of inventory file                        *
*     IXFILE, IXUNIT  :  name and unit number of index file            *
*                                                                      *
* Accepts:  INDEX, LIMIT, LREC                                         *
* Input:    INFILE, IXFILE                                             *
* Returns:  INUNIT, INDEX                                              *
* Output:   User prompts                                               *
************************************************************************

      SUBROUTINE INIT(INUNIT, INDEX, LIMIT, LREC)

      CHARACTER*20 INFILE, IXFILE
      INTEGER INUNIT, LIMIT, INDEX(0:LIMIT), IXUNIT, LREC

      PRINT *, 'ENTER NAME OF INVENTORY FILE:'
      READ '(A)', INFILE
      CALL OPENER(INFILE, INUNIT, 'FORMATTED', 'OLD', 'DA', LREC)
      PRINT *, 'ENTER NAME OF INDEX FILE:'
      READ '(A)', IXFILE
      CALL OPENER(IXFILE, IXUNIT, 'UNFORMATTED', 'OLD', 'SE', 0)
      CALL CONST(IXUNIT, INDEX, LIMIT)
      END


**OPENER****************************************************************
* Subroutine to open a file and assign it a unit number.  Successive   *
* calls to this subroutine assign unit numbers 10, 11, 12, ...  A call *
* to OPENER with TYPE = 'SE' opens a sequential file, and a call with  *
* TYPE = 'DA' opens a direct-access file.  Variables used are:         *
*     FNAME  :  name of file to be opened                              *
*     NUNIT  :  unit number to be connected to file (integer)          *
*     N      :  last unit number assigned by subroutine                *
*     FORMSP :  'FORMATTED' or 'UNFORMATTED' depending on whether file *
*            :  is formatted or unformatted                            *
*     STAT   :  status of file ('OLD', 'NEW', 'SCRATCH', etc.)         *
*     TYPE   :  indicates if file is sequential or direct access       *
*     LREC   :  length of records for direct-access files              *
*                                                                      *
* Accepts:  FNAME, FORMSP, STAT, TYPE, LREC                            *
* Returns:  NUNIT                                                      *
* Output:   Messages re opening of files                               *
************************************************************************

      SUBROUTINE OPENER(FNAME, NUNIT, FORMSP, STAT, TYPE, LREC)

      CHARACTER*(*) FNAME, FORMSP, STAT, TYPE
      INTEGER LREC, NUNIT, N
      SAVE N
      DATA N/10/

      IF(TYPE .EQ. 'SE') THEN
          OPEN(UNIT = N, FILE = FNAME, FORM = FORMSP, STATUS = STAT,
     +          ERR = 10)
      ELSE
          OPEN(UNIT = N, FILE = FNAME, FORM = FORMSP, STATUS = STAT,
     +          ACCESS = 'DIRECT', RECL = LREC, ERR = 10)
      END IF
      NUNIT = N
      N = N + 1
      RETURN
 10       PRINT *, FNAME, ' CANNOT BE OPENED'

      END


**CONST*****************************************************************
* This subroutine constructs the array INDEX of item numbers from the  *
* (unformatted) file IXFILE.  IXFILE, IXUNIT, INDEX, and LIMIT are as  *
* in MAIN.  Other variables used are:                                  *
*     I       :  count of records in inventory file (stored in         *
*             :  INDEX(0) before return)                               *
*     ITNUM   :  item number                                           *
*                                                                      *
* Accepts:      IXUNIT, INDEX, LIMIT                                   *
* Input (file): Elements of the array INDEX                            *
* Returns:      INDEX                                                  *
************************************************************************

      SUBROUTINE CONST(IXUNIT, INDEX, LIMIT)

      INTEGER LIMIT, INDEX(0:LIMIT), IXUNIT, I, ITNUM

      I = 0

* While there is more data, do the following:

 10       CONTINUE
          READ (IXUNIT, END = 20) ITNUM
          I = I + 1
          INDEX(I) = ITNUM
      GO TO 10
 20       CONTINUE

* Store the count in INDEX(0)

      INDEX(0) = I
      END


**TRANS*****************************************************************
* This subroutine processes a transaction by accepting an order for    *
* a certain item from the terminal, searching the array INDEX to find  *
* the number of the record in the inventory file describing this item, *
* and then updating this record (displaying out-of-stock and/or reorder*
* messages at the terminal when necessary).  Variables used:           *
*     INUNIT, INDEX, LIMIT as in MAIN and INIT                         *
*     NUMORD  :  order number                                          *
*     ITNUM   :  item number                                           *
*     QUANT   :  number of items ordered                               *
*     NUMREC  :  number of record containing information re ITNUM      *
*             :  (VALUE 0 indicates item not found)                    *
*                                                                      *
* Accepts:  INUNIT, INDEX, LIMIT                                       *
* Input  :  NUMORD, ITNUM, QUANT                                       *
* Accepts:  INUNIT, INDEX, LIMIT                                       *
* Output :  User prompts                                               *
************************************************************************

      SUBROUTINE TRANS(INUNIT, INDEX, LIMIT)

      INTEGER LIMIT, INDEX (0:LIMIT), INUNIT, NUMORD, ITNUM, QUANT,
     +         NUMREC

      PRINT *, 'ENTER ORDER #'
      READ *, NUMORD
      PRINT *, '(ENTER 0/ FOR ITEM # TO TERMINATE ORDER)'
      PRINT *, 'ITEM #, QUANTITY'
      READ *, ITNUM, QUANT

* While ITNUM not equal to 0 do the following:

 10       IF (ITNUM .NE. 0) THEN
          CALL SEARCH(ITNUM, INDEX, LIMIT, NUMREC)
          IF (NUMREC .NE. 0)
     +        CALL PROCES(NUMREC, QUANT, NUMORD, INUNIT)
          PRINT *, 'ITEM #, QUANTITY'
          READ *, ITNUM, QUANT
      GO TO 10
      END IF
      END


**SEARCH****************************************************************
* This subroutine searches the array INDEX of item numbers to locate   *
* the number NUMREC of the record in the inventory file containing     *
* information re the item with item number ITNUM.  LIMIT is as in MAIN *
* and FOUND is a boolean indicating whether the item has been found.   *
*                                                                      *
* Accepts:  INDEX, ITNUM, LIMIT                                        *
* Returns:  NUMREC                                                     *
************************************************************************

      SUBROUTINE SEARCH(ITNUM, INDEX, LIMIT, NUMREC)

      INTEGER LIMIT, INDEX(0:LIMIT), ITNUM, NUMREC, I
      LOGICAL FOUND

      I = 1
      FOUND = .FALSE.

* While FOUND is false and I is less than or equal to the
* number of items in the array INDEX do the following:

 10       IF ((.NOT. FOUND) .AND. (I .LE. INDEX(0))) THEN
          IF (ITNUM .EQ. INDEX(I)) THEN
              NUMREC = I
              FOUND = .TRUE.
          ELSE
              I = I + 1
          END IF
      GO TO 10
      END IF
      IF (.NOT. FOUND) THEN
          PRINT *, 'BAD ITEM NUMBER'
          NUMREC = 0
      END IF
      END


**PROCES****************************************************************
* This subroutine processes an order (order # NUMORD) for QUANT items. *
* The NUMREC-th record of the inventory file (unit number INUNIT) is   *
* examined to determine whether the number in stock is sufficient to   *
* fill the order.  If not, an out-of-stock message will be displayed   *
* at the terminal.  In either case, this record will be updated.       *
* Also, if the new number in stock is below the reorder point, a       *
* reorder message will be displayed at the terminal.  New variables    *
* used are:                                                            *
*     INFO    :  unused information in a record                        *
*     REORD   :  reorder point                                         *
*     INSTOK  :  number of items in stock                              *
*     INLEV   :  desired inventory level                               *
*     STOCK   :  INSTOK - QUANT (# remaining in stock)                 *
*     FORM    :  an i/o format                                         *
*                                                                      *
* Accepts:        NUMREC, QUANT, NUMORD, INUNIT                        *
* Input (file):   ITNUM, INFO, REORD, INSTOK, INLEV                    *
* Output(screen): Messages re the order being processed and reordering *
*                 information                                          *
* Output(file):   ITNUM, INFO, REORD, INSTOK (updated), INLEV          *
************************************************************************

      SUBROUTINE PROCES(NUMREC, QUANT, NUMORD, INUNIT)

      CHARACTER*36 INFO, FORM
      INTEGER NUMREC, QUANT, NUMORD, INUNIT, REORD, INSTOK, INLEV, STOCK
      SAVE FORM
      DATA FORM / '(I4, A35, 3I6)' /

      READ (INUNIT, FORM, REC = NUMREC) ITNUM, INFO, REORD, INSTOK,
     +     INLEV
      STOCK = INSTOK - QUANT
      IF (STOCK .LT. 0) THEN
          PRINT *, 'OUT OF STOCK ON ITEM #', ITNUM
          PRINT *, 'BACK ORDER', -1*STOCK, ' FOR ORDER #', NUMORD
          PRINT *, 'ONLY', INSTOK,' UNITS CAN BE SHIPPED AT THIS TIME'
          PRINT *, 'THE DESIRED INVENTORY LEVEL IS', INLEV
          INSTOK = 0
      ELSE
          INSTOK = STOCK
          PRINT *, 'DONE'
      END IF
      WRITE (INUNIT, FORM, REC = NUMREC) ITNUM, INFO, REORD, INSTOK,
     +      INLEV
      IF ((STOCK .GE. 0) .AND. (STOCK .LE. REORD)) THEN
          PRINT *, 'ONLY',INSTOK,' UNITS OF',ITNUM,' REMAIN IN STOCK'
          PRINT *, 'REORDER POINT IS', REORD
          PRINT *, 'DESIRED INVENTORY LEVEL IS', INLEV
      END IF
      END
