subroutine DBMP0 (X, AMPL, THETA)
c Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
c ALL RIGHTS RESERVED.
c Based on Government Sponsored Research NAS7-03001.
c>> 2002-03-29 DBMP0 Krogh  Very minor clean up of code.
c>> 1996-04-27 DBMP0 Krogh  Changes to use .C. and C%%.
c>> 1996-03-30 DBMP0 Krogh  Added external statement.
C>> 1995-11-28 DBMP0 Krogh  Changes to simplify conversion to C.
C>> 1995-11-03 DBMP0 Krogh  Removed blanks in numbers for C conversion.
C>> 1994-11-11 DBMP0 Krogh  Declared all vars.
C>> 1994-10-20 DBMP0 Krogh  Changes to use M77CON
C>> 1991-01-14 DBMP0 CLL Changed to generic name SQRT
C>> 1990-11-29 DBMP0 CLL Changed subroutine name to DBMP0
C>> 1985-12-03 D9B0MP Lawson  Initial code.
C JULY 1977 EDITION.  W. FULLERTON, C3, LOS ALAMOS SCIENTIFIC LAB.
C C.L.LAWSON & S.CHAN, JPL, 1984 FEB ADAPTED TO JPL MATH77 LIBRARY.
C
C EVALUATE THE MODULUS AND PHASE FOR THE BESSEL J0 AND Y0 FUNCTIONS.
C     (13-JAN-83) : UTAH: MISSING ARGUMENT 37 INSERTED FOLLOWING
C                   37H.. IN LAST CALL TO XERROR
C     ------------------------------------------------------------------
c--D replaces "?": ?BMP0, ?INITS, ?CSEVL, ?ERM1, ?ERV1
C     ------------------------------------------------------------------
      external D1MACH, DCSEVL
      integer NBM0, NBT02, NBM02, NBTH0
      double precision X, AMPL, THETA, BM0CS(37), BT02CS(39), ETA
      double precision BM02CS(40), BTH0CS(44), XMAX, PI4
      double precision Z, D1MACH, DCSEVL
C
      save ETA, NBM0, NBT02, NBM02, NBTH0, XMAX
C
C SERIES FOR BM0        ON THE INTERVAL  1.56250D-02 TO  6.25000D-02
C                                        WITH WEIGHTED ERROR   4.40D-32
C                                         LOG WEIGHTED ERROR  31.36
C                               SIGNIFICANT FIGURES REQUIRED  30.02
C                                    DECIMAL PLACES REQUIRED  32.14
C
c++ Save data by elements if ~.C.
      data BM0CS(1) /   +.9211656246827742712573767730182D-1 /
      data BM0CS(2) /   -.1050590997271905102480716371755D-2 /
      data BM0CS(3) /   +.1470159840768759754056392850952D-4 /
      data BM0CS(4) /   -.5058557606038554223347929327702D-6 /
      data BM0CS(5) /   +.2787254538632444176630356137881D-7 /
      data BM0CS(6) /   -.2062363611780914802618841018973D-8 /
      data BM0CS(7) /   +.1870214313138879675138172596261D-9 /
      data BM0CS(8) /   -.1969330971135636200241730777825D-10 /
      data BM0CS(9) /   +.2325973793999275444012508818052D-11 /
      data BM0CS(10) /  -.3009520344938250272851224734482D-12 /
      data BM0CS(11) /  +.4194521333850669181471206768646D-13 /
      data BM0CS(12) /  -.6219449312188445825973267429564D-14 /
      data BM0CS(13) /  +.9718260411336068469601765885269D-15 /
      data BM0CS(14) /  -.1588478585701075207366635966937D-15 /
      data BM0CS(15) /  +.2700072193671308890086217324458D-16 /
      data BM0CS(16) /  -.4750092365234008992477504786773D-17 /
      data BM0CS(17) /  +.8615128162604370873191703746560D-18 /
      data BM0CS(18) /  -.1605608686956144815745602703359D-18 /
      data BM0CS(19) /  +.3066513987314482975188539801599D-19 /
      data BM0CS(20) /  -.5987764223193956430696505617066D-20 /
      data BM0CS(21) /  +.1192971253748248306489069841066D-20 /
      data BM0CS(22) /  -.2420969142044805489484682581333D-21 /
      data BM0CS(23) /  +.4996751760510616453371002879999D-22 /
      data BM0CS(24) /  -.1047493639351158510095040511999D-22 /
      data BM0CS(25) /  +.2227786843797468101048183466666D-23 /
      data BM0CS(26) /  -.4801813239398162862370542933333D-24 /
      data BM0CS(27) /  +.1047962723470959956476996266666D-24 /
      data BM0CS(28) /  -.2313858165678615325101260800000D-25 /
      data BM0CS(29) /  +.5164823088462674211635199999999D-26 /
      data BM0CS(30) /  -.1164691191850065389525401599999D-26 /
      data BM0CS(31) /  +.2651788486043319282958336000000D-27 /
      data BM0CS(32) /  -.6092559503825728497691306666666D-28 /
      data BM0CS(33) /  +.1411804686144259308038826666666D-28 /
      data BM0CS(34) /  -.3298094961231737245750613333333D-29 /
      data BM0CS(35) /  +.7763931143074065031714133333333D-30 /
      data BM0CS(36) /  -.1841031343661458478421333333333D-30 /
      data BM0CS(37) /  +.4395880138594310737100799999999D-31 /
