mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
393 lines
16 KiB
Fortran
393 lines
16 KiB
Fortran
*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
|