      DOUBLE PRECISION FUNCTION DBI(X)
C***BEGIN PROLOGUE  DBI
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C10D
C***KEYWORDS  BAIRY FUNCTION,DOUBLE PRECISION,SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Calculates the d.p. Bairy function (Airy of second kind).
C***DESCRIPTION
C
C DBI(X) calculates the double precision Airy function of the
C second kind for double precision argument X.
C
C Series for BIF        on the interval -1.00000E+00 to  1.00000E+00
C                                        with weighted error   1.45E-32
C                                         log weighted error  31.84
C                               significant figures required  30.85
C                                    decimal places required  32.40
C
C Series for BIG        on the interval -1.00000E+00 to  1.00000E+00
C                                        with weighted error   1.29E-33
C                                         log weighted error  32.89
C                               significant figures required  31.48
C                                    decimal places required  33.45
C
C Series for BIF2       on the interval  1.00000E+00 to  8.00000E+00
C                                        with weighted error   6.08E-32
C                                         log weighted error  31.22
C                        approx significant figures required  30.8
C                                    decimal places required  31.80
C
C Series for BIG2       on the interval  1.00000E+00 to  8.00000E+00
C                                        with weighted error   4.91E-33
C                                         log weighted error  32.31
C                        approx significant figures required  31.6
C                                    decimal places required  32.90
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH,D9AIMP,DBIE,DCSEVL,INITDS,XERROR
C***END PROLOGUE  DBI
      DOUBLE PRECISION X, BIFCS(13), BIGCS(13), BIF2CS(15), BIG2CS(15),
     1  THETA, XM, XMAX, X3SML, Z,  D1MACH, DCSEVL, DBIE
      DATA BIF CS(  1) / -.1673021647 1986649483 5374239281 76 D-1     /
      DATA BIF CS(  2) / +.1025233583 4249445611 4263627777 57 D+0     /
      DATA BIF CS(  3) / +.1708309250 7381516539 4296502420 13 D-2     /
      DATA BIF CS(  4) / +.1186254546 7744681179 2164592100 40 D-4     /
      DATA BIF CS(  5) / +.4493290701 7792133694 5318879272 42 D-7     /
      DATA BIF CS(  6) / +.1069820714 3387889067 5677676636 28 D-9     /
      DATA BIF CS(  7) / +.1748064339 9771824706 0105176285 73 D-12    /
      DATA BIF CS(  8) / +.2081023107 1761711025 8818918343 99 D-15    /
      DATA BIF CS(  9) / +.1884981469 5665416509 9279717333 33 D-18    /
      DATA BIF CS( 10) / +.1342577917 3097804625 8826666666 66 D-21    /
      DATA BIF CS( 11) / +.7715959342 9658887893 3333333333 33 D-25    /
      DATA BIF CS( 12) / +.3653387961 7478566399 9999999999 99 D-28    /
      DATA BIF CS( 13) / +.1449756592 7953066666 6666666666 66 D-31    /
      DATA BIG CS(  1) / +.2246622324 8574522283 4682201390 24 D-1     /
      DATA BIG CS(  2) / +.3736477545 3019545441 7275616667 52 D-1     /
      DATA BIG CS(  3) / +.4447621895 7212285696 2152943266 39 D-3     /
      DATA BIG CS(  4) / +.2470807563 6329384245 4945919488 82 D-5     /
      DATA BIG CS(  5) / +.7919135339 5149635134 8624262855 96 D-8     /
      DATA BIG CS(  6) / +.1649807985 1827779880 8878724027 06 D-10    /
      DATA BIG CS(  7) / +.2411990666 4835455909 2475011228 41 D-13    /
      DATA BIG CS(  8) / +.2610373623 6091436985 1847812693 33 D-16    /
      DATA BIG CS(  9) / +.2175308297 7160323853 1237920000 00 D-19    /
      DATA BIG CS( 10) / +.1438694640 0390433219 4837333333 33 D-22    /
      DATA BIG CS( 11) / +.7734912561 2083468629 3333333333 33 D-26    /
      DATA BIG CS( 12) / +.3446929203 3849002666 6666666666 66 D-29    /
      DATA BIG CS( 13) / +.1293891927 3216000000 0000000000 00 D-32    /
      DATA BIF2CS(  1) / +.0998457269 3816041044 6828425799 3 D+0      /
      DATA BIF2CS(  2) / +.4786249778 6300553772 2114673182 31 D+0     /
      DATA BIF2CS(  3) / +.2515521196 0433011771 3244154366 75 D-1     /
      DATA BIF2CS(  4) / +.5820693885 2326456396 5156978722 16 D-3     /
      DATA BIF2CS(  5) / +.7499765964 4377865943 8614573782 17 D-5     /
      DATA BIF2CS(  6) / +.6134602870 3493836681 4030103564 74 D-7     /
      DATA BIF2CS(  7) / +.3462753885 1480632900 4342687333 59 D-9     /
      DATA BIF2CS(  8) / +.1428891008 0270254287 7708467489 31 D-11    /
      DATA BIF2CS(  9) / +.4496270429 8334641895 0564721792 00 D-14    /
      DATA BIF2CS( 10) / +.1114232306 5833011708 4283001066 66 D-16    /
      DATA BIF2CS( 11) / +.2230479106 6175002081 5178666666 66 D-19    /
      DATA BIF2CS( 12) / +.3681577873 6393142842 9226666666 66 D-22    /
      DATA BIF2CS( 13) / +.5096086844 9338261333 3333333333 33 D-25    /
      DATA BIF2CS( 14) / +.6000338692 6288554666 6666666666 66 D-28    /
      DATA BIF2CS( 15) / +.6082749744 6570666666 6666666666 66 D-31    /
      DATA BIG2CS(  1) / +.0333056621 4551434046 5176188111 647 D+0    /
      DATA BIG2CS(  2) / +.1613092151 2319706761 3287532084 943 D+0    /
      DATA BIG2CS(  3) / +.6319007309 6134286912 1615634921 173 D-2    /
      DATA BIG2CS(  4) / +.1187904568 1625173638 9780192304 567 D-3    /
      DATA BIG2CS(  5) / +.1304534588 6200265614 7116485012 843 D-5    /
      DATA BIG2CS(  6) / +.9374125995 5352172954 6809615508 936 D-8    /
      DATA BIG2CS(  7) / +.4745801886 7472515378 8510169834 595 D-10   /
      DATA BIG2CS(  8) / +.1783107265 0948139980 0065667560 946 D-12   /
      DATA BIG2CS(  9) / +.5167591927 8495818037 4276356640 000 D-15   /
      DATA BIG2CS( 10) / +.1190045083 8682712512 9496251733 333 D-17   /
      DATA BIG2CS( 11) / +.2229828806 6640351727 7063466666 666 D-20   /
      DATA BIG2CS( 12) / +.3465519230 2768941972 2666666666 666 D-23   /
      DATA BIG2CS( 13) / +.4539263363 2050451413 3333333333 333 D-26   /
      DATA BIG2CS( 14) / +.5078849965 1352234666 6666666666 666 D-29   /
      DATA BIG2CS( 15) / +.4910206746 9653333333 3333333333 333 D-32   /
      DATA NBIF, NBIG, NBIF2, NBIG2, X3SML, XMAX / 4*0, 2*0.D0 /
C***FIRST EXECUTABLE STATEMENT  DBI
      IF (NBIF.NE.0) GO TO 10
      ETA = 0.1*SNGL(D1MACH(3))
      NBIF = INITDS (BIFCS, 13, ETA)
      NBIG = INITDS (BIGCS, 13, ETA)
      NBIF2 = INITDS (BIF2CS, 15, ETA)
      NBIG2 = INITDS (BIG2CS, 15, ETA)
C
      X3SML = ETA**0.3333
      XMAX = (1.5*DLOG(D1MACH(2)))**0.6666D0
C
 10   IF (X.GE.(-1.0D0)) GO TO 20
      CALL D9AIMP (X, XM, THETA)
      DBI = XM * DSIN(THETA)
      RETURN
C
 20   IF (X.GT.1.0D0) GO TO 30
      Z = 0.D0
      IF (DABS(X).GT.X3SML) Z = X**3
      DBI = 0.625 + DCSEVL (Z, BIFCS, NBIF) + X*(0.4375D0 +
     1  DCSEVL (Z, BIGCS, NBIG))
      RETURN
C
 30   IF (X.GT.2.0D0) GO TO 40
      Z = (2.0D0*X**3 - 9.0D0)/7.D0
      DBI = 1.125D0 + DCSEVL (Z, BIF2CS, NBIF2) + X*(0.625D0 +
     1  DCSEVL (Z, BIG2CS, NBIG2))
      RETURN
C
 40   IF (X.GT.XMAX) CALL XERROR ( 'DBI     X SO BIG THAT BI OVERFLOWS',
     1 34, 1, 2)
C
      DBI = DBIE(X) * DEXP(2.0D0*X*DSQRT(X)/3.0D0)
      RETURN
C
      END
      SUBROUTINE D9AIMP(X,AMPL,THETA)
C***BEGIN PROLOGUE  D9AIMP
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C10D
C***KEYWORDS  AIRY FUNCTION,DOUBLE PRECISION,MODULUS,PHASE,
C             SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Evaluates the Airy modulus and phase for X .LE. -1.0
C***DESCRIPTION
C
C Evaluate the Airy modulus and phase for X .LE. -1.0
C
C Series for AM20       on the interval -1.56250E-02 to  0.
C                                        with weighted error   3.12E-32
C                                         log weighted error  31.51
C                               significant figures required  29.24
C                                    decimal places required  32.38
C
C Series for ATH0       on the interval -1.56250E-02 to  0.
C                                        with weighted error   2.75E-32
C                                         log weighted error  31.56
C                               significant figures required  30.17
C                                    decimal places required  32.42
C
C Series for AM21       on the interval -1.25000E-01 to -1.56250E-02
C                                        with weighted error   3.40E-32
C                                         log weighted error  31.47
C                               significant figures required  29.02
C                                    decimal places required  32.36
C
C Series for ATH1       on the interval -1.25000E-01 to -1.56250E-02
C                                        with weighted error   2.94E-32
C                                         log weighted error  31.53
C                               significant figures required  30.08
C                                    decimal places required  32.41
C
C Series for AM22       on the interval -1.00000E+00 to -1.25000E-01
C                                        with weighted error   3.76E-32
C                                         log weighted error  31.42
C                               significant figures required  29.47
C                                    decimal places required  32.36
C
C Series for ATH2       on the interval -1.00000E+00 to -1.25000E-01
C                                        with weighted error   4.97E-32
C                                         log weighted error  31.30
C                               significant figures required  29.79
C                                    decimal places required  32.23
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH,DCSEVL,INITDS,XERROR
C***END PROLOGUE  D9AIMP
      DOUBLE PRECISION X, AMPL, THETA, AM20CS(57), ATH0CS(53),
     1  AM21CS(60), ATH1CS(58), AM22CS(74), ATH2CS(72), PI4, SQRTX,
     2  XSML, Z,  D1MACH, DCSEVL
      DATA AM20CS(  1) / +.1087167490 8656185661 5730588125 D-1        /
      DATA AM20CS(  2) / +.3694892289 8266355509 1728665146 D-3        /
      DATA AM20CS(  3) / +.4406801004 8468956366 7507001327 D-5        /
      DATA AM20CS(  4) / +.1436867623 6191115392 9183952833 D-6        /
      DATA AM20CS(  5) / +.8242755523 9007830867 0628855353 D-8        /
      DATA AM20CS(  6) / +.6844267588 9366160617 3927278180 D-9        /
      DATA AM20CS(  7) / +.7395666972 8273928773 1004740213 D-10       /
      DATA AM20CS(  8) / +.9745956336 9682501763 8702600847 D-11       /
      DATA AM20CS(  9) / +.1500768858 2940577565 0973119497 D-11       /
      DATA AM20CS( 10) / +.2621479102 2152763420 6252854802 D-12       /
      DATA AM20CS( 11) / +.5083541113 7648718035 7278966914 D-13       /
      DATA AM20CS( 12) / +.1076847533 5881144049 2985997070 D-13       /
      DATA AM20CS( 13) / +.2460912866 1843342933 5914062617 D-14       /
      DATA AM20CS( 14) / +.6007863803 5865641843 6110373550 D-15       /
      DATA AM20CS( 15) / +.1554491561 0238807115 0651388384 D-15       /
      DATA AM20CS( 16) / +.4235351250 3557660442 6382780182 D-16       /
      DATA AM20CS( 17) / +.1208621662 8929984015 4401109189 D-16       /
      DATA AM20CS( 18) / +.3596096512 1465824086 1499706423 D-17       /
      DATA AM20CS( 19) / +.1111342183 8639563826 1774604677 D-17       /
      DATA AM20CS( 20) / +.3555595324 3236660989 3680289225 D-18       /
      DATA AM20CS( 21) / +.1174330216 0013930999 8766947387 D-18       /
      DATA AM20CS( 22) / +.3993974546 6107756138 9162200966 D-19       /
      DATA AM20CS( 23) / +.1395766715 2891631042 5606325640 D-19       /
      DATA AM20CS( 24) / +.5002400553 0923604139 3459280716 D-20       /
      DATA AM20CS( 25) / +.1835527609 5813267918 4834866457 D-20       /
      DATA AM20CS( 26) / +.6884909981 7920274319 7790112404 D-21       /
      DATA AM20CS( 27) / +.2636310356 1141701235 9996885105 D-21       /
      DATA AM20CS( 28) / +.1029248902 3733836028 7153563785 D-21       /
      DATA AM20CS( 29) / +.4092469666 7159488548 9762960571 D-22       /
      DATA AM20CS( 30) / +.1655585734 0673465103 9727903828 D-22       /
      DATA AM20CS( 31) / +.6807974670 6303335611 6599685727 D-23       /
      DATA AM20CS( 32) / +.2843265599 3407983241 9751134476 D-23       /
      DATA AM20CS( 33) / +.1205073983 4896525509 7287818819 D-23       /
      DATA AM20CS( 34) / +.5179612432 8750521797 6613610424 D-24       /
      DATA AM20CS( 35) / +.2256226134 2756281630 3268640887 D-24       /
      DATA AM20CS( 36) / +.9954188011 4774516883 2117078246 D-25       /
      DATA AM20CS( 37) / +.4445516963 9734242430 8280582053 D-25       /
      DATA AM20CS( 38) / +.2008651954 6150110142 5916097338 D-25       /
      DATA AM20CS( 39) / +.9177863441 5177516597 3885645402 D-26       /
      DATA AM20CS( 40) / +.4238729581 0558924066 1672197948 D-26       /
      DATA AM20CS( 41) / +.1977892720 0784609237 0846251490 D-26       /
      DATA AM20CS( 42) / +.9321163512 8462066568 0435253373 D-27       /
      DATA AM20CS( 43) / +.4434821332 4991809995 5611379722 D-27       /
      DATA AM20CS( 44) / +.2129456723 6557389559 4589552837 D-27       /
      DATA AM20CS( 45) / +.1031585696 5107597755 2209344907 D-27       /
      DATA AM20CS( 46) / +.5040237730 2259119915 7904590029 D-28       /
      DATA AM20CS( 47) / +.2483013045 7015594530 4046541005 D-28       /
      DATA AM20CS( 48) / +.1233017831 2856219605 4198238560 D-28       /
      DATA AM20CS( 49) / +.6170334499 2052174612 1976730507 D-29       /
      DATA AM20CS( 50) / +.3110926174 1591889723 3869792213 D-29       /
      DATA AM20CS( 51) / +.1579830852 0170617301 5269071503 D-29       /
      DATA AM20CS( 52) / +.8079319875 3828360767 8121339092 D-30       /
      DATA AM20CS( 53) / +.4159973941 3866756272 2951360052 D-30       /
      DATA AM20CS( 54) / +.2156109340 9771690047 1935862504 D-30       /
      DATA AM20CS( 55) / +.1124688572 6586917829 6752823613 D-30       /
      DATA AM20CS( 56) / +.5903315606 3283809112 3040811797 D-31       /
      DATA AM20CS( 57) / +.3117356676 9292856204 6280505333 D-31       /
      DATA ATH0CS(  1) / -.8172601764 1616344998 4020870054 3 D-1      /
      DATA ATH0CS(  2) / -.8004012824 7882732875 9648111306 8 D-3      /
      DATA ATH0CS(  3) / -.3186525268 7821132037 9555362824 2 D-5      /
      DATA ATH0CS(  4) / -.6688388266 4775093307 4169886503 3 D-7      /
      DATA ATH0CS(  5) / -.2931759284 9945645165 0682246318 4 D-8      /
      DATA ATH0CS(  6) / -.2011263760 8836216690 4903030718 6 D-9      /
      DATA ATH0CS(  7) / -.1877522678 0559734260 7400816665 2 D-10     /
      DATA ATH0CS(  8) / -.2199637137 7046012518 9900219984 8 D-11     /
      DATA ATH0CS(  9) / -.3071616682 5922724490 2574660558 6 D-12     /
      DATA ATH0CS( 10) / -.4936140553 6734183610 2560098538 9 D-13     /
      DATA ATH0CS( 11) / -.8902833722 5836604169 3523696986 6 D-14     /
      DATA ATH0CS( 12) / -.1768987764 6152726136 5681419946 7 D-14     /
      DATA ATH0CS( 13) / -.3817868689 0322770146 7819960960 0 D-15     /
      DATA ATH0CS( 14) / -.8851159014 8199475941 5628650998 4 D-16     /
      DATA ATH0CS( 15) / -.2184818181 4143659531 4967767956 8 D-16     /
      DATA ATH0CS( 16) / -.5700849046 9864523805 9944229511 9 D-17     /
      DATA ATH0CS( 17) / -.1563121122 1778753925 1603179549 5 D-17     /
      DATA ATH0CS( 18) / -.4481437996 7689950679 0668877635 3 D-18     /
      DATA ATH0CS( 19) / -.1337794883 7361880220 4456604409 8 D-18     /
      DATA ATH0CS( 20) / -.4143340036 8741144537 7685244544 2 D-19     /
      DATA ATH0CS( 21) / -.1327263385 7188050250 8048116465 2 D-19     /
      DATA ATH0CS( 22) / -.4385728589 1284405222 1575683595 5 D-20     /
      DATA ATH0CS( 23) / -.1491360695 9528180676 8620174395 6 D-20     /
      DATA ATH0CS( 24) / -.5208104738 6307113771 5423818877 3 D-21     /
      DATA ATH0CS( 25) / -.1864382222 3904989238 7252660497 9 D-21     /
      DATA ATH0CS( 26) / -.6830263751 1679690129 7543538188 1 D-22     /
      DATA ATH0CS( 27) / -.2557117058 0293296292 9620759134 7 D-22     /
      DATA ATH0CS( 28) / -.9770158640 2543002182 4690725404 6 D-23     /
      DATA ATH0CS( 29) / -.3805161433 4166790840 6842825488 6 D-23     /
      DATA ATH0CS( 30) / -.1509022750 7370540634 9392648299 5 D-23     /
      DATA ATH0CS( 31) / -.6087551341 2424249290 0556801452 5 D-24     /
      DATA ATH0CS( 32) / -.2495879513 8097114954 2598212405 8 D-24     /
      DATA ATH0CS( 33) / -.1039157654 5819209489 0958808427 4 D-24     /
      DATA ATH0CS( 34) / -.4390235913 9768465369 7459496905 1 D-25     /
      DATA ATH0CS( 35) / -.1880790678 4479902116 7582682058 2 D-25     /
      DATA ATH0CS( 36) / -.8165070764 1994629488 6302220575 3 D-26     /
      DATA ATH0CS( 37) / -.3589944503 7497505142 6643558504 1 D-26     /
      DATA ATH0CS( 38) / -.1597658126 6321328729 8129160870 8 D-26     /
      DATA ATH0CS( 39) / -.7193250175 7038239691 1380283530 5 D-27     /
      DATA ATH0CS( 40) / -.3274943012 7278565062 0935113272 1 D-27     /
      DATA ATH0CS( 41) / -.1507042445 7836906658 1697504727 2 D-27     /
      DATA ATH0CS( 42) / -.7006624198 3199047178 4396794914 0 D-28     /
      DATA ATH0CS( 43) / -.3289907402 9837182265 2881567835 6 D-28     /
      DATA ATH0CS( 44) / -.1559518084 3651465264 4532271149 6 D-28     /
      DATA ATH0CS( 45) / -.7460690508 2082545828 3385111972 1 D-29     /
      DATA ATH0CS( 46) / -.3600877034 8246620205 6327724943 1 D-29     /
      DATA ATH0CS( 47) / -.1752851437 4737722573 5040221919 7 D-29     /
      DATA ATH0CS( 48) / -.8603275775 1885129096 2377862872 4 D-30     /
      DATA ATH0CS( 49) / -.4256432603 2269465346 6803948010 5 D-30     /
      DATA ATH0CS( 50) / -.2122161865 0442629277 2365069820 6 D-30     /
      DATA ATH0CS( 51) / -.1065996156 7048790524 7206079856 1 D-30     /
      DATA ATH0CS( 52) / -.5393568608 8169491164 1068808689 2 D-31     /
      DATA ATH0CS( 53) / -.2748174851 0439548222 7849651787 0 D-31     /
      DATA AM21CS(  1) / +.5927902667 2130958837 5717482814 D-2        /
      DATA AM21CS(  2) / +.2005694053 9316518642 8695217690 D-2        /
      DATA AM21CS(  3) / +.9110818502 6227589355 3072526291 D-4        /
      DATA AM21CS(  4) / +.8498943063 7204715563 3172107475 D-5        /
      DATA AM21CS(  5) / +.1132979089 7691307663 7929215494 D-5        /
      DATA AM21CS(  6) / +.1875179461 0066649618 0950627804 D-6        /
      DATA AM21CS(  7) / +.3593065190 1824583269 9035211192 D-7        /
      DATA AM21CS(  8) / +.7657577140 7168386403 9093517470 D-8        /
      DATA AM21CS(  9) / +.1769999671 6803917392 5953460744 D-8        /
      DATA AM21CS( 10) / +.4362595556 5459893272 0546585535 D-9        /
      DATA AM21CS( 11) / +.1132916413 3785323003 5520085219 D-9        /
      DATA AM21CS( 12) / +.3072576909 8241924413 7868398126 D-10       /
      DATA AM21CS( 13) / +.8644824164 8220107554 1200465766 D-11       /
      DATA AM21CS( 14) / +.2510152500 6092440211 5104562212 D-11       /
      DATA AM21CS( 15) / +.7491024967 6444037160 1802227751 D-12       /
      DATA AM21CS( 16) / +.2289969284 8799407308 9565214432 D-12       /
      DATA AM21CS( 17) / +.7151136589 2798769494 9327491175 D-13       /
      DATA AM21CS( 18) / +.2276079249 5956684194 6395165061 D-13       /
      DATA AM21CS( 19) / +.7369421427 6088651396 9953227782 D-14       /
      DATA AM21CS( 20) / +.2423286752 6782749046 3991742006 D-14       /
      DATA AM21CS( 21) / +.8081537745 4823986928 3406558403 D-15       /
      DATA AM21CS( 22) / +.2730080798 0435608665 9174563386 D-15       /
      DATA AM21CS( 23) / +.9332360708 9138531847 3519474326 D-16       /
      DATA AM21CS( 24) / +.3225080996 8108462221 3867546973 D-16       /
      DATA AM21CS( 25) / +.1125819323 4644454121 7757573416 D-16       /
      DATA AM21CS( 26) / +.3966994639 8693882166 0259459530 D-17       /
      DATA AM21CS( 27) / +.1410065679 4431950466 0865034527 D-17       /
      DATA AM21CS( 28) / +.5053020865 3785121337 5537393032 D-18       /
      DATA AM21CS( 29) / +.1824615232 1594514119 7999102789 D-18       /
      DATA AM21CS( 30) / +.6635845682 6213046692 8029121642 D-19       /
      DATA AM21CS( 31) / +.2429637316 3127617974 1747455826 D-19       /
      DATA AM21CS( 32) / +.8952389151 2368780201 3669922963 D-20       /
      DATA AM21CS( 33) / +.3318452893 5005079126 0229250755 D-20       /
      DATA AM21CS( 34) / +.1237061961 8865831538 4437905922 D-20       /
      DATA AM21CS( 35) / +.4636366770 1239084030 6767734243 D-21       /
      DATA AM21CS( 36) / +.1746531359 4776447546 9758765989 D-21       /
      DATA AM21CS( 37) / +.6611168102 3499117630 7910643111 D-22       /
      DATA AM21CS( 38) / +.2514099189 9407248617 6125666459 D-22       /
      DATA AM21CS( 39) / +.9602749955 7173256869 4034386998 D-23       /
      DATA AM21CS( 40) / +.3683249522 8929639568 6436898078 D-23       /
      DATA AM21CS( 41) / +.1418431382 6915913614 5535939553 D-23       /
      DATA AM21CS( 42) / +.5483426742 7693583010 6345800990 D-24       /
      DATA AM21CS( 43) / +.2127610546 2311880665 0372562616 D-24       /
      DATA AM21CS( 44) / +.8284437008 4941859148 7734760953 D-25       /
      DATA AM21CS( 45) / +.3236705639 2612700142 1028600927 D-25       /
      DATA AM21CS( 46) / +.1268688829 6328605735 5055062493 D-25       /
      DATA AM21CS( 47) / +.4988438189 9212162693 5068934362 D-26       /
      DATA AM21CS( 48) / +.1967345844 6764939096 7119381790 D-26       /
      DATA AM21CS( 49) / +.7781359710 2032695771 3212064836 D-27       /
      DATA AM21CS( 50) / +.3086339414 9891115291 9192968451 D-27       /
      DATA AM21CS( 51) / +.1227446470 4545311978 9338037234 D-27       /
      DATA AM21CS( 52) / +.4894312791 3429220588 5241216204 D-28       /
      DATA AM21CS( 53) / +.1956468798 0290982117 5925099724 D-28       /
      DATA AM21CS( 54) / +.7839889529 2242617116 6311492266 D-29       /
      DATA AM21CS( 55) / +.3148969140 0248422374 8298978099 D-29       /
      DATA AM21CS( 56) / +.1267697631 3725068130 7067842559 D-29       /
      DATA AM21CS( 57) / +.5114706919 0690014164 1632107724 D-30       /
      DATA AM21CS( 58) / +.2068017097 9553877025 0900316706 D-30       /
      DATA AM21CS( 59) / +.8378913447 6851900132 5996867583 D-31       /
      DATA AM21CS( 60) / +.3401689919 7148980205 2339079577 D-31       /
      DATA ATH1CS(  1) / -.6972849916 2088838458 8814841503 7 D-1      /
      DATA ATH1CS(  2) / -.5108722790 6500449870 7344807796 1 D-2      /
      DATA ATH1CS(  3) / -.8644335996 9897550945 2533474951 2 D-4      /
      DATA ATH1CS(  4) / -.5604720044 2352635421 8869891612 5 D-5      /
      DATA ATH1CS(  5) / -.6045735125 6238974091 5637664007 7 D-6      /
      DATA ATH1CS(  6) / -.8639802632 4883343932 1972113849 9 D-7      /
      DATA ATH1CS(  7) / -.1480809484 3099271571 4778248078 0 D-7      /
      DATA ATH1CS(  8) / -.2885809334 5772360399 9944990871 2 D-8      /
      DATA ATH1CS(  9) / -.6191631975 6656996093 0919123180 0 D-9      /
      DATA ATH1CS( 10) / -.1431992808 8609578309 3136525987 9 D-9      /
      DATA ATH1CS( 11) / -.3518141102 1372147215 0461687432 1 D-10     /
      DATA ATH1CS( 12) / -.9084761919 9550782900 7033980805 1 D-11     /
      DATA ATH1CS( 13) / -.2446171672 6885984493 4328366476 7 D-11     /
      DATA ATH1CS( 14) / -.6826083203 2134462408 2899671026 4 D-12     /
      DATA ATH1CS( 15) / -.1964579931 1949401712 7854625780 2 D-12     /
      DATA ATH1CS( 16) / -.5808933227 1396931640 0919126585 6 D-13     /
      DATA ATH1CS( 17) / -.1759042249 5274419927 9540095902 4 D-13     /
      DATA ATH1CS( 18) / -.5440902932 7148966136 3253894531 9 D-14     /
      DATA ATH1CS( 19) / -.1715247407 4868068026 2235851945 1 D-14     /
      DATA ATH1CS( 20) / -.5500929233 5769915468 7110184716 1 D-15     /
      DATA ATH1CS( 21) / -.1791878287 7393172594 9515263875 4 D-15     /
      DATA ATH1CS( 22) / -.5920372520 0866941977 7841106223 1 D-16     /
      DATA ATH1CS( 23) / -.1981713027 8764839624 7097220659 0 D-16     /
      DATA ATH1CS( 24) / -.6713232347 0163522620 4998434379 0 D-17     /
      DATA ATH1CS( 25) / -.2299450243 6582811161 2235861983 2 D-17     /
      DATA ATH1CS( 26) / -.7957300928 2363765953 0463714563 4 D-18     /
      DATA ATH1CS( 27) / -.2779994027 2917841571 7229023373 9 D-18     /
      DATA ATH1CS( 28) / -.9798924361 3269852244 0679548081 4 D-19     /
      DATA ATH1CS( 29) / -.3482717006 0615743867 0264556584 9 D-19     /
      DATA ATH1CS( 30) / -.1247489122 5585990571 7330005808 4 D-19     /
      DATA ATH1CS( 31) / -.4501210041 4782281134 8775182445 2 D-20     /
      DATA ATH1CS( 32) / -.1635346244 0133521355 9611416466 7 D-20     /
      DATA ATH1CS( 33) / -.5980102897 7803362680 9876226594 1 D-21     /
      DATA ATH1CS( 34) / -.2200246286 2861234540 2819629547 5 D-21     /
      DATA ATH1CS( 35) / -.8142463073 5150858974 0820529151 9 D-22     /
      DATA ATH1CS( 36) / -.3029924773 6600425374 3233070967 4 D-22     /
      DATA ATH1CS( 37) / -.1133390098 5746235377 2294396968 9 D-22     /
      DATA ATH1CS( 38) / -.4260766024 7492957192 8304988979 1 D-23     /
      DATA ATH1CS( 39) / -.1609363396 2781897187 9750063445 3 D-23     /
      DATA ATH1CS( 40) / -.6106377190 8250262930 4533044428 7 D-24     /
      DATA ATH1CS( 41) / -.2326954318 0216940618 3657788757 3 D-24     /
      DATA ATH1CS( 42) / -.8903987877 4722526044 7412955818 6 D-25     /
      DATA ATH1CS( 43) / -.3420558530 0056750241 1791475234 1 D-25     /
      DATA ATH1CS( 44) / -.1319026715 2572726590 1721210060 7 D-25     /
      DATA ATH1CS( 45) / -.5104899493 6120430913 1619117738 6 D-26     /
      DATA ATH1CS( 46) / -.1982599478 4745474512 4244466346 6 D-26     /
      DATA ATH1CS( 47) / -.7725702356 8808305356 3611185151 9 D-27     /
      DATA ATH1CS( 48) / -.3020234733 6646801008 1577686357 3 D-27     /
      DATA ATH1CS( 49) / -.1184379739 0741699937 1294638080 0 D-27     /
      DATA ATH1CS( 50) / -.4658430227 9223085205 7325284010 6 D-28     /
      DATA ATH1CS( 51) / -.1837554188 1003846471 5750200661 3 D-28     /
      DATA ATH1CS( 52) / -.7268566894 4279909533 2187668480 0 D-29     /
      DATA ATH1CS( 53) / -.2882863120 3914681355 2708987562 6 D-29     /
      DATA ATH1CS( 54) / -.1146374629 4599063504 1759166463 9 D-29     /
      DATA ATH1CS( 55) / -.4570031437 7485330581 7999168853 3 D-30     /
      DATA ATH1CS( 56) / -.1826276602 0453461048 0993402879 9 D-30     /
      DATA ATH1CS( 57) / -.7315349993 3852504691 1106635093 3 D-31     /
      DATA ATH1CS( 58) / -.2936925599 9714297816 3781577386 6 D-31     /
      DATA AM22CS(  1) / -.1562844480 6253411275 3545828583 D-1        /
      DATA AM22CS(  2) / +.7783364452 3968130701 8943100334 D-2        /
      DATA AM22CS(  3) / +.8670577704 7718952840 6072812110 D-3        /
      DATA AM22CS(  4) / +.1569662731 5611371946 9953482266 D-3        /
      DATA AM22CS(  5) / +.3563962571 4328651132 4100666302 D-4        /
      DATA AM22CS(  6) / +.9245983354 2504315449 5080090994 D-5        /
      DATA AM22CS(  7) / +.2621101618 5042238952 3194982066 D-5        /
      DATA AM22CS(  8) / +.7918822165 1601256148 9469982263 D-6        /
      DATA AM22CS(  9) / +.2510415279 2101184780 3162690862 D-6        /
      DATA AM22CS( 10) / +.8265223206 6540773447 2997712940 D-7        /
      DATA AM22CS( 11) / +.2805711662 8130526439 6384290014 D-7        /
      DATA AM22CS( 12) / +.9768210904 8468078667 4631273890 D-8        /
      DATA AM22CS( 13) / +.3474079232 2771034328 7279035573 D-8        /
      DATA AM22CS( 14) / +.1258281321 6983691421 9092738164 D-8        /
      DATA AM22CS( 15) / +.4629882606 4189526449 7330784625 D-9        /
      DATA AM22CS( 16) / +.1727282588 1360407246 8143128696 D-9        /
      DATA AM22CS( 17) / +.6523192001 3115413514 8574124970 D-10       /
      DATA AM22CS( 18) / +.2490471685 2098205601 9881087112 D-10       /
      DATA AM22CS( 19) / +.9601568205 5376594807 8189890126 D-11       /
      DATA AM22CS( 20) / +.3734480020 6772685697 4776596757 D-11       /
      DATA AM22CS( 21) / +.1464175650 3205339172 2216189678 D-11       /
      DATA AM22CS( 22) / +.5782654711 6851282547 5827881553 D-12       /
      DATA AM22CS( 23) / +.2299154072 4470611856 0254184494 D-12       /
      DATA AM22CS( 24) / +.9197807112 3199725715 0883662365 D-13       /
      DATA AM22CS( 25) / +.3700600688 1309006580 7504045556 D-13       /
      DATA AM22CS( 26) / +.1496757616 9867298782 3326345205 D-13       /
      DATA AM22CS( 27) / +.6083611949 3846114872 0451399443 D-14       /
      DATA AM22CS( 28) / +.2484040871 1512139763 5425326873 D-14       /
      DATA AM22CS( 29) / +.1018624765 2676908072 7914465339 D-14       /
      DATA AM22CS( 30) / +.4193838563 5275398942 9640310957 D-15       /
      DATA AM22CS( 31) / +.1733189017 6293075614 9702493501 D-15       /
      DATA AM22CS( 32) / +.7188219023 8850851782 0445406811 D-16       /
      DATA AM22CS( 33) / +.2991236335 9840360771 2470896113 D-16       /
      DATA AM22CS( 34) / +.1248689904 3323862785 5713110880 D-16       /
      DATA AM22CS( 35) / +.5228293446 0948366192 8651193632 D-17       /
      DATA AM22CS( 36) / +.2195329617 2471339659 5998454359 D-17       /
      DATA AM22CS( 37) / +.9242983252 2977728115 4410024332 D-18       /
      DATA AM22CS( 38) / +.3901577082 3609140782 5543197309 D-18       /
      DATA AM22CS( 39) / +.1650938926 9386370721 3759030367 D-18       /
      DATA AM22CS( 40) / +.7002218157 1599436756 5716554487 D-19       /
      DATA AM22CS( 41) / +.2976518336 1678691557 3214963506 D-19       /
      DATA AM22CS( 42) / +.1267965390 8690207257 1134261229 D-19       /
      DATA AM22CS( 43) / +.5412434006 9707762868 7581725061 D-20       /
      DATA AM22CS( 44) / +.2314873502 1815525229 6382133283 D-20       /
      DATA AM22CS( 45) / +.9919202883 8656656346 2623851167 D-21       /
      DATA AM22CS( 46) / +.4258030153 2373235715 8897608174 D-21       /
      DATA AM22CS( 47) / +.1831018429 7302450167 8402003088 D-21       /
      DATA AM22CS( 48) / +.7886787123 1107537556 4526811022 D-22       /
      DATA AM22CS( 49) / +.3402546073 8622987495 6582997235 D-22       /
      DATA AM22CS( 50) / +.1470208814 0571253079 1860892535 D-22       /
      DATA AM22CS( 51) / +.6362110183 2491695773 3348071767 D-23       /
      DATA AM22CS( 52) / +.2757070506 8098072191 9395987768 D-23       /
      DATA AM22CS( 53) / +.1196458580 9010407135 6261780457 D-23       /
      DATA AM22CS( 54) / +.5199125457 2924214798 1768210567 D-24       /
      DATA AM22CS( 55) / +.2262176748 4710447526 0575286850 D-24       /
      DATA AM22CS( 56) / +.9855261137 5443181944 8565068283 D-25       /
      DATA AM22CS( 57) / +.4298706303 3250871722 3681286187 D-25       /
      DATA AM22CS( 58) / +.1877236416 6158063982 9657670189 D-25       /
      DATA AM22CS( 59) / +.8207219417 7284213726 8801052115 D-26       /
      DATA AM22CS( 60) / +.3592146656 0461550781 2767944463 D-26       /
      DATA AM22CS( 61) / +.1573905946 1277331561 1458940587 D-26       /
      DATA AM22CS( 62) / +.6903297810 3933383496 5319153586 D-27       /
      DATA AM22CS( 63) / +.3030920790 7896853460 7859331415 D-27       /
      DATA AM22CS( 64) / +.1332049341 6048121918 5689121944 D-27       /
      DATA AM22CS( 65) / +.5859788368 5152349011 7937981442 D-28       /
      DATA AM22CS( 66) / +.2580168684 8948780633 8425080457 D-28       /
      DATA AM22CS( 67) / +.1137124336 3728366722 3632182863 D-28       /
      DATA AM22CS( 68) / +.5015925572 2606850923 6430548549 D-29       /
      DATA AM22CS( 69) / +.2214458293 9550937332 2569708484 D-29       /
      DATA AM22CS( 70) / +.9784702838 8650728998 4691416411 D-30       /
      DATA AM22CS( 71) / +.4326954149 3418017011 2000952983 D-30       /
      DATA AM22CS( 72) / +.1914972881 9399457061 2929860440 D-30       /
      DATA AM22CS( 73) / +.8481646224 0239235417 1298331562 D-31       /
      DATA AM22CS( 74) / +.3759470651 7395591994 7455052934 D-31       /
      DATA ATH2CS(  1) / +.4405273458 7187789970 6112705777 5 D-2      /
      DATA ATH2CS(  2) / -.3042919452 3184546084 8384423987 3 D-1      /
      DATA ATH2CS(  3) / -.1385653283 7717937916 0269284265 3 D-2      /
      DATA ATH2CS(  4) / -.1804443908 9549523026 7048691095 2 D-3      /
      DATA ATH2CS(  5) / -.3380847108 3273086710 5746532361 8 D-4      /
      DATA ATH2CS(  6) / -.7678183535 2290230552 5767681776 5 D-5      /
      DATA ATH2CS(  7) / -.1967839443 7160353246 9093541707 7 D-5      /
      DATA ATH2CS(  8) / -.5483727115 8777003615 8614365928 1 D-6      /
      DATA ATH2CS(  9) / -.1625461550 5326124527 1269621225 8 D-6      /
      DATA ATH2CS( 10) / -.5053049981 2688950152 7763784207 8 D-7      /
      DATA ATH2CS( 11) / -.1631580701 1240668811 8385171561 7 D-7      /
      DATA ATH2CS( 12) / -.5434204112 3485175079 6343669481 7 D-8      /
      DATA ATH2CS( 13) / -.1857398556 4099003257 6385010963 0 D-8      /
      DATA ATH2CS( 14) / -.6489512033 3261088162 1351364067 6 D-9      /
      DATA ATH2CS( 15) / -.2310594885 8009447204 8299598707 9 D-9      /
      DATA ATH2CS( 16) / -.8363282183 2044116828 1932954674 5 D-10     /
      DATA ATH2CS( 17) / -.3071196844 8901914626 6066130389 1 D-10     /
      DATA ATH2CS( 18) / -.1142367142 4327168194 0951457989 2 D-10     /
      DATA ATH2CS( 19) / -.4298116066 3458030658 2247010897 1 D-11     /
      DATA ATH2CS( 20) / -.1633898699 5967154406 0164608663 2 D-11     /
      DATA ATH2CS( 21) / -.6269328620 0166194321 2344375407 6 D-12     /
      DATA ATH2CS( 22) / -.2426052694 8162573573 5615920399 1 D-12     /
      DATA ATH2CS( 23) / -.9461198321 6240390907 4252776505 2 D-13     /
      DATA ATH2CS( 24) / -.3716060313 4115048068 4779828126 9 D-13     /
      DATA ATH2CS( 25) / -.1469155684 0975267631 7013881030 9 D-13     /
      DATA ATH2CS( 26) / -.5843694726 1409119445 5640136309 4 D-14     /
      DATA ATH2CS( 27) / -.2337502595 5919512988 3267503493 4 D-14     /
      DATA ATH2CS( 28) / -.9399231371 1714354011 6016735841 1 D-15     /
      DATA ATH2CS( 29) / -.3798014669 3728945000 7633526371 5 D-15     /
      DATA ATH2CS( 30) / -.1541731043 9849725248 8344368177 5 D-15     /
      DATA ATH2CS( 31) / -.6285287079 5353071629 2566236520 2 D-16     /
      DATA ATH2CS( 32) / -.2572731812 8114554247 5538399277 4 D-16     /
      DATA ATH2CS( 33) / -.1057098119 3540178093 4097486655 5 D-16     /
      DATA ATH2CS( 34) / -.4359080267 4026969666 9599269996 4 D-17     /
      DATA ATH2CS( 35) / -.1803634315 9599780139 5317694554 0 D-17     /
      DATA ATH2CS( 36) / -.7486838064 3805368217 1943167691 4 D-18     /
      DATA ATH2CS( 37) / -.3117261367 3476046567 9959720998 5 D-18     /
      DATA ATH2CS( 38) / -.1301687980 9277007347 9287162069 6 D-18     /
      DATA ATH2CS( 39) / -.5450527587 5195224689 7388390990 9 D-19     /
      DATA ATH2CS( 40) / -.2288293490 1142318722 6863593190 3 D-19     /
      DATA ATH2CS( 41) / -.9631059503 8295386556 5506044008 8 D-20     /
      DATA ATH2CS( 42) / -.4063281001 5246140890 9219541643 4 D-20     /
      DATA ATH2CS( 43) / -.1718203980 9080267639 0041385851 0 D-20     /
      DATA ATH2CS( 44) / -.7281574619 8925363674 1532247332 8 D-21     /
      DATA ATH2CS( 45) / -.3092352652 6806431279 6068034579 0 D-21     /
      DATA ATH2CS( 46) / -.1315917855 9654404903 8341702325 4 D-21     /
      DATA ATH2CS( 47) / -.5610606786 0870555126 6490741266 8 D-22     /
      DATA ATH2CS( 48) / -.2396621894 0863552060 2030433789 5 D-22     /
      DATA ATH2CS( 49) / -.1025574332 3905812008 3295442392 4 D-22     /
      DATA ATH2CS( 50) / -.4396264138 1436564764 0360732366 3 D-23     /
      DATA ATH2CS( 51) / -.1887652998 3725773733 4250871945 0 D-23     /
      DATA ATH2CS( 52) / -.8118140359 5768076035 7943323044 5 D-24     /
      DATA ATH2CS( 53) / -.3496734274 3662868563 7595208921 4 D-24     /
      DATA ATH2CS( 54) / -.1508402925 1568732151 7175147586 7 D-24     /
      DATA ATH2CS( 55) / -.6516268284 7786710597 8777383434 1 D-25     /
      DATA ATH2CS( 56) / -.2818945797 5292074245 0594211458 3 D-25     /
      DATA ATH2CS( 57) / -.1221127596 5122627445 9809446450 5 D-25     /
      DATA ATH2CS( 58) / -.5296674341 1698671686 2001170507 3 D-26     /
      DATA ATH2CS( 59) / -.2300359270 7736734313 5887097174 4 D-26     /
      DATA ATH2CS( 60) / -.1000279482 3553674947 8122034893 0 D-26     /
      DATA ATH2CS( 61) / -.4354760404 1808793948 0689316217 9 D-27     /
      DATA ATH2CS( 62) / -.1898056134 7414775225 1548282703 0 D-27     /
      DATA ATH2CS( 63) / -.8282111868 7129746975 5400930931 5 D-28     /
      DATA ATH2CS( 64) / -.3617815493 0665690065 8621348437 4 D-28     /
      DATA ATH2CS( 65) / -.1582018896 1780036548 5894184363 6 D-28     /
      DATA ATH2CS( 66) / -.6925068597 8022700117 7282038324 7 D-29     /
      DATA ATH2CS( 67) / -.3034390239 7786291289 0862972733 5 D-29     /
      DATA ATH2CS( 68) / -.1330889568 1667252247 6197744650 9 D-29     /
      DATA ATH2CS( 69) / -.5842848522 1730901204 8760697170 6 D-30     /
      DATA ATH2CS( 70) / -.2567488423 2383026311 2127435767 8 D-30     /
      DATA ATH2CS( 71) / -.1129232322 2688821857 9150581915 1 D-30     /
      DATA ATH2CS( 72) / -.4970947029 7533369165 5057010502 3 D-31     /
      DATA PI4 / 0.7853981633 9744830961 5660845819 88D0 /
      DATA NAM20, NATH0, NAM21, NATH21, NAM22, NATH2 / 6*0 /
      DATA XSML / 0.D0 /
C***FIRST EXECUTABLE STATEMENT  D9AIMP
      IF (NAM20.NE.0) GO TO 10
      ETA = 0.1*SNGL(D1MACH(3))
      NAM20 = INITDS (AM20CS, 57, ETA)
      NATH0 = INITDS (ATH0CS, 53, ETA)
      NAM21 = INITDS (AM21CS, 60, ETA)
      NATH1 = INITDS (ATH1CS, 58, ETA)
      NAM22 = INITDS (AM22CS, 74, ETA)
      NATH2 = INITDS (ATH2CS, 72, ETA)
C
      XSML = -1.0D0/D1MACH(3)**0.3333D0
C
 10   IF (X.GE.(-4.0D0)) GO TO 20
      Z = 1.0D0
      IF (X.GT.XSML) Z = 128.D0/X**3 + 1.0D0
      AMPL = 0.3125D0 + DCSEVL (Z, AM20CS, NAM20)
      THETA = -0.625D0 + DCSEVL (Z, ATH0CS, NATH0)
      GO TO 40
C
 20   IF (X.GE.(-2.0D0)) GO TO 30
      Z = (128.D0/X**3 + 9.0D0)/7.0D0
      AMPL = 0.3125D0 + DCSEVL (Z, AM21CS, NAM21)
      THETA = -0.625D0 + DCSEVL (Z, ATH1CS, NATH1)
      GO TO 40
C
 30   IF (X.GE.(-1.0D0)) CALL XERROR ( 'D9AIMP  X MUST BE LE -1.0', 25,
     11, 2)
C
      Z = (16.D0/X**3 + 9.0D0)/7.0D0
      AMPL = 0.3125D0 + DCSEVL (Z, AM22CS, NAM22)
      THETA = -0.625D0 + DCSEVL (Z, ATH2CS, NATH2)
C
 40   SQRTX = DSQRT(-X)
      AMPL = DSQRT (AMPL/SQRTX)
      THETA = PI4 - X*SQRTX*THETA
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION D1MACH(I)
C***BEGIN PROLOGUE  D1MACH
C***DATE WRITTEN   750101   (YYMMDD)
C***REVISION DATE  880330   (YYMMDD)
C***CATEGORY NO.  R1
C***KEYWORDS  MACHINE CONSTANTS
C***AUTHOR  FOX, P. A., (BELL LABS)
C           HALL, A. D., (BELL LABS)
C           SCHRYER, N. L., (BELL LABS)
C***PURPOSE  Returns double precision machine dependent constants
C***DESCRIPTION
C
C     This is the CMLIB version of D1MACH, the double precision machine
C     constants subroutine originally developed for the PORT library.
C
C     D1MACH can be used to obtain machine-dependent parameters
C     for the local machine environment.  It is a function
C     subprogram with one (input) argument, and can be called
C     as follows, for example
C
C          D = D1MACH(I)
C
C     where I=1,...,5.  The (output) value of D above is
C     determined by the (input) value of I.  The results for
C     various values of I are discussed below.
C
C  Double-precision machine constants
C  D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude.
C  D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
C  D1MACH( 3) = B**(-T), the smallest relative spacing.
C  D1MACH( 4) = B**(1-T), the largest relative spacing.
C  D1MACH( 5) = LOG10(B)
C***REFERENCES  FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A
C                 PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188.
C***ROUTINES CALLED  XERROR
C***END PROLOGUE  D1MACH
C
      INTEGER SMALL(4)
      INTEGER LARGE(4)
      INTEGER RIGHT(4)
      INTEGER DIVER(4)
      INTEGER LOG10(4)
C
      DOUBLE PRECISION DMACH(5)
C
      EQUIVALENCE (DMACH(1),SMALL(1))
      EQUIVALENCE (DMACH(2),LARGE(1))
      EQUIVALENCE (DMACH(3),RIGHT(1))
      EQUIVALENCE (DMACH(4),DIVER(1))
      EQUIVALENCE (DMACH(5),LOG10(1))