C
C SERIES FOR BTH0       ON THE INTERVAL  0.          TO  1.56250D-02
C                                        WITH WEIGHTED ERROR   2.66D-32
C                                         LOG WEIGHTED ERROR  31.57
C                               SIGNIFICANT FIGURES REQUIRED  30.67
C                                    DECIMAL PLACES REQUIRED  32.40
C
c++ Save data by elements if ~.C.
      data BTH0CS(1) /   -.24901780862128936717709793789967D+0 /
      data BTH0CS(2) /   +.48550299609623749241048615535485D-3 /
      data BTH0CS(3) /   -.54511837345017204950656273563505D-5 /
      data BTH0CS(4) /   +.13558673059405964054377445929903D-6 /
      data BTH0CS(5) /   -.55691398902227626227583218414920D-8 /
      data BTH0CS(6) /   +.32609031824994335304004205719468D-9 /
      data BTH0CS(7) /   -.24918807862461341125237903877993D-10 /
      data BTH0CS(8) /   +.23449377420882520554352413564891D-11 /
      data BTH0CS(9) /   -.26096534444310387762177574766136D-12 /
      data BTH0CS(10) /  +.33353140420097395105869955014923D-13 /
      data BTH0CS(11) /  -.47890000440572684646750770557409D-14 /
      data BTH0CS(12) /  +.75956178436192215972642568545248D-15 /
      data BTH0CS(13) /  -.13131556016891440382773397487633D-15 /
      data BTH0CS(14) /  +.24483618345240857495426820738355D-16 /
      data BTH0CS(15) /  -.48805729810618777683256761918331D-17 /
      data BTH0CS(16) /  +.10327285029786316149223756361204D-17 /
      data BTH0CS(17) /  -.23057633815057217157004744527025D-18 /
      data BTH0CS(18) /  +.54044443001892693993017108483765D-19 /
      data BTH0CS(19) /  -.13240695194366572724155032882385D-19 /
      data BTH0CS(20) /  +.33780795621371970203424792124722D-20 /
      data BTH0CS(21) /  -.89457629157111779003026926292299D-21 /
      data BTH0CS(22) /  +.24519906889219317090899908651405D-21 /
      data BTH0CS(23) /  -.69388422876866318680139933157657D-22 /
      data BTH0CS(24) /  +.20228278714890138392946303337791D-22 /
      data BTH0CS(25) /  -.60628500002335483105794195371764D-23 /
      data BTH0CS(26) /  +.18649748964037635381823788396270D-23 /
      data BTH0CS(27) /  -.58783732384849894560245036530867D-24 /
      data BTH0CS(28) /  +.18958591447999563485531179503513D-24 /
      data BTH0CS(29) /  -.62481979372258858959291620728565D-25 /
      data BTH0CS(30) /  +.21017901684551024686638633529074D-25 /
      data BTH0CS(31) /  -.72084300935209253690813933992446D-26 /
      data BTH0CS(32) /  +.25181363892474240867156405976746D-26 /
      data BTH0CS(33) /  -.89518042258785778806143945953643D-27 /
      data BTH0CS(34) /  +.32357237479762298533256235868587D-27 /
      data BTH0CS(35) /  -.11883010519855353657047144113796D-27 /
      data BTH0CS(36) /  +.44306286907358104820579231941731D-28 /
      data BTH0CS(37) /  -.16761009648834829495792010135681D-28 /
      data BTH0CS(38) /  +.64292946921207466972532393966088D-29 /
      data BTH0CS(39) /  -.24992261166978652421207213682763D-29 /
      data BTH0CS(40) /  +.98399794299521955672828260355318D-30 /
      data BTH0CS(41) /  -.39220375242408016397989131626158D-30 /
      data BTH0CS(42) /  +.15818107030056522138590618845692D-30 /
      data BTH0CS(43) /  -.64525506144890715944344098365426D-31 /
      data BTH0CS(44) /  +.26611111369199356137177018346367D-31 /
