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