C
C     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T
C     3B SERIES AND MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T
C     PC 7300), SUN SPARCSTATIONS, SILICON GRAPHCS WORKSTATIONS, HP
C     9000 WORKSTATIONS, IBM RS/6000 WORKSTATIONS IN WHICH THE MOST 
C     SIGNIFICANT BYTE IS STORED FIRST.
C
C === MACHINE = ATT.3B
C === MACHINE = ATT.7300
C === MACHINE = HP.9000
C === MACHINE = IBM.RS6000
C === MACHINE = IEEE.MOST-SIG-BYTE-FIRST
C === MACHINE = SGI
C === MACHINE = SUN
C === MACHINE = 68000
C      DATA SMALL(1),SMALL(2) /    1048576,          0 /
C      DATA LARGE(1),LARGE(2) / 2146435071,         -1 /
C      DATA RIGHT(1),RIGHT(2) / 1017118720,          0 /
C      DATA DIVER(1),DIVER(2) / 1018167296,          0 /
C      DATA LOG10(1),LOG10(2) / 1070810131, 1352628735 /
C
C     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES AND 8087-BASED
C     MICROS, SUCH AS THE IBM PC AND AT&T 6300, IN WHICH THE LEAST
C     SIGNIFICANT BYTE IS STORED FIRST.
C
C === MACHINE = IEEE.LEAST-SIG-BYTE-FIRST
C === MACHINE = 8087
C === MACHINE = IBM.PC
C === MACHINE = ATT.6300
C      DATA SMALL(1),SMALL(2) /          0,    1048576 /
C      DATA LARGE(1),LARGE(2) /         -1, 2146435071 /
C      DATA RIGHT(1),RIGHT(2) /          0, 1017118720 /
C      DATA DIVER(1),DIVER(2) /          0, 1018167296 /
C      DATA LOG10(1),LOG10(2) / 1352628735, 1070810131 /
C
C     MACHINE CONSTANTS FOR SUN WORKSTATIONS.  f77 WITH -r8 OPTION.
C
C === MACHINE = SUN.F77-WITH-R8-OPTION
C      DATA DMACH(1) / 3.3621031431120935062626778173217526D-4932 /
C      DATA DMACH(2) / 1.1897314953572317650857593266280070D+4932 /
C      DATA DMACH(3) / 9.6296497219361792652798897129246366D-035  /
C      DATA DMACH(4) / 1.9259299443872358530559779425849273D-034  /
C      DATA DMACH(5) / 0.30102999566398119521373889472449302      /
C
C     MACHINE CONSTANTS FOR IBM RS/6000 WORKSTATIONS WITH -qautodbl=dblpad.
C
C === MACHINE = IBM.RS6000.XLF-WITH-AUTODBL-OPTION
C      DATA DMACH(1) / 2.2250738585072E-308 /
C      DATA DMACH(2) / 1.7976931348623E308  /
C      DATA DMACH(3) / 0.48148248609680896326399448564623183E-34  /
C      DATA DMACH(4) / 0.48148248609680896326399448564623183E-34  /
C      DATA DMACH(5) / 0.30102999566398119521373889472449302      /
C
C     MACHINE CONSTANTS FOR SGI Origin 2000 with -r8 -d16 options.
C
C === MACHINE = SGI.ORIGIN.F77-WITH-R8-D16-OPTIONS
C      DATA DMACH(1) / 1.8051943758648295760692620811737E-276 /
C      DATA DMACH(2) / 8.9884656743115795386465259539451E+307  /
C      DATA DMACH(3) / 6.1629758220391547297791294162718E-33  /
C      DATA DMACH(4) / 1.2325951644078309459558258832544E-32  /
C      DATA DMACH(5) / 0.30102999566398119521373889472449302  /
C
C     MACHINE CONSTANTS FOR AMDAHL MACHINES.
C
C === MACHINE = AMDAHL
C      DATA SMALL(1),SMALL(2) /    1048576,          0 /
C      DATA LARGE(1),LARGE(2) / 2147483647,         -1 /
C      DATA RIGHT(1),RIGHT(2) /  856686592,          0 /
C      DATA DIVER(1),DIVER(2) /  873463808,          0 /
C      DATA LOG10(1),LOG10(2) / 1091781651, 1352628735 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
C
C === MACHINE = BURROUGHS.1700
C      DATA SMALL(1) / ZC00800000 /
C      DATA SMALL(2) / Z000000000 /
C      DATA LARGE(1) / ZDFFFFFFFF /
C      DATA LARGE(2) / ZFFFFFFFFF /
C      DATA RIGHT(1) / ZCC5800000 /
C      DATA RIGHT(2) / Z000000000 /
C      DATA DIVER(1) / ZCC6800000 /
C      DATA DIVER(2) / Z000000000 /
C      DATA LOG10(1) / ZD00E730E7 /
C      DATA LOG10(2) / ZC77800DC0 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM.
C
C === MACHINE = BURROUGHS.5700
C      DATA SMALL(1) / O1771000000000000 /
C      DATA SMALL(2) / O0000000000000000 /
C      DATA LARGE(1) / O0777777777777777 /
C      DATA LARGE(2) / O0007777777777777 /
C      DATA RIGHT(1) / O1461000000000000 /
C      DATA RIGHT(2) / O0000000000000000 /
C      DATA DIVER(1) / O1451000000000000 /
C      DATA DIVER(2) / O0000000000000000 /
C      DATA LOG10(1) / O1157163034761674 /
C      DATA LOG10(2) / O0006677466732724 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS.
C
C === MACHINE = BURROUGHS.6700
C === MACHINE = BURROUGHS.7700
C      DATA SMALL(1) / O1771000000000000 /
C      DATA SMALL(2) / O7770000000000000 /
C      DATA LARGE(1) / O0777777777777777 /
C      DATA LARGE(2) / O7777777777777777 /
C      DATA RIGHT(1) / O1461000000000000 /
C      DATA RIGHT(2) / O0000000000000000 /
C      DATA DIVER(1) / O1451000000000000 /
C      DATA DIVER(2) / O0000000000000000 /
C      DATA LOG10(1) / O1157163034761674 /
C      DATA LOG10(2) / O0006677466732724 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES (NATIVE MODE)
C
C === MACHINE = CONVEX
C      DATA DMACH(1) / 5.562684646268007D-309 /
C      DATA DMACH(2) / 8.988465674311577D+307 /
C      DATA DMACH(3) / 1.110223024625157D-016 /
C      DATA DMACH(4) / 2.220446049250313D-016 /
C      DATA DMACH(5) / 3.010299956639812D-001 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES (NATIVE MODE)
C     WITH -P8 OPTION
C
C === MACHINE = CONVEX.P8
C      DATA DMACH(1) / 8.500000000000000000000000000000000Q-4933 /
C      DATA DMACH(2) / 5.900000000000000000000000000000000Q+4931 /
C      DATA DMACH(3) / 1.925929944387235853055977942584927Q-0034 /
C      DATA DMACH(4) / 3.851859888774471706111955885169854Q-0034 /
C      DATA DMACH(5) / 3.010299956639811952137388947244930Q-0001 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES (IEEE MODE)
C     WITH OR WITHOUT -P8 OPTION
C
C === MACHINE = CONVEX.IEEE
C === MACHINE = CONVEX.IEEE.P8
C      DATA DMACH(1) / 2.225073858507202D-308 /
C      DATA DMACH(2) / 1.797693134862315D+308 /
C      DATA DMACH(3) / 1.110223024625157D-016 /
C      DATA DMACH(4) / 2.220446049250313D-016 /
C      DATA DMACH(5) / 3.010299956639812D-001 /
C
C     MACHINE CONSTANTS FOR THE CYBER 170/180 SERIES USING NOS (FTN5).
C
C === MACHINE = CYBER.170.NOS
C === MACHINE = CYBER.180.NOS
C      DATA SMALL(1) / O"00604000000000000000" /
C      DATA SMALL(2) / O"00000000000000000000" /
C      DATA LARGE(1) / O"37767777777777777777" /
C      DATA LARGE(2) / O"37167777777777777777" /
C      DATA RIGHT(1) / O"15604000000000000000" /
C      DATA RIGHT(2) / O"15000000000000000000" /
C      DATA DIVER(1) / O"15614000000000000000" /
C      DATA DIVER(2) / O"15010000000000000000" /
C      DATA LOG10(1) / O"17164642023241175717" /
C      DATA LOG10(2) / O"16367571421742254654" /
C
C     MACHINE CONSTANTS FOR THE CDC 180 SERIES USING NOS/VE
C
C === MACHINE = CYBER.180.NOS/VE
C      DATA SMALL(1) / Z"3001800000000000" /
C      DATA SMALL(2) / Z"3001000000000000" /
C      DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" /
C      DATA LARGE(2) / Z"4FFE000000000000" /
C      DATA RIGHT(1) / Z"3FD2800000000000" /
C      DATA RIGHT(2) / Z"3FD2000000000000" /
C      DATA DIVER(1) / Z"3FD3800000000000" /
C      DATA DIVER(2) / Z"3FD3000000000000" /
C      DATA LOG10(1) / Z"3FFF9A209A84FBCF" /
C      DATA LOG10(2) / Z"3FFFF7988F8959AC" /
C
C     MACHINE CONSTANTS FOR THE CYBER 205
C
C === MACHINE = CYBER.205
C      DATA SMALL(1) / X'9000400000000000' /
C      DATA SMALL(2) / X'8FD1000000000000' /
C      DATA LARGE(1) / X'6FFF7FFFFFFFFFFF' /
C      DATA LARGE(2) / X'6FD07FFFFFFFFFFF' /
C      DATA RIGHT(1) / X'FF74400000000000' /
C      DATA RIGHT(2) / X'FF45000000000000' /
C      DATA DIVER(1) / X'FF75400000000000' /
C      DATA DIVER(2) / X'FF46000000000000' /
C      DATA LOG10(1) / X'FFD04D104D427DE7' /
C      DATA LOG10(2) / X'FFA17DE623E2566A' /
C
C     MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES.
C
C === MACHINE = CDC.6000
C === MACHINE = CDC.7000
C      DATA SMALL(1) / 00604000000000000000B /
C      DATA SMALL(2) / 00000000000000000000B /
C      DATA LARGE(1) / 37767777777777777777B /
C      DATA LARGE(2) / 37167777777777777777B /
C      DATA RIGHT(1) / 15604000000000000000B /
C      DATA RIGHT(2) / 15000000000000000000B /
C      DATA DIVER(1) / 15614000000000000000B /
C      DATA DIVER(2) / 15010000000000000000B /
C      DATA LOG10(1) / 17164642023241175717B /
C      DATA LOG10(2) / 16367571421742254654B /
C
C     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3.
C
C === MACHINE = CRAY.46-BIT-INTEGER
C === MACHINE = CRAY.64-BIT-INTEGER
C      DATA SMALL(1) / 201354000000000000000B /
C      DATA SMALL(2) / 000000000000000000000B /
C      DATA LARGE(1) / 577767777777777777777B /
C      DATA LARGE(2) / 000007777777777777776B /
C      DATA RIGHT(1) / 376434000000000000000B /
C      DATA RIGHT(2) / 000000000000000000000B /
C      DATA DIVER(1) / 376444000000000000000B /
C      DATA DIVER(2) / 000000000000000000000B /
C      DATA LOG10(1) / 377774642023241175717B /
C      DATA LOG10(2) / 000007571421742254654B /
C
C     MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
C
C     NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING LINE -
C     STATIC DMACH(5)
C
C === MACHINE = DATA_GENERAL.ECLIPSE.S/200
C      DATA SMALL/20K,3*0/,LARGE/77777K,3*177777K/
C      DATA RIGHT/31420K,3*0/,DIVER/32020K,3*0/
C      DATA LOG10/40423K,42023K,50237K,74776K/
C
C     ELXSI 6400
C
C === MACHINE = ELSXI.6400
C      DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X /
C      DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X /
C      DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X /
C      DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X /
C      DATA LOG10(1), DIVER(2) / '3FD34413'X,'509F79FF'X /
C
C     MACHINE CONSTANTS FOR THE HARRIS 220
C     MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7
C
C === MACHINE = HARRIS.220
C === MACHINE = HARRIS.SLASH6
C === MACHINE = HARRIS.SLASH7
C      DATA SMALL(1),SMALL(2) / '20000000, '00000201 /
C      DATA LARGE(1),LARGE(2) / '37777777, '37777577 /
C      DATA RIGHT(1),RIGHT(2) / '20000000, '00000333 /
C      DATA DIVER(1),DIVER(2) / '20000000, '00000334 /
C      DATA LOG10(1),LOG10(2) / '23210115, '10237777 /
C
C     MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES.
C     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
C
C === MACHINE = HONEYWELL.600/6000
C === MACHINE = HONEYWELL.DPS.8/70
C      DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
C      DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
C      DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
C      DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
C      DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /
C
C      MACHINE CONSTANTS FOR THE HP 2100
C      3 WORD DOUBLE PRECISION OPTION WITH FTN4
C
C === MACHINE = HP.2100.3_WORD_DP
C      DATA SMALL(1), SMALL(2), SMALL(3) / 40000B,       0,       1 /
C      DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B /
C      DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B,       0,    265B /
C      DATA DIVER(1), DIVER(2), DIVER(3) / 40000B,       0,    276B /
C      DATA LOG10(1), LOG10(2), LOG10(3) / 46420B,  46502B,  77777B /
C
C      MACHINE CONSTANTS FOR THE HP 2100
C      4 WORD DOUBLE PRECISION OPTION WITH FTN4
C
C === MACHINE = HP.2100.4_WORD_DP
C      DATA SMALL(1), SMALL(2) /  40000B,       0 /
C      DATA SMALL(3), SMALL(4) /       0,       1 /
C      DATA LARGE(1), LARGE(2) /  77777B, 177777B /
C      DATA LARGE(3), LARGE(4) / 177777B, 177776B /
C      DATA RIGHT(1), RIGHT(2) /  40000B,       0 /
C      DATA RIGHT(3), RIGHT(4) /       0,    225B /
C      DATA DIVER(1), DIVER(2) /  40000B,       0 /
C      DATA DIVER(3), DIVER(4) /       0,    227B /
C      DATA LOG10(1), LOG10(2) /  46420B,  46502B /
C      DATA LOG10(3), LOG10(4) /  76747B, 176377B /
C
C     MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
C     THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND
C     THE INTERDATA 3230 AND INTERDATA 7/32.
C
C === MACHINE = IBM.360
C === MACHINE = IBM.370
C === MACHINE = XEROX.SIGMA.5
C === MACHINE = XEROX.SIGMA.7
C === MACHINE = XEROX.SIGMA.9
C === MACHINE = SEL.85
C === MACHINE = SEL.86
C === MACHINE = INTERDATA.3230
C === MACHINE = INTERDATA.7/32
C      DATA SMALL(1),SMALL(2) / Z00100000, Z00000000 /
C      DATA LARGE(1),LARGE(2) / Z7FFFFFFF, ZFFFFFFFF /
C      DATA RIGHT(1),RIGHT(2) / Z33100000, Z00000000 /
C      DATA DIVER(1),DIVER(2) / Z34100000, Z00000000 /
C      DATA LOG10(1),LOG10(2) / Z41134413, Z509F79FF /
C
C     MACHINE CONSTANTS FOR THE INTERDATA 8/32
C     WITH THE UNIX SYSTEM FORTRAN 77 COMPILER.
C
C     FOR THE INTERDATA FORTRAN VII COMPILER REPLACE
C     THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S.
C
C === MACHINE = INTERDATA.8/32.UNIX
C      DATA SMALL(1),SMALL(2) / Z'00100000', Z'00000000' /
C      DATA LARGE(1),LARGE(2) / Z'7EFFFFFF', Z'FFFFFFFF' /
C      DATA RIGHT(1),RIGHT(2) / Z'33100000', Z'00000000' /
C      DATA DIVER(1),DIVER(2) / Z'34100000', Z'00000000' /
C      DATA LOG10(1),LOG10(2) / Z'41134413', Z'509F79FF' /
C
C     MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
C
C === MACHINE = PDP-10.KA
C      DATA SMALL(1),SMALL(2) / "033400000000, "000000000000 /
C      DATA LARGE(1),LARGE(2) / "377777777777, "344777777777 /
C      DATA RIGHT(1),RIGHT(2) / "113400000000, "000000000000 /
C      DATA DIVER(1),DIVER(2) / "114400000000, "000000000000 /
C      DATA LOG10(1),LOG10(2) / "177464202324, "144117571776 /
C
C     MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
C
C === MACHINE = PDP-10.KI
C      DATA SMALL(1),SMALL(2) / "000400000000, "000000000000 /
C      DATA LARGE(1),LARGE(2) / "377777777777, "377777777777 /
C      DATA RIGHT(1),RIGHT(2) / "103400000000, "000000000000 /
C      DATA DIVER(1),DIVER(2) / "104400000000, "000000000000 /
C      DATA LOG10(1),LOG10(2) / "177464202324, "047674776746 /
C
C     MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
C     32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
C
C === MACHINE = PDP-11.32-BIT
C      DATA SMALL(1),SMALL(2) /    8388608,           0 /
C      DATA LARGE(1),LARGE(2) / 2147483647,          -1 /
C      DATA RIGHT(1),RIGHT(2) /  612368384,           0 /
C      DATA DIVER(1),DIVER(2) /  620756992,           0 /
C      DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /
C
C      DATA SMALL(1),SMALL(2) / O00040000000, O00000000000 /
C      DATA LARGE(1),LARGE(2) / O17777777777, O37777777777 /
C      DATA RIGHT(1),RIGHT(2) / O04440000000, O00000000000 /
C      DATA DIVER(1),DIVER(2) / O04500000000, O00000000000 /
C      DATA LOG10(1),LOG10(2) / O07746420232, O20476747770 /
C
C     MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
C     16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
C
C === MACHINE = PDP-11.16-BIT
C      DATA SMALL(1),SMALL(2) /    128,      0 /
C      DATA SMALL(3),SMALL(4) /      0,      0 /
C      DATA LARGE(1),LARGE(2) /  32767,     -1 /
C      DATA LARGE(3),LARGE(4) /     -1,     -1 /
C      DATA RIGHT(1),RIGHT(2) /   9344,      0 /
C      DATA RIGHT(3),RIGHT(4) /      0,      0 /
C      DATA DIVER(1),DIVER(2) /   9472,      0 /
C      DATA DIVER(3),DIVER(4) /      0,      0 /
C      DATA LOG10(1),LOG10(2) /  16282,   8346 /
C      DATA LOG10(3),LOG10(4) / -31493, -12296 /
C
C      DATA SMALL(1),SMALL(2) / O000200, O000000 /
C      DATA SMALL(3),SMALL(4) / O000000, O000000 /
C      DATA LARGE(1),LARGE(2) / O077777, O177777 /
C      DATA LARGE(3),LARGE(4) / O177777, O177777 /
C      DATA RIGHT(1),RIGHT(2) / O022200, O000000 /
C      DATA RIGHT(3),RIGHT(4) / O000000, O000000 /
C      DATA DIVER(1),DIVER(2) / O022400, O000000 /
C      DATA DIVER(3),DIVER(4) / O000000, O000000 /
C      DATA LOG10(1),LOG10(2) / O037632, O020232 /
C      DATA LOG10(3),LOG10(4) / O102373, O147770 /
C
C     MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000
C
C === MACHINE = SEQUENT.BALANCE.8000
C      DATA SMALL(1),SMALL(2) / $00000000,  $00100000 /
C      DATA LARGE(1),LARGE(2) / $FFFFFFFF,  $7FEFFFFF /
C      DATA RIGHT(1),RIGHT(2) / $00000000,  $3CA00000 /
C      DATA DIVER(1),DIVER(2) / $00000000,  $3CB00000 /
C      DATA LOG10(1),LOG10(2) / $509F79FF,  $3FD34413 /
C
C     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. FTN COMPILER
C
C === MACHINE = UNIVAC.1100
C      DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
C      DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
C      DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
C      DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
C      DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /
C
C     MACHINE CONSTANTS FOR VAX 11/780
C     (EXPRESSED IN INTEGER AND HEXADECIMAL)
C    *** THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS***
C
C === MACHINE = VAX.11/780
C      DATA SMALL(1), SMALL(2) /        128,           0 /
C      DATA LARGE(1), LARGE(2) /     -32769,          -1 /
C      DATA RIGHT(1), RIGHT(2) /       9344,           0 /
C      DATA DIVER(1), DIVER(2) /       9472,           0 /
C      DATA LOG10(1), LOG10(2) /  546979738,  -805796613 /
C
C    ***THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSYEMS***
C      DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 /
C      DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
C      DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 /
C      DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 /
C      DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB /
C
C   MACHINE CONSTANTS FOR VAX 11/780 (G-FLOATING)
C     (EXPRESSED IN INTEGER AND HEXADECIMAL)
C    *** THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS***
C
C      DATA SMALL(1), SMALL(2) /         16,           0 /
C      DATA LARGE(1), LARGE(2) /     -32769,          -1 /
C      DATA RIGHT(1), RIGHT(2) /      15552,           0 /
C      DATA DIVER(1), DIVER(2) /      15568,           0 /
C      DATA LOG10(1), LOG10(2) /  1142112243, 2046775455 /
C
C    ***THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSYEMS***
C      DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 /
C      DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
C      DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 /
C      DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 /
C      DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F /
C
C
C***FIRST EXECUTABLE STATEMENT  D1MACH
C
      D1MACH = DMACH(I)
      RETURN
C
      END
      SUBROUTINE XERROR(MESSG,NMESSG,NERR,LEVEL)
