      REAL FUNCTION $DMJ0M*8 (X)
C
C-----------------------------------------------------------------------
C
C   ALL RIGHTS RESERVED,COPYRIGHT(C)1981,HITACHI,LTD.S-1511-1
C   LICENSED MATERIAL OF HITACHI,LTD.
C
C   NAME                - $DMJ0M : DOUBLE PRECISION
C
C   USAGE               - Y=$DMJ0M(X)
C
C   FUNCTION            - BY CHEBYSHEV INTERPOLATION, WE OBTAIN THE
C                           VALUE OF THE BESSEL FUNCTION OF THE FIRST
C                           KIND OF ORDER ZERO.
C
C   ARGUMENTS  X        - INPUT. VARIABLE OF THE BESSEL FUNCTION
C                           (!X!<1.0D12).
C              ($DMJ0M) - OUTPUT. THE VALUE OF THE BESSEL FUNCTION.
C
C   NOTICE              - WHEN !X!>=1.0D12, ERROR MESSAGE IS PRINTED
C                           OUT AND $DMJ0M IS SET TO 0.0.
C
C   REQD. MSLII SUBPROG.- $SUERM
C
C   STATUS              - S-1511-1 05-02
C
C   HISTORY             - DATE.    1981.10
C                                  1986. 6
C
C-----------------------------------------------------------------------
C
      IMPLICIT REAL*8 (A-H,O-Z)
      GENERIC
      DIMENSION NAME(2)
      DATA C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10
     *   / -2.2270 614            D-9,  7.8594 0046           D-8,
     *     -1.9891 96578 6        D-6,  4.0310 96038 59       D-5,
     *     -6.4499 78225 950      D-4,  7.9012 34182 8039     D-3,
     *     -7.1111 11100 46304    D-2,  4.4444 44444 25769 5  D-1,
     *     -1.7777 77777 77584 46 D 0,  3.9999 99999 99989 66 D 0,
     *     -3.9999 99999 99999 78 D 0                             /
      DATA D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13
     *   /  3.3150 18             D-11,  4.6970 63             D-11,
     *     -5.6633 6210           D- 9, -4.8842 9867           D- 9,
     *      6.7810 96622 5        D- 7,  2.1332 90985 8        D- 7,
     *     -5.3795 00918 201      D- 5,  1.1202 21502 384      D- 5,
     *      2.5202 11970 18629    D- 3, -1.7073 87596 90737    D- 3,
     *     -5.6148 69347 44975 4  D- 2,  5.6040 47189 80261 6  D- 2,
     *      3.2757 91375 91465 09 D- 1, -1.7759 67713 14338 34 D- 1 /
      DATA E0,E1,E2,E3,E4,E5,E6,E7,E8,E9,E10,E11,E12,E13,E14
     *   / -1.9865 0              D-12, -1.5178 02          D-11,
     *      3.9649 790            D-10,  2.4051 2241        D- 9,
     *     -5.7071 43476          D- 8, -2.5797 89310 5     D- 7,
     *      5.6607 46146 93       D- 6,  1.7226 12595 802   D- 5,
     *     -3.5284 91002 3231     D- 4, -5.9314 89738 8202  D- 4,
     *      1.1790 12935 71024 6  D- 2,  6.3961 29897 84324 D- 3,
     *     -1.5037 41226 51373 90 D- 1,  4.6828 23482 34590 D- 3,
     *      3.0007 92705 19555 60 D- 1                            /
      DATA A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10
     *   /  2.8228 605             D-10, -1.9415 5134       D-9,
     *      6.5160 2613            D- 9, -1.5339 82923      D-8,
     *      3.2676 79187           D- 8, -8.0992 84883      D-8,
     *      2.8872 15007 2         D- 7, -1.7424 98968 02   D-6,
     *      2.1846 78334 973       D- 5, -8.7658 21590 6110 D-4,
     *      0.7978 84560 80286 526 D  0                         /
      DATA B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12
     *   / -8.9331 052           D-10,  6.6532 7442       D-9,
     *     -2.3224 79945         D- 8,  5.1878 39807      D-8,
     *     -8.7651 63373         D- 8,  1.3089 75220 0    D-7,
     *     -2.0632 29204 9       D- 7,  4.0856 34631 8    D-7,
     *     -1.1593 30628 42      D- 6,  5.2586 51475 08   D-6,
     *     -4.4239 73781 374     D- 5,  9.1310 64157 0497 D-4,
     *     -9.9735 57010 03581 5 D- 2                         /
      DATA PI4  / 0.78539 81633 97448 31D0 /
      DATA NAME / '$DMJ', '0M  ' /
      AX=ABS(X)
      IF (AX .GE. 1.0D12) GO TO 40
      IF (AX .GE. 8.0D0) GO TO 30
      IF (AX .GE. 6.0D0) GO TO 20
      IF (AX .GE. 4.0D0) GO TO 10
C
C     !X! < 4
C
      Z=(X*0.25D0)**2
      $DMJ0M=((((((((((C0*Z +C1)*Z +C2)*Z +C3)*Z +C4)*Z +C5)*Z +C6)*Z
     *       +C7)*Z +C8)*Z +C9)*Z +C10)*Z +1.0D0
      GO TO 9999
C
C     4 <= !X! < 6
C
   10 Z=AX-5.0D0
      $DMJ0M=((((((((((((D0*Z +D1)*Z +D2)*Z +D3)*Z +D4)*Z +D5)*Z
     *       +D6)*Z +D7)*Z +D8)*Z +D9)*Z +D10)*Z +D11)*Z +D12)*Z +D13
      GO TO 9999
C
C     6 <= !X! < 8
C
   20 Z=AX-7.0D0
      $DMJ0M=(((((((((((((E0*Z +E1)*Z +E2)*Z +E3)*Z +E4)*Z +E5)*Z
     *       +E6)*Z +E7)*Z +E8)*Z +E9)*Z +E10)*Z +E11)*Z +E12)*Z
     *       +E13)*Z +E14
      GO TO 9999
C
C     8 <= !X! < 1.0D12
C
   30 Z=(8.0D0/AX)**2
      A=(((((((((A0*Z +A1)*Z +A2)*Z +A3)*Z +A4)*Z +A5)*Z +A6)*Z
     *  +A7)*Z +A8)*Z +A9)*Z +A10
      B=((((((((((((B0*Z +B1)*Z +B2)*Z +B3)*Z +B4)*Z +B5)*Z +B6)*Z
     *  +B7)*Z +B8)*Z +B9)*Z +B10)*Z +B11)*Z +B12) /AX
      Q=AX-PI4
      $DMJ0M=(A*COS(Q) - B*SIN(Q)) /SQRT(AX)
      GO TO 9999
C
C     PARAMETER ERROR
C
   40 $DMJ0M=0.0D0
      CALL $SUERM (NAME,2000,IER)
C
 9999 RETURN
      END