C
C SERIES FOR BM02       ON THE INTERVAL  0.          TO  1.56250D-02
C                                        WITH WEIGHTED ERROR   4.72D-32
C                                         LOG WEIGHTED ERROR  31.33
C                               SIGNIFICANT FIGURES REQUIRED  30.00
C                                    DECIMAL PLACES REQUIRED  32.13
C
c++ Save data by elements if ~.C.
      data BM02CS(1) /   +.9500415145228381369330861335560D-1 /
      data BM02CS(2) /   -.3801864682365670991748081566851D-3 /
      data BM02CS(3) /   +.2258339301031481192951829927224D-5 /
      data BM02CS(4) /   -.3895725802372228764730621412605D-7 /
      data BM02CS(5) /   +.1246886416512081697930990529725D-8 /
      data BM02CS(6) /   -.6065949022102503779803835058387D-10 /
      data BM02CS(7) /   +.4008461651421746991015275971045D-11 /
      data BM02CS(8) /   -.3350998183398094218467298794574D-12 /
      data BM02CS(9) /   +.3377119716517417367063264341996D-13 /
      data BM02CS(10) /  -.3964585901635012700569356295823D-14 /
      data BM02CS(11) /  +.5286111503883857217387939744735D-15 /
      data BM02CS(12) /  -.7852519083450852313654640243493D-16 /
      data BM02CS(13) /  +.1280300573386682201011634073449D-16 /
      data BM02CS(14) /  -.2263996296391429776287099244884D-17 /
      data BM02CS(15) /  +.4300496929656790388646410290477D-18 /
      data BM02CS(16) /  -.8705749805132587079747535451455D-19 /
      data BM02CS(17) /  +.1865862713962095141181442772050D-19 /
      data BM02CS(18) /  -.4210482486093065457345086972301D-20 /
      data BM02CS(19) /  +.9956676964228400991581627417842D-21 /
      data BM02CS(20) /  -.2457357442805313359605921478547D-21 /
      data BM02CS(21) /  +.6307692160762031568087353707059D-22 /
      data BM02CS(22) /  -.1678773691440740142693331172388D-22 /
      data BM02CS(23) /  +.4620259064673904433770878136087D-23 /
      data BM02CS(24) /  -.1311782266860308732237693402496D-23 /
      data BM02CS(25) /  +.3834087564116302827747922440276D-24 /
      data BM02CS(26) /  -.1151459324077741271072613293576D-24 /
      data BM02CS(27) /  +.3547210007523338523076971345213D-25 /
      data BM02CS(28) /  -.1119218385815004646264355942176D-25 /
      data BM02CS(29) /  +.3611879427629837831698404994257D-26 /
      data BM02CS(30) /  -.1190687765913333150092641762463D-26 /
      data BM02CS(31) /  +.4005094059403968131802476449536D-27 /
      data BM02CS(32) /  -.1373169422452212390595193916017D-27 /
      data BM02CS(33) /  +.4794199088742531585996491526437D-28 /
      data BM02CS(34) /  -.1702965627624109584006994476452D-28 /
      data BM02CS(35) /  +.6149512428936330071503575161324D-29 /
      data BM02CS(36) /  -.2255766896581828349944300237242D-29 /
      data BM02CS(37) /  +.8399707509294299486061658353200D-30 /
      data BM02CS(38) /  -.3172997595562602355567423936152D-30 /
      data BM02CS(39) /  +.1215205298881298554583333026514D-30 /
      data BM02CS(40) /  -.4715852749754438693013210568045D-31 /
C
C SERIES FOR BT02       ON THE INTERVAL  1.56250D-02 TO  6.25000D-02
C                                        WITH WEIGHTED ERROR   2.99D-32
C                                         LOG WEIGHTED ERROR  31.52
C                               SIGNIFICANT FIGURES REQUIRED  30.61
C                                    DECIMAL PLACES REQUIRED  32.32
C
c++ Save data by elements if ~.C.
      data BT02CS(1) /   -.24548295213424597462050467249324D+0 /
      data BT02CS(2) /   +.12544121039084615780785331778299D-2 /
      data BT02CS(3) /   -.31253950414871522854973446709571D-4 /
      data BT02CS(4) /   +.14709778249940831164453426969314D-5 /
      data BT02CS(5) /   -.99543488937950033643468850351158D-7 /
      data BT02CS(6) /   +.85493166733203041247578711397751D-8 /
      data BT02CS(7) /   -.86989759526554334557985512179192D-9 /
      data BT02CS(8) /   +.10052099533559791084540101082153D-9 /
      data BT02CS(9) /   -.12828230601708892903483623685544D-10 /
      data BT02CS(10) /  +.17731700781805131705655750451023D-11 /
      data BT02CS(11) /  -.26174574569485577488636284180925D-12 /
      data BT02CS(12) /  +.40828351389972059621966481221103D-13 /
      data BT02CS(13) /  -.66751668239742720054606749554261D-14 /
      data BT02CS(14) /  +.11365761393071629448392469549951D-14 /
      data BT02CS(15) /  -.20051189620647160250559266412117D-15 /
      data BT02CS(16) /  +.36497978794766269635720591464106D-16 /
      data BT02CS(17) /  -.68309637564582303169355843788800D-17 /
      data BT02CS(18) /  +.13107583145670756620057104267946D-17 /
      data BT02CS(19) /  -.25723363101850607778757130649599D-18 /
      data BT02CS(20) /  +.51521657441863959925267780949333D-19 /
      data BT02CS(21) /  -.10513017563758802637940741461333D-19 /
      data BT02CS(22) /  +.21820381991194813847301084501333D-20 /
      data BT02CS(23) /  -.46004701210362160577225905493333D-21 /
      data BT02CS(24) /  +.98407006925466818520953651199999D-22 /
      data BT02CS(25) /  -.21334038035728375844735986346666D-22 /
      data BT02CS(26) /  +.46831036423973365296066286933333D-23 /
      data BT02CS(27) /  -.10400213691985747236513382399999D-23 /
      data BT02CS(28) /  +.23349105677301510051777740800000D-24 /
      data BT02CS(29) /  -.52956825323318615788049749333333D-25 /
      data BT02CS(30) /  +.12126341952959756829196287999999D-25 /
      data BT02CS(31) /  -.28018897082289428760275626666666D-26 /
      data BT02CS(32) /  +.65292678987012873342593706666666D-27 /
      data BT02CS(33) /  -.15337980061873346427835733333333D-27 /
      data BT02CS(34) /  +.36305884306364536682359466666666D-28 /
      data BT02CS(35) /  -.86560755713629122479172266666666D-29 /
      data BT02CS(36) /  +.20779909972536284571238399999999D-29 /
      data BT02CS(37) /  -.50211170221417221674325333333333D-30 /
      data BT02CS(38) /  +.12208360279441714184191999999999D-30 /
      data BT02CS(39) /  -.29860056267039913454250666666666D-31 /
C
      data PI4 / 0.785398163397448309615660845819876D0 /
      data NBM0, NBT02, NBM02, NBTH0, XMAX / 4*0, 0.D0 /
C     ------------------------------------------------------------------
      if (NBM0 .eq. 0) then
         ETA = 0.1D0 * D1MACH(3)
         call DINITS (BM0CS, 37, ETA,  NBM0 )
         call DINITS (BT02CS, 39, ETA, NBT02)
         call DINITS (BM02CS, 40, ETA, NBM02)
         call DINITS (BTH0CS, 44, ETA, NBTH0)
C
         XMAX = 0.04D0/D1MACH(4)
      endif
C
      if (X .lt. 4.D0) then
        AMPL = 0.D0
        THETA = 0.D0
        call DERM1 ('DBMP0',1,0,'X MUST BE .GE. 4','X',X,'.')
      end if
C
      if (X .le. 8.D0) then
        Z = (128.D0/(X*X) - 5.D0)/3.D0
        AMPL = (.75D0 + DCSEVL (Z, BM0CS, NBM0))/SQRT(X)
        THETA = X - PI4 + DCSEVL (Z, BT02CS, NBT02)/X
        return
      endif
C
      if (X .gt. XMAX) then
         AMPL = 0.D0
         THETA = 0.D0
         call DERM1 ('DBMP0',2,0,'NO PRECISION BECAUSE X .GT. XMAX',
     *        'X',X,',')
         call DERV1 ('XMAX',XMAX,'.')
      end if
C
      Z = 128.D0/(X*X) - 1.D0
      AMPL = (.75D0 + DCSEVL (Z, BM02CS, NBM02))/SQRT(X)
      THETA = X - PI4 + DCSEVL (Z, BTH0CS, NBTH0)/X
      return
C
      end

.