PROGRAM Inventory_Maintenance
!-Main------------------------------------------------------------------
! This program accepts an order from the keyboard, searches an inventory
! 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:
!   ItemsLimit      : limit on number of items in inventory file
!   InputUnitNumber : unit number of input file
!   Index           : array of item numbers (Index(0) = # of items)
!   Response        : response from user (Y or N) about more orders 
!                    to process
!
! Input:  Response
! Output: User prompts
!-----------------------------------------------------------------------

  IMPLICIT NONE
  INTEGER, PARAMETER :: ItemsLimit = 1000
  INTEGER :: InputUnitNumber
  CHARACTER(1) Response
  INTEGER, DIMENSION(0:ItemsLimit) :: Index

  CALL Initialize (ItemsLimit, InputUnitNumber, Index)

  ! Repeat the following until there are no more transactions

  DO
     CALL ProcessTransaction(InputUnitNumber, Index, ItemsLimit)
     WRITE (*, '(/ 1X, A)', ADVANCE = "NO") &
           "More transactions (Y or N)? "
     READ *, Response
     IF (Response /= "Y") EXIT
  END DO

CONTAINS

  !-Initialize----------------------------------------------------------
  ! This subroutine opens the inventory file and the index file and
  ! constructs the array Index of ItemsLimit numbers. ItemsLimit,
  ! RecordLength, InputUnitNumber, Index as in Main.  Other local
  ! variables used are:
  !   InventoryFile : name of inventory file
  !   IndexFile     : name of index file
  !   OpenStatus    : status variable for OPEN
  !   RecordLength  : length of records in inventory file
  !
  ! Accepts:  Index, ItemsLimit, RecordLength
  ! Input:    InventoryFile, IndexFile
  ! Returns:  InputUnitNumber, Index
  ! Output:   User prompts
  !---------------------------------------------------------------------
  
  SUBROUTINE Initialize(ItemsLimit, InputUnitNumber, Index)
  
    INTEGER, PARAMETER :: RecordLength = 80
    INTEGER, INTENT(IN) :: ItemsLimit
    INTEGER, INTENT(OUT) :: InputUnitNumber
    INTEGER, DIMENSION(0:ItemsLimit), INTENT(OUT) :: Index
    CHARACTER(20) :: InventoryFile, IndexFile
    INTEGER :: OpenStatus
  
    WRITE (*, '(1X, A)', ADVANCE = "NO") &
          "Enter name of inventory file: "
    READ *, InventoryFile
    InputUnitNumber = 10
    OPEN(FILE = InventoryFile, UNIT = 10, STATUS = "OLD", &
         FORM = "FORMATTED", POSITION = "REWIND", &
         ACTION = "READWRITE", ACCESS = "DIRECT", &
         RECL = RecordLength, IOSTAT = OpenStatus)
    IF (OpenStatus > 0) STOP "*** Cannot open inventory file ***"
  
    WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter name of index file: "
    READ *, IndexFile

    OPEN (FILE = IndexFile, UNIT = 11, STATUS = "OLD", &
          FORM = "UNFORMATTED", POSITION = "REWIND", &
          ACTION = "READ",  ACCESS = "SEQUENTIAL", &
          IOSTAT = OpenStatus)
    IF (OpenStatus > 0) STOP "*** Cannot open index file ***"
  
    CALL ConstructIndex(11, ItemsLimit, Index)
  
  END SUBROUTINE Initialize
  
  
  !-ConstructIndex------------------------------------------------------
  ! This subroutine constructs the array Index of item numbers from an
  ! (unformatted) file whose unit number is UnitNumber.  Index and
  ! ItemsLimit are as in Main.  Other local variables used are:
  !   I           : count of records in inventory file (stored in
  !                   Index(0) before return)
  !   InputStatus : status variable for READ 
  !   ItemNumber  : item number
  
  ! Accepts:      UnitNumber, Index, ItemsLimit
  ! Input (file): Elements of the array Index
  ! Returns:      Index
  !---------------------------------------------------------------------
  
  SUBROUTINE ConstructIndex(UnitNumber, ItemsLimit, Index)
  
    INTEGER, INTENT(IN) :: UnitNumber, ItemsLimit
    INTEGER, DIMENSION(0:ItemsLimit), INTENT(INOUT) :: Index
    INTEGER :: I, InputStatus, ItemNumber
  
    I = 0
  
    ! While there is more data, do the following:
    DO
       READ (UNIT = UnitNumber, IOSTAT = InputStatus) ItemNumber
       IF (InputStatus > 0) STOP "*** Input error ***"
       IF (InputStatus < 0) EXIT   ! end of file

       ! Otherwise, store ItemNumber in array Index
       I = I + 1
       Index(I) = ItemNumber
    END DO
  
    ! Store the count in Index(0)
    Index(0) = I
  
  END SUBROUTINE ConstructIndex
  

  !-ProcessTransaction--------------------------------------------------
  ! This subroutine processes a transaction by accepting an order for
  ! a certain item from the keyboard, searching the array Index to find
  ! the number of the record in the inventory file with unit number
  ! InvFileUnitNumber describing this item, and then updating this 
  ! record (displaying out-of-stock and/or reorder messages on the 
  ! screen when necessary).  Index and ItemsLimit are as in Main and 
  ! Initialize.  Other local variables used are:
  !     OrderNumber   :  order number
  !     ItemNumber    :  item number
  !     Quantity      :  number of items ordered
  !     RecordNumber  :  number of record containing information about
  !                      ItemNumber (value 0 indicates item not found)
  !
  ! Accepts:  InputUnitNumber, Index, ItemsLimit
  ! Input  :  OrderNumber, ItemNumber, Quantity
  ! Accepts:  InputUnitNumber, Index, ItemsLimit
  ! Output :  User prompts
  !---------------------------------------------------------------------
  
  SUBROUTINE ProcessTransaction(InvFileUnitNumber, Index, ItemsLimit)
  
    INTEGER, INTENT(IN) ::  InvFileUnitNumber, ItemsLimit
    INTEGER, DIMENSION(0:ItemsLimit), INTENT(IN) :: Index
    INTEGER :: OrderNumber, ItemNumber, Quantity, RecordNumber
  
    WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter order #: "
    READ *, OrderNumber
  
    DO
       PRINT *, "(Enter 0/ for item # to terminate order)"
       WRITE (*, '(1X, A)', ADVANCE = "NO") "Item #, Quantity: "
       READ *, ItemNumber, Quantity
  
       IF (ItemNumber == 0) EXIT
       ! If no more items, terminate repetition
  
       ! Otherwise process this item
       CALL Search(ItemNumber, Index, ItemsLimit, RecordNumber)
       IF (RecordNumber /=  0) &
          CALL ProcessOrder(RecordNumber, Quantity, OrderNumber, &
                            InvFileUnitNumber)
    END DO
  
  END SUBROUTINE ProcessTransaction
  

  !-Search--------------------------------------------------------------
  ! This subroutine searches the array Index of item numbers to locate
  ! the RecordNumber of the record in the inventory file containing
  ! information about the item ItemNumber.  ItemsLimit is as in Main.
  ! Other local variables used are:
  !     I     : subscript
  !     Found : indicates if item has been found
  !
  ! Accepts:  Index, ItemNumber, ItemsLimit
  ! Returns:  RecordNumber (0 if ItemNumber not found in Index)
  !---------------------------------------------------------------------
  
  SUBROUTINE Search(ItemNumber, Index, ItemsLimit, RecordNumber)
  
    INTEGER, INTENT(IN) :: ItemNumber, ItemsLimit
    INTEGER, DIMENSION(0:ItemsLimit), INTENT(IN) :: Index
    INTEGER, INTENT(OUT) :: RecordNumber
    LOGICAL :: Found
    INTEGER :: I
  
    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:
    DO
       IF ((Found) .OR. (I > Index(0))) EXIT
       ! If ItemNumber Found or entire array Index
       ! has been searched, terminate repetition
  
       ! Otherwise continue the search
       IF (ItemNumber == Index(I)) THEN
          RecordNumber = I
          Found = .TRUE.
       ELSE
          I = I + 1
       END IF
    END DO
  
    IF (.NOT. Found) THEN
       PRINT *, "Bad item number"
       RecordNumber = 0
    END IF
  
  END SUBROUTINE Search
  

  !-ProcessOrder--------------------------------------------------------
  ! This subroutine processes an order (order # OrderNumber) for 
  ! Quantity items.  The RecordNumber-th record of the inventory file 
  ! (unit number InputUnitNumber) 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 on 
  ! the screen.  Local variables used are:
  !     InventoryRecord : derived type for processing inventory records
  !     IOStatus        : status variable for READ and WRITE
  !     InvRecord       : an inventory record
  !     StockRemaining  : stock remaining after filling order (negative
  !                       if order can't be filled)
  !
  ! Accepts:        RecordNumber, Quantity, OrderNumber, InputUnitNumber
  ! Input (file):   InvRecord
  ! Output(screen): Messages about the order being processed and 
  !                 reordering information
  ! Output(file):   InvRecord (updated)
  !---------------------------------------------------------------------
  
  SUBROUTINE ProcessOrder(RecordNumber, Quantity, OrderNumber, &
                          InputUnitNumber)
  
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: RecordNumber, Quantity, OrderNumber, &
                           InputUnitNumber
  
    TYPE InventoryRecord
       INTEGER :: ItemNumber
       CHARACTER(25) :: ItemName
       INTEGER :: LotSize
       REAL :: Price
       INTEGER :: ReorderPoint, &
                  NumberInStock, &
                  OptimalInvLevel
    END TYPE InventoryRecord
  
    TYPE(InventoryRecord) :: InvRecord
    INTEGER ::  IOStatus, StockRemaining
  
    READ (UNIT = InputUnitNumber, FMT = 10, REC = RecordNumber, &
          IOSTAT = IOStatus) InvRecord%ItemNumber, InvRecord%ItemName, &
          InvRecord%LotSize, InvRecord%Price, InvRecord%ReorderPoint, &
          InvRecord%NumberInStock, InvRecord%OptimalInvLevel
    10 FORMAT(I4, A, I4, F6.2, 3I6)
    IF (IOStatus /= 0) STOP "*** Error reading inventory file ***"
  
    StockRemaining  = InvRecord%NumberInStock - Quantity
    IF (StockRemaining  < 0) THEN
    ! Not enough stock to fill order
       PRINT *, "Out of stock on item #", InvRecord%ItemNumber
       PRINT *, "Back order", -StockRemaining, " for order #", &
                OrderNumber
       PRINT *, "Only", InvRecord%NumberInStock, &
               " units can be shipped at this time"
       PRINT *, "The desired inventory level is", &
                InvRecord%OptimalInvLevel
       InvRecord%NumberInStock = 0
  
    ELSE
    ! Can fill the order
       InvRecord%NumberInStock = StockRemaining
       PRINT *, "Done"
    END IF
  
    ! Update inventory file
    WRITE (UNIT = InputUnitNumber, FMT = 10,  REC = RecordNumber,&
           IOSTAT = IOStatus) InvRecord%ItemNumber, InvRecord%ItemName, &
           InvRecord%LotSize, InvRecord%Price, InvRecord%ReorderPoint, &
           InvRecord%NumberInStock, InvRecord%OptimalInvLevel
    IF (IOStatus /= 0) STOP "*** Error writing to inventory file ***"

    IF ((0 <= StockRemaining ) .AND. &
       (StockRemaining <= InvRecord%ReorderPoint)) THEN
       PRINT *, "Only ", InvRecord%NumberInStock, " units of", &
                InvRecord%ItemNumber," remain in stock"
       PRINT *, "Reorder point is ", InvRecord%ReorderPoint
       PRINT *, "Desired inventory level is ", InvRecord%OptimalInvLevel
    END IF
  
  END SUBROUTINE ProcessOrder

END PROGRAM Inventory_Maintenance