C***BEGIN PROLOGUE  XERROR
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  R3C
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Processes an error (diagnostic) message.
C***DESCRIPTION
C     Abstract
C        XERROR processes a diagnostic message, in a manner
C        determined by the value of LEVEL and the current value
C        of the library error control flag, KONTRL.
C        (See subroutine XSETF for details.)
C
C     Description of Parameters
C      --Input--
C        MESSG - the Hollerith message to be processed, containing
C                no more than 72 characters.
C        NMESSG- the actual number of characters in MESSG.
C        NERR  - the error number associated with this message.
C                NERR must not be zero.
C        LEVEL - error category.
C                =2 means this is an unconditionally fatal error.
C                =1 means this is a recoverable error.  (I.e., it is
C                   non-fatal if XSETF has been appropriately called.)
C                =0 means this is a warning message only.
C                =-1 means this is a warning message which is to be
C                   printed at most once, regardless of how many
C                   times this call is executed.
C
C     Examples
C        CALL XERROR('SMOOTH -- NUM WAS ZERO.',23,1,2)
C        CALL XERROR('INTEG  -- LESS THAN FULL ACCURACY ACHIEVED.',
C                    43,2,1)
C        CALL XERROR('ROOTER -- ACTUAL ZERO OF F FOUND BEFORE INTERVAL F
C    1ULLY COLLAPSED.',65,3,0)
C        CALL XERROR('EXP    -- UNDERFLOWS BEING SET TO ZERO.',39,1,-1)
C
C     Latest revision ---  19 MAR 1980
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  XERRWV
C***END PROLOGUE  XERROR
      CHARACTER*(*) MESSG
C***FIRST EXECUTABLE STATEMENT  XERROR
      CALL XERRWV(MESSG,NMESSG,NERR,LEVEL,0,0,0,0,0.,0.)
      RETURN
      END
      SUBROUTINE XERRWV(MESSG,NMESSG,NERR,LEVEL,NI,I1,I2,NR,R1,R2)
C***BEGIN PROLOGUE  XERRWV
C***DATE WRITTEN   800319   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  R3C
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Processes error message allowing 2 integer and two real
C            values to be included in the message.
C***DESCRIPTION
C     Abstract
C        XERRWV processes a diagnostic message, in a manner
C        determined by the value of LEVEL and the current value
C        of the library error control flag, KONTRL.
C        (See subroutine XSETF for details.)
C        In addition, up to two integer values and two real
C        values may be printed along with the message.
C
C     Description of Parameters
C      --Input--
C        MESSG - the Hollerith message to be processed.
C        NMESSG- the actual number of characters in MESSG.
C        NERR  - the error number associated with this message.
C                NERR must not be zero.
C        LEVEL - error category.
C                =2 means this is an unconditionally fatal error.
C                =1 means this is a recoverable error.  (I.e., it is
C                   non-fatal if XSETF has been appropriately called.)
C                =0 means this is a warning message only.
C                =-1 means this is a warning message which is to be
C                   printed at most once, regardless of how many
C                   times this call is executed.
C        NI    - number of integer values to be printed. (0 to 2)
C        I1    - first integer value.
C        I2    - second integer value.
C        NR    - number of real values to be printed. (0 to 2)
C        R1    - first real value.
C        R2    - second real value.
C
C     Examples
C        CALL XERRWV('SMOOTH -- NUM (=I1) WAS ZERO.',29,1,2,
C    1   1,NUM,0,0,0.,0.)
C        CALL XERRWV('QUADXY -- REQUESTED ERROR (R1) LESS THAN MINIMUM (
C    1R2).,54,77,1,0,0,0,2,ERRREQ,ERRMIN)
C
C     Latest revision ---  19 MAR 1980
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  FDUMP,I1MACH,J4SAVE,XERABT,XERCTL,XERPRT,XERSAV,
C                    XGETUA
C***END PROLOGUE  XERRWV
      CHARACTER*(*) MESSG
      CHARACTER*20 LFIRST
      CHARACTER*37 FORM
      DIMENSION LUN(5)
C     GET FLAGS
C***FIRST EXECUTABLE STATEMENT  XERRWV
      LKNTRL = J4SAVE(2,0,.FALSE.)
      MAXMES = J4SAVE(4,0,.FALSE.)
C     CHECK FOR VALID INPUT
      IF ((NMESSG.GT.0).AND.(NERR.NE.0).AND.
     1    (LEVEL.GE.(-1)).AND.(LEVEL.LE.2)) GO TO 10
         IF (LKNTRL.GT.0) CALL XERPRT('FATAL ERROR IN...',17)
         CALL XERPRT('XERROR -- INVALID INPUT',23)
         IF (LKNTRL.GT.0) CALL FDUMP
         IF (LKNTRL.GT.0) CALL XERPRT('JOB ABORT DUE TO FATAL ERROR.',
     1  29)
         IF (LKNTRL.GT.0) CALL XERSAV(' ',0,0,0,KDUMMY)
         CALL XERABT('XERROR -- INVALID INPUT',23)
         RETURN
   10 CONTINUE
C     RECORD MESSAGE
      JUNK = J4SAVE(1,NERR,.TRUE.)
      CALL XERSAV(MESSG,NMESSG,NERR,LEVEL,KOUNT)
C     LET USER OVERRIDE
      LFIRST = MESSG
      LMESSG = NMESSG
      LERR = NERR
      LLEVEL = LEVEL
      CALL XERCTL(LFIRST,LMESSG,LERR,LLEVEL,LKNTRL)
C     RESET TO ORIGINAL VALUES
      LMESSG = NMESSG
      LERR = NERR
      LLEVEL = LEVEL
      LKNTRL = MAX0(-2,MIN0(2,LKNTRL))
      MKNTRL = IABS(LKNTRL)
C     DECIDE WHETHER TO PRINT MESSAGE
      IF ((LLEVEL.LT.2).AND.(LKNTRL.EQ.0)) GO TO 100
      IF (((LLEVEL.EQ.(-1)).AND.(KOUNT.GT.MIN0(1,MAXMES)))
     1.OR.((LLEVEL.EQ.0)   .AND.(KOUNT.GT.MAXMES))
     2.OR.((LLEVEL.EQ.1)   .AND.(KOUNT.GT.MAXMES).AND.(MKNTRL.EQ.1))
     3.OR.((LLEVEL.EQ.2)   .AND.(KOUNT.GT.MAX0(1,MAXMES)))) GO TO 100
         IF (LKNTRL.LE.0) GO TO 20
            CALL XERPRT(' ',1)
C           INTRODUCTION
            IF (LLEVEL.EQ.(-1)) CALL XERPRT
     1('WARNING MESSAGE...THIS MESSAGE WILL ONLY BE PRINTED ONCE.',57)
            IF (LLEVEL.EQ.0) CALL XERPRT('WARNING IN...',13)
            IF (LLEVEL.EQ.1) CALL XERPRT
     1      ('RECOVERABLE ERROR IN...',23)
            IF (LLEVEL.EQ.2) CALL XERPRT('FATAL ERROR IN...',17)
   20    CONTINUE
C        MESSAGE
         CALL XERPRT(MESSG,LMESSG)
         CALL XGETUA(LUN,NUNIT)
         ISIZEI = LOG10(FLOAT(I1MACH(9))) + 1.0
         ISIZEF = LOG10(FLOAT(I1MACH(10))**I1MACH(11)) + 1.0
         DO 50 KUNIT=1,NUNIT
            IUNIT = LUN(KUNIT)
            IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
            DO 22 I=1,MIN(NI,2)
               WRITE (FORM,21) I,ISIZEI
   21          FORMAT ('(11X,21HIN ABOVE MESSAGE, I',I1,'=,I',I2,')   ')
               IF (I.EQ.1) WRITE (IUNIT,FORM) I1
               IF (I.EQ.2) WRITE (IUNIT,FORM) I2
   22       CONTINUE
            DO 24 I=1,MIN(NR,2)
               WRITE (FORM,23) I,ISIZEF+10,ISIZEF
   23          FORMAT ('(11X,21HIN ABOVE MESSAGE, R',I1,'=,E',
     1         I2,'.',I2,')')
               IF (I.EQ.1) WRITE (IUNIT,FORM) R1
               IF (I.EQ.2) WRITE (IUNIT,FORM) R2
   24       CONTINUE
            IF (LKNTRL.LE.0) GO TO 40
C              ERROR NUMBER
               WRITE (IUNIT,30) LERR
   30          FORMAT (15H ERROR NUMBER =,I10)
   40       CONTINUE
   50    CONTINUE
C        TRACE-BACK
         IF (LKNTRL.GT.0) CALL FDUMP
  100 CONTINUE
      IFATAL = 0
      IF ((LLEVEL.EQ.2).OR.((LLEVEL.EQ.1).AND.(MKNTRL.EQ.2)))
     1IFATAL = 1
C     QUIT HERE IF MESSAGE IS NOT FATAL
      IF (IFATAL.LE.0) RETURN
      IF ((LKNTRL.LE.0).OR.(KOUNT.GT.MAX0(1,MAXMES))) GO TO 120
C        PRINT REASON FOR ABORT
         IF (LLEVEL.EQ.1) CALL XERPRT
     1   ('JOB ABORT DUE TO UNRECOVERED ERROR.',35)
         IF (LLEVEL.EQ.2) CALL XERPRT
     1   ('JOB ABORT DUE TO FATAL ERROR.',29)
C        PRINT ERROR SUMMARY
         CALL XERSAV(' ',-1,0,0,KDUMMY)
  120 CONTINUE
C     ABORT
      IF ((LLEVEL.EQ.2).AND.(KOUNT.GT.MAX0(1,MAXMES))) LMESSG = 0
      CALL XERABT(MESSG,LMESSG)
      RETURN
      END
      SUBROUTINE XGETUA(IUNITA,N)
C***BEGIN PROLOGUE  XGETUA
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  R3C
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Returns unit number(s) to which error messages are being
C            sent.
C***DESCRIPTION
C     Abstract
C        XGETUA may be called to determine the unit number or numbers
C        to which error messages are being sent.
C        These unit numbers may have been set by a call to XSETUN,
C        or a call to XSETUA, or may be a default value.
C
C     Description of Parameters
C      --Output--
C        IUNIT - an array of one to five unit numbers, depending
C                on the value of N.  A value of zero refers to the
C                default unit, as defined by the I1MACH machine
C                constant routine.  Only IUNIT(1),...,IUNIT(N) are
C                defined by XGETUA.  The values of IUNIT(N+1),...,
C                IUNIT(5) are not defined (for N .LT. 5) or altered
C                in any way by XGETUA.
C        N     - the number of units to which copies of the
C                error messages are being sent.  N will be in the
C                range from 1 to 5.
C
C     Latest revision ---  19 MAR 1980
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  J4SAVE
C***END PROLOGUE  XGETUA
      DIMENSION IUNITA(5)
C***FIRST EXECUTABLE STATEMENT  XGETUA
      N = J4SAVE(5,0,.FALSE.)
      DO 30 I=1,N
         INDEX = I+4
         IF (I.EQ.1) INDEX = 3
         IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
   30 CONTINUE
      RETURN
      END
      SUBROUTINE XERCTL(MESSG1,NMESSG,NERR,LEVEL,KONTRL)
C***BEGIN PROLOGUE  XERCTL
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  R3C
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Allows user control over handling of individual errors.
C***DESCRIPTION
C     Abstract
C        Allows user control over handling of individual errors.
C        Just after each message is recorded, but before it is
C        processed any further (i.e., before it is printed or
C        a decision to abort is made), a call is made to XERCTL.
C        If the user has provided his own version of XERCTL, he
C        can then override the value of KONTROL used in processing
C        this message by redefining its value.
C        KONTRL may be set to any value from -2 to 2.
C        The meanings for KONTRL are the same as in XSETF, except
C        that the value of KONTRL changes only for this message.
C        If KONTRL is set to a value outside the range from -2 to 2,
C        it will be moved back into that range.
C
C     Description of Parameters
C
C      --Input--
C        MESSG1 - the first word (only) of the error message.
C        NMESSG - same as in the call to XERROR or XERRWV.
C        NERR   - same as in the call to XERROR or XERRWV.
C        LEVEL  - same as in the call to XERROR or XERRWV.
C        KONTRL - the current value of the control flag as set
C                 by a call to XSETF.
C
C      --Output--
C        KONTRL - the new value of KONTRL.  If KONTRL is not
C                 defined, it will remain at its original value.
C                 This changed value of control affects only
C                 the current occurrence of the current message.
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  XERCTL
      CHARACTER*20 MESSG1
C***FIRST EXECUTABLE STATEMENT  XERCTL
      RETURN
      END
      SUBROUTINE FDUMP
C***BEGIN PROLOGUE  FDUMP
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  Z
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Symbolic dump (should be locally written).
C***DESCRIPTION
C        ***Note*** Machine Dependent Routine
C        FDUMP is intended to be replaced by a locally written
C        version which produces a symbolic dump.  Failing this,
C        it should be replaced by a version which prints the
C        subprogram nesting list.  Note that this dump must be
C        printed on each of up to five files, as indicated by the
C        XGETUA routine.  See XSETUA and XGETUA for details.
C
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C     Latest revision ---  23 May 1979
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  FDUMP
C***FIRST EXECUTABLE STATEMENT  FDUMP
      RETURN
      END
      DOUBLE PRECISION FUNCTION DBIE(X)
