COBOL ARITHMETIC operations represent one of the most fundamental and powerful computational capabilities in business programming, serving as the cornerstone for implementing sophisticated financial calculations, complex mathematical processing, and comprehensive numerical analysis that enable applications to perform precise business computations with exceptional accuracy and reliability. Far more than simple mathematical operators, COBOL arithmetic statements embody the language's comprehensive approach to business mathematics by providing advanced precision control, sophisticated rounding mechanisms, comprehensive overflow handling, and robust error detection capabilities that enable applications to implement enterprise-grade financial processing, complex statistical analysis, and sophisticated mathematical modeling while maintaining numerical accuracy, computational integrity, and robust error handling capabilities that are essential for mission-critical business applications requiring precise mathematical computations and comprehensive numerical processing.
In enterprise computing environments, COBOL arithmetic operations serve as critical foundations for advanced mathematical processing implementation, enabling developers to create sophisticated financial applications that handle complex calculation requirements, implement comprehensive numerical algorithms, provide precise computational accuracy, and maintain enterprise-grade mathematical capabilities. Their capabilities extend far beyond simple arithmetic to encompass sophisticated precision management, advanced rounding strategies, complex mathematical functions, and integration with modern computational frameworks that are essential for applications requiring comprehensive mathematical processing and enterprise-grade computational capabilities that support complex business calculations and advanced numerical analysis across multiple computational domains and sophisticated mathematical processing scenarios.
COBOL arithmetic operations are a comprehensive set of mathematical statements that enable precise numerical computations in business applications. These operations include ADD, SUBTRACT, MULTIPLY, DIVIDE, and COMPUTE statements, each designed to handle specific mathematical requirements while maintaining the precision and accuracy essential for financial and business calculations.
Unlike simple mathematical expressions in other languages, COBOL arithmetic operations provide explicit control over precision, rounding, overflow handling, and error conditions. This level of control is particularly valuable in financial applications where accuracy is paramount and even small rounding errors can have significant business implications. COBOL's arithmetic capabilities are specifically designed to meet the stringent requirements of business computing.
COBOL provides five primary arithmetic statements, each with specific syntax and capabilities. These statements can operate on individual data items or multiple operands, with automatic handling of data type conversions, precision management, and result formatting. The statements also support various options for error handling and result validation.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127*> Basic COBOL arithmetic operations DATA DIVISION. WORKING-STORAGE SECTION. 01 ARITHMETIC-VARIABLES. 05 NUMBER-A PIC 9(5)V99 VALUE 123.45. 05 NUMBER-B PIC 9(5)V99 VALUE 67.89. 05 NUMBER-C PIC 9(5)V99 VALUE 0. 05 RESULT-FIELD PIC 9(8)V99 VALUE 0. 05 REMAINDER-FIELD PIC 9(5)V99 VALUE 0. 05 QUOTIENT-FIELD PIC 9(6)V99 VALUE 0. 01 FINANCIAL-CALCULATIONS. 05 PRINCIPAL PIC 9(8)V99 VALUE 10000.00. 05 INTEREST-RATE PIC 9(2)V9(4) VALUE 0.0525. 05 TIME-PERIOD PIC 9(3) VALUE 12. 05 MONTHLY-PAYMENT PIC 9(6)V99 VALUE 0. 05 TOTAL-INTEREST PIC 9(8)V99 VALUE 0. PROCEDURE DIVISION. ARITHMETIC-DEMONSTRATIONS. *> ADD operations ADD-OPERATIONS. DISPLAY "=== ADD Operations ===". *> Simple addition ADD NUMBER-A TO NUMBER-B. DISPLAY "Simple ADD: " NUMBER-A " + original B = " NUMBER-B. *> Addition with GIVING clause ADD NUMBER-A NUMBER-B GIVING RESULT-FIELD. DISPLAY "ADD with GIVING: " NUMBER-A " + " NUMBER-B " = " RESULT-FIELD. *> Multiple operand addition ADD NUMBER-A NUMBER-B NUMBER-C GIVING RESULT-FIELD. DISPLAY "Multiple ADD: " NUMBER-A " + " NUMBER-B " + " NUMBER-C " = " RESULT-FIELD. *> Addition with literal ADD 100.50 TO NUMBER-A. DISPLAY "ADD literal: " NUMBER-A " (after adding 100.50)". DISPLAY " ". *> SUBTRACT operations SUBTRACT-OPERATIONS. DISPLAY "=== SUBTRACT Operations ===". *> Simple subtraction SUBTRACT 50.25 FROM NUMBER-A. DISPLAY "Simple SUBTRACT: " NUMBER-A " (after subtracting 50.25)". *> Subtraction with GIVING clause SUBTRACT NUMBER-B FROM NUMBER-A GIVING RESULT-FIELD. DISPLAY "SUBTRACT with GIVING: " NUMBER-A " - " NUMBER-B " = " RESULT-FIELD. *> Multiple operand subtraction SUBTRACT NUMBER-B NUMBER-C FROM NUMBER-A GIVING RESULT-FIELD. DISPLAY "Multiple SUBTRACT: " NUMBER-A " - " NUMBER-B " - " NUMBER-C " = " RESULT-FIELD. DISPLAY " ". *> MULTIPLY operations MULTIPLY-OPERATIONS. DISPLAY "=== MULTIPLY Operations ===". *> Simple multiplication MULTIPLY 2.5 BY NUMBER-A. DISPLAY "Simple MULTIPLY: " NUMBER-A " (after multiplying by 2.5)". *> Multiplication with GIVING clause MULTIPLY NUMBER-A BY NUMBER-B GIVING RESULT-FIELD. DISPLAY "MULTIPLY with GIVING: " NUMBER-A " * " NUMBER-B " = " RESULT-FIELD. *> Interest calculation example MULTIPLY PRINCIPAL BY INTEREST-RATE GIVING TOTAL-INTEREST. DISPLAY "Interest calculation: " PRINCIPAL " * " INTEREST-RATE " = " TOTAL-INTEREST. DISPLAY " ". *> DIVIDE operations DIVIDE-OPERATIONS. DISPLAY "=== DIVIDE Operations ===". *> Simple division DIVIDE NUMBER-A BY 3. DISPLAY "Simple DIVIDE: " NUMBER-A " (after dividing by 3)". *> Division with GIVING clause DIVIDE NUMBER-A BY NUMBER-B GIVING QUOTIENT-FIELD. DISPLAY "DIVIDE with GIVING: " NUMBER-A " / " NUMBER-B " = " QUOTIENT-FIELD. *> Division with remainder DIVIDE NUMBER-A BY NUMBER-B GIVING QUOTIENT-FIELD REMAINDER REMAINDER-FIELD. DISPLAY "DIVIDE with remainder: " NUMBER-A " / " NUMBER-B. DISPLAY " Quotient: " QUOTIENT-FIELD. DISPLAY " Remainder: " REMAINDER-FIELD. *> Division INTO format DIVIDE 1000 INTO NUMBER-A. DISPLAY "DIVIDE INTO: " NUMBER-A " (1000 divided into original value)". DISPLAY " ". *> COMPUTE operations COMPUTE-OPERATIONS. DISPLAY "=== COMPUTE Operations ===". *> Simple computation COMPUTE RESULT-FIELD = NUMBER-A + NUMBER-B - NUMBER-C. DISPLAY "Simple COMPUTE: " NUMBER-A " + " NUMBER-B " - " NUMBER-C " = " RESULT-FIELD. *> Complex mathematical expression COMPUTE RESULT-FIELD = (NUMBER-A * NUMBER-B) / (NUMBER-C + 1). DISPLAY "Complex COMPUTE: (" NUMBER-A " * " NUMBER-B ") / (" NUMBER-C " + 1) = " RESULT-FIELD. *> Financial calculation with COMPUTE COMPUTE MONTHLY-PAYMENT = (PRINCIPAL * INTEREST-RATE) / (1 - ((1 + INTEREST-RATE) ** (-TIME-PERIOD))). DISPLAY "Loan payment calculation: " MONTHLY-PAYMENT. *> Using mathematical functions COMPUTE RESULT-FIELD = FUNCTION SQRT(NUMBER-A * NUMBER-A + NUMBER-B * NUMBER-B). DISPLAY "Pythagorean theorem: SQRT(" NUMBER-A "² + " NUMBER-B "²) = " RESULT-FIELD. DISPLAY " ".
Basic arithmetic operations demonstrate COBOL's comprehensive mathematical capabilities.
The examples above demonstrate the fundamental arithmetic operations in COBOL. Each operation provides multiple syntax options: the basic form that modifies operands in place, and the GIVING clause that stores results in separate fields. The COMPUTE statement offers the most flexibility, allowing complex mathematical expressions similar to algebraic notation.
COBOL's arithmetic operations include sophisticated features for precision control, error handling, and mathematical functions. These advanced capabilities enable developers to implement complex financial algorithms, statistical calculations, and mathematical models with the precision and reliability required for business applications.
Advanced features include the ON SIZE ERROR clause for overflow handling, ROUNDED option for precision control, and integration with COBOL's extensive library of mathematical functions. These capabilities ensure that arithmetic operations can handle edge cases, maintain accuracy, and provide appropriate error handling for production environments.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209*> Advanced arithmetic features and error handling DATA DIVISION. WORKING-STORAGE SECTION. 01 ADVANCED-ARITHMETIC-FIELDS. 05 LARGE-NUMBER-A PIC 9(10)V99 VALUE 9999999.99. 05 LARGE-NUMBER-B PIC 9(10)V99 VALUE 8888888.88. 05 SMALL-DIVISOR PIC 9(3)V99 VALUE 0.01. 05 RESULT-LARGE PIC 9(15)V99 VALUE 0. 05 RESULT-ROUNDED PIC 9(8)V99 VALUE 0. 05 OVERFLOW-FLAG PIC X(1) VALUE "N". 88 OVERFLOW-OCCURRED VALUE "Y". 88 NO-OVERFLOW VALUE "N". 01 MATHEMATICAL-FUNCTIONS. 05 ANGLE-DEGREES PIC 9(3) VALUE 45. 05 ANGLE-RADIANS PIC 9(1)V9(6) VALUE 0. 05 SINE-VALUE PIC S9(1)V9(6) VALUE 0. 05 COSINE-VALUE PIC S9(1)V9(6) VALUE 0. 05 LOGARITHM-BASE PIC 9(5)V99 VALUE 100.00. 05 LOG-RESULT PIC 9(3)V9(4) VALUE 0. 01 STATISTICAL-CALCULATIONS. 05 DATA-POINTS OCCURS 10 TIMES PIC 9(5)V99. 05 MEAN-VALUE PIC 9(6)V99 VALUE 0. 05 VARIANCE PIC 9(8)V99 VALUE 0. 05 STANDARD-DEVIATION PIC 9(6)V99 VALUE 0. 05 SUM-OF-SQUARES PIC 9(10)V99 VALUE 0. 05 DATA-COUNT PIC 9(3) VALUE 10. 01 FINANCIAL-ADVANCED. 05 PRESENT-VALUE PIC 9(10)V99 VALUE 0. 05 FUTURE-VALUE PIC 9(10)V99 VALUE 50000.00. 05 DISCOUNT-RATE PIC 9(1)V9(4) VALUE 0.0750. 05 PERIODS PIC 9(3) VALUE 60. 05 COMPOUND-FACTOR PIC 9(3)V9(6) VALUE 0. PROCEDURE DIVISION. ADVANCED-ARITHMETIC-PROCESSING. *> Error handling with ON SIZE ERROR ERROR-HANDLING-DEMO. DISPLAY "=== Error Handling Demonstrations ===". *> Multiplication with overflow detection MULTIPLY LARGE-NUMBER-A BY LARGE-NUMBER-B GIVING RESULT-LARGE ON SIZE ERROR MOVE "Y" TO OVERFLOW-FLAG DISPLAY "Overflow detected in multiplication" NOT ON SIZE ERROR DISPLAY "Multiplication successful: " RESULT-LARGE END-MULTIPLY. *> Division by zero protection IF SMALL-DIVISOR = 0 DISPLAY "Division by zero prevented" ELSE DIVIDE LARGE-NUMBER-A BY SMALL-DIVISOR GIVING RESULT-LARGE ON SIZE ERROR DISPLAY "Division overflow detected" NOT ON SIZE ERROR DISPLAY "Division result: " RESULT-LARGE END-DIVIDE END-IF. DISPLAY " ". *> Rounding demonstrations ROUNDING-DEMO. DISPLAY "=== Rounding Demonstrations ===". *> Division with rounding DIVIDE 1000 BY 3 GIVING RESULT-ROUNDED ROUNDED. DISPLAY "1000 / 3 with rounding: " RESULT-ROUNDED. *> Multiplication with rounding MULTIPLY 123.456 BY 7.891 GIVING RESULT-ROUNDED ROUNDED. DISPLAY "123.456 * 7.891 with rounding: " RESULT-ROUNDED. *> COMPUTE with rounding COMPUTE RESULT-ROUNDED ROUNDED = (LARGE-NUMBER-A * 1.23456) / 7.89123. DISPLAY "Complex calculation with rounding: " RESULT-ROUNDED. DISPLAY " ". *> Mathematical functions MATHEMATICAL-FUNCTIONS-DEMO. DISPLAY "=== Mathematical Functions ===". *> Trigonometric functions COMPUTE ANGLE-RADIANS = ANGLE-DEGREES * 3.14159 / 180. COMPUTE SINE-VALUE = FUNCTION SIN(ANGLE-RADIANS). COMPUTE COSINE-VALUE = FUNCTION COS(ANGLE-RADIANS). DISPLAY "Angle: " ANGLE-DEGREES " degrees (" ANGLE-RADIANS " radians)". DISPLAY "Sine: " SINE-VALUE. DISPLAY "Cosine: " COSINE-VALUE. *> Logarithmic functions COMPUTE LOG-RESULT = FUNCTION LOG10(LOGARITHM-BASE). DISPLAY "Log base 10 of " LOGARITHM-BASE " = " LOG-RESULT. *> Square root and power functions COMPUTE RESULT-ROUNDED = FUNCTION SQRT(LOGARITHM-BASE). DISPLAY "Square root of " LOGARITHM-BASE " = " RESULT-ROUNDED. COMPUTE RESULT-ROUNDED = LOGARITHM-BASE ** 0.5. DISPLAY "Power function " LOGARITHM-BASE " ** 0.5 = " RESULT-ROUNDED. DISPLAY " ". *> Statistical calculations STATISTICAL-CALCULATIONS-DEMO. DISPLAY "=== Statistical Calculations ===". *> Initialize sample data MOVE 125.50 TO DATA-POINTS(1). MOVE 134.75 TO DATA-POINTS(2). MOVE 118.25 TO DATA-POINTS(3). MOVE 142.00 TO DATA-POINTS(4). MOVE 129.80 TO DATA-POINTS(5). MOVE 136.45 TO DATA-POINTS(6). MOVE 121.90 TO DATA-POINTS(7). MOVE 145.60 TO DATA-POINTS(8). MOVE 132.15 TO DATA-POINTS(9). MOVE 127.35 TO DATA-POINTS(10). *> Calculate mean COMPUTE MEAN-VALUE = (DATA-POINTS(1) + DATA-POINTS(2) + DATA-POINTS(3) + DATA-POINTS(4) + DATA-POINTS(5) + DATA-POINTS(6) + DATA-POINTS(7) + DATA-POINTS(8) + DATA-POINTS(9) + DATA-POINTS(10)) / DATA-COUNT. DISPLAY "Sample data mean: " MEAN-VALUE. *> Calculate variance COMPUTE SUM-OF-SQUARES = ((DATA-POINTS(1) - MEAN-VALUE) ** 2) + ((DATA-POINTS(2) - MEAN-VALUE) ** 2) + ((DATA-POINTS(3) - MEAN-VALUE) ** 2) + ((DATA-POINTS(4) - MEAN-VALUE) ** 2) + ((DATA-POINTS(5) - MEAN-VALUE) ** 2) + ((DATA-POINTS(6) - MEAN-VALUE) ** 2) + ((DATA-POINTS(7) - MEAN-VALUE) ** 2) + ((DATA-POINTS(8) - MEAN-VALUE) ** 2) + ((DATA-POINTS(9) - MEAN-VALUE) ** 2) + ((DATA-POINTS(10) - MEAN-VALUE) ** 2). COMPUTE VARIANCE = SUM-OF-SQUARES / (DATA-COUNT - 1). COMPUTE STANDARD-DEVIATION = FUNCTION SQRT(VARIANCE). DISPLAY "Sample variance: " VARIANCE. DISPLAY "Standard deviation: " STANDARD-DEVIATION. DISPLAY " ". *> Financial calculations FINANCIAL-CALCULATIONS-DEMO. DISPLAY "=== Advanced Financial Calculations ===". *> Present value calculation COMPUTE COMPOUND-FACTOR = (1 + DISCOUNT-RATE) ** PERIODS. COMPUTE PRESENT-VALUE = FUTURE-VALUE / COMPOUND-FACTOR. DISPLAY "Future Value: $" FUTURE-VALUE. DISPLAY "Discount Rate: " DISCOUNT-RATE " per period". DISPLAY "Number of Periods: " PERIODS. DISPLAY "Present Value: $" PRESENT-VALUE. *> Compound interest with monthly compounding COMPUTE COMPOUND-FACTOR = (1 + (DISCOUNT-RATE / 12)) ** (PERIODS * 12). COMPUTE FUTURE-VALUE = PRESENT-VALUE * COMPOUND-FACTOR. DISPLAY "With monthly compounding:". DISPLAY "Future Value: $" FUTURE-VALUE. DISPLAY " ". *> Complex business calculations BUSINESS-CALCULATIONS-DEMO. DISPLAY "=== Complex Business Calculations ===". *> Break-even analysis 01 BREAK-EVEN-ANALYSIS. 05 FIXED-COSTS PIC 9(8)V99 VALUE 50000.00. 05 VARIABLE-COST-RATE PIC 9(1)V99 VALUE 0.60. 05 SELLING-PRICE PIC 9(3)V99 VALUE 25.00. 05 BREAK-EVEN-UNITS PIC 9(8) VALUE 0. 05 CONTRIBUTION-MARGIN PIC 9(3)V99 VALUE 0. COMPUTE CONTRIBUTION-MARGIN = SELLING-PRICE - (SELLING-PRICE * VARIABLE-COST-RATE). COMPUTE BREAK-EVEN-UNITS = FIXED-COSTS / CONTRIBUTION-MARGIN. DISPLAY "Break-even Analysis:". DISPLAY " Fixed Costs: $" FIXED-COSTS. DISPLAY " Variable Cost Rate: " VARIABLE-COST-RATE. DISPLAY " Selling Price: $" SELLING-PRICE. DISPLAY " Contribution Margin: $" CONTRIBUTION-MARGIN. DISPLAY " Break-even Units: " BREAK-EVEN-UNITS. DISPLAY " ". DISPLAY "Advanced arithmetic demonstrations completed".
Advanced arithmetic features demonstrate error handling, rounding, and mathematical functions.
These advanced examples showcase COBOL's sophisticated arithmetic capabilities. The ON SIZE ERROR clause provides robust error handling for overflow conditions, while the ROUNDED option ensures appropriate precision management. Mathematical functions enable complex calculations including trigonometry, logarithms, and statistical analysis, making COBOL suitable for sophisticated business and scientific applications.
To demonstrate the practical power of COBOL arithmetic operations in enterprise applications, let's examine a comprehensive financial calculation system for an investment management company. This example showcases how COBOL's arithmetic capabilities enable sophisticated financial modeling, risk analysis, portfolio optimization, and comprehensive investment calculations with the precision and reliability required for financial services.
This financial system demonstrates advanced arithmetic operations including compound interest calculations, present value analysis, risk assessment metrics, portfolio diversification calculations, and comprehensive financial reporting. The system maintains the precision and accuracy essential for financial applications while providing robust error handling and validation capabilities.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460IDENTIFICATION DIVISION. PROGRAM-ID. FINANCIAL-ARITHMETIC-SYSTEM. DATA DIVISION. WORKING-STORAGE SECTION. *> Investment portfolio data structures 01 PORTFOLIO-INVESTMENTS. 05 INVESTMENT-RECORDS OCCURS 20 TIMES INDEXED BY INV-IDX. 10 INVESTMENT-ID PIC X(10). 10 INVESTMENT-TYPE PIC X(15). 88 STOCK VALUE "STOCK". 88 BOND VALUE "BOND". 88 MUTUAL-FUND VALUE "MUTUAL-FUND". 88 REAL-ESTATE VALUE "REAL-ESTATE". 10 PURCHASE-PRICE PIC 9(8)V99. 10 CURRENT-VALUE PIC 9(8)V99. 10 SHARES-UNITS PIC 9(6)V99. 10 ANNUAL-DIVIDEND PIC 9(6)V99. 10 RISK-RATING PIC 9(1)V9. 10 BETA-COEFFICIENT PIC S9(1)V9(4). 10 EXPECTED-RETURN PIC S9(2)V9(4). *> Financial calculation results 01 PORTFOLIO-ANALYSIS. 05 TOTAL-PORTFOLIO-VALUE PIC 9(10)V99 VALUE 0. 05 TOTAL-COST-BASIS PIC 9(10)V99 VALUE 0. 05 TOTAL-UNREALIZED-GAIN PIC S9(10)V99 VALUE 0. 05 PORTFOLIO-RETURN-RATE PIC S9(3)V9(4) VALUE 0. 05 WEIGHTED-AVERAGE-BETA PIC S9(1)V9(4) VALUE 0. 05 PORTFOLIO-RISK-SCORE PIC 9(2)V9(2) VALUE 0. 05 DIVERSIFICATION-INDEX PIC 9(1)V9(4) VALUE 0. 05 SHARPE-RATIO PIC S9(1)V9(4) VALUE 0. *> Compound interest and time value calculations 01 TIME-VALUE-CALCULATIONS. 05 PRESENT-VALUE-INPUTS. 10 FUTURE-CASH-FLOW PIC 9(8)V99. 10 DISCOUNT-RATE PIC 9(1)V9(4). 10 TIME-PERIODS PIC 9(3). 10 COMPOUNDING-FREQUENCY PIC 9(2). 05 PRESENT-VALUE-RESULTS. 10 CALCULATED-PV PIC 9(8)V99. 10 NET-PRESENT-VALUE PIC S9(8)V99. 10 INTERNAL-RATE-RETURN PIC S9(2)V9(4). *> Loan and mortgage calculations 01 LOAN-CALCULATIONS. 05 LOAN-PARAMETERS. 10 LOAN-PRINCIPAL PIC 9(8)V99. 10 ANNUAL-INTEREST-RATE PIC 9(2)V9(4). 10 LOAN-TERM-MONTHS PIC 9(4). 10 PAYMENT-FREQUENCY PIC 9(2) VALUE 12. 05 LOAN-RESULTS. 10 MONTHLY-PAYMENT PIC 9(6)V99. 10 TOTAL-INTEREST PIC 9(8)V99. 10 TOTAL-PAYMENTS PIC 9(8)V99. 05 AMORTIZATION-SCHEDULE OCCURS 360 TIMES. 10 PAYMENT-NUMBER PIC 9(4). 10 PAYMENT-AMOUNT PIC 9(6)V99. 10 PRINCIPAL-PAYMENT PIC 9(6)V99. 10 INTEREST-PAYMENT PIC 9(6)V99. 10 REMAINING-BALANCE PIC 9(8)V99. *> Risk analysis calculations 01 RISK-ANALYSIS. 05 HISTORICAL-RETURNS OCCURS 60 TIMES PIC S9(2)V9(4). 05 RISK-METRICS. 10 AVERAGE-RETURN PIC S9(2)V9(4). 10 RETURN-VARIANCE PIC 9(4)V9(6). 10 STANDARD-DEVIATION PIC 9(2)V9(4). 10 VALUE-AT-RISK PIC 9(8)V99. 10 MAXIMUM-DRAWDOWN PIC S9(3)V9(4). 10 CORRELATION-COEFFICIENT PIC S9(1)V9(4). *> Options pricing calculations 01 OPTIONS-PRICING. 05 BLACK-SCHOLES-INPUTS. 10 STOCK-PRICE PIC 9(6)V99. 10 STRIKE-PRICE PIC 9(6)V99. 10 TIME-TO-EXPIRATION PIC 9(1)V9(4). 10 RISK-FREE-RATE PIC 9(1)V9(4). 10 VOLATILITY PIC 9(1)V9(4). 05 BLACK-SCHOLES-RESULTS. 10 CALL-OPTION-PRICE PIC 9(4)V99. 10 PUT-OPTION-PRICE PIC 9(4)V99. 10 DELTA PIC S9(1)V9(4). 10 GAMMA PIC 9(1)V9(6). 10 THETA PIC S9(2)V9(4). *> Performance tracking 01 PERFORMANCE-METRICS. 05 CALCULATION-STATISTICS. 10 CALCULATIONS-PERFORMED PIC 9(8) VALUE 0. 10 PRECISION-ERRORS PIC 9(6) VALUE 0. 10 OVERFLOW-INCIDENTS PIC 9(4) VALUE 0. 10 ROUNDING-ADJUSTMENTS PIC 9(6) VALUE 0. 05 TIMING-METRICS. 10 TOTAL-PROCESSING-TIME PIC 9(8)V99 VALUE 0. 10 AVERAGE-CALC-TIME PIC 9(4)V99 VALUE 0. PROCEDURE DIVISION. MAIN-FINANCIAL-PROCESSING. DISPLAY "=== Financial Arithmetic System Demonstration ===". DISPLAY " ". PERFORM INITIALIZE-PORTFOLIO-DATA PERFORM CALCULATE-PORTFOLIO-METRICS PERFORM PERFORM-TIME-VALUE-ANALYSIS PERFORM CALCULATE-LOAN-AMORTIZATION PERFORM ANALYZE-INVESTMENT-RISK PERFORM CALCULATE-OPTIONS-PRICING PERFORM GENERATE-FINANCIAL-REPORTS PERFORM DISPLAY-PERFORMANCE-METRICS DISPLAY " ". DISPLAY "Financial arithmetic system demonstration completed successfully". STOP RUN. INITIALIZE-PORTFOLIO-DATA. DISPLAY "1. Initializing Portfolio Data:". DISPLAY " ============================". *> Initialize sample investment data MOVE "STOCK001" TO INVESTMENT-ID(1). MOVE "STOCK" TO INVESTMENT-TYPE(1). MOVE 50000.00 TO PURCHASE-PRICE(1). MOVE 65000.00 TO CURRENT-VALUE(1). MOVE 1000.00 TO SHARES-UNITS(1). MOVE 2000.00 TO ANNUAL-DIVIDEND(1). MOVE 7.5 TO RISK-RATING(1). MOVE 1.2500 TO BETA-COEFFICIENT(1). MOVE 0.1200 TO EXPECTED-RETURN(1). MOVE "BOND001" TO INVESTMENT-ID(2). MOVE "BOND" TO INVESTMENT-TYPE(2). MOVE 100000.00 TO PURCHASE-PRICE(2). MOVE 102000.00 TO CURRENT-VALUE(2). MOVE 100.00 TO SHARES-UNITS(2). MOVE 4500.00 TO ANNUAL-DIVIDEND(2). MOVE 3.0 TO RISK-RATING(2). MOVE 0.2500 TO BETA-COEFFICIENT(2). MOVE 0.0450 TO EXPECTED-RETURN(2). MOVE "FUND001" TO INVESTMENT-ID(3). MOVE "MUTUAL-FUND" TO INVESTMENT-TYPE(3). MOVE 75000.00 TO PURCHASE-PRICE(3). MOVE 82500.00 TO CURRENT-VALUE(3). MOVE 2500.00 TO SHARES-UNITS(3). MOVE 3200.00 TO ANNUAL-DIVIDEND(3). MOVE 6.0 TO RISK-RATING(3). MOVE 0.9500 TO BETA-COEFFICIENT(3). MOVE 0.0850 TO EXPECTED-RETURN(3). DISPLAY " ✓ Sample portfolio data initialized (3 investments)". DISPLAY " Stock: $65,000 current value". DISPLAY " Bond: $102,000 current value". DISPLAY " Mutual Fund: $82,500 current value". DISPLAY " ". CALCULATE-PORTFOLIO-METRICS. DISPLAY "2. Calculating Portfolio Metrics:". DISPLAY " ===============================". *> Calculate total portfolio value and cost basis MOVE 0 TO TOTAL-PORTFOLIO-VALUE. MOVE 0 TO TOTAL-COST-BASIS. PERFORM VARYING INV-IDX FROM 1 BY 1 UNTIL INV-IDX > 3 ADD CURRENT-VALUE(INV-IDX) TO TOTAL-PORTFOLIO-VALUE ADD PURCHASE-PRICE(INV-IDX) TO TOTAL-COST-BASIS END-PERFORM. *> Calculate unrealized gain/loss COMPUTE TOTAL-UNREALIZED-GAIN = TOTAL-PORTFOLIO-VALUE - TOTAL-COST-BASIS. *> Calculate portfolio return rate COMPUTE PORTFOLIO-RETURN-RATE = (TOTAL-UNREALIZED-GAIN / TOTAL-COST-BASIS) * 100 ON SIZE ERROR MOVE 0 TO PORTFOLIO-RETURN-RATE DISPLAY "Error calculating portfolio return rate" END-COMPUTE. *> Calculate weighted average beta COMPUTE WEIGHTED-AVERAGE-BETA = ((CURRENT-VALUE(1) * BETA-COEFFICIENT(1)) + (CURRENT-VALUE(2) * BETA-COEFFICIENT(2)) + (CURRENT-VALUE(3) * BETA-COEFFICIENT(3))) / TOTAL-PORTFOLIO-VALUE ON SIZE ERROR MOVE 0 TO WEIGHTED-AVERAGE-BETA DISPLAY "Error calculating weighted average beta" END-COMPUTE. *> Calculate diversification index (simplified) COMPUTE DIVERSIFICATION-INDEX = 1 - ((CURRENT-VALUE(1) / TOTAL-PORTFOLIO-VALUE) ** 2 + (CURRENT-VALUE(2) / TOTAL-PORTFOLIO-VALUE) ** 2 + (CURRENT-VALUE(3) / TOTAL-PORTFOLIO-VALUE) ** 2). DISPLAY " Portfolio Analysis Results:". DISPLAY " Total Portfolio Value: $" TOTAL-PORTFOLIO-VALUE. DISPLAY " Total Cost Basis: $" TOTAL-COST-BASIS. DISPLAY " Unrealized Gain/Loss: $" TOTAL-UNREALIZED-GAIN. DISPLAY " Portfolio Return Rate: " PORTFOLIO-RETURN-RATE "%". DISPLAY " Weighted Average Beta: " WEIGHTED-AVERAGE-BETA. DISPLAY " Diversification Index: " DIVERSIFICATION-INDEX. DISPLAY " ". PERFORM-TIME-VALUE-ANALYSIS. DISPLAY "3. Time Value of Money Analysis:". DISPLAY " ==============================". *> Present value calculation MOVE 100000.00 TO FUTURE-CASH-FLOW. MOVE 0.0750 TO DISCOUNT-RATE. MOVE 10 TO TIME-PERIODS. MOVE 1 TO COMPOUNDING-FREQUENCY. COMPUTE CALCULATED-PV = FUTURE-CASH-FLOW / ((1 + DISCOUNT-RATE) ** TIME-PERIODS) ON SIZE ERROR MOVE 0 TO CALCULATED-PV DISPLAY "Error in present value calculation" END-COMPUTE. DISPLAY " Present Value Analysis:". DISPLAY " Future Cash Flow: $" FUTURE-CASH-FLOW. DISPLAY " Discount Rate: " DISCOUNT-RATE. DISPLAY " Time Periods: " TIME-PERIODS " years". DISPLAY " Present Value: $" CALCULATED-PV. *> Compound interest calculation 01 COMPOUND-INTEREST-DEMO. 05 INITIAL-INVESTMENT PIC 9(8)V99 VALUE 25000.00. 05 ANNUAL-RATE PIC 9(1)V9(4) VALUE 0.0650. 05 YEARS PIC 9(2) VALUE 15. 05 FINAL-VALUE PIC 9(8)V99. 05 INTEREST-EARNED PIC 9(8)V99. COMPUTE FINAL-VALUE = INITIAL-INVESTMENT * ((1 + ANNUAL-RATE) ** YEARS) ON SIZE ERROR MOVE 0 TO FINAL-VALUE DISPLAY "Error in compound interest calculation" END-COMPUTE. COMPUTE INTEREST-EARNED = FINAL-VALUE - INITIAL-INVESTMENT. DISPLAY " ". DISPLAY " Compound Interest Analysis:". DISPLAY " Initial Investment: $" INITIAL-INVESTMENT. DISPLAY " Annual Rate: " ANNUAL-RATE. DISPLAY " Investment Period: " YEARS " years". DISPLAY " Final Value: $" FINAL-VALUE. DISPLAY " Interest Earned: $" INTEREST-EARNED. DISPLAY " ". CALCULATE-LOAN-AMORTIZATION. DISPLAY "4. Loan Amortization Calculations:". DISPLAY " ================================". *> Mortgage calculation MOVE 350000.00 TO LOAN-PRINCIPAL. MOVE 0.0425 TO ANNUAL-INTEREST-RATE. MOVE 360 TO LOAN-TERM-MONTHS. *> Calculate monthly payment using standard formula 01 MONTHLY-RATE PIC 9(1)V9(8). COMPUTE MONTHLY-RATE = ANNUAL-INTEREST-RATE / 12. COMPUTE MONTHLY-PAYMENT = (LOAN-PRINCIPAL * MONTHLY-RATE) / (1 - ((1 + MONTHLY-RATE) ** (-LOAN-TERM-MONTHS))) ON SIZE ERROR MOVE 0 TO MONTHLY-PAYMENT DISPLAY "Error calculating monthly payment" END-COMPUTE. COMPUTE TOTAL-PAYMENTS = MONTHLY-PAYMENT * LOAN-TERM-MONTHS. COMPUTE TOTAL-INTEREST = TOTAL-PAYMENTS - LOAN-PRINCIPAL. DISPLAY " Mortgage Calculation Results:". DISPLAY " Loan Principal: $" LOAN-PRINCIPAL. DISPLAY " Annual Interest Rate: " ANNUAL-INTEREST-RATE. DISPLAY " Loan Term: " LOAN-TERM-MONTHS " months". DISPLAY " Monthly Payment: $" MONTHLY-PAYMENT. DISPLAY " Total Payments: $" TOTAL-PAYMENTS. DISPLAY " Total Interest: $" TOTAL-INTEREST. *> Calculate first few payments for amortization schedule 01 REMAINING-PRINCIPAL PIC 9(8)V99. 01 INTEREST-PORTION PIC 9(6)V99. 01 PRINCIPAL-PORTION PIC 9(6)V99. MOVE LOAN-PRINCIPAL TO REMAINING-PRINCIPAL. DISPLAY " ". DISPLAY " First 5 Payments Amortization:". DISPLAY " Payment Interest Principal Balance". PERFORM VARYING PAYMENT-NUMBER(1) FROM 1 BY 1 UNTIL PAYMENT-NUMBER(1) > 5 COMPUTE INTEREST-PORTION = REMAINING-PRINCIPAL * MONTHLY-RATE COMPUTE PRINCIPAL-PORTION = MONTHLY-PAYMENT - INTEREST-PORTION COMPUTE REMAINING-PRINCIPAL = REMAINING-PRINCIPAL - PRINCIPAL-PORTION DISPLAY " " PAYMENT-NUMBER(1) " $" INTEREST-PORTION " $" PRINCIPAL-PORTION " $" REMAINING-PRINCIPAL END-PERFORM. DISPLAY " ". ANALYZE-INVESTMENT-RISK. DISPLAY "5. Investment Risk Analysis:". DISPLAY " =========================". *> Initialize sample historical returns (monthly) MOVE 0.0250 TO HISTORICAL-RETURNS(1). MOVE -0.0150 TO HISTORICAL-RETURNS(2). MOVE 0.0380 TO HISTORICAL-RETURNS(3). MOVE 0.0120 TO HISTORICAL-RETURNS(4). MOVE -0.0280 TO HISTORICAL-RETURNS(5). MOVE 0.0450 TO HISTORICAL-RETURNS(6). MOVE 0.0180 TO HISTORICAL-RETURNS(7). MOVE -0.0090 TO HISTORICAL-RETURNS(8). MOVE 0.0320 TO HISTORICAL-RETURNS(9). MOVE 0.0210 TO HISTORICAL-RETURNS(10). *> Calculate average return COMPUTE AVERAGE-RETURN = (HISTORICAL-RETURNS(1) + HISTORICAL-RETURNS(2) + HISTORICAL-RETURNS(3) + HISTORICAL-RETURNS(4) + HISTORICAL-RETURNS(5) + HISTORICAL-RETURNS(6) + HISTORICAL-RETURNS(7) + HISTORICAL-RETURNS(8) + HISTORICAL-RETURNS(9) + HISTORICAL-RETURNS(10)) / 10. *> Calculate variance and standard deviation 01 SUM-SQUARED-DEVIATIONS PIC 9(4)V9(8). COMPUTE SUM-SQUARED-DEVIATIONS = ((HISTORICAL-RETURNS(1) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(2) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(3) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(4) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(5) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(6) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(7) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(8) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(9) - AVERAGE-RETURN) ** 2) + ((HISTORICAL-RETURNS(10) - AVERAGE-RETURN) ** 2). COMPUTE RETURN-VARIANCE = SUM-SQUARED-DEVIATIONS / 9. COMPUTE STANDARD-DEVIATION = FUNCTION SQRT(RETURN-VARIANCE). *> Calculate Value at Risk (95% confidence level) COMPUTE VALUE-AT-RISK = TOTAL-PORTFOLIO-VALUE * (AVERAGE-RETURN - (1.645 * STANDARD-DEVIATION)) ON SIZE ERROR MOVE 0 TO VALUE-AT-RISK END-COMPUTE. DISPLAY " Risk Analysis Results:". DISPLAY " Average Monthly Return: " AVERAGE-RETURN. DISPLAY " Return Variance: " RETURN-VARIANCE. DISPLAY " Standard Deviation: " STANDARD-DEVIATION. DISPLAY " Value at Risk (95%): $" VALUE-AT-RISK. DISPLAY " ". CALCULATE-OPTIONS-PRICING. DISPLAY "6. Options Pricing Calculations:". DISPLAY " ==============================". *> Black-Scholes model inputs MOVE 100.00 TO STOCK-PRICE. MOVE 105.00 TO STRIKE-PRICE. MOVE 0.25 TO TIME-TO-EXPIRATION. MOVE 0.0300 TO RISK-FREE-RATE. MOVE 0.20 TO VOLATILITY. *> Simplified Black-Scholes calculation (approximation) 01 D1 PIC S9(1)V9(6). 01 D2 PIC S9(1)V9(6). 01 N-D1 PIC 9(1)V9(4). 01 N-D2 PIC 9(1)V9(4). COMPUTE D1 = (FUNCTION LOG(STOCK-PRICE / STRIKE-PRICE) + (RISK-FREE-RATE + (VOLATILITY ** 2) / 2) * TIME-TO-EXPIRATION) / (VOLATILITY * FUNCTION SQRT(TIME-TO-EXPIRATION)) ON SIZE ERROR MOVE 0 TO D1 END-COMPUTE. COMPUTE D2 = D1 - (VOLATILITY * FUNCTION SQRT(TIME-TO-EXPIRATION)). *> Approximate normal distribution values (simplified) MOVE 0.6000 TO N-D1. MOVE 0.5500 TO N-D2. COMPUTE CALL-OPTION-PRICE = (STOCK-PRICE * N-D1) - (STRIKE-PRICE * FUNCTION EXP(-RISK-FREE-RATE * TIME-TO-EXPIRATION) * N-D2) ON SIZE ERROR MOVE 0 TO CALL-OPTION-PRICE END-COMPUTE. COMPUTE PUT-OPTION-PRICE = CALL-OPTION-PRICE - STOCK-PRICE + (STRIKE-PRICE * FUNCTION EXP(-RISK-FREE-RATE * TIME-TO-EXPIRATION)). DISPLAY " Options Pricing Results:". DISPLAY " Stock Price: $" STOCK-PRICE. DISPLAY " Strike Price: $" STRIKE-PRICE. DISPLAY " Time to Expiration: " TIME-TO-EXPIRATION " years". DISPLAY " Risk-free Rate: " RISK-FREE-RATE. DISPLAY " Volatility: " VOLATILITY. DISPLAY " Call Option Price: $" CALL-OPTION-PRICE. DISPLAY " Put Option Price: $" PUT-OPTION-PRICE. DISPLAY " ". GENERATE-FINANCIAL-REPORTS. DISPLAY "7. Financial Reports Summary:". DISPLAY " ===========================". DISPLAY " Portfolio Performance Summary:". DISPLAY " Total Investment Value: $" TOTAL-PORTFOLIO-VALUE. DISPLAY " Total Return: " PORTFOLIO-RETURN-RATE "%". DISPLAY " Risk-Adjusted Return: " SHARPE-RATIO. DISPLAY " Portfolio Beta: " WEIGHTED-AVERAGE-BETA. DISPLAY " ". DISPLAY " Risk Management Summary:". DISPLAY " Portfolio Standard Deviation: " STANDARD-DEVIATION. DISPLAY " Value at Risk (95%): $" VALUE-AT-RISK. DISPLAY " Diversification Index: " DIVERSIFICATION-INDEX. DISPLAY " ". DISPLAY-PERFORMANCE-METRICS. DISPLAY "8. System Performance Metrics:". DISPLAY " ============================". ADD 1 TO CALCULATIONS-PERFORMED. DISPLAY " Arithmetic Operations Performed:". DISPLAY " Total Calculations: " CALCULATIONS-PERFORMED. DISPLAY " Precision Errors: " PRECISION-ERRORS. DISPLAY " Overflow Incidents: " OVERFLOW-INCIDENTS. DISPLAY " Rounding Adjustments: " ROUNDING-ADJUSTMENTS. DISPLAY " ". DISPLAY " COBOL Arithmetic Benefits Demonstrated:". DISPLAY " - Precise financial calculations". DISPLAY " - Comprehensive error handling". DISPLAY " - Advanced mathematical functions". DISPLAY " - Robust precision management". DISPLAY " - Enterprise-grade computational accuracy". DISPLAY " - Complex business algorithm implementation".
This comprehensive financial system demonstrates how COBOL arithmetic operations enable sophisticated financial modeling and analysis:
The financial system demonstrates COBOL's ability to handle complex mathematical operations with the precision required for financial applications. Error handling ensures robust operation, while advanced functions enable sophisticated modeling capabilities that meet enterprise requirements for accuracy and reliability.
Effective COBOL arithmetic requires careful precision management:
Financial arithmetic requires special attention to accuracy and compliance: