function value = r4_bide ( x )

%*****************************************************************************80
%
%% R4_BIDE: exponentially scaled derivative, Airy function Bi of an R4 argument.
%
%  Discussion:
%
%    if X < 0,
%      R4_BIDE ( X ) = R4_BID ( X )
%    else
%      R4_BIDE ( X ) = R4_BID ( X ) * exp ( - 2/3 * X^(3/2) )
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 October 2011
%
%  Author:
%
%    Original FORTRAN77 version by Wayne Fullerton.
%    MATLAB version by John Burkardt.
%
%  Reference:
%
%    Wayne Fullerton,
%    Portable Special Function Routines,
%    in Portability of Numerical Software,
%    edited by Wayne Cowell,
%    Lecture Notes in Computer Science, Volume 57,
%    Springer 1977,
%    ISBN: 978-3-540-08446-4,
%    LC: QA297.W65.
%
%  Parameters:
%
%    Input, real X, the argument.
%
%    Output, real VALUE, the exponentially scaled derivative of
%    the Airy function Bi of X.
%
  persistent atr
  persistent bif2cs
  persistent bifcs
  persistent big2cs
  persistent bigcs
  persistent bip1cs
  persistent bip2cs
  persistent btr
  persistent nbif
  persistent nbif2
  persistent nbig
  persistent nbig2
  persistent nbip1
  persistent nbip2
  persistent x2sml
  persistent x3sml
  persistent x32sml
  persistent xbig

  atr =  8.7506905708484345;
  btr = -2.0938363213560543;

  if ( isempty ( nbif ) )

    bif2cs = [ ...
       0.323493987603522033521E+00, ...
       0.086297871535563559139E+00, ...
       0.002994025552655397426E+00, ...
       0.000051430528364661637E+00, ...
       0.000000525840250036811E+00, ...
       0.000000003561751373958E+00, ...
       0.000000000017146864007E+00, ...
       0.000000000000061663520E+00, ...
       0.000000000000000171911E+00, ...
       0.000000000000000000382E+00 ]';
    bifcs = [ ...
       0.1153536790828570243E+00, ...
       0.0205007894049192875E+00, ...
       0.0002135290278902876E+00, ...
       0.0000010783960614677E+00, ...
       0.0000000032094708833E+00, ...
       0.0000000000062930407E+00, ...
       0.0000000000000087403E+00, ...
       0.0000000000000000090E+00 ]';
    big2cs = [ ...
       1.6062999463621294578E+00, ...
       0.7449088819876088652E+00, ...
       0.0470138738610277380E+00, ...
       0.0012284422062548239E+00, ...
       0.0000173222412256624E+00, ...
       0.0000001521901652368E+00, ...
       0.0000000009113560249E+00, ...
       0.0000000000039547918E+00, ...
       0.0000000000000130017E+00, ...
       0.0000000000000000335E+00 ]';
    bigcs = [ ...
      -0.097196440416443537390E+00, ...
       0.149503576843167066571E+00, ...
       0.003113525387121326042E+00, ...
       0.000024708570579821297E+00, ...
       0.000000102949627731379E+00, ...
       0.000000000263970373987E+00, ...
       0.000000000000458279271E+00, ...
       0.000000000000000574283E+00, ...
       0.000000000000000000544E+00 ]';
    bip1cs = [ ...
      -0.1729187351079553719E+00, ...
      -0.0149358492984694364E+00, ...
      -0.0005471104951678566E+00, ...
       0.0001537966292958408E+00, ...
       0.0000154353476192179E+00, ...
      -0.0000065434113851906E+00, ...
       0.0000003728082407879E+00, ...
       0.0000002072078388189E+00, ...
      -0.0000000658173336470E+00, ...
       0.0000000074926746354E+00, ...
       0.0000000011101336884E+00, ...
      -0.0000000007265140553E+00, ...
       0.0000000001782723560E+00, ...
      -0.0000000000217346352E+00, ...
      -0.0000000000020302035E+00, ...
       0.0000000000019311827E+00, ...
      -0.0000000000006044953E+00, ...
       0.0000000000001209450E+00, ...
      -0.0000000000000125109E+00, ...
      -0.0000000000000019917E+00, ...
       0.0000000000000015154E+00, ...
      -0.0000000000000004977E+00, ...
       0.0000000000000001155E+00, ...
      -0.0000000000000000186E+00 ]';
    bip2cs = [ ...
      -0.13269705443526630495E+00, ...
      -0.00568443626045977481E+00, ...
      -0.00015643601119611610E+00, ...
      -0.00001136737203679562E+00, ...
      -0.00000143464350991284E+00, ...
      -0.00000018098531185164E+00, ...
       0.00000000926177343611E+00, ...
       0.00000001710005490721E+00, ...
       0.00000000476698163504E+00, ...
      -0.00000000035195022023E+00, ...
      -0.00000000058890614316E+00, ...
      -0.00000000006678499608E+00, ...
       0.00000000006395565102E+00, ...
       0.00000000001554529427E+00, ...
      -0.00000000000792397000E+00, ...
      -0.00000000000258326243E+00, ...
       0.00000000000121655048E+00, ...
       0.00000000000038707207E+00, ...
      -0.00000000000022487045E+00, ...
      -0.00000000000004953477E+00, ...
       0.00000000000004563782E+00, ...
       0.00000000000000332998E+00, ...
      -0.00000000000000921750E+00, ...
       0.00000000000000094157E+00, ...
       0.00000000000000167154E+00, ...
      -0.00000000000000055134E+00, ...
      -0.00000000000000022369E+00, ...
       0.00000000000000017487E+00, ...
       0.00000000000000000207E+00 ]';

    eta = 0.1 * r4_mach ( 3 );
    nbif = r4_inits ( bifcs, 8, eta );
    nbig = r4_inits ( bigcs, 9, eta );
    nbif2 = r4_inits ( bif2cs, 10, eta );
    nbig2 = r4_inits ( big2cs, 10, eta );
    nbip1 = r4_inits ( bip1cs, 24, eta );
    nbip2 = r4_inits ( bip2cs, 29, eta );
    x2sml = sqrt ( eta );
    x3sml = eta^0.3333;
    x32sml = 1.3104 * x3sml * x3sml;
    xbig = r4_mach ( 2 )^0.6666;

  end

  if ( x <= - 1.0 )
    [ xn, phi ] = r4_admp ( x );
    value = xn * sin ( phi );
  elseif ( 0.0 <= x && x <= x32sml )
    x2 = 0.0;
    x3 = 0.0;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25 ) ...
      + r4_csevl ( x3, bigcs, nbig ) + 0.5;
  elseif ( abs ( x ) <= x2sml )
    x2 = 0.0;
    x3 = 0.0;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25 ) ...
      + r4_csevl ( x3, bigcs, nbig ) + 0.5;
    value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
  elseif ( x <= x3sml )
    x2 = x * x;
    x3 = 0.0;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25 ) ...
      + r4_csevl ( x3, bigcs, nbig ) + 0.5;
    value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
  elseif ( x <= 1.0 )
    x2 = x * x;
    x3 = x * x * x;
    value = x2 * ( r4_csevl ( x3, bifcs, nbif ) + 0.25 ) ...
      + r4_csevl ( x3, bigcs, nbig ) + 0.5;
    value = value * exp ( - 2.0 * x * sqrt ( x ) / 3.0 );
  elseif ( x <= 2.0 )
    z = ( 2.0 * x * x * x - 9.0 ) / 7.0;
    value = exp ( - 2.0 * x * sqrt ( x ) / 3.0 ) ...
      * ( x * x * ( 0.25 + r4_csevl ( z, bif2cs, nbif2 ) ) ...
      + 0.5 + r4_csevl ( z, big2cs, nbig2 ) );
  elseif ( x <= 4.0 )
    sqrtx = sqrt ( x );
    z = atr / ( x * sqrtx ) + btr;
    value = ( 0.625 ...
      + r4_csevl ( z, bip1cs, nbip1 ) ) * sqrt ( sqrtx );
  elseif ( x < xbig )
    sqrtx = sqrt ( x );
    z = 16.0 / ( x * sqrtx ) - 1.0;
    value = ( 0.625 + r4_csevl ( z, bip2cs, nbip2 ) ) ...
      * sqrt ( sqrtx );
  else
    sqrtx = sqrt ( x );
    z = - 1.0;
    value = ( 0.625 + r4_csevl ( z, bip2cs, nbip2 ) ) * sqrt ( sqrtx );
  end

  return
end