101 013 JOB 1401 FORTRAN ARITH AND RELOCATABLE ROUTINES 50633 102 CTL 644 11 103 * 104 SFX B 105 * MACRO 106 XINITXL1,XL2,XL3,,,,XXXX GEN XXX EQU 0 GEN XL1 EQU 089 GEN 089 DCW 000 GEN 091 DC 00 GEN XL2 EQU 094 GEN 094 DCW 000 GEN 096 DC 00 GEN XL3 EQU 099 GEN 099 DCW 000 GEN 100 DC 0 107 * MACRO 108 XNMBR GEN X1 EQU 089 GEN X2 EQU 094 GEN X3 EQU 099 109 * 110 WKZON EQU 200 111 TOP EQU WKZON&1 112 SPOT EQU WKZON&50 113 ACCHI EQU WKZON&79 114 * 115 ORG 700 116 * 117 * ARITHMETIC ROUTINE MONITOR 118 * 119 ARITF SBR X2 120 SBR 086 STORE FIRST LOCATION OF ARITH STRING 121 SBR STMNM&6 122 ARITH MCW 2&X2, X1 123 SAR ALGRT&6 124 SBBR1 SBR BRWHR&6 125 BCE STSUB,0&X2,$ CHECK FOR SUBSCRIPTED STORE LOCATION 126 SBR OUT2&6,0&X1 127 CS WKZON&103 CLEAR WORK AREA 128 CS 129 CS 130 LCA @0@, ACCHI&1 131 CLRX S X1&2 132 ALGRT SBR XL2, XXX 133 C 4&X2, @#@ 134 MCW 4&X2, SIGNF 135 SW TOP 136 EXIT BL QFUNCT 137 SBR NGBMP&6,4&X2 138 BCE OPDSC,5&X2,$ CHECK FOR SUBSCRIPTED OPERAND 139 MCW 7&X2, XL1 140 SAR ALGRT&6 141 SBBR2 BWZ XSIZE,X1-1,K BRANCH IF FIXPT COMPUTATION 142 BWZ XSIZE,X1-1,S 143 * 144 * FLOAT ARITHMETIC 145 * 146 FSIZE SBR X3,XXX STORE FLOAT SIZE 147 CW FIXSW#1 148 MCW 0&X1,EXPB STORE EXPONENT 149 SAR XL1 150 MCW 0&X1,SPOT INITIALIZE WORK AREA 151 SBR XL2 152 LCA @0@ 153 NGBMP BW *&8,0 154 MZ SPOT, NSIGN 155 S @0@,SPOT&2&X3 156 C 1&X2, @0@ 157 A XL3, XL2 158 BCE FDIV,CODE,/ BRANCH FOR DIVISION 159 BCE FMPY,CODE,* BRANCH FOR MULTIPLICATION - 160 * 161 * FLOATING ADD / SUBTRACT 162 * 163 S SIGNF 164 SIGNF ZA NSIGN 165 BCE NUVAL,ACCHI&1,0 BR, IF 1ST OPERAND OF COMPUTATION 166 BE CLRWK 167 S EXPB,EXP 168 ZA EXP&1,XL1&1 169 C XL3,XL1 170 BM RTN1,EXP 171 BH CHGEX BR IF PREV RESULT TO BE RETAINED IN WK ACC 172 A EXP,EXPB 173 ZA SPOT,SPOT&X1 INITIALIZE WORK AREA 174 ZA XL3&1,XL1&1 175 ASCOM MZ NSIGN,0&X2 176 A ACCHI&X1,0&X2 177 MVZON MZ 0&X2,NSIGN 178 NUVAL ZA EXPB,EXP 179 * 180 * NORMALIZE 181 * 182 NMLZ1 MCW RCDMK,1&X2 183 MZ 184 MZ 185 A 186 MN 187 SBR XL1 188 S ACCHI&2&X3 189 NLOOP BCE STRZE,2&X1,| 190 SBR XL1 191 BCE NLOOP, 1&X1, 0 192 MCM 1&X1, ACCHI&1 193 S XL3, XL2 194 CW 195 CW 196 S 197 S XL1,EXP 198 NSIGN ZA ACCHI&X3 MOVE PROPER SIGN TO WORK ACCUMULATOR 199 SW 200 BCE CLRWK,EXP-2,0 201 BM STRZE,EXP BRANCH ON EXPONENT UNDERFLOW 202 * 203 * EXPONENT OVERFLOW DUE TO NORMALIZATION 204 * 205 B ERMSG 206 DCW @NOF@ 207 * 208 * STORE NINES IN WORK ACCUMULATOR AND EXP ON EXPONENT OVFL 209 * 210 STR99 ZA &99,EXP 211 MN &99,ACCHI&X3 212 MCW 213 MCW ACCHI-1&X3 214 CLRWK CS ACCHI-1 215 B CLRX 216 * 217 * STORE ZERO IN WORK ACCUMULATOR 218 * 219 STRZE S EXP 220 S ACCHI&X3 221 B CLRWK 222 * 223 * DIVISION BY ZERO ATTEMPTED 224 * 225 DVERR B ERMSG 226 DCW @DZE@ 227 B STR99 228 * 229 RTN1 BH NUVAL BRANCH TO STORE NEW VALUE IN WK ACC 230 S XL3&1,XL1&1 INITIALIZE INDEX REGISTERS 231 MZ ACCHI&X3,ACCHI&X1 INITIALIZE WORK ACCUMULATOR 232 B ASCOM 233 * 234 CHGEX A EXPB,EXP 235 B CLRWK 236 * 237 * SUBSCRIPTED VARIABLES 238 * 239 OPDSC SBR X2,5&X2 240 STSUB B XXX 241 MN 0&X2 242 MN 243 MN 244 MN 245 SAR ALGRT&6 246 BRWHR BCE SBBR1,XXX,$ 247 B SBBR2 248 * 249 * FLOATING DIVIDE 250 * 251 FDIV BE DVERR 252 MN ACCHI&X3, 1&X2 253 MCW 254 MN 255 D 0&X1, SPOT&1 256 ZS EXPB 257 B NDMDV 258 * 259 * FLOATING MULTIPLY 260 * 261 FMPY M ACCHI&X3, SPOT&1&X3 262 SBR X2,3&X2 263 S &2,EXP 264 NDMDV A EXPB, EXP 265 MZ ACCHI&X3, *&1 266 ZA NSIGN 267 B NMLZ1 268 * 269 * EXIT ROUTINE 270 * 271 QFUNCT BCE OUT1,4&X2,| BR IF CONTENTS OF WK ACC TO BE STORED 272 SBR ALGRT&6,1&X2 273 C ACCHI&1,@0@ 274 B XXX BRANCH TO FUNCTION SELECTION ROUTINE 275 OUT1 BCE OUT2,ACCHI&1,0 276 BW OUT2,FIXSW 277 BW FINST,4&X2 BRANCH IF FINAL STORAGE OF COMP 278 SBR X3,2&X3 279 MVEXP MCM EXP-1,ACCHI-1&X3 280 OUT2 LCA ACCHI&X3,XXX 281 BW 5&X2,4&X2 BR TO PROG MAINLINE IF END OF ARITH STR 282 SAR XL2 283 B ARITH 284 * 285 * ROUNDING FOR FINAL STORAGE 286 * 287 FINST A &5,ACCHI-1&X3 288 BWZ RDOVF,ACCHI&1,S 289 ZONMV MZ ACCHI&X3,ACCHI-2&X3 290 B MVEXP 291 RDOVF A &1,EXP 292 BCE NORND,EXP-2,1 293 S ACCHI&X3 294 LCA @1@,ACCHI&1 295 B ZONMV 296 * 297 * NO ROUNDING IF EXPONENT OVERFLOW WOULD OCCUR 298 * 299 NORND MN &99,ACCHI&X3 300 MCW 301 MCW ACCHI-1&X3 302 S &1,EXP 303 B ZONMV 304 * 305 * PRINT ERROR MESSAGE 306 * 307 ERMSG SBR STRX2&6 308 CS TOP&1&X3 309 SBR RINX2&6,0&X3 310 STRX2 SBR X3,XXX 311 MCW 2&X3,TOP&11 312 STMNM SBR TOP&16,XXX 313 W 314 SW TOP 315 SBR ERMXT&3,3&X3 316 RINX2 SBR X3,XXX 317 ERMXT B XXX 318 * 319 * FIXED POINT ENTRY 320 * 321 XSIZE SBR X3,XXX STORE FIX-SIZE 322 SW FIXSW 323 * 324 FIXPT MCS 0&X1, SPOT 325 BCE XDIV, CODE, / 326 BCE XMPY, CODE, * 327 * 328 * FIXED ADD / SUBTRACT 329 * 330 BWZ SUBTR, CODE, K Q. SUBTRACT 331 A 0&X1, ACCHI&X3 332 ADDRT ZA ACCHI&X3 333 B CLRWK 334 * 335 SUBTR S 0&X1, ACCHI&X3 336 B ADDRT 337 * 338 * FIXED MULTIPLY 339 * 340 XMPY LCA 0&X1, SPOT 341 M ACCHI&X3, SPOT&1&X3 342 MCW SPOT&1&X3, ACCHI&X3 343 B CLRWK 344 * 345 * FIXED DIVIDE 346 * 347 XDIV BCE DVERR, SPOT, 348 MCW 0&X1,SPOT&X3 349 MN 350 SBR MVQUT&3 351 LCA ACCHI&X3 352 ZA ACCHI&X3, SPOT&X3 353 D 0&X1, SPOT&1 354 MVQUT MCW SPOT-1,ACCHI&X3 355 B CLRWK 356 * 357 DCW 000 358 RCDMK DCW @|@ 359 DCW 0 360 EXP DCW 000 361 DC @|@ 362 EXPB DCW 00 363 DC 0 364 CODE EQU SIGNF 365 ZROSW EQU *&1 366 BASEZ EQU *&1 367 XPNUM DCW @8@ 368 LTORG 369 DS 1 370 DCW @0@ 371 DCW @}@ SYSTEM GROUP MARK 372 JOB 1401 FORTRAN RELOCATABLE PACKAGE 50533 373 DIVID EQU 14000 374 CALC EQU DIVID&47 375 CALC1 EQU DIVID&58 376 LOGM1 EQU DIVID&149 377 LOGM2 EQU DIVID&171 378 CALXT EQU DIVID&187 379 STR1 EQU DIVID&191 380 LN10 EQU DIVID&226 381 UPBY EQU DIVID&250 382 NCON EQU DIVID&253 383 NCTR EQU DIVID&256 384 DEC EQU DIVID&259 385 TWTCH EQU DIVID&260 386 DELTA EQU ACCHI-200 MACRO 387 PARAM GEN PARAMA EQU 686 GEN XBEGIN EQU 838 GEN MONTOR EQU 769 GEN MONTER EQU 700 GEN TCLEAR EQU 710 GEN INITAP EQU 780 GEN INITXT EQU 793 GEN BCLEAR EQU 833 GEN FAILSW EQU 184 388 XLINKS EQU 840 389 ATANFN EQU 894 MACRO 390 RELOC ORG 841 GEN YUSR12 DS 3 GEN YUSR11 DS 3 GEN YUSR10 DS 3 GEN YUSER9 DS 3 GEN YUSER8 DS 3 GEN YUSER7 DS 3 GEN YUSER6 DS 3 GEN YUSER5 DS 3 GEN YUSER4 DS 3 GEN YUSER3 DS 3 GEN YUSER2 DS 3 GEN YUSER1 DS 3 GEN SQRTFN DS 3 GEN FLTFUN DS 3 GEN FIXFUN DS 3 GEN NEGTFN DS 3 GEN ABSVAL DS 3 GEN INVTFN DS 3 GEN XPNETL DS 3 GEN LOGFUN DS 3 GEN SINFUN DS 3 GEN COMFN1 DS 3 GEN DOSBSC DS 3 GEN OBLIST DS 3 GEN DOINIT DS 3 GEN DOADR3 DS 3 GEN DOADR2 DS 3 GEN DOADR1 DS 3 391 JOB 1401 FORTRAN OBJECT TIME DO 50533 392 SFX A 393 X1 EQU 089 394 X2 EQU 94 395 X3 EQU 099 396 ORG 2000 397 DO1 SBR EXITL 398 SBR X2 399 SBR X2,4&X2 400 B INITL&4 401 INITL EQU *&74 402 EXITL EQU *&123 403 XFR 0 404 ORG 2000 405 DO2 SBR X2 406 MCW 11&X2,DO3&6 407 MCW 408 MCW 5&X2,LIMT&3 409 MCW 11&X2,SBIX&3 410 MCW 14&X2,TESTL&3 411 SBR EXDO3&3,15&X2 412 DO3 EQU *&1 413 LIMT EQU *&8 414 SBIX EQU *&15 415 TESTL EQU *&22 416 EXDO3 EQU *&30 417 XFR 0 418 ORG 2000 419 A 0,0 MACRO 420 BFIXWZA,000,FIXWORD GEN ZA GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 MACRO 421 BFIXWS,000,FIXWORD GEN S GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 MACRO 422 BFIXWBWZ,000,FIXWORD,,K GEN BWZ GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 GEN DC @K@ 423 B 0 424 XFR 0 425 JOB 1401 FORTRAN INITIALIZATION OF DO LOOPS FOR DO,LIST 50533 426 ORG 2000 427 INITIL SBR EXITEL&3 428 MCW 2&X2,*&4 429 * NOTE - ADDRESS OF FIXWORD INITIALIZED BY LATER PASS MACRO 430 BFIXWZA,000,FIXWORD GEN ZA GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 431 MCW 8&X2,*&4 MACRO 432 BFIXWS,000,FIXWORD GEN S GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 433 MCW 11&X2,*&7 MACRO 434 AFIXWLCA,FIXWORD,,000 GEN LCA GEN DC @_0@ 11-7-8,0 GEN DC 0 GEN DC 000 435 EXITEL B 000 436 LTORG* 437 XFR 0 438 JOB 1401 FORTRAN OBJECT TIME LIST 50533 439 ORG 2000 440 OBJLST SBR X2 441 SBR BSTAN&6,2&X2 442 SBR XTLST&3,3&X2 443 MCW 2&X2,ADLST#3 444 XYZ MCW ADLST,X2 445 BW SMPLE,0&X2 446 BCE ARRAY,0&X2,, 447 BCE SUBSCR,0&X2,$ 448 BCE INDX1,0&X2,% BEGIN OF DO-TYPE 449 BCE INDX4,0&X2,) END OF INNERMOST DO 450 BCE INDX2,0&X2,# END OF OUTER DO-TYPE 451 MCW BLANK#3,X1 END OF LIST 452 BSTAN MCW ADLST,0 453 XTLST B 0 454 RAY DCW @XXXXXX@ 455 SMPLE MCW 2&X2,X1 456 SBR ADLST,3&X2 457 B BSTAN 458 ARRAY MZ 2136,*&8 FMTZON CHANGE ON REASM OF OBJ FORMAT 459 BCE NOSWT,@2S@,2 460 BCE 461 BWZ INRAY,RAY-4,2 462 MCW 6&X2,RAY 463 MN PARAMA&4,SBRLT&6 464 MN 465 BWZ *&9,RAY-4,K 466 MN PARAMA&6,SBRLT&6 467 MN 468 MZ *-4,RAY-4 469 INRAY MCW RAY-3,X1 470 SBRLT SBR X1,0&X1 471 MCW X1,RAY-3 472 C RAY,RAY-3 473 BU BSTAN 474 MZ *-6,RAY-4 475 B DUN1 476 NOSWT MCW 6&X2,RAY 477 MCW @.@,X1 478 DUN1 SBR ADLST,7&X2 479 B BSTAN 480 SUBSCR T DOSBSC 481 MZ *-4,X1-1 482 MCW X2,ADLST 483 B BSTAN 484 INDX1 SBR X2,1&X2 485 T DOINIT 486 MN 0&X2 487 SBR X2 488 B SETUP 489 INDX2 MCW 3&X2,X2 490 SETUP MCW 12&X2,INDX3&6 491 MCW 492 MCW 6&X2,LIMIT&3 493 MCW 12&X2,SUBIX&3 494 SBR LPARN#3,0&X2 SAVE ADDR OF LEFT PAREN 495 INDX4 MCW LPARN,X2 SET X2 TO ADDR OF LEFT PAREN 496 INDX3 A 0,0 497 * NOTE - ADDRESS OF FIXWORD INITIALIZED BY LATER PHASE OF COMPILER MACRO 498 LIMIT BFIXWZA,000,FIXWORD GEN LIMIT ZA GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 MACRO 499 SUBIX BFIXWS,000,FIXWORD GEN SUBIX S GEN DC 000 GEN DC @_0@ 11-7-8,0 GEN DC 0 500 * IMPORTANT NOTE - THE OPERAND -SATFY- IN THE FOLLOWING MACRO 501 * WILL NOT BE CODED AS RELOCATABLE BY THE RELOCATABLE 502 * CONDENSING ROUTINE. THIS IS DUE TO THE FACT THAT THE 503 * CONDENSER DOES NOT RECOGNIZE DC OR DCW STATEMENTS AS HAVING 504 * RELOCATABLE OPERANDS. IT IS NECESSARY TO MANUALLY ZONE THE 505 * SET WORD MARK INSTRUCTION WITH AND 11-PUNCH TO CAUSE 506 * RELOCATION. MACRO 507 BFIXWBWZ,SATFY,FIXWORD,,K GEN BWZ GEN DC SATFY GEN DC @_0@ 11-7-8,0 GEN DC 0 GEN DC @K@ 508 SBR ADLST,16&X2 509 B XYZ 510 SATFY MCW 15&X2,ADLST 511 B XYZ 512 LTORG* 513 XFR 0 514 JOB 1401 FORTRAN OBJECT TIME SUBSCRIPTS 50533 515 ORG 2000 516 OTSUB SBR EXITS&3 517 MCW 3&X2,AAA#3 518 S PROD#5 519 BAV *&1 520 SBR1 MCW 9&X2,LCA&3 521 MCW 6&X2,ZA&3 522 ZA ZA 000,WORK#5 523 LCA LCA 000,BFEEL-6 524 M WORK,BFEEL#11 525 A BFEEL,PROD 526 C PROD-3,@15@ 527 BL OHALT 528 BCE PACK,10&X2,$ 529 SBR X2,6&X2 530 B SBR1 531 PACK A &96,PROD-3 532 BAV PACK 533 MZ PROD-4,PROD 534 ZA PROD-2,X1&1 535 MZ ZONES-99&X1,PROD-2 536 MCW PROD,X1 537 MCW X1,SBR&6 538 MZ ZONES-2,SBR&5 539 MCW AAA,X1 540 SBR SBR X1,0&X1 COMPUTE ADDRESS 541 MZ AAA-1,X1-1 542 SBR X2,11&X2 543 EXITS B 000 544 OHALT NOP 2002 545 H 546 B OHALT 547 ZONES DCW @2SKB@ 548 LTORG* 549 XFR 0 550 JOB 1401 FLOATING POINT SINE - COSINE SUBROUTINE 50533 551 SFX B 552 * INSERT FUNCTION COMMON DECK HERE 553 ORG 2000 554 * 555 TRIGF BCE COSF,CODE,C 556 SINF BE STRZE SINE 0 # 0 557 MZ ACCHI&X3,ZA1 SINE -X # -SINE X 558 B SNCS 559 COSF BE STR1 COSINE 0 # 1 560 MZ &1,ZA1 COS -X # COS X 561 SNCS MCW @ @,BOX 562 ZA EXP,EXPB 563 S &1,EXP 564 BM SMALL,EXP 565 A &2,EXP 566 S X3,EXP 567 BWZ ARGLG,EXP,B 568 ZA EXPB,EXP 569 SBR X1,PIOV2&X3 REDUCE ARGUMENT 570 ZA EXP&1,X2&1 571 B DIVID DIVIDE ARGUMENT BY PI/2 572 ZA 1&X1,X2&1 573 SUB4 S &40,X2&1 DETERMINE QUADRANT IN WHICH 574 BWZ SUB4,X2&1,B ANGLE IS LOCATED AND WHETHER 575 BCE *&8,CODE,C SINE OR COSINE FUNCTION IS TO 576 SBR X2,1&X2 577 MZ ZONZ&X2,NSIGN 578 MN ZONZ&X2,BOX#1 579 S DEC DEC # 0 580 S EXP 581 BCE COS,BOX,2 582 * 583 * SINE INITIALIZATION 584 * 585 SINE ZA ACCHI&X3,TOP&1&X3 586 B SQRX 587 ZA TOP&1&X3,SPOT-1 FIRST TERM # X 588 ZA SPOT&1 589 ZS &2,NCON NCON # -2 590 * 591 * GENERAL INITIALIZATION FOR SERIES EVALUATION 592 * 593 SCGEN ZA &8,UPBY UPBY # &8 594 S NCTR NCTR # 8 595 B CALC 596 * 597 * PREPARE FIELDS FOR NORMALIZATION 598 * 599 ZA1 ZA NSIGN 600 SBR X2,TOP&X3 601 B NMLZ1 602 * 603 * COSINE INITIALIZATION 604 * 605 COS B SQRX 606 MN &1,0&X1 FIRST TERM # 1 607 ZS &6,NCON NCON # -6 608 S EXP 609 B SCGEN 610 * 611 * SQUARE ARGUMENT 612 * 613 SQRX SBR SQRXT&3 614 MCW ACCHI&X3,SPOT 615 SBR X1 616 LCA @0@ 617 M ACCHI&X3,SPOT&1&X3 618 ZS SPOT&2,ACCHI&X3 CHANGE TO -% X SQUARED ) 619 S SPOT&1 620 SQRXT B XXX 621 * 622 * SMALL VALUES OF X 623 * 624 SMALL A X3,EXP 625 BM TSTFC,EXP 626 ZA EXPB,EXP 627 MZ ACCHI&X3,ACCHI-1&X3 SHIFT CONTENTS OF ACCHI&X3 628 ZA ACCHI-1&X3,ACCHI&X3 ONE POSITION RIGHT 629 A EXPB 630 ZS EXPB&1,DEC DEC # 20*EXP 631 MZ &1,NSIGN 632 BCE COS,CODE,C 633 B SINE 634 TSTFC BCE STR1,CODE,C 635 ZA EXPB,EXP 636 B CLRWK 637 ARGLG B ERMSG 638 DCW @SCL@ 639 B STRZE 640 * 641 ZONZ EQU * 642 DCW @AKJBA@ 643 * 644 PIOV2 EQU * 645 DCW 1570796326794896619231 LITS LITS 646 EX TRIGF 647 JOB 1401 FLOATING POINT NATURAL LOGARITHM 50533 648 * 649 ORG 2000 650 * 651 LOGF MZ ACCHI&X3,BASEZ 652 LOGF2 BE LOG99 653 BM LOGER, ACCHI&X3 Q. NEGATIVE ARGUMENT 654 LOGF1 C SPOT-2,ACCHI&X3 655 SAR X1 656 SW 0&X1 657 MN &1, 2&X1 SET UP CONSTANT ONE 658 * FOR FASTEST RATE OF CONVERGENCE, PLACE ARG BETWEEN .32 AND 3.2 659 C ACCHI&2,@31@ 660 BH NOSHF 661 ZA ACCHI-1&X3,ACCHI&X3 662 A &1, EXP SHIFT DEC POINT 1 TO LEFT 663 * 664 NOSHF S ACCHI&X3, SPOT-1 COMPUTE 1-X 665 ZS SPOT-1,LZONE CORRECT SIGN 666 S &1, EXP SHIFT DEC POINT 1 TO RIGHT 667 A &1, ACCHI&1 COMPUTE X&1 668 S &0, SPOT&X3 CREATE QUOTIENT FIELD 669 D ACCHI&X3, SPOT-1 COMPUTE U # X-1 / X&1 670 LCA SPOT-1, HOLD 671 M HOLD, SPOT&1&X3 COMPUTE U **2 672 ZA SPOT-1, ACCHI&X3 673 ZA HOLD, SPOT&1 674 ZA LINIT,DEC DEC SET TO 0 675 ZA NCTR SET TO 1 676 ZA NCON SET TO 2 677 ZA UPBY SET TO 0 678 SW LOGM1,LOGM2 679 SBR LOGM1-4,HOLD 680 SBR LOGM2-1 681 SBR CALXT&3,LOGRT 682 B CALC1 683 LOGRT A TOP&1&X3 DOUBLE RESULT 684 MZ LZONE, TOP&X3 GET PROPER SIGN 685 ZA LN10&1&X3,SPOT-2 686 M EXP, SPOT&2 COMPUTE N * LOG10 687 A TOP&X3, SPOT&2 ADD N * LOG10 TO RESULT 688 SBR X2, SPOT&2 689 S EXPB 690 B MVZON 691 * 692 LOGER BW *&8,4&X2 693 B ERMSG 694 DCW @LNN@ 695 MZ LINIT,ACCHI&X3 MAKE SIGN PLUS AND FIND 696 B LOGF1 LOG OF ABSOLUTE VALUE 697 LOG99 BW POWER,4&X2 698 B ERMSG 699 DCW @LNZ@ 700 MZ -0,ACCHI&X3 GIVE LARGE NEG NUMBER AS RESULT 701 B STR99 702 POWER CW ZROSW 703 B STR1 704 * 705 DCW &0 UPBY 706 DCW &2 NCON 707 DCW &1 NCTR 708 LINIT DCW &0 DEC 709 HOLD DCW #26 710 LZONE DCW #1 LITS LITS 711 EX LOGF 712 JOB 1401 FORTRAN FLOATING POINT EXPONENTIAL 50533 713 * 714 ORG 2000 715 * 716 EXPF MZ ONE,NSIGN 717 MN XPNUM,*&8 718 BCE OUTM1,@02468@,0 719 CHAIN4 720 MZ BASEZ,NSIGN 721 MN @8@,XPNUM 722 OUTM1 BW RUNML,ZROSW 723 SW ZROSW BASE IS ZERO 724 ZS ACCHI&X3 725 BU QSIGN BRANCH IF ARG NOT ZERO 726 B ERMSG 727 DCW @ZTZ@ ZERO TO ZERO POWER 728 PETTY MZ NSIGN,TWTCH 729 B STR1 730 RUNML BE PETTY 731 NRML ZA EXP,EXPB 732 S ONE,EXPB 733 BM SML,EXPB BRANCH IF EXP LESS OR # TO ZERO 734 S THREE,EXPB 735 BM REDUC,EXPB BRANCH IF EXP GREATER THAN ZERO 736 * AND LESS THAN FOUR 737 * 738 * DETERMINE WHETHER EXPONENT OVERFLOW OR UNDERFLOW 739 * 740 QSIGN BM STRZE,ACCHI&X3 BRANCH IF ARGUMENT NEGATIVE 741 B ERMSG EXPONENT OVERFLOW 742 DCW @EOF@ 743 B STR99 744 * 745 * EXPONENT # &1, &2, OR &3 746 * 747 REDUC SBR X1,LN10&X3 STORE ADDRESS OF DIVISOR 748 ZA EXP&1,X2&1 749 B DIVID 750 C 0&X1,THC99 751 BL QSIGN BRANCH IF QUOT GREATER THAN 99 752 ZA 0&X1,EXP 753 MZ ACCHI&X3,EXP 754 * 755 * PREPARE FIELDS FOR SERIES CALCULATION 756 * 757 S DEC 758 FTERM C SPOT,ACCHI&X3 SET UP TERM DEVELOPMENT AREA 759 SAR X1 760 SW 0&X1 761 S SPOT&1 CLEAR TERM DEVELOPMENT AREA 762 MN ONE,0&X1 FIRST TERM # 1 763 ZA THC99-2,NCTR SET NCTR # ZERO 764 ZA SET NCON # 1 765 ZA SET UPBY # ZERO 766 B CALC 767 * 768 * PREPARE FIELDS FOR NORMALIZING 769 * 770 MZ TOP&1&X3,TOP&X3 771 SBR X2,TOP&X3 772 B NMLZ1 773 * 774 * EXPONENTS LESS OR # TO ZERO 775 * 776 SML A X3,EXPB 777 BM PETTY,EXPB BRANCH IF -E GREATER THAN PRECISION 778 ZS EXP&1,DEC SET DEC # E 779 S EXP 780 MZ ACCHI&X3,ACCHI-1&X3 SET UP SERIES MULTIPLIER 781 ZA ACCHI-1&X3,ACCHI&X3 782 B FTERM 783 DCW 0 784 ONE DCW &1 785 THC99 DCW &099 786 THREE DCW &3 LITS LITS 787 EX EXPF 788 JOB 1401 FLOATING POINT ARCTANGENT 50533 789 * 790 ORG 2000 791 * 792 CASE1 BE STRZE 793 MZ &1,INITL 794 ZA ACCHI-1&X3,ACCHI&X3 795 S DEC 796 S TOP&1&X3 797 C SPOT-2,ACCHI&X3 798 SAR X1 799 SW 0&X1 800 ZA @0?@,SPOT&X3 801 MCW @0?@,EXPB 802 MN EXP,EXPB 803 MN 804 C EXPB,@0?@ 805 BE ZEREX 806 S X3,EXPB 807 BM TEST,EXPB 808 BM CASE2,EXP 809 B CASE7 810 CASE2 MCW ACCHI&X3,TOP&X3 811 A &1,EXP 812 B SIGN 813 CASE7 S EXP 814 ADDPI2 A PIOV4&1&X3,TOP&1&X3 815 ADDPI4 A PIOV4&1&X3,TOP&1&X3 816 SIGN SBR X2,TOP&X3 817 B NMLZ1 818 TEST BM CASE3,EXP 819 MN &1,2&X1 820 SHIFT ZA SPOT-1&X3,SPOT&X3 821 S &1,EXP 822 C EXP,@0?@ 823 BL SHIFT 824 D ACCHI&X3,SPOT-1 825 C 2&X1,@042@ 826 BH CASE6 827 ZS INITL 828 MCW SPOT-3,ACCHI&X3 829 ZA @0?@,SPOT&X3 830 B CASE4 831 CASE6 SBR CALXT&3,ADDPI2 832 ZS INITL 833 B MLTPLY 834 CASE3 SBR CALXT&3,SIGN 835 ZA EXP,EXPB 836 A EXPB 837 ZS EXPB&1,DEC 838 MCW ACCHI&X3,SPOT-3 839 B MLTPLY 840 ZEREX C ACCHI&3,@042@ 841 BH CASE3 842 CASE4 SBR CALXT&3,ADDPI4 843 ZS INITL 844 MN &1,2&X1 845 S ACCHI&X3,SPOT-1 846 A &1,ACCHI&1 847 A @0?@,SPOT&X3 848 D ACCHI&X3,SPOT-1 849 MLTPLY LCA SPOT-1,HOLDD 850 M HOLDD,SPOT&2&X3 851 ZS SPOT-1,ACCHI&X3 852 INITL ZA HOLDD 853 ZA HOLDD,SPOT&1 854 ZA &2,NCON 855 S UPBY 856 ZA &1,NCTR 857 SW LOGM1,LOGM2 858 SBR LOGM1-4,HOLDD 859 SBR LOGM2-1 860 B CALC1 861 PIOV4 EQU *&1 862 DCW @078539816339744830961566@ 863 HOLDD DCW #24 LITS LITS 864 EX CASE1 865 JOB 1401 ABSOLUTE VALUE - NEGATE SUBROUTINE 50533 866 * 867 ORG 2000 868 ABSVL MZ *&1,ACCHI&X3 NEGATE ABSOLUTE VALUE OF ARGUMENT LITS LITS 869 EX ABSVL 870 * 871 ORG 2000 872 NEGF ZS ACCHI&X3 873 B CLRWK LITS LITS 874 EX NEGF 875 JOB FLOAT TO FIX CONVERSION 50533 876 * 877 ORG 2000 878 * 879 FIXF SW FIXSW 880 SBR X1,0&X3 881 MCW PARAMA&4,*&7 882 SBR X3,000 883 S &1,EXP 884 BM STRZE,EXP STORE ZERO IF CHAR OF ARG LESS THAN 1 885 ZA EXP&1,X2&1 886 C X1,X2 887 BL EXPLS 888 S X1&1,X2&1 889 C X3,X2 890 BH STRZE 891 S SPOT&1&X2 892 ZA ACCHI&X1,SPOT 893 MZ SPOT,SPOT&1&X2 894 ZA SPOT&1&X2,ACCHI&X3 STORE FIXPT NUMBERS MODULO K 895 B CLRWK 896 EXPLS MZ ACCHI&X1,ACCHI&1&X2 ADD ONLY INTEGER PLACES 897 LCA ACCHI&1&X2,SPOT 898 ZA SPOT,ACCHI&X3 899 B CLRWK LITS LITS 900 EX FIXF 901 JOB FIX TO FLOAT CONVERSION 50533 902 * 903 ORG 2000 904 * 905 FLOT CW FIXSW 906 BW *&5,4&X2 907 B *&8 908 MN ACCHI&X3,XPNUM 909 SBR X2,SPOT 910 LCA ACCHI&X3 911 MCW PARAMA&6,*&7 912 SBR X3,000 913 ZA X3,EXPB 914 B MVZON LITS LITS 915 EX FLOT 916 JOB 1401 FLOATING POINT SQUARE ROOT 50533 917 * 918 ORG 2000 919 * 920 SQRTF BM QERR,ACCHI&X3 BRANCH IF ARGUMENT NEGATIVE 921 MN ACCHI&X3,TOP&21&X3 922 MCW 923 SW 924 SBR X1 925 LCA &1,TOP INITIALIZE SUBTRAHEND 926 SBR X2 927 ZA EXP&1,ACCHI&4 DETERMINE EXPONENT OF ROOT 928 A &1, ACCHI&3 929 M &50,ACCHI&6 930 MN ACCHI&4, EXP 931 MN 932 BCE CKSGN,ACCHI&5,0 933 SBR X1,1&X1 934 B QSTRT 935 CKSGN BWZ QSTRT,EXP,B 936 A &1,EXP 937 QSTRT S ACCHI&X3 938 QRTN S &11,2&X2 ADJUST SUBTRAHEND 939 SW 21&X2 940 CW 941 SBR X2, 1&X2 942 ZS &1, CNTR#1 943 QLOOP A &1,CNTR COMPUTE RESULT DIGITS 944 A &2,1&X2 INCREASE SUBTRAHEND 945 S 1&X2,2&X1 DO ODD-INTEGER SUBTRACTIONS 946 BWZ QLOOP, 2&X1, B 947 A 1&X2, 2&X1 948 MN CNTR, DELTA&X2 949 SBR X1, 2&X1 950 BWZ QRTN, DELTA&X2, 2 951 B CLRWK 952 QERR B ERMSG 953 DCW @SQN@ 954 MZ &1,ACCHI&X3 955 CS ACCHI-1 956 B SQRTF&8 LITS LITS 957 EX SQRTF 958 JOB 1401 FORTRAN USER FUNCTIONS 50533 959 SFX A 960 ORG 2000 961 DCW @USER FUNCTION 1 GOES HERE@ 962 XFR 0 963 ORG 2000 964 DCW @USER FUNCTION 2 GOES HERE@ 965 XFR 0 966 ORG 2000 967 DCW @USER FUNCTION 3 GOES HERE@ 968 XFR 0 969 ORG 2000 970 DCW @USER FUNCTION 4 GOES HERE@ 971 XFR 0 972 ORG 2000 973 DCW @USER FUNCTION 5 GOES HERE@ 974 XFR 0 975 ORG 2000 976 DCW @USER FUNCTION 6 GOES HERE@ 977 XFR 0 978 ORG 2000 979 DCW @USER FUNCTION 7 GOES HERE@ 980 XFR 0 981 ORG 2000 982 DCW @USER FUNCTION 8 GOES HERE@ 983 XFR 0 984 ORG 2000 985 DCW @USER FUNCTION 9 GOES HERE@ 986 XFR 0 987 ORG 2000 988 DCW @USER FUNCTION 10 GOES HERE@ 989 XFR 0 990 ORG 2000 991 DCW @USER FUNCTION 11 GOES HERE@ 992 XFR 0 993 ORG 2000 994 DCW @USER FUNCTION 12 GOES HERE@ 995 XFR 0 996 JOB 1401 FORTRAN RELOCATABLE XLINKF 50533 997 ORG 2000 998 START MCW CLRCON,359 CHANG ON REASM OF FIXED XLINK 999 B 337 1000 CLRCON DCW #3 LITS LITS 1001 EX START 1002 JOB 1401 FORTRAN FUNCTION BRANCH ROUTINE 50533 1003 ORG 2000 1004 T SINFUN,4&X2,S 1005 XFR 0 1006 ORG 2000 1007 T SINFUN,4&X2,C 1008 XFR 0 1009 ORG 2000 1010 T LOGFUN,4&X2,G 1011 XFR 0 1012 ORG 2000 1013 T XPNETL,4&X2,E 1014 XFR 0 1015 ORG 2000 1016 T ATANFN,4&X2,T 1017 XFR 0 1018 ORG 2000 1019 T ABSVAL,4&X2,A 1020 XFR 0 1021 ORG 2000 1022 T NEGTFN,4&X2,N 1023 XFR 0 1024 ORG 2000 1025 T FIXFUN,4&X2,X 1026 XFR 0 1027 ORG 2000 1028 T FLTFUN,4&X2,F 1029 XFR 0 1030 ORG 2000 1031 T SQRTFN,4&X2,Q 1032 XFR 0 1033 ORG 2000 1034 T YUSER1,4&X2,R 1035 XFR 0 1036 ORG 2000 1037 T YUSER2,4&X2,U 1038 XFR 0 1039 ORG 2000 1040 T YUSER3,4&X2,P 1041 XFR 0 1042 ORG 2000 1043 T YUSER4,4&X2,W 1044 XFR 0 1045 ORG 2000 1046 T YUSER5,4&X2,Y 1047 XFR 0 1048 ORG 2000 1049 T YUSER6,4&X2,Z 1050 XFR 0 1051 ORG 2000 1052 T YUSER7,4&X2,J 1053 XFR 0 1054 ORG 2000 1055 T YUSER8,4&X2,K 1056 XFR 0 1057 ORG 2000 1058 T YUSER9,4&X2,L 1059 XFR 0 1060 ORG 2000 1061 T YUSR10,4&X2,M 1062 XFR 0 1063 ORG 2000 1064 T YUSR11,4&X2,D 1065 XFR 0 1066 ORG 2000 1067 T YUSR12,4&X2,H 1068 XFR 0 1069 ORG 2000 1070 T XLINKS,4&X2,I 1071 XFR 0 LITS LITS 1072 END