C***BEGIN PROLOGUE  DBIE
C***DATE WRITTEN   770701   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C10D
C***KEYWORDS  BAIRY FUNCTION,DOUBLE PRECISION,EXPONENTIALLY SCALED,
C             SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Calculates the d.p. Bairy function for negative X and an
C            exponentially scaled Bairy function for positive X.
C***DESCRIPTION
C
C DBIE(X) calculates the double precision Airy function of the
C second kind or the double precision exponentially scaled Airy
C function of the second kind, depending on the value of the
C double precision argument X.
C
C Evaluate BI(X) for X .LE. 0.0  and  BI(X)*EXP(-ZETA)  where
C ZETA = 2/3 * X**(3/2)  for X .GE. 0.0
C
C
C Series for BIF        on the interval -1.00000E+00 to  1.00000E+00
C                                        with weighted error   1.45E-32
C                                         log weighted error  31.84
C                               significant figures required  30.85
C                                    decimal places required  32.40
C
C
C Series for BIG        on the interval -1.00000E+00 to  1.00000E+00
C                                        with weighted error   1.29E-33
C                                         log weighted error  32.89
C                               significant figures required  31.48
C                                    decimal places required  33.45
C
C
C Series for BIF2       on the interval  1.00000E+00 to  8.00000E+00
C                                        with weighted error   6.08E-32
C                                         log weighted error  31.22
C                        approx significant figures required  30.8
C                                    decimal places required  31.80
C
C
C Series for BIG2       on the interval  1.00000E+00 to  8.00000E+00
C                                        with weighted error   4.91E-33
C                                         log weighted error  32.31
C                        approx significant figures required  31.6
C                                    decimal places required  32.90
C
C
C Series for BIP1       on the interval  1.25000E-01 to  3.53553E-01
C                                        with weighted error   1.06E-32
C                                         log weighted error  31.98
C                               significant figures required  30.61
C                                    decimal places required  32.81
C
C
C Series for BIP2       on the interval  0.          to  1.25000E-01
C                                        with weighted error   4.04E-33
C                                         log weighted error  32.39
C                               significant figures required  31.15
C                                    decimal places required  33.37
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH,D9AIMP,DCSEVL,INITDS
C***END PROLOGUE  DBIE
      DOUBLE PRECISION X, BIFCS(13), BIGCS(13), BIF2CS(15), BIG2CS(15),
     1  BIP1CS(47), BIP2CS(88), ATR, BTR, SQRTX, THETA, XBIG, XM, X3SML,
     2  X32SML, Z, D1MACH, DCSEVL
      DATA BIF CS(  1) / -.1673021647 1986649483 5374239281 76 D-1     /
      DATA BIF CS(  2) / +.1025233583 4249445611 4263627777 57 D+0     /
      DATA BIF CS(  3) / +.1708309250 7381516539 4296502420 13 D-2     /
      DATA BIF CS(  4) / +.1186254546 7744681179 2164592100 40 D-4     /
      DATA BIF CS(  5) / +.4493290701 7792133694 5318879272 42 D-7     /
      DATA BIF CS(  6) / +.1069820714 3387889067 5677676636 28 D-9     /
      DATA BIF CS(  7) / +.1748064339 9771824706 0105176285 73 D-12    /
      DATA BIF CS(  8) / +.2081023107 1761711025 8818918343 99 D-15    /
      DATA BIF CS(  9) / +.1884981469 5665416509 9279717333 33 D-18    /
      DATA BIF CS( 10) / +.1342577917 3097804625 8826666666 66 D-21    /
      DATA BIF CS( 11) / +.7715959342 9658887893 3333333333 33 D-25    /
      DATA BIF CS( 12) / +.3653387961 7478566399 9999999999 99 D-28    /
      DATA BIF CS( 13) / +.1449756592 7953066666 6666666666 66 D-31    /
      DATA BIG CS(  1) / +.2246622324 8574522283 4682201390 24 D-1     /
      DATA BIG CS(  2) / +.3736477545 3019545441 7275616667 52 D-1     /
      DATA BIG CS(  3) / +.4447621895 7212285696 2152943266 39 D-3     /
      DATA BIG CS(  4) / +.2470807563 6329384245 4945919488 82 D-5     /
      DATA BIG CS(  5) / +.7919135339 5149635134 8624262855 96 D-8     /
      DATA BIG CS(  6) / +.1649807985 1827779880 8878724027 06 D-10    /
      DATA BIG CS(  7) / +.2411990666 4835455909 2475011228 41 D-13    /
      DATA BIG CS(  8) / +.2610373623 6091436985 1847812693 33 D-16    /
      DATA BIG CS(  9) / +.2175308297 7160323853 1237920000 00 D-19    /
      DATA BIG CS( 10) / +.1438694640 0390433219 4837333333 33 D-22    /
      DATA BIG CS( 11) / +.7734912561 2083468629 3333333333 33 D-26    /
      DATA BIG CS( 12) / +.3446929203 3849002666 6666666666 66 D-29    /
      DATA BIG CS( 13) / +.1293891927 3216000000 0000000000 00 D-32    /
      DATA BIF2CS(  1) / +.0998457269 3816041044 6828425799 3 D+0      /
      DATA BIF2CS(  2) / +.4786249778 6300553772 2114673182 31 D+0     /
      DATA BIF2CS(  3) / +.2515521196 0433011771 3244154366 75 D-1     /
      DATA BIF2CS(  4) / +.5820693885 2326456396 5156978722 16 D-3     /
      DATA BIF2CS(  5) / +.7499765964 4377865943 8614573782 17 D-5     /
      DATA BIF2CS(  6) / +.6134602870 3493836681 4030103564 74 D-7     /
      DATA BIF2CS(  7) / +.3462753885 1480632900 4342687333 59 D-9     /
      DATA BIF2CS(  8) / +.1428891008 0270254287 7708467489 31 D-11    /
      DATA BIF2CS(  9) / +.4496270429 8334641895 0564721792 00 D-14    /
      DATA BIF2CS( 10) / +.1114232306 5833011708 4283001066 66 D-16    /
      DATA BIF2CS( 11) / +.2230479106 6175002081 5178666666 66 D-19    /
      DATA BIF2CS( 12) / +.3681577873 6393142842 9226666666 66 D-22    /
      DATA BIF2CS( 13) / +.5096086844 9338261333 3333333333 33 D-25    /
      DATA BIF2CS( 14) / +.6000338692 6288554666 6666666666 66 D-28    /
      DATA BIF2CS( 15) / +.6082749744 6570666666 6666666666 66 D-31    /
      DATA BIG2CS(  1) / +.0333056621 4551434046 5176188111 647 D+0    /
      DATA BIG2CS(  2) / +.1613092151 2319706761 3287532084 943 D+0    /
      DATA BIG2CS(  3) / +.6319007309 6134286912 1615634921 173 D-2    /
      DATA BIG2CS(  4) / +.1187904568 1625173638 9780192304 567 D-3    /
      DATA BIG2CS(  5) / +.1304534588 6200265614 7116485012 843 D-5    /
      DATA BIG2CS(  6) / +.9374125995 5352172954 6809615508 936 D-8    /
      DATA BIG2CS(  7) / +.4745801886 7472515378 8510169834 595 D-10   /
      DATA BIG2CS(  8) / +.1783107265 0948139980 0065667560 946 D-12   /
      DATA BIG2CS(  9) / +.5167591927 8495818037 4276356640 000 D-15   /
      DATA BIG2CS( 10) / +.1190045083 8682712512 9496251733 333 D-17   /
      DATA BIG2CS( 11) / +.2229828806 6640351727 7063466666 666 D-20   /
      DATA BIG2CS( 12) / +.3465519230 2768941972 2666666666 666 D-23   /
      DATA BIG2CS( 13) / +.4539263363 2050451413 3333333333 333 D-26   /
      DATA BIG2CS( 14) / +.5078849965 1352234666 6666666666 666 D-29   /
      DATA BIG2CS( 15) / +.4910206746 9653333333 3333333333 333 D-32   /
      DATA BIP1CS(  1) / -.8322047477 9434474687 4718647079 73 D-1     /
      DATA BIP1CS(  2) / +.1146118927 3711742889 9202261280 31 D-1     /
      DATA BIP1CS(  3) / +.4289644071 8911509494 1344725666 35 D-3     /
      DATA BIP1CS(  4) / -.1490663937 9950514017 8476777329 54 D-3     /
      DATA BIP1CS(  5) / -.1307659726 7876290663 1363409988 81 D-4     /
      DATA BIP1CS(  6) / +.6327598396 1030344754 5357160324 94 D-5     /
      DATA BIP1CS(  7) / -.4222669698 2681924884 7785158894 33 D-6     /
      DATA BIP1CS(  8) / -.1914718629 8654689632 8354941812 77 D-6     /
      DATA BIP1CS(  9) / +.6453106284 5583173611 0381578809 34 D-7     /
      DATA BIP1CS( 10) / -.7844854677 1397719289 7483104486 28 D-8     /
      DATA BIP1CS( 11) / -.9607721662 3785085879 1985335654 32 D-9     /
      DATA BIP1CS( 12) / +.7000471331 6443966339 0060744020 68 D-9     /
      DATA BIP1CS( 13) / -.1773178913 2814932022 0831280566 98 D-9     /
      DATA BIP1CS( 14) / +.2272089478 3465236347 2821263893 11 D-10    /
      DATA BIP1CS( 15) / +.1654045631 3972049847 0328606818 91 D-11    /
      DATA BIP1CS( 16) / -.1851712555 9292316390 7553698966 93 D-11    /
      DATA BIP1CS( 17) / +.5957631247 7117290165 6807155342 77 D-12    /
      DATA BIP1CS( 18) / -.1219434814 7346564781 0557694989 86 D-12    /
      DATA BIP1CS( 19) / +.1334786925 3513048815 3863478135 97 D-13    /
      DATA BIP1CS( 20) / +.1727831152 4339746664 3847928897 31 D-14    /
      DATA BIP1CS( 21) / -.1459073201 3016720735 2688717131 66 D-14    /
      DATA BIP1CS( 22) / +.4901031992 7115819978 9949895201 04 D-15    /
      DATA BIP1CS( 23) / -.1155654551 9261548129 2629727625 21 D-15    /
      DATA BIP1CS( 24) / +.1909880736 7072411430 6717324415 24 D-16    /
      DATA BIP1CS( 25) / -.1176896685 4492179886 9139959578 62 D-17    /
      DATA BIP1CS( 26) / -.6327192514 9530064474 5374596770 47 D-18    /
      DATA BIP1CS( 27) / +.3386183888 0715361614 1301913223 16 D-18    /
      DATA BIP1CS( 28) / -.1072582532 1758625254 9921622196 22 D-18    /
      DATA BIP1CS( 29) / +.2599570960 5617169284 7869331155 62 D-19    /
      DATA BIP1CS( 30) / -.4847758357 1081193660 9623094941 01 D-20    /
      DATA BIP1CS( 31) / +.5529891398 2121625361 5055131989 33 D-21    /
      DATA BIP1CS( 32) / +.4942166082 6069471371 7481974442 66 D-22    /
      DATA BIP1CS( 33) / -.5516212192 4145707458 0697208149 33 D-22    /
      DATA BIP1CS( 34) / +.2143756041 7632550086 6318844996 26 D-22    /
      DATA BIP1CS( 35) / -.6191031338 7655605798 7850611370 66 D-23    /
      DATA BIP1CS( 36) / +.1462936270 7391245659 8309673369 59 D-23    /
      DATA BIP1CS( 37) / -.2791848447 1059005576 1778660693 33 D-24    /
      DATA BIP1CS( 38) / +.3645570316 8570246150 9067953493 33 D-25    /
      DATA BIP1CS( 39) / +.5851182190 6188711839 3824597333 33 D-27    /
      DATA BIP1CS( 40) / -.2494695048 7566510969 7450475519 99 D-26    /
      DATA BIP1CS( 41) / +.1097932398 0338380977 9195794773 33 D-26    /
      DATA BIP1CS( 42) / -.3474338834 5961115015 0340881066 66 D-27    /
      DATA BIP1CS( 43) / +.9137340263 5349697363 1710822400 00 D-28    /
      DATA BIP1CS( 44) / -.2051035272 8210629186 2477209599 99 D-28    /
      DATA BIP1CS( 45) / +.3797698569 8546461748 6516223999 99 D-29    /
      DATA BIP1CS( 46) / -.4847945849 7755565887 8484480000 00 D-30    /
      DATA BIP1CS( 47) / -.1055830694 1230714314 2058666666 66 D-31    /
      DATA BIP2CS(  1) / -.1135967375 8598867913 7973108955 27 D+0     /
      DATA BIP2CS(  2) / +.4138147394 7881595760 0520811714 44 D-2     /
      DATA BIP2CS(  3) / +.1353470622 1193329857 6969217275 08 D-3     /
      DATA BIP2CS(  4) / +.1042731665 3015353405 8871834567 80 D-4     /
      DATA BIP2CS(  5) / +.1347495476 7849907889 5899119589 25 D-5     /
      DATA BIP2CS(  6) / +.1696537405 4383983356 0625111637 56 D-6     /
      DATA BIP2CS(  7) / -.1009650086 5641624301 3662283963 73 D-7     /
      DATA BIP2CS(  8) / -.1672911949 3778475127 8369730959 43 D-7     /
      DATA BIP2CS(  9) / -.4581536448 5068383217 1527956133 91 D-8     /
      DATA BIP2CS( 10) / +.3736681366 5655477274 0647493842 84 D-9     /
      DATA BIP2CS( 11) / +.5766930320 1452448119 5846435021 11 D-9     /
      DATA BIP2CS( 12) / +.6218126508 7850324095 3934087923 71 D-10    /
      DATA BIP2CS( 13) / -.6329412028 2743068241 5891772813 54 D-10    /
      DATA BIP2CS( 14) / -.1491504790 8598767633 9990919894 87 D-10    /
      DATA BIP2CS( 15) / +.7889621394 2486771938 1723942948 91 D-11    /
      DATA BIP2CS( 16) / +.2496051372 1857797984 8880640001 27 D-11    /
      DATA BIP2CS( 17) / -.1213007528 7291659477 7466647348 14 D-11    /
      DATA BIP2CS( 18) / -.3740493910 8727277887 3434604027 16 D-12    /
      DATA BIP2CS( 19) / +.2237727814 0321476798 7834469310 91 D-12    /
      DATA BIP2CS( 20) / +.4749029631 2192466341 9860774725 14 D-13    /
      DATA BIP2CS( 21) / -.4526160799 1821224810 6056558312 94 D-13    /
      DATA BIP2CS( 22) / -.3017227184 1986072645 1122458760 20 D-14    /
      DATA BIP2CS( 23) / +.9105860355 8754058327 5926834789 08 D-14    /
      DATA BIP2CS( 24) / -.9814923803 3807062926 6438642077 09 D-15    /
      DATA BIP2CS( 25) / -.1642940064 7889465253 6012452515 89 D-14    /
      DATA BIP2CS( 26) / +.5533483421 4274215451 1821146351 64 D-15    /
      DATA BIP2CS( 27) / +.2175047986 4482655984 3743819981 56 D-15    /
      DATA BIP2CS( 28) / -.1737923620 0220656971 2870295580 87 D-15    /
      DATA BIP2CS( 29) / -.1047002347 1443714959 2839093136 04 D-17    /
      DATA BIP2CS( 30) / +.3921914598 6056386925 4414033114 62 D-16    /
      DATA BIP2CS( 31) / -.1162129368 6345196925 8240056659 10 D-16    /
      DATA BIP2CS( 32) / -.5402747449 1754245533 7354113077 73 D-17    /
      DATA BIP2CS( 33) / +.4544158212 3884610882 6754285533 04 D-17    /
      DATA BIP2CS( 34) / -.2877559962 5221075729 4275854800 86 D-18    /
      DATA BIP2CS( 35) / -.1001734092 7225341243 5961629604 40 D-17    /
      DATA BIP2CS( 36) / +.4482393121 5068369856 3325619063 13 D-18    /
      DATA BIP2CS( 37) / +.7613596865 4908942328 9489823667 75 D-19    /
      DATA BIP2CS( 38) / -.1444832409 4881347238 9560601454 22 D-18    /
      DATA BIP2CS( 39) / +.4046085944 9205362251 6248473921 12 D-19    /
      DATA BIP2CS( 40) / +.2032108570 0338446891 3251907072 77 D-19    /
      DATA BIP2CS( 41) / -.1960279547 1446798718 2727580419 62 D-19    /
      DATA BIP2CS( 42) / +.3427303844 3944824263 5189582117 38 D-20    /
      DATA BIP2CS( 43) / +.3702370585 3905135480 0246515931 54 D-20    /
      DATA BIP2CS( 44) / -.2687959517 2041591131 4003329667 12 D-20    /
      DATA BIP2CS( 45) / +.2812167846 3531712209 7144546833 64 D-21    /
      DATA BIP2CS( 46) / +.6093396363 6177797173 2711196803 29 D-21    /
      DATA BIP2CS( 47) / -.3866662189 7150844994 1729778934 13 D-21    /
      DATA BIP2CS( 48) / +.2598933125 3566943450 8956519272 28 D-22    /
      DATA BIP2CS( 49) / +.9719439362 2938503767 2811752160 84 D-22    /
      DATA BIP2CS( 50) / -.5939281783 4375098415 6304782045 91 D-22    /
      DATA BIP2CS( 51) / +.3886494997 7113015409 5919604394 44 D-23    /
      DATA BIP2CS( 52) / +.1533430739 3617272869 7215128687 69 D-22    /
      DATA BIP2CS( 53) / -.9751355520 9762624036 3365214097 24 D-23    /
      DATA BIP2CS( 54) / +.9634064444 0489471424 7413393837 26 D-24    /
      DATA BIP2CS( 55) / +.2384199940 0208880109 9467487924 54 D-23    /
      DATA BIP2CS( 56) / -.1689698631 5019706184 8480442052 07 D-23    /
      DATA BIP2CS( 57) / +.2735271588 8928361222 5784448014 78 D-24    /
      DATA BIP2CS( 58) / +.3566001618 5409578960 1116850257 30 D-24    /
      DATA BIP2CS( 59) / -.3023402660 8258827249 5342806669 54 D-24    /
      DATA BIP2CS( 60) / +.7500204160 5973930653 1442048232 32 D-25    /
      DATA BIP2CS( 61) / +.4840328757 5851388827 4553198387 48 D-25    /
      DATA BIP2CS( 62) / -.5436413765 4447888432 6980102977 66 D-25    /
      DATA BIP2CS( 63) / +.1928121447 0820962653 3459788097 56 D-25    /
      DATA BIP2CS( 64) / +.5011635502 0532656659 6118141721 72 D-26    /
      DATA BIP2CS( 65) / -.9504074458 2693253786 0346208699 72 D-26    /
      DATA BIP2CS( 66) / +.4637264615 7101975948 6963322456 11 D-26    /
      DATA BIP2CS( 67) / +.2117717070 4466954163 7681705770 46 D-28    /
      DATA BIP2CS( 68) / -.1540485026 8168594303 6922045487 26 D-26    /
      DATA BIP2CS( 69) / +.1038794429 3201213662 0478891944 41 D-26    /
      DATA BIP2CS( 70) / -.1989007815 6915416751 3167282351 53 D-27    /
      DATA BIP2CS( 71) / -.2102217387 8658495471 1770445225 32 D-27    /
      DATA BIP2CS( 72) / +.2135309972 4525793150 6333566704 91 D-27    /
      DATA BIP2CS( 73) / -.7904081074 7961342319 0235376326 27 D-28    /
      DATA BIP2CS( 74) / -.1657535996 0435585049 9737417635 92 D-28    /
      DATA BIP2CS( 75) / +.3886834285 0124112587 6255864965 37 D-28    /
      DATA BIP2CS( 76) / -.2230923733 0896866182 6215624247 17 D-28    /
      DATA BIP2CS( 77) / +.2777724442 0176260265 6259774043 82 D-29    /
      DATA BIP2CS( 78) / +.5707854347 2657725368 7124337827 72 D-29    /
      DATA BIP2CS( 79) / -.5174308444 5303852800 1733715552 80 D-29    /
      DATA BIP2CS( 80) / +.1841328075 1095837198 4509270715 69 D-29    /
      DATA BIP2CS( 81) / +.4442256239 0957094598 5440710686 47 D-30    /
      DATA BIP2CS( 82) / -.9850414263 9629801547 4649582269 43 D-30    /
      DATA BIP2CS( 83) / +.5885720135 3585104884 7541988819 95 D-30    /
      DATA BIP2CS( 84) / -.9763607544 0429787961 4023126285 95 D-31    /
      DATA BIP2CS( 85) / -.1358101199 6074695047 0635978841 22 D-30    /
      DATA BIP2CS( 86) / +.1399974351 8492413270 5680483803 45 D-30    /
      DATA BIP2CS( 87) / -.5975490454 5248477620 8845629811 18 D-31    /
      DATA BIP2CS( 88) / -.4039165387 5428313641 0453275298 56 D-32    /
      DATA ATR / 8.750690570 8484345088 0771988210 148 D0 /
      DATA BTR / -2.093836321 3560543136 0096498526 268 D0 /
      DATA NBIF, NBIG, NBIF2, NBIG2, NBIP1, NBIP2 / 6*0 /
      DATA X3SML, X32SML, XBIG / 3*0.0D0 /
C***FIRST EXECUTABLE STATEMENT  DBIE
      IF (NBIF.NE.0) GO TO 10
      ETA = 0.1*SNGL(D1MACH(3))
      NBIF = INITDS (BIFCS, 13, ETA)
      NBIG = INITDS (BIGCS, 13, ETA)
      NBIF2 = INITDS (BIF2CS, 15, ETA)
      NBIG2 = INITDS (BIG2CS, 15, ETA)
      NBIP1 = INITDS (BIP1CS, 47, ETA)
      NBIP2 = INITDS (BIP2CS, 88, ETA)
C
      X3SML = ETA**0.3333
      X32SML = 1.3104D0*X3SML**2
      XBIG = D1MACH(2)**0.6666D0
C
 10   IF (X.GE.(-1.0D0)) GO TO 20
      CALL D9AIMP (X, XM, THETA)
      DBIE = XM * DSIN(THETA)
      RETURN
C
 20   IF (X.GT.1.0D0) GO TO 30
      Z = 0.D0
      IF (DABS(X).GT.X3SML) Z = X**3
      DBIE = 0.625D0 + DCSEVL (Z, BIFCS, NBIF) + X*(0.4375D0 +
     1  DCSEVL (Z, BIGCS, NBIG) )
      IF (X.GT.X32SML) DBIE = DBIE * DEXP(-2.0D0*X*DSQRT(X)/3.0D0)
      RETURN
C
 30   IF (X.GT.2.0D0) GO TO 40
      Z = (2.0D0*X**3 - 9.0D0)/7.0D0
      DBIE = DEXP(-2.0D0*X*DSQRT(X)/3.0D0) * (1.125D0 +
     1  DCSEVL (Z, BIF2CS, NBIF2) + X*(0.625D0 + DCSEVL (Z, BIG2CS,
     2  NBIG2)) )
      RETURN
C
 40   IF (X.GT.4.0D0) GO TO 50
      SQRTX = DSQRT(X)
      Z = ATR/(X*SQRTX) + BTR
      DBIE = (0.625D0 + DCSEVL (Z, BIP1CS, NBIP1))/DSQRT(SQRTX)
      RETURN
C
 50   SQRTX = DSQRT(X)
      Z = -1.0D0
      IF (X.LT.XBIG) Z = 16.D0/(X*SQRTX) - 1.0D0
      DBIE = (0.625D0 + DCSEVL (Z, BIP2CS, NBIP2))/DSQRT(SQRTX)
      RETURN
C
      END
      FUNCTION INITDS(DOS,NOS,ETA)
