relibc_openlibm/slatec/yairy.f

*DECK YAIRY
      SUBROUTINE YAIRY (X, RX, C, BI, DBI)
C***BEGIN PROLOGUE  YAIRY
C***SUBSIDIARY
C***PURPOSE  Subsidiary to BESJ and BESY
C***LIBRARY   SLATEC
C***TYPE      SINGLE PRECISION (YAIRY-S, DYAIRY-D)
C***AUTHOR  Amos, D. E., (SNLA)
C           Daniel, S. L., (SNLA)
C***DESCRIPTION
C
C                  YAIRY computes the Airy function BI(X)
C                   and its derivative DBI(X) for ASYJY
C
C                                     INPUT
C
C         X  - Argument, computed by ASYJY, X unrestricted
C        RX  - RX=SQRT(ABS(X)), computed by ASYJY
C         C  - C=2.*(ABS(X)**1.5)/3., computed by ASYJY
C
C                                    OUTPUT
C        BI  - Value of function BI(X)
C       DBI  - Value of the derivative DBI(X)
C
C***SEE ALSO  BESJ, BESY
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   750101  DATE WRITTEN
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900328  Added TYPE section.  (WRB)
C   910408  Updated the AUTHOR section.  (WRB)
C***END PROLOGUE  YAIRY
C
      INTEGER I, J, M1, M1D, M2, M2D, M3, M3D, M4D, N1, N1D, N2, N2D,
     1 N3, N3D, N4D
      REAL AA, AX, BB, BI, BJN, BJP, BK1, BK2, BK3, BK4, C, CON1, CON2,
     1 CON3, CV, DAA, DBB, DBI, DBJN, DBJP, DBK1, DBK2, DBK3, DBK4, D1,
     2 D2, EX, E1, E2, FPI12, F1, F2, RTRX, RX, SPI12, S1, S2, T, TC,
     3 TEMP1, TEMP2, TT, X
      DIMENSION BK1(20), BK2(20), BK3(20), BK4(14)
      DIMENSION BJP(19), BJN(19), AA(14), BB(14)
      DIMENSION DBK1(21), DBK2(20), DBK3(20), DBK4(14)
      DIMENSION DBJP(19), DBJN(19), DAA(14), DBB(14)
      SAVE N1, N2, N3, M1, M2, M3, N1D, N2D, N3D, N4D,
     1 M1D, M2D, M3D, M4D, FPI12, SPI12, CON1, CON2, CON3,
     2 BK1, BK2, BK3, BK4, BJP, BJN, AA, BB, DBK1, DBK2, DBK3, DBK4,
     3 DBJP, DBJN, DAA, DBB
      DATA N1,N2,N3/20,19,14/
      DATA M1,M2,M3/18,17,12/
      DATA N1D,N2D,N3D,N4D/21,20,19,14/
      DATA M1D,M2D,M3D,M4D/19,18,17,12/
      DATA FPI12,SPI12,CON1,CON2,CON3/
     1 1.30899693899575E+00, 1.83259571459405E+00, 6.66666666666667E-01,
     2 7.74148278841779E+00, 3.64766105490356E-01/
      DATA BK1(1),  BK1(2),  BK1(3),  BK1(4),  BK1(5),  BK1(6),
     1     BK1(7),  BK1(8),  BK1(9),  BK1(10), BK1(11), BK1(12),
     2     BK1(13), BK1(14), BK1(15), BK1(16), BK1(17), BK1(18),
     3     BK1(19), BK1(20)/ 2.43202846447449E+00, 2.57132009754685E+00,
     4 1.02802341258616E+00, 3.41958178205872E-01, 8.41978629889284E-02,
     5 1.93877282587962E-02, 3.92687837130335E-03, 6.83302689948043E-04,
     6 1.14611403991141E-04, 1.74195138337086E-05, 2.41223620956355E-06,
     7 3.24525591983273E-07, 4.03509798540183E-08, 4.70875059642296E-09,
     8 5.35367432585889E-10, 5.70606721846334E-11, 5.80526363709933E-12,
     9 5.76338988616388E-13, 5.42103834518071E-14, 4.91857330301677E-15/
      DATA BK2(1),  BK2(2),  BK2(3),  BK2(4),  BK2(5),  BK2(6),
     1     BK2(7),  BK2(8),  BK2(9),  BK2(10), BK2(11), BK2(12),
     2     BK2(13), BK2(14), BK2(15), BK2(16), BK2(17), BK2(18),
     3     BK2(19), BK2(20)/ 5.74830555784088E-01,-6.91648648376891E-03,
     4 1.97460263052093E-03,-5.24043043868823E-04, 1.22965147239661E-04,
     5-2.27059514462173E-05, 2.23575555008526E-06, 4.15174955023899E-07,
     6-2.84985752198231E-07, 8.50187174775435E-08,-1.70400826891326E-08,
     7 2.25479746746889E-09,-1.09524166577443E-10,-3.41063845099711E-11,
     8 1.11262893886662E-11,-1.75542944241734E-12, 1.36298600401767E-13,
     9 8.76342105755664E-15,-4.64063099157041E-15, 7.78772758732960E-16/
      DATA BK3(1),  BK3(2),  BK3(3),  BK3(4),  BK3(5),  BK3(6),
     1     BK3(7),  BK3(8),  BK3(9),  BK3(10), BK3(11), BK3(12),
     2     BK3(13), BK3(14), BK3(15), BK3(16), BK3(17), BK3(18),
     3     BK3(19), BK3(20)/ 5.66777053506912E-01, 2.63672828349579E-03,
     4 5.12303351473130E-05, 2.10229231564492E-06, 1.42217095113890E-07,
     5 1.28534295891264E-08, 7.28556219407507E-10,-3.45236157301011E-10,
     6-2.11919115912724E-10,-6.56803892922376E-11,-8.14873160315074E-12,
     7 3.03177845632183E-12, 1.73447220554115E-12, 1.67935548701554E-13,
     8-1.49622868806719E-13,-5.15470458953407E-14, 8.75741841857830E-15,
     9 7.96735553525720E-15,-1.29566137861742E-16,-1.11878794417520E-15/
      DATA BK4(1),  BK4(2),  BK4(3),  BK4(4),  BK4(5),  BK4(6),
     1     BK4(7),  BK4(8),  BK4(9),  BK4(10), BK4(11), BK4(12),
     2     BK4(13), BK4(14)/ 4.85444386705114E-01,-3.08525088408463E-03,
     3 6.98748404837928E-05,-2.82757234179768E-06, 1.59553313064138E-07,
     4-1.12980692144601E-08, 9.47671515498754E-10,-9.08301736026423E-11,
     5 9.70776206450724E-12,-1.13687527254574E-12, 1.43982917533415E-13,
     6-1.95211019558815E-14, 2.81056379909357E-15,-4.26916444775176E-16/
      DATA BJP(1),  BJP(2),  BJP(3),  BJP(4),  BJP(5),  BJP(6),
     1     BJP(7),  BJP(8),  BJP(9),  BJP(10), BJP(11), BJP(12),
     2     BJP(13), BJP(14), BJP(15), BJP(16), BJP(17), BJP(18),
     3     BJP(19)         / 1.34918611457638E-01,-3.19314588205813E-01,
     4 5.22061946276114E-02, 5.28869112170312E-02,-8.58100756077350E-03,
     5-2.99211002025555E-03, 4.21126741969759E-04, 8.73931830369273E-05,
     6-1.06749163477533E-05,-1.56575097259349E-06, 1.68051151983999E-07,
     7 1.89901103638691E-08,-1.81374004961922E-09,-1.66339134593739E-10,
     8 1.42956335780810E-11, 1.10179811626595E-12,-8.60187724192263E-14,
     9-5.71248177285064E-15, 4.08414552853803E-16/
      DATA BJN(1),  BJN(2),  BJN(3),  BJN(4),  BJN(5),  BJN(6),
     1     BJN(7),  BJN(8),  BJN(9),  BJN(10), BJN(11), BJN(12),
     2     BJN(13), BJN(14), BJN(15), BJN(16), BJN(17), BJN(18),
     3     BJN(19)         / 6.59041673525697E-02,-4.24905910566004E-01,
     4 2.87209745195830E-01, 1.29787771099606E-01,-4.56354317590358E-02,
     5-1.02630175982540E-02, 2.50704671521101E-03, 3.78127183743483E-04,
     6-7.11287583284084E-05,-8.08651210688923E-06, 1.23879531273285E-06,
     7 1.13096815867279E-07,-1.46234283176310E-08,-1.11576315688077E-09,
     8 1.24846618243897E-10, 8.18334132555274E-12,-8.07174877048484E-13,
     9-4.63778618766425E-14, 4.09043399081631E-15/
      DATA AA(1),   AA(2),   AA(3),   AA(4),   AA(5),   AA(6),
     1     AA(7),   AA(8),   AA(9),   AA(10),  AA(11),  AA(12),
     2     AA(13),  AA(14) /-2.78593552803079E-01, 3.52915691882584E-03,
     3 2.31149677384994E-05,-4.71317842263560E-06, 1.12415907931333E-07,
     4 2.00100301184339E-08,-2.60948075302193E-09, 3.55098136101216E-11,
     5 3.50849978423875E-11,-5.83007187954202E-12, 2.04644828753326E-13,
     6 1.10529179476742E-13,-2.87724778038775E-14, 2.88205111009939E-15/
      DATA BB(1),   BB(2),   BB(3),   BB(4),   BB(5),   BB(6),
     1     BB(7),   BB(8),   BB(9),   BB(10),  BB(11),  BB(12),
     2     BB(13),  BB(14) /-4.90275424742791E-01,-1.57647277946204E-03,
     3 9.66195963140306E-05,-1.35916080268815E-07,-2.98157342654859E-07,
     4 1.86824767559979E-08, 1.03685737667141E-09,-3.28660818434328E-10,
     5 2.57091410632780E-11, 2.32357655300677E-12,-9.57523279048255E-13,
     6 1.20340828049719E-13, 2.90907716770715E-15,-4.55656454580149E-15/
      DATA DBK1(1), DBK1(2), DBK1(3), DBK1(4), DBK1(5), DBK1(6),
     1     DBK1(7), DBK1(8), DBK1(9), DBK1(10),DBK1(11),DBK1(12),
     2     DBK1(13),DBK1(14),DBK1(15),DBK1(16),DBK1(17),DBK1(18),
     3     DBK1(19),DBK1(20),
     4     DBK1(21)        / 2.95926143981893E+00, 3.86774568440103E+00,
     5 1.80441072356289E+00, 5.78070764125328E-01, 1.63011468174708E-01,
     6 3.92044409961855E-02, 7.90964210433812E-03, 1.50640863167338E-03,
     7 2.56651976920042E-04, 3.93826605867715E-05, 5.81097771463818E-06,
     8 7.86881233754659E-07, 9.93272957325739E-08, 1.21424205575107E-08,
     9 1.38528332697707E-09, 1.50190067586758E-10, 1.58271945457594E-11,
     1 1.57531847699042E-12, 1.50774055398181E-13, 1.40594335806564E-14,
     2 1.24942698777218E-15/
      DATA DBK2(1), DBK2(2), DBK2(3), DBK2(4), DBK2(5), DBK2(6),
     1     DBK2(7), DBK2(8), DBK2(9), DBK2(10),DBK2(11),DBK2(12),
     2     DBK2(13),DBK2(14),DBK2(15),DBK2(16),DBK2(17),DBK2(18),
     3    DBK2(19),DBK2(20)/ 5.49756809432471E-01, 9.13556983276901E-03,
     4-2.53635048605507E-03, 6.60423795342054E-04,-1.55217243135416E-04,
     5 3.00090325448633E-05,-3.76454339467348E-06,-1.33291331611616E-07,
     6 2.42587371049013E-07,-8.07861075240228E-08, 1.71092818861193E-08,
     7-2.41087357570599E-09, 1.53910848162371E-10, 2.56465373190630E-11,
     8-9.88581911653212E-12, 1.60877986412631E-12,-1.20952524741739E-13,
     9-1.06978278410820E-14, 5.02478557067561E-15,-8.68986130935886E-16/
      DATA DBK3(1), DBK3(2), DBK3(3), DBK3(4), DBK3(5), DBK3(6),
     1     DBK3(7), DBK3(8), DBK3(9), DBK3(10),DBK3(11),DBK3(12),
     2     DBK3(13),DBK3(14),DBK3(15),DBK3(16),DBK3(17),DBK3(18),
     3    DBK3(19),DBK3(20)/ 5.60598509354302E-01,-3.64870013248135E-03,
     4-5.98147152307417E-05,-2.33611595253625E-06,-1.64571516521436E-07,
     5-2.06333012920569E-08,-4.27745431573110E-09,-1.08494137799276E-09,
     6-2.37207188872763E-10,-2.22132920864966E-11, 1.07238008032138E-11,
     7 5.71954845245808E-12, 7.51102737777835E-13,-3.81912369483793E-13,
     8-1.75870057119257E-13, 6.69641694419084E-15, 2.26866724792055E-14,
     9 2.69898141356743E-15,-2.67133612397359E-15,-6.54121403165269E-16/
      DATA DBK4(1), DBK4(2), DBK4(3), DBK4(4), DBK4(5), DBK4(6),
     1     DBK4(7), DBK4(8), DBK4(9), DBK4(10),DBK4(11),DBK4(12),
     2    DBK4(13),DBK4(14)/ 4.93072999188036E-01, 4.38335419803815E-03,
     3-8.37413882246205E-05, 3.20268810484632E-06,-1.75661979548270E-07,
     4 1.22269906524508E-08,-1.01381314366052E-09, 9.63639784237475E-11,
     5-1.02344993379648E-11, 1.19264576554355E-12,-1.50443899103287E-13,
     6 2.03299052379349E-14,-2.91890652008292E-15, 4.42322081975475E-16/
      DATA DBJP(1), DBJP(2), DBJP(3), DBJP(4), DBJP(5), DBJP(6),
     1     DBJP(7), DBJP(8), DBJP(9), DBJP(10),DBJP(11),DBJP(12),
     2     DBJP(13),DBJP(14),DBJP(15),DBJP(16),DBJP(17),DBJP(18),
     3     DBJP(19)        / 1.13140872390745E-01,-2.08301511416328E-01,
     4 1.69396341953138E-02, 2.90895212478621E-02,-3.41467131311549E-03,
     5-1.46455339197417E-03, 1.63313272898517E-04, 3.91145328922162E-05,
     6-3.96757190808119E-06,-6.51846913772395E-07, 5.98707495269280E-08,
     7 7.44108654536549E-09,-6.21241056522632E-10,-6.18768017313526E-11,
     8 4.72323484752324E-12, 3.91652459802532E-13,-2.74985937845226E-14,
     9-1.95036497762750E-15, 1.26669643809444E-16/
      DATA DBJN(1), DBJN(2), DBJN(3), DBJN(4), DBJN(5), DBJN(6),
     1     DBJN(7), DBJN(8), DBJN(9), DBJN(10),DBJN(11),DBJN(12),
     2     DBJN(13),DBJN(14),DBJN(15),DBJN(16),DBJN(17),DBJN(18),
     3     DBJN(19)        /-1.88091260068850E-02,-1.47798180826140E-01,
     4 5.46075900433171E-01, 1.52146932663116E-01,-9.58260412266886E-02,
     5-1.63102731696130E-02, 5.75364806680105E-03, 7.12145408252655E-04,
     6-1.75452116846724E-04,-1.71063171685128E-05, 3.24435580631680E-06,
     7 2.61190663932884E-07,-4.03026865912779E-08,-2.76435165853895E-09,
     8 3.59687929062312E-10, 2.14953308456051E-11,-2.41849311903901E-12,
     9-1.28068004920751E-13, 1.26939834401773E-14/
      DATA DAA(1),  DAA(2),  DAA(3),  DAA(4),  DAA(5),  DAA(6),
     1     DAA(7),  DAA(8),  DAA(9),  DAA(10), DAA(11), DAA(12),
     2     DAA(13), DAA(14)/ 2.77571356944231E-01,-4.44212833419920E-03,
     3 8.42328522190089E-05, 2.58040318418710E-06,-3.42389720217621E-07,
     4 6.24286894709776E-09, 2.36377836844577E-09,-3.16991042656673E-10,
     5 4.40995691658191E-12, 5.18674221093575E-12,-9.64874015137022E-13,
     6 4.90190576608710E-14, 1.77253430678112E-14,-5.55950610442662E-15/
      DATA DBB(1),  DBB(2),  DBB(3),  DBB(4),  DBB(5),  DBB(6),
     1     DBB(7),  DBB(8),  DBB(9),  DBB(10), DBB(11), DBB(12),
     2     DBB(13), DBB(14)/ 4.91627321104601E-01, 3.11164930427489E-03,
     3 8.23140762854081E-05,-4.61769776172142E-06,-6.13158880534626E-08,
     4 2.87295804656520E-08,-1.81959715372117E-09,-1.44752826642035E-10,
     5 4.53724043420422E-11,-3.99655065847223E-12,-3.24089119830323E-13,
     6 1.62098952568741E-13,-2.40765247974057E-14, 1.69384811284491E-16/
C***FIRST EXECUTABLE STATEMENT  YAIRY
      AX = ABS(X)
      RX = SQRT(AX)
      C = CON1*AX*RX
      IF (X.LT.0.0E0) GO TO 120
      IF (C.GT.8.0E0) GO TO 60
      IF (X.GT.2.5E0) GO TO 30
      T = (X+X-2.5E0)*0.4E0
      TT = T + T
      J = N1
      F1 = BK1(J)
      F2 = 0.0E0
      DO 10 I=1,M1
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + BK1(J)
        F2 = TEMP1
   10 CONTINUE
      BI = T*F1 - F2 + BK1(1)
      J = N1D
      F1 = DBK1(J)
      F2 = 0.0E0
      DO 20 I=1,M1D
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + DBK1(J)
        F2 = TEMP1
   20 CONTINUE
      DBI = T*F1 - F2 + DBK1(1)
      RETURN
   30 CONTINUE
      RTRX = SQRT(RX)
      T = (X+X-CON2)*CON3
      TT = T + T
      J = N1
      F1 = BK2(J)
      F2 = 0.0E0
      DO 40 I=1,M1
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + BK2(J)
        F2 = TEMP1
   40 CONTINUE
      BI = (T*F1-F2+BK2(1))/RTRX
      EX = EXP(C)
      BI = BI*EX
      J = N2D
      F1 = DBK2(J)
      F2 = 0.0E0
      DO 50 I=1,M2D
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + DBK2(J)
        F2 = TEMP1
   50 CONTINUE
      DBI = (T*F1-F2+DBK2(1))*RTRX
      DBI = DBI*EX
      RETURN
C
   60 CONTINUE
      RTRX = SQRT(RX)
      T = 16.0E0/C - 1.0E0
      TT = T + T
      J = N1
      F1 = BK3(J)
      F2 = 0.0E0
      DO 70 I=1,M1
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + BK3(J)
        F2 = TEMP1
   70 CONTINUE
      S1 = T*F1 - F2 + BK3(1)
      J = N2D
      F1 = DBK3(J)
      F2 = 0.0E0
      DO 80 I=1,M2D
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + DBK3(J)
        F2 = TEMP1
   80 CONTINUE
      D1 = T*F1 - F2 + DBK3(1)
      TC = C + C
      EX = EXP(C)
      IF (TC.GT.35.0E0) GO TO 110
      T = 10.0E0/C - 1.0E0
      TT = T + T
      J = N3
      F1 = BK4(J)
      F2 = 0.0E0
      DO 90 I=1,M3
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + BK4(J)
        F2 = TEMP1
   90 CONTINUE
      S2 = T*F1 - F2 + BK4(1)
      BI = (S1+EXP(-TC)*S2)/RTRX
      BI = BI*EX
      J = N4D
      F1 = DBK4(J)
      F2 = 0.0E0
      DO 100 I=1,M4D
        J = J - 1
        TEMP1 = F1
        F1 = TT*F1 - F2 + DBK4(J)
        F2 = TEMP1
  100 CONTINUE
      D2 = T*F1 - F2 + DBK4(1)
      DBI = RTRX*(D1+EXP(-TC)*D2)
      DBI = DBI*EX
      RETURN
  110 BI = EX*S1/RTRX
      DBI = EX*RTRX*D1
      RETURN
C
  120 CONTINUE
      IF (C.GT.5.0E0) GO TO 150
      T = 0.4E0*C - 1.0E0
      TT = T + T
      J = N2
      F1 = BJP(J)
      E1 = BJN(J)
      F2 = 0.0E0
      E2 = 0.0E0
      DO 130 I=1,M2
        J = J - 1
        TEMP1 = F1
        TEMP2 = E1
        F1 = TT*F1 - F2 + BJP(J)
        E1 = TT*E1 - E2 + BJN(J)
        F2 = TEMP1
        E2 = TEMP2
  130 CONTINUE
      BI = (T*E1-E2+BJN(1)) - AX*(T*F1-F2+BJP(1))
      J = N3D
      F1 = DBJP(J)
      E1 = DBJN(J)
      F2 = 0.0E0
      E2 = 0.0E0
      DO 140 I=1,M3D
        J = J - 1
        TEMP1 = F1
        TEMP2 = E1
        F1 = TT*F1 - F2 + DBJP(J)
        E1 = TT*E1 - E2 + DBJN(J)
        F2 = TEMP1
        E2 = TEMP2
  140 CONTINUE
      DBI = X*X*(T*F1-F2+DBJP(1)) + (T*E1-E2+DBJN(1))
      RETURN
C
  150 CONTINUE
      RTRX = SQRT(RX)
      T = 10.0E0/C - 1.0E0
      TT = T + T
      J = N3
      F1 = AA(J)
      E1 = BB(J)
      F2 = 0.0E0
      E2 = 0.0E0
      DO 160 I=1,M3
        J = J - 1
        TEMP1 = F1
        TEMP2 = E1
        F1 = TT*F1 - F2 + AA(J)
        E1 = TT*E1 - E2 + BB(J)
        F2 = TEMP1
        E2 = TEMP2
  160 CONTINUE
      TEMP1 = T*F1 - F2 + AA(1)
      TEMP2 = T*E1 - E2 + BB(1)
      CV = C - FPI12
      BI = (TEMP1*COS(CV)+TEMP2*SIN(CV))/RTRX
      J = N4D
      F1 = DAA(J)
      E1 = DBB(J)
      F2 = 0.0E0
      E2 = 0.0E0
      DO 170 I=1,M4D
        J = J - 1
        TEMP1 = F1
        TEMP2 = E1
        F1 = TT*F1 - F2 + DAA(J)
        E1 = TT*E1 - E2 + DBB(J)
        F2 = TEMP1
        E2 = TEMP2
  170 CONTINUE
      TEMP1 = T*F1 - F2 + DAA(1)
      TEMP2 = T*E1 - E2 + DBB(1)
      CV = C - SPI12
      DBI = (TEMP1*COS(CV)-TEMP2*SIN(CV))*RTRX
      RETURN
      END