000050$$ SET LIST MAP MAPONELINE PAGESIZE=80 000100$$ SET LINEINFO BINDINFO 000120$$ FEDLEVEL=5 001000 100000 IDENTIFICATION DIVISION. 100100 PROGRAM-ID. AS4027-EXPLIB IS LIBRARY PROGRAM. 100200 AUTHOR. P.KIMPEL. 100300*INSTALLATION. PARADIGM CORPORATION, SAN DIEGO. 100400*DATE-WRITTEN. NOVEMBER 2002. 100500 100600****************************************************************** 100700* UNITE/AS4027/COBOL85/EXPLIB * 100800****************************************************************** 100900* THIS PROGRAM ILLUSTRATES A SIMPLE COBOL-85 PROGRAM LIBRARY 101000* FOR THE PURPOSE OF SHOWING HOW IT WILL APPEAR IN A PROGRAM- 101100* WHEN CALLED BY ANOTHER PROGRAM. 105000****************************************************************** 105002* MODIFICATION LOG. 105006* 2002-11-01 P.KIMPEL 105007* ORIGINAL VERSION, CLONED FROM ISAMCALC. 109990****************************************************************** 110000 110020 ENVIRONMENT DIVISION. 110200 CONFIGURATION SECTION. 110300 SOURCE-COMPUTER. UNISYS-MCP. 110400 OBJECT-COMPUTER. UNISYS-MCP. 150000 150100 DATA DIVISION. 300020****************************************************************** 300100 WORKING-STORAGE SECTION. 300200 77 W-CALL-COUNT PIC S9(11) GLOBAL BINARY. 330000 330100 01 WLN-LOG-AREA GLOBAL. 330600 05 WLN-LN-2 PIC S9(1)V9(10) BINARY 330700 VALUE 0.6931471806. 331200 05 WLN-FACTOR-VALUES. 331300 10 FILLER PIC S9(1)V9(10) VALUE +0.9999964239 COMP. 331400 10 FILLER PIC S9(1)V9(10) VALUE -0.4998741238 COMP. 331500 10 FILLER PIC S9(1)V9(10) VALUE +0.3317990258 COMP. 331600 10 FILLER PIC S9(1)V9(10) VALUE -0.2407338084 COMP. 331700 10 FILLER PIC S9(1)V9(10) VALUE +0.1676540711 COMP. 331800 10 FILLER PIC S9(1)V9(10) VALUE -0.0953293897 COMP. 331900 10 FILLER PIC S9(1)V9(10) VALUE +0.0360884937 COMP. 332000 10 FILLER PIC S9(1)V9(10) VALUE -0.0064535442 COMP. 332100 05 WLN-FACTOR-TABLE REDEFINES WLN-FACTOR-VALUES 332200 OCCURS 8 INDEXED WLN-FX. 332300 10 WLN-FACTOR PIC S9(1)V9(10) COMP. 332320 332340****************************************************************** 332360 PROGRAM-LIBRARY SECTION. 332380 LB AS4027-EXPLIB EXPORT 332400 ATTRIBUTE SHARING IS SHAREDBYALL. 332420 ENTRY PROCEDURE COMPUTE-LN. 500000/ 500100 PROCEDURE DIVISION. 500120****************************************************************** 500200 000-MAIN SECTION. 500300 000-BEGIN. 500400 500500 MOVE ZERO TO W-CALL-COUNT. 502500 502600 CALL SYSTEM FREEZE TEMPORARY. 502700 502800 000-EXIT. 502900 STOP RUN. 502920 502940*================================================================= 502960 IDENTIFICATION DIVISION. 502980 PROGRAM-ID. COMPUTE-LN. 503000 503020 DATA DIVISION. 503040 WORKING-STORAGE SECTION. 503060 77 WLN-TERM PIC S9(7)V9(16) BINARY. 503080 77 WLN-SUM PIC S9(3)V9(20) COMP. 503100 77 WLN-POWER PIC S9(7)V9(16) COMP. 503120 77 WLN-N PIC S9(5) BINARY. 503140 503160 LINKAGE SECTION. 503180 77 L-ARG PIC S9(7)V9(5) COMP. 503200 77 L-RESULT PIC S9(2)V9(9) BINARY. 650000 650020 PROCEDURE DIVISION USING L-ARG, L-RESULT. 650040 650100 200-COMPUTE-LN SECTION. 650200* THIS ROUTINE CALCULATES THE NATURAL LOGARITHM OF L-ARG 650300* LEAVING THE RESULT IN L-RESULT. IT IS ACCURATE TO ONE 650400* PART IN 10**7. FROM HBK OF MATH FUNCTIONS, ABRAMOWITZ & 650500* STEGUN, DOVER, NEW YORK, 1965 (LCCN 65-12253), PP 67 FF. 650600* (I CAN'T BELIEVE I'M ACTUALLY DOING THIS IN COBOL...) 650700 200-BEGIN. 650800 MOVE ZERO TO WLN-N, WLN-SUM. 650900 MOVE L-ARG TO WLN-TERM. 651000 651100 200-SCALE-LOOP. 651200 IF WLN-TERM > 2.0 651300 ADD 1 TO WLN-N 651400 COMPUTE WLN-TERM ROUNDED = WLN-TERM / 2 651500 GO TO 200-SCALE-LOOP 651600 ELSE IF WLN-TERM < 1.0 651700 SUBTRACT 1 FROM WLN-N 651800 COMPUTE WLN-TERM ROUNDED = WLN-TERM * 2 651900 GO TO 200-SCALE-LOOP. 652200 652300 SET WLN-FX TO 1. 652400 MOVE 1.0 TO WLN-POWER. 652500 SUBTRACT 1.0 FROM WLN-TERM ROUNDED. 652600 652700 200-SERIES-LOOP. 652800 MULTIPLY WLN-TERM BY WLN-POWER ROUNDED. 652900 COMPUTE WLN-SUM ROUNDED = WLN-SUM + 653000 WLN-FACTOR (WLN-FX) * WLN-POWER. 653100 IF WLN-FX < 8 653200 SET WLN-FX UP BY 1 653300 GO TO 200-SERIES-LOOP. 653400 653500 COMPUTE L-RESULT ROUNDED = WLN-SUM + 653600 WLN-N * WLN-LN-2. 653700 653800* ---- GENERATE A ONE-TIME SNAPSHOT PROGRAMDUMP ---- 653900 ADD 1 TO W-CALL-COUNT. 654000 IF W-CALL-COUNT = 6 654100 CALL SYSTEM DUMP. 654200 654300 200-EXIT. 654400 EXIT PROGRAM. 654500 654600 END PROGRAM COMPUTE-LN. 999800 999900 END PROGRAM AS4027-EXPLIB.