C***BEGIN PROLOGUE  INITDS
C***DATE WRITTEN   770601   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C3A2
C***KEYWORDS  CHEBYSHEV,DOUBLE PRECISION,INITIALIZE,
C             ORTHOGONAL POLYNOMIAL,SERIES,SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Initializes the d.p. properly normalized orthogonal
C            polynomial series to determine the number of terms needed
C            for specific accuracy.
C***DESCRIPTION
C
C Initialize the double precision orthogonal series DOS so that INITDS
C is the number of terms needed to insure the error is no larger than
C ETA.  Ordinarily ETA will be chosen to be one-tenth machine precision
C
C             Input Arguments --
C DOS    dble prec array of NOS coefficients in an orthogonal series.
C NOS    number of coefficients in DOS.
C ETA    requested accuracy of series.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  XERROR
C***END PROLOGUE  INITDS
C
      DOUBLE PRECISION DOS(NOS)
C***FIRST EXECUTABLE STATEMENT  INITDS
      IF (NOS.LT.1) CALL XERROR ( 'INITDS  NUMBER OF COEFFICIENTS LT 1',
     1 35, 2, 2)
C
      ERR = 0.
      DO 10 II=1,NOS
        I = NOS + 1 - II
        ERR = ERR + ABS(SNGL(DOS(I)))
        IF (ERR.GT.ETA) GO TO 20
 10   CONTINUE
C
 20   IF (I.EQ.NOS) CALL XERROR ( 'INITDS  ETA MAY BE TOO SMALL', 28,
     1  1, 2)
      INITDS = I
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DCSEVL(X,A,N)
C***BEGIN PROLOGUE  DCSEVL
C***DATE WRITTEN   770401   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  C3A2
C***KEYWORDS  CHEBYSHEV,FNLIB,SPECIAL FUNCTION
C***AUTHOR  FULLERTON, W., (LANL)
C***PURPOSE  Evaluate the double precision N-term Chebyshev series A
C            at X.
C***DESCRIPTION
C
C Evaluate the N-term Chebyshev series A at X.  Adapted from
C R. Broucke, Algorithm 446, C.A.C.M., 16, 254 (1973).
C W. Fullerton, C-3, Los Alamos Scientific Laboratory.
C
C       Input Arguments --
C X    double precision value at which the series is to be evaluated.
C A    double precision array of N terms of a Chebyshev series.  In
C      evaluating A, only half of the first coefficient is summed.
C N    number of terms in array A.
C***REFERENCES  (NONE)
C***ROUTINES CALLED  XERROR
C***END PROLOGUE  DCSEVL
C
       DOUBLE PRECISION A(N),X,TWOX,B0,B1,B2
C***FIRST EXECUTABLE STATEMENT  DCSEVL
       IF(N.LT.1)CALL XERROR( 'DCSEVL  NUMBER OF TERMS LE 0', 28, 2,2)
       IF(N.GT.1000) CALL XERROR ( 'DCSEVL  NUMBER OF TERMS GT 1000',
     1   31, 3, 2)
       IF ((X.LT.-1.D0) .OR. (X.GT.1.D0)) CALL XERROR ( 'DCSEVL  X OUTSI
     1DE (-1,+1)', 25, 1, 1)
C
       TWOX = 2.0D0*X
       B1 = 0.D0
       B0=0.D0
       DO 10 I=1,N
         B2=B1
         B1=B0
         NI = N - I + 1
         B0 = TWOX*B1 - B2 + A(NI)
 10    CONTINUE
C
       DCSEVL = 0.5D0 * (B0-B2)
C
       RETURN
      END
      INTEGER FUNCTION I1MACH(I)
C***BEGIN PROLOGUE  I1MACH
C***DATE WRITTEN   750101   (YYMMDD)
C***REVISION DATE  840405   (YYMMDD)
C***CATEGORY NO.  R1
C***KEYWORDS  MACHINE CONSTANTS
C***AUTHOR  FOX, P. A., (BELL LABS)
C           HALL, A. D., (BELL LABS)
C           SCHRYER, N. L., (BELL LABS)
C***PURPOSE  Returns integer machine dependent constants
C***DESCRIPTION
C
C     This is the CMLIB version of I1MACH, the integer machine
C     constants subroutine originally developed for the PORT library.
C
C     I1MACH can be used to obtain machine-dependent parameters
C     for the local machine environment.  It is a function
C     subroutine with one (input) argument, and can be called
C     as follows, for example
C
C          K = I1MACH(I)
C
C     where I=1,...,16.  The (output) value of K above is
C     determined by the (input) value of I.  The results for
C     various values of I are discussed below.
C
C  I/O unit numbers.
C    I1MACH( 1) = the standard input unit.
C    I1MACH( 2) = the standard output unit.
C    I1MACH( 3) = the standard punch unit.
C    I1MACH( 4) = the standard error message unit.
C
C  Words.
C    I1MACH( 5) = the number of bits per integer storage unit.
C    I1MACH( 6) = the number of characters per integer storage unit.
C
C  Integers.
C    assume integers are represented in the S-digit, base-A form
C
C               sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
C
C               where 0 .LE. X(I) .LT. A for I=0,...,S-1.
C    I1MACH( 7) = A, the base.
C    I1MACH( 8) = S, the number of base-A digits.
C    I1MACH( 9) = A**S - 1, the largest magnitude.
C
C  Floating-Point Numbers.
C    Assume floating-point numbers are represented in the T-digit,
C    base-B form
C               sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
C
C               where 0 .LE. X(I) .LT. B for I=1,...,T,
C               0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
C    I1MACH(10) = B, the base.
C
C  Single-Precision
C    I1MACH(11) = T, the number of base-B digits.
C    I1MACH(12) = EMIN, the smallest exponent E.
C    I1MACH(13) = EMAX, the largest exponent E.
C
C  Double-Precision
C    I1MACH(14) = T, the number of base-B digits.
C    I1MACH(15) = EMIN, the smallest exponent E.
C    I1MACH(16) = EMAX, the largest exponent E.
C
C  To alter this function for a particular environment,
C  the desired set of DATA statements should be activated by
C  removing the C from column 1.  Also, the values of
C  I1MACH(1) - I1MACH(4) should be checked for consistency
C  with the local operating system.
C***REFERENCES  FOX P.A., HALL A.D., SCHRYER N.L.,*FRAMEWORK FOR A
C                 PORTABLE LIBRARY*, ACM TRANSACTIONS ON MATHEMATICAL
C                 SOFTWARE, VOL. 4, NO. 2, JUNE 1978, PP. 177-188.
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  I1MACH
C
      INTEGER IMACH(16),OUTPUT
      EQUIVALENCE (IMACH(4),OUTPUT)
C
C     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T
C     3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T
C     PC 7300), SUN SPARCSTATIONS, SILICON GRAPHCS WORKSTATIONS, HP
C     9000 WORKSTATIONS, IBM RS/6000 WORKSTATIONS, AND 8087 BASED 
C     MICROS (E.G. IBM PC AND AT&T 6300).
C
C === MACHINE = ATT.3B
C === MACHINE = ATT.6300
C === MACHINE = ATT.7300
C === MACHINE = HP.9000
C === MACHINE = IBM.PC
C === MACHINE = IBM.RS6000
C === MACHINE = IEEE.MOST-SIG-BYTE-FIRST
C === MACHINE = IEEE.LEAST-SIG-BYTE-FIRST
C === MACHINE = SGI
C === MACHINE = SUN
C === MACHINE = 68000
C === MACHINE = 8087
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -125 /
C      DATA IMACH(13) /  128 /
C      DATA IMACH(14) /   53 /
C      DATA IMACH(15) / -1021 /
C      DATA IMACH(16) /  1024 /
C
C     MACHINE CONSTANTS FOR SUN WORKSTATIONS.  f77 WITH -r8 OPTION.
C
C === MACHINE = SUN.F77-WITH-R8-OPTION
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    6 /
C      DATA IMACH( 4) /    0 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   53 /
C      DATA IMACH(12) / -1021 /
C      DATA IMACH(13) /  1024 /
C      DATA IMACH(14) /   113 /
C      DATA IMACH(15) / -16382 /
C      DATA IMACH(16) /  16384 /
C
C     MACHINE CONSTANTS FOR SGI Origin 2000 with -r8 -d16 options.
C
C === MACHINE = SGI.ORIGIN.F77-WITH-R8-D16-OPTIONS
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    6 /
C      DATA IMACH( 4) /    0 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   53 /
C      DATA IMACH(12) / -1022 /
C      DATA IMACH(13) /  1024 /
C      DATA IMACH(14) /   107 /
C      DATA IMACH(15) /  -916 /
C      DATA IMACH(16) /  1025 /
C
C     MACHINE CONSTANTS FOR IBM RS/6000 WORKSTATIONS WITH -qautodbl=dblpad.
C
C === MACHINE = IBM.RS6000.XLF-WITH-AUTODBL-OPTION
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    6 /
C      DATA IMACH( 4) /    0 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   53 /
C      DATA IMACH(12) / -1021 /
C      DATA IMACH(13) /  1024 /
C      DATA IMACH(14) /   114 /
C      DATA IMACH(15) / -1021 /
C      DATA IMACH(16) /  1024 /
C
C     MACHINE CONSTANTS FOR AMDAHL MACHINES.
C
C === MACHINE = AMDAHL
C      DATA IMACH( 1) /   5 /
C      DATA IMACH( 2) /   6 /
C      DATA IMACH( 3) /   7 /
C      DATA IMACH( 4) /   6 /
C      DATA IMACH( 5) /  32 /
C      DATA IMACH( 6) /   4 /
C      DATA IMACH( 7) /   2 /
C      DATA IMACH( 8) /  31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /  16 /
C      DATA IMACH(11) /   6 /
C      DATA IMACH(12) / -64 /
C      DATA IMACH(13) /  63 /
C      DATA IMACH(14) /  14 /
C      DATA IMACH(15) / -64 /
C      DATA IMACH(16) /  63 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM.
C
C === MACHINE = BURROUGHS.1700
C      DATA IMACH( 1) /    7 /
C      DATA IMACH( 2) /    2 /
C      DATA IMACH( 3) /    2 /
C      DATA IMACH( 4) /    2 /
C      DATA IMACH( 5) /   36 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   33 /
C      DATA IMACH( 9) / Z1FFFFFFFF /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -256 /
C      DATA IMACH(13) /  255 /
C      DATA IMACH(14) /   60 /
C      DATA IMACH(15) / -256 /
C      DATA IMACH(16) /  255 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM.
C
C === MACHINE = BURROUGHS.5700
C      DATA IMACH( 1) /   5 /
C      DATA IMACH( 2) /   6 /
C      DATA IMACH( 3) /   7 /
C      DATA IMACH( 4) /   6 /
C      DATA IMACH( 5) /  48 /
C      DATA IMACH( 6) /   6 /
C      DATA IMACH( 7) /   2 /
C      DATA IMACH( 8) /  39 /
C      DATA IMACH( 9) / O0007777777777777 /
C      DATA IMACH(10) /   8 /
C      DATA IMACH(11) /  13 /
C      DATA IMACH(12) / -50 /
C      DATA IMACH(13) /  76 /
C      DATA IMACH(14) /  26 /
C      DATA IMACH(15) / -50 /
C      DATA IMACH(16) /  76 /
C
C     MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS.
C
C === MACHINE = BURROUGHS.6700
C === MACHINE = BURROUGHS.7700
C      DATA IMACH( 1) /   5 /
C      DATA IMACH( 2) /   6 /
C      DATA IMACH( 3) /   7 /
C      DATA IMACH( 4) /   6 /
C      DATA IMACH( 5) /  48 /
C      DATA IMACH( 6) /   6 /
C      DATA IMACH( 7) /   2 /
C      DATA IMACH( 8) /  39 /
C      DATA IMACH( 9) / O0007777777777777 /
C      DATA IMACH(10) /   8 /
C      DATA IMACH(11) /  13 /
C      DATA IMACH(12) / -50 /
C      DATA IMACH(13) /  76 /
C      DATA IMACH(14) /  26 /
C      DATA IMACH(15) / -32754 /
C      DATA IMACH(16) /  32780 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES
C
C === MACHINE = CONVEX
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    0 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -127 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   53 /
C      DATA IMACH(15) / -1023 /
C      DATA IMACH(16) /  1023 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES (NATIVE MODE)
C     WITH -P8 OPTION
C
C === MACHINE = CONVEX.P8
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /     0 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    64 /
C      DATA IMACH( 6) /     8 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    63 /
C      DATA IMACH( 9) / 9223372036854775807 /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    53 /
C      DATA IMACH(12) / -1023 /
C      DATA IMACH(13) /  1023 /
C      DATA IMACH(14) /   112 /
C      DATA IMACH(15) / -16383 /
C      DATA IMACH(16) /  16383 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES (IEEE MODE)
C
C === MACHINE = CONVEX.IEEE
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    0 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -125 /
C      DATA IMACH(13) /  128 /
C      DATA IMACH(14) /   53 /
C      DATA IMACH(15) / -1021 /
C      DATA IMACH(16) /  1024 /
C
C     MACHINE CONSTANTS FOR THE CONVEX C1, C2, C3 SERIES(IEEE MODE)
C     WITH -P8 OPTION
C
C === MACHINE = CONVEX.IEEE.P8
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /     0 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    32 /
C      DATA IMACH( 6) /     4 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    53 /
C      DATA IMACH(12) / -1021 /
C      DATA IMACH(13) /  1024 /
C      DATA IMACH(14) /    53 /
C      DATA IMACH(15) / -1021 /
C      DATA IMACH(16) /  1024 /
C
C     MACHINE CONSTANTS FOR THE CYBER 170/180 SERIES USING NOS (FTN5).
C
C === MACHINE = CYBER.170.NOS
C === MACHINE = CYBER.180.NOS
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   60 /
C      DATA IMACH( 6) /   10 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   48 /
C      DATA IMACH( 9) / O"00007777777777777777" /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   48 /
C      DATA IMACH(12) / -974 /
C      DATA IMACH(13) / 1070 /
C      DATA IMACH(14) /   96 /
C      DATA IMACH(15) / -927 /
C      DATA IMACH(16) / 1070 /
C
C     MACHINE CONSTANTS FOR THE CDC 180 SERIES USING NOS/VE
C
C === MACHINE = CYBER.180.NOS/VE
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /     7 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    64 /
C      DATA IMACH( 6) /     8 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    63 /
C      DATA IMACH( 9) / 9223372036854775807 /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    47 /
C      DATA IMACH(12) / -4095 /
C      DATA IMACH(13) /  4094 /
C      DATA IMACH(14) /    94 /
C      DATA IMACH(15) / -4095 /
C      DATA IMACH(16) /  4094 /
C
C     MACHINE CONSTANTS FOR THE CYBER 205
C
C === MACHINE = CYBER.205
C      DATA IMACH( 1) /      5 /
C      DATA IMACH( 2) /      6 /
C      DATA IMACH( 3) /      7 /
C      DATA IMACH( 4) /      6 /
C      DATA IMACH( 5) /     64 /
C      DATA IMACH( 6) /      8 /
C      DATA IMACH( 7) /      2 /
C      DATA IMACH( 8) /     47 /
C      DATA IMACH( 9) / X'00007FFFFFFFFFFF' /
C      DATA IMACH(10) /      2 /
C      DATA IMACH(11) /     47 /
C      DATA IMACH(12) / -28625 /
C      DATA IMACH(13) /  28718 /
C      DATA IMACH(14) /     94 /
C      DATA IMACH(15) / -28625 /
C      DATA IMACH(16) /  28718 /
C
C     MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES.
C
C === MACHINE = CDC.6000
C === MACHINE = CDC.7000
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   60 /
C      DATA IMACH( 6) /   10 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   48 /
C      DATA IMACH( 9) / 00007777777777777777B /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   48 /
C      DATA IMACH(12) / -974 /
C      DATA IMACH(13) / 1070 /
C      DATA IMACH(14) /   96 /
C      DATA IMACH(15) / -927 /
C      DATA IMACH(16) / 1070 /
C
C     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3.
C     USING THE 46 BIT INTEGER COMPILER OPTION
C
C === MACHINE = CRAY.46-BIT-INTEGER
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /   102 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    64 /
C      DATA IMACH( 6) /     8 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    46 /
C      DATA IMACH( 9) /  777777777777777777777B /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    47 /
C      DATA IMACH(12) / -8189 /
C      DATA IMACH(13) /  8190 /
C      DATA IMACH(14) /    94 /
C      DATA IMACH(15) / -8099 /
C      DATA IMACH(16) /  8190 /
C
C     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3.
C     USING THE 64 BIT INTEGER COMPILER OPTION
C
C === MACHINE = CRAY.64-BIT-INTEGER
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /   102 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    64 /
C      DATA IMACH( 6) /     8 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    63 /
C      DATA IMACH( 9) /  777777777777777777777B /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    47 /
C      DATA IMACH(12) / -8189 /
C      DATA IMACH(13) /  8190 /
C      DATA IMACH(14) /    94 /
C      DATA IMACH(15) / -8099 /
C      DATA IMACH(16) /  8190 /C
C     MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
C
C === MACHINE = DATA_GENERAL.ECLIPSE.S/200
C      DATA IMACH( 1) /   11 /
C      DATA IMACH( 2) /   12 /
C      DATA IMACH( 3) /    8 /
C      DATA IMACH( 4) /   10 /
C      DATA IMACH( 5) /   16 /
C      DATA IMACH( 6) /    2 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   15 /
C      DATA IMACH( 9) /32767 /
C      DATA IMACH(10) /   16 /
C      DATA IMACH(11) /    6 /
C      DATA IMACH(12) /  -64 /
C      DATA IMACH(13) /   63 /
C      DATA IMACH(14) /   14 /
C      DATA IMACH(15) /  -64 /
C      DATA IMACH(16) /   63 /
C
C     ELXSI  6400
C
C === MACHINE = ELSXI.6400
C      DATA IMACH( 1) /     5 /
C      DATA IMACH( 2) /     6 /
C      DATA IMACH( 3) /     6 /
C      DATA IMACH( 4) /     6 /
C      DATA IMACH( 5) /    32 /
C      DATA IMACH( 6) /     4 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    32 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    24 /
C      DATA IMACH(12) /  -126 /
C      DATA IMACH(13) /   127 /
C      DATA IMACH(14) /    53 /
C      DATA IMACH(15) / -1022 /
C      DATA IMACH(16) /  1023 /
C
C     MACHINE CONSTANTS FOR THE HARRIS 220
C     MACHINE CONSTANTS FOR THE HARRIS SLASH 6 AND SLASH 7
C
C === MACHINE = HARRIS.220
C === MACHINE = HARRIS.SLASH6
C === MACHINE = HARRIS.SLASH7
C      DATA IMACH( 1) /       5 /
C      DATA IMACH( 2) /       6 /
C      DATA IMACH( 3) /       0 /
C      DATA IMACH( 4) /       6 /
C      DATA IMACH( 5) /      24 /
C      DATA IMACH( 6) /       3 /
C      DATA IMACH( 7) /       2 /
C      DATA IMACH( 8) /      23 /
C      DATA IMACH( 9) / 8388607 /
C      DATA IMACH(10) /       2 /
C      DATA IMACH(11) /      23 /
C      DATA IMACH(12) /    -127 /
C      DATA IMACH(13) /     127 /
C      DATA IMACH(14) /      38 /
C      DATA IMACH(15) /    -127 /
C      DATA IMACH(16) /     127 /
C
C     MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES.
C     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
C
C === MACHINE = HONEYWELL.600/6000
C === MACHINE = HONEYWELL.DPS.8/70
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /   43 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   36 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   35 /
C      DATA IMACH( 9) / O377777777777 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   27 /
C      DATA IMACH(12) / -127 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   63 /
C      DATA IMACH(15) / -127 /
C      DATA IMACH(16) /  127 /
C
C     MACHINE CONSTANTS FOR THE HP 2100
C     3 WORD DOUBLE PRECISION OPTION WITH FTN4
C
C === MACHINE = HP.2100.3_WORD_DP
C      DATA IMACH(1) /      5/
C      DATA IMACH(2) /      6 /
C      DATA IMACH(3) /      4 /
C      DATA IMACH(4) /      1 /
C      DATA IMACH(5) /     16 /
C      DATA IMACH(6) /      2 /
C      DATA IMACH(7) /      2 /
C      DATA IMACH(8) /     15 /
C      DATA IMACH(9) /  32767 /
C      DATA IMACH(10)/      2 /
C      DATA IMACH(11)/     23 /
C      DATA IMACH(12)/   -128 /
C      DATA IMACH(13)/    127 /
C      DATA IMACH(14)/     39 /
C      DATA IMACH(15)/   -128 /
C      DATA IMACH(16)/    127 /
C
C     MACHINE CONSTANTS FOR THE HP 2100
C     4 WORD DOUBLE PRECISION OPTION WITH FTN4
C
C === MACHINE = HP.2100.4_WORD_DP
C      DATA IMACH(1) /      5 /
C      DATA IMACH(2) /      6 /
C      DATA IMACH(3) /      4 /
C      DATA IMACH(4) /      1 /
C      DATA IMACH(5) /     16 /
C      DATA IMACH(6) /      2 /
C      DATA IMACH(7) /      2 /
C      DATA IMACH(8) /     15 /
C      DATA IMACH(9) /  32767 /
C      DATA IMACH(10)/      2 /
C      DATA IMACH(11)/     23 /
C      DATA IMACH(12)/   -128 /
C      DATA IMACH(13)/    127 /
C      DATA IMACH(14)/     55 /
C      DATA IMACH(15)/   -128 /
C      DATA IMACH(16)/    127 /
C
C     MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
C     THE XEROX SIGMA 5/7/9 AND THE SEL SYSTEMS 85/86 AND
C     THE INTERDATA 3230 AND INTERDATA 7/32.
C
C === MACHINE = IBM.360
C === MACHINE = IBM.370
C === MACHINE = XEROX.SIGMA.5
C === MACHINE = XEROX.SIGMA.7
C === MACHINE = XEROX.SIGMA.9
C === MACHINE = SEL.85
C === MACHINE = SEL.86
C === MACHINE = INTERDATA.3230
C === MACHINE = INTERDATA.7/32
C      DATA IMACH( 1) /   5 /
C      DATA IMACH( 2) /   6 /
C      DATA IMACH( 3) /   7 /
C      DATA IMACH( 4) /   6 /
C      DATA IMACH( 5) /  32 /
C      DATA IMACH( 6) /   4 /
C      DATA IMACH( 7) /   2 /
C      DATA IMACH( 8) /  31 /
C      DATA IMACH( 9) / Z7FFFFFFF /
C      DATA IMACH(10) /  16 /
C      DATA IMACH(11) /   6 /
C      DATA IMACH(12) / -64 /
C      DATA IMACH(13) /  63 /
C      DATA IMACH(14) /  14 /
C      DATA IMACH(15) / -64 /
C      DATA IMACH(16) /  63 /
C
C     MACHINE CONSTANTS FOR THE INTERDATA 8/32
C     WITH THE UNIX SYSTEM FORTRAN 77 COMPILER.
C
C     FOR THE INTERDATA FORTRAN VII COMPILER REPLACE
C     THE Z'S SPECIFYING HEX CONSTANTS WITH Y'S.
C
C === MACHINE = INTERDATA.8/32.UNIX
C      DATA IMACH( 1) /   5 /
C      DATA IMACH( 2) /   6 /
C      DATA IMACH( 3) /   6 /
C      DATA IMACH( 4) /   6 /
C      DATA IMACH( 5) /  32 /
C      DATA IMACH( 6) /   4 /
C      DATA IMACH( 7) /   2 /
C      DATA IMACH( 8) /  31 /
C      DATA IMACH( 9) / Z'7FFFFFFF' /
C      DATA IMACH(10) /  16 /
C      DATA IMACH(11) /   6 /
C      DATA IMACH(12) / -64 /
C      DATA IMACH(13) /  62 /
C      DATA IMACH(14) /  14 /
C      DATA IMACH(15) / -64 /
C      DATA IMACH(16) /  62 /
C
C     MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR).
C
C === MACHINE = PDP-10.KA
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   36 /
C      DATA IMACH( 6) /    5 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   35 /
C      DATA IMACH( 9) / "377777777777 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   27 /
C      DATA IMACH(12) / -128 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   54 /
C      DATA IMACH(15) / -101 /
C      DATA IMACH(16) /  127 /
C
C     MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR).
C
C === MACHINE = PDP-10.KI
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   36 /
C      DATA IMACH( 6) /    5 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   35 /
C      DATA IMACH( 9) / "377777777777 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   27 /
C      DATA IMACH(12) / -128 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   62 /
C      DATA IMACH(15) / -128 /
C      DATA IMACH(16) /  127 /
C
C     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
C     32-BIT INTEGER ARITHMETIC.
C
C === MACHINE = PDP-11.32-BIT
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   32 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   31 /
C      DATA IMACH( 9) / 2147483647 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -127 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   56 /
C      DATA IMACH(15) / -127 /
C      DATA IMACH(16) /  127 /
C
C     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
C     16-BIT INTEGER ARITHMETIC. 
C
C === MACHINE = PDP-11.16-BIT
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    7 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   16 /
C      DATA IMACH( 6) /    2 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   15 /
C      DATA IMACH( 9) / 32767 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   24 /
C      DATA IMACH(12) / -127 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   56 /
C      DATA IMACH(15) / -127 /
C      DATA IMACH(16) /  127 /
C
C     MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000.
C
C === MACHINE = SEQUENT.BALANCE.8000
C      DATA IMACH( 1) /     0 /
C      DATA IMACH( 2) /     0 /
C      DATA IMACH( 3) /     7 /
C      DATA IMACH( 4) /     0 /
C      DATA IMACH( 5) /    32 /
C      DATA IMACH( 6) /     1 /
C      DATA IMACH( 7) /     2 /
C      DATA IMACH( 8) /    31 /
C      DATA IMACH( 9) /  2147483647 /
C      DATA IMACH(10) /     2 /
C      DATA IMACH(11) /    24 /
C      DATA IMACH(12) /  -125 /
C      DATA IMACH(13) /   128 /
C      DATA IMACH(14) /    53 /
C      DATA IMACH(15) / -1021 /
C      DATA IMACH(16) /  1024 /
C
C     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. FTN COMPILER
C
C === MACHINE = UNIVAC.1100
C      DATA IMACH( 1) /    5 /
C      DATA IMACH( 2) /    6 /
C      DATA IMACH( 3) /    1 /
C      DATA IMACH( 4) /    6 /
C      DATA IMACH( 5) /   36 /
C      DATA IMACH( 6) /    4 /
C      DATA IMACH( 7) /    2 /
C      DATA IMACH( 8) /   35 /
C      DATA IMACH( 9) / O377777777777 /
C      DATA IMACH(10) /    2 /
C      DATA IMACH(11) /   27 /
C      DATA IMACH(12) / -128 /
C      DATA IMACH(13) /  127 /
C      DATA IMACH(14) /   60 /
C      DATA IMACH(15) /-1024 /
C      DATA IMACH(16) / 1023 /
C
C     MACHINE CONSTANTS FOR THE VAX 11/780
C
C === MACHINE = VAX.11/780
C      DATA IMACH(1) /    5 /
C      DATA IMACH(2) /    6 /
C      DATA IMACH(3) /    5 /
C      DATA IMACH(4) /    6 /
C      DATA IMACH(5) /   32 /
C      DATA IMACH(6) /    4 /
C      DATA IMACH(7) /    2 /
C      DATA IMACH(8) /   31 /
C      DATA IMACH(9) /2147483647 /
C      DATA IMACH(10)/    2 /
C      DATA IMACH(11)/   24 /
C      DATA IMACH(12)/ -127 /
C      DATA IMACH(13)/  127 /
C      DATA IMACH(14)/   56 /
C      DATA IMACH(15)/ -127 /
C      DATA IMACH(16)/  127 /
C
C
C***FIRST EXECUTABLE STATEMENT  I1MACH
C
      I1MACH=IMACH(I)
      RETURN
C
      END
      SUBROUTINE XERSAV(MESSG,NMESSG,NERR,LEVEL,ICOUNT)
C***BEGIN PROLOGUE  XERSAV
C***DATE WRITTEN   800319   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  Z
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Records that an error occurred.
C***DESCRIPTION
C     Abstract
C        Record that this error occurred.
C
C     Description of Parameters
C     --Input--
C       MESSG, NMESSG, NERR, LEVEL are as in XERROR,
C       except that when NMESSG=0 the tables will be
C       dumped and cleared, and when NMESSG is less than zero the
C       tables will be dumped and not cleared.
C     --Output--
C       ICOUNT will be the number of times this message has
C       been seen, or zero if the table has overflowed and
C       does not contain this message specifically.
C       When NMESSG=0, ICOUNT will not be altered.
C
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C     Latest revision ---  19 Mar 1980
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  I1MACH,S88FMT,XGETUA
C***END PROLOGUE  XERSAV
      INTEGER LUN(5)
      CHARACTER*(*) MESSG
      CHARACTER*20 MESTAB(10),MES
      DIMENSION NERTAB(10),LEVTAB(10),KOUNT(10)
      SAVE MESTAB,NERTAB,LEVTAB,KOUNT,KOUNTX
C     NEXT TWO DATA STATEMENTS ARE NECESSARY TO PROVIDE A BLANK
C     ERROR TABLE INITIALLY
      DATA KOUNT(1),KOUNT(2),KOUNT(3),KOUNT(4),KOUNT(5),
     1     KOUNT(6),KOUNT(7),KOUNT(8),KOUNT(9),KOUNT(10)
     2     /0,0,0,0,0,0,0,0,0,0/
      DATA KOUNTX/0/
C***FIRST EXECUTABLE STATEMENT  XERSAV
      IF (NMESSG.GT.0) GO TO 80
C     DUMP THE TABLE
         IF (KOUNT(1).EQ.0) RETURN
C        PRINT TO EACH UNIT
         CALL XGETUA(LUN,NUNIT)
         DO 60 KUNIT=1,NUNIT
            IUNIT = LUN(KUNIT)
            IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
C           PRINT TABLE HEADER
            WRITE (IUNIT,10)
   10       FORMAT (32H0          ERROR MESSAGE SUMMARY/
     1      51H MESSAGE START             NERR     LEVEL     COUNT)
C           PRINT BODY OF TABLE
            DO 20 I=1,10
               IF (KOUNT(I).EQ.0) GO TO 30
               WRITE (IUNIT,15) MESTAB(I),NERTAB(I),LEVTAB(I),KOUNT(I)
   15          FORMAT (1X,A20,3I10)
   20       CONTINUE
   30       CONTINUE
C           PRINT NUMBER OF OTHER ERRORS
            IF (KOUNTX.NE.0) WRITE (IUNIT,40) KOUNTX
   40       FORMAT (41H0OTHER ERRORS NOT INDIVIDUALLY TABULATED=,I10)
            WRITE (IUNIT,50)
   50       FORMAT (1X)
   60    CONTINUE
         IF (NMESSG.LT.0) RETURN
C        CLEAR THE ERROR TABLES
         DO 70 I=1,10
   70       KOUNT(I) = 0
         KOUNTX = 0
         RETURN
   80 CONTINUE
C     PROCESS A MESSAGE...
C     SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
C     OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
      MES = MESSG
      DO 90 I=1,10
         II = I
         IF (KOUNT(I).EQ.0) GO TO 110
         IF (MES.NE.MESTAB(I)) GO TO 90
         IF (NERR.NE.NERTAB(I)) GO TO 90
         IF (LEVEL.NE.LEVTAB(I)) GO TO 90
         GO TO 100
   90 CONTINUE
C     THREE POSSIBLE CASES...
C     TABLE IS FULL
         KOUNTX = KOUNTX+1
         ICOUNT = 1
         RETURN
C     MESSAGE FOUND IN TABLE
  100    KOUNT(II) = KOUNT(II) + 1
         ICOUNT = KOUNT(II)
         RETURN
C     EMPTY SLOT FOUND FOR NEW MESSAGE
  110    MESTAB(II) = MES
         NERTAB(II) = NERR
         LEVTAB(II) = LEVEL
         KOUNT(II)  = 1
         ICOUNT = 1
         RETURN
      END
      SUBROUTINE XERABT(MESSG,NMESSG)
C***BEGIN PROLOGUE  XERABT
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  R3C
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Aborts program execution and prints error message.
C***DESCRIPTION
C     Abstract
C        ***Note*** machine dependent routine
C        XERABT aborts the execution of the program.
C        The error message causing the abort is given in the calling
C        sequence, in case one needs it for printing on a dayfile,
C        for example.
C
C     Description of Parameters
C        MESSG and NMESSG are as in XERROR, except that NMESSG may
C        be zero, in which case no message is being supplied.
C
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C     Latest revision ---  19 MAR 1980
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  XERABT
      CHARACTER*(*) MESSG
C***FIRST EXECUTABLE STATEMENT  XERABT
      STOP
      END
      SUBROUTINE XERPRT(MESSG,NMESSG)
C***BEGIN PROLOGUE  XERPRT
C***DATE WRITTEN   790801   (YYMMDD)
C***REVISION DATE  820801   (YYMMDD)
C***CATEGORY NO.  Z
C***KEYWORDS  ERROR,XERROR PACKAGE
C***AUTHOR  JONES, R. E., (SNLA)
C***PURPOSE  Prints error messages.
C***DESCRIPTION
C     Abstract
C        Print the Hollerith message in MESSG, of length NMESSG,
C        on each file indicated by XGETUA.
C     Latest revision ---  19 MAR 1980
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  I1MACH,S88FMT,XGETUA
C***END PROLOGUE  XERPRT
      INTEGER LUN(5)
      CHARACTER*(*) MESSG
C     OBTAIN UNIT NUMBERS AND WRITE LINE TO EACH UNIT
C***FIRST EXECUTABLE STATEMENT  XERPRT
      CALL XGETUA(LUN,NUNIT)
      LENMES = LEN(MESSG)
      DO 20 KUNIT=1,NUNIT
         IUNIT = LUN(KUNIT)
         IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
         DO 10 ICHAR=1,LENMES,72
            LAST = MIN0(ICHAR+71 , LENMES)
            WRITE (IUNIT,'(1X,A)') MESSG(ICHAR:LAST)
   10    CONTINUE
   20 CONTINUE
      RETURN
      END
      FUNCTION J4SAVE(IWHICH,IVALUE,ISET)
C***BEGIN PROLOGUE  J4SAVE
C***REFER TO  XERROR
C     Abstract
C        J4SAVE saves and recalls several global variables needed
C        by the library error handling routines.
C
C     Description of Parameters
C      --Input--
C        IWHICH - Index of item desired.
C                = 1 Refers to current error number.
C                = 2 Refers to current error control flag.
C                 = 3 Refers to current unit number to which error
C                    messages are to be sent.  (0 means use standard.)
C                 = 4 Refers to the maximum number of times any
C                     message is to be printed (as set by XERMAX).
C                 = 5 Refers to the total number of units to which
C                     each error message is to be written.
C                 = 6 Refers to the 2nd unit for error messages
C                 = 7 Refers to the 3rd unit for error messages
C                 = 8 Refers to the 4th unit for error messages
C                 = 9 Refers to the 5th unit for error messages
C        IVALUE - The value to be set for the IWHICH-th parameter,
C                 if ISET is .TRUE. .
C        ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
C                 given the value, IVALUE.  If ISET=.FALSE., the
C                 IWHICH-th parameter will be unchanged, and IVALUE
C                 is a dummy parameter.
C      --Output--
C        The (old) value of the IWHICH-th parameter will be returned
C        in the function value, J4SAVE.
C
C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
C    Adapted from Bell Laboratories PORT Library Error Handler
C     Latest revision ---  23 MAY 1979
C***REFERENCES  JONES R.E., KAHANER D.K., "XERROR, THE SLATEC ERROR-
C                 HANDLING PACKAGE", SAND82-0800, SANDIA LABORATORIES,
C                 1982.
C***ROUTINES CALLED  (NONE)
C***END PROLOGUE  J4SAVE
      LOGICAL ISET
      INTEGER IPARAM(9)
      SAVE IPARAM
      DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
      DATA IPARAM(5)/1/
      DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
C***FIRST EXECUTABLE STATEMENT  J4SAVE
      J4SAVE = IPARAM(IWHICH)
      IF (ISET) IPARAM(IWHICH) = IVALUE
      RETURN
      END
