* * $Id: besj064.F,v 1.1.1.1 1996/04/01 15:01:59 mclareni Exp $ * * $Log: besj064.F,v $ * Revision 1.1.1.1 1996/04/01 15:01:59 mclareni * Mathlib gen * * #include "gen/pilot.h" #if !defined(CERNLIB_DOUBLE) FUNCTION BESJ0(X) #endif #if defined(CERNLIB_DOUBLE) FUNCTION DBESJ0(X) #include "gen/imp64.inc" #endif #include "gen/defc64.inc" + C,F,I,CB0,CB1,CB2 CHARACTER NAME0*(*),NAME1*(*) CHARACTER*80 ERRTXT LOGICAL LJ0,LY0,LJ1,LY1 DIMENSION A(0:16),B(0:16),C(0:19),D(0:16),E(0:16),F(0:19) #if !defined(CERNLIB_DOUBLE) PARAMETER (NAME0 = 'BESY0', NAME1 = 'BESY1') #endif #if defined(CERNLIB_DOUBLE) PARAMETER (NAME0 = 'BESY0/DBESY0', NAME1 = 'BESY1/DBESY1') #endif PARAMETER (I = (0,1)) PARAMETER (Z1 = 1, HF = Z1/2, R8 = Z1/8, R32 = Z1/32) PARAMETER (CE = 0.57721 56649 01532 861D0) PARAMETER (PI = 3.14159 26535 89793 238D0) PARAMETER (PI1 = 2/PI, PI3 = 3*PI/4, PI4 = PI/4) DATA A( 0) /+0.15772 79714 74890 120D0/ DATA A( 1) /-0.00872 34423 52852 221D0/ DATA A( 2) /+0.26517 86132 03336 810D0/ DATA A( 3) /-0.37009 49938 72649 779D0/ DATA A( 4) /+0.15806 71023 32097 261D0/ DATA A( 5) /-0.03489 37694 11408 885D0/ DATA A( 6) /+0.00481 91800 69467 605D0/ DATA A( 7) /-0.00046 06261 66206 275D0/ DATA A( 8) /+0.00003 24603 28821 005D0/ DATA A( 9) /-0.00000 17619 46907 762D0/ DATA A(10) /+0.00000 00760 81635 924D0/ DATA A(11) /-0.00000 00026 79253 531D0/ DATA A(12) /+0.00000 00000 78486 963D0/ DATA A(13) /-0.00000 00000 01943 835D0/ DATA A(14) /+0.00000 00000 00041 253D0/ DATA A(15) /-0.00000 00000 00000 759D0/ DATA A(16) /+0.00000 00000 00000 012D0/ DATA B( 0) /-0.02150 51114 49657 551D0/ DATA B( 1) /-0.27511 81330 43518 791D0/ DATA B( 2) /+0.19860 56347 02554 156D0/ DATA B( 3) /+0.23425 27461 09021 802D0/ DATA B( 4) /-0.16563 59817 13650 413D0/ DATA B( 5) /+0.04462 13795 40669 282D0/ DATA B( 6) /-0.00693 22862 91523 188D0/ DATA B( 7) /+0.00071 91174 03752 303D0/ DATA B( 8) /-0.00005 39250 79722 939D0/ DATA B( 9) /+0.00000 30764 93288 108D0/ DATA B(10) /-0.00000 01384 57181 230D0/ DATA B(11) /+0.00000 00050 51054 369D0/ DATA B(12) /-0.00000 00001 52582 850D0/ DATA B(13) /+0.00000 00000 03882 867D0/ DATA B(14) /-0.00000 00000 00084 429D0/ DATA B(15) /+0.00000 00000 00001 587D0/ DATA B(16) /-0.00000 00000 00000 026D0/ #if defined(CERNLIB_DOUBLE) DATA + C( 0)/ (+0.99898 80898 58965 153D0, -0.01233 15205 78544 144D0)/, 1 C( 1)/ (-0.00133 84285 49971 856D0, -0.01224 94962 81259 475D0)/, 2 C( 2)/ (-0.00031 87898 78061 893D0, +0.00009 64941 84993 423D0)/, 3 C( 3)/ (+0.00000 85112 32210 657D0, +0.00001 36555 70490 357D0)/, 4 C( 4)/ (+0.00000 06915 42349 139D0, -0.00000 08518 06644 426D0)/, 5 C( 5)/ (-0.00000 00907 70101 537D0, -0.00000 00272 44053 414D0)/, 6 C( 6)/ (+0.00000 00014 54928 079D0, +0.00000 00096 46421 338D0)/, 7 C( 7)/ (+0.00000 00009 26762 487D0, -0.00000 00006 83347 518D0)/, 8 C( 8)/ (-0.00000 00001 39166 198D0, -0.00000 00000 60627 380D0)/, 9 C( 9)/ (+0.00000 00000 03237 975D0, +0.00000 00000 21695 716D0)/, * C(10)/ (+0.00000 00000 02535 357D0, -0.00000 00000 02304 899D0)/ DATA A C(11)/ (-0.00000 00000 00559 090D0, -0.00000 00000 00122 554D0)/, B C(12)/ (+0.00000 00000 00041 919D0, +0.00000 00000 00092 314D0)/, C C(13)/ (+0.00000 00000 00008 733D0, -0.00000 00000 00016 778D0)/, D C(14)/ (-0.00000 00000 00003 619D0, +0.00000 00000 00000 754D0)/, E C(15)/ (+0.00000 00000 00000 594D0, +0.00000 00000 00000 462D0)/, F C(16)/ (-0.00000 00000 00000 010D0, -0.00000 00000 00000 159D0)/, G C(17)/ (-0.00000 00000 00000 024D0, +0.00000 00000 00000 025D0)/, H C(18)/ (+0.00000 00000 00000 008D0, +0.00000 00000 00000 000D0)/, I C(19)/ (-0.00000 00000 00000 001D0, -0.00000 00000 00000 001D0)/ #endif #if !defined(CERNLIB_DOUBLE) DATA + C( 0)/ (+0.99898 80898 58965 153E0, -0.01233 15205 78544 144E0)/, 1 C( 1)/ (-0.00133 84285 49971 856E0, -0.01224 94962 81259 475E0)/, 2 C( 2)/ (-0.00031 87898 78061 893E0, +0.00009 64941 84993 423E0)/, 3 C( 3)/ (+0.00000 85112 32210 657E0, +0.00001 36555 70490 357E0)/, 4 C( 4)/ (+0.00000 06915 42349 139E0, -0.00000 08518 06644 426E0)/, 5 C( 5)/ (-0.00000 00907 70101 537E0, -0.00000 00272 44053 414E0)/, 6 C( 6)/ (+0.00000 00014 54928 079E0, +0.00000 00096 46421 338E0)/, 7 C( 7)/ (+0.00000 00009 26762 487E0, -0.00000 00006 83347 518E0)/, 8 C( 8)/ (-0.00000 00001 39166 198E0, -0.00000 00000 60627 380E0)/, 9 C( 9)/ (+0.00000 00000 03237 975E0, +0.00000 00000 21695 716E0)/, * C(10)/ (+0.00000 00000 02535 357E0, -0.00000 00000 02304 899E0)/ DATA A C(11)/ (-0.00000 00000 00559 090E0, -0.00000 00000 00122 554E0)/, B C(12)/ (+0.00000 00000 00041 919E0, +0.00000 00000 00092 314E0)/, C C(13)/ (+0.00000 00000 00008 733E0, -0.00000 00000 00016 778E0)/, D C(14)/ (-0.00000 00000 00003 619E0, +0.00000 00000 00000 754E0)/, E C(15)/ (+0.00000 00000 00000 594E0, +0.00000 00000 00000 462E0)/, F C(16)/ (-0.00000 00000 00000 010E0, -0.00000 00000 00000 159E0)/, G C(17)/ (-0.00000 00000 00000 024E0, +0.00000 00000 00000 025E0)/, H C(18)/ (+0.00000 00000 00000 008E0, +0.00000 00000 00000 000E0)/, I C(19)/ (-0.00000 00000 00000 001E0, -0.00000 00000 00000 001E0)/ #endif DATA D( 0) /+0.64835 87706 05264 921D0/ DATA D( 1) /-1.19180 11605 41216 873D0/ DATA D( 2) /+1.28799 40988 57677 620D0/ DATA D( 3) /-0.66144 39341 34543 253D0/ DATA D( 4) /+0.17770 91172 39728 283D0/ DATA D( 5) /-0.02917 55248 06154 208D0/ DATA D( 6) /+0.00324 02701 82683 857D0/ DATA D( 7) /-0.00026 04443 89348 581D0/ DATA D( 8) /+0.00001 58870 19239 932D0/ DATA D( 9) /-0.00000 07617 58780 540D0/ DATA D(10) /+0.00000 00294 97070 073D0/ DATA D(11) /-0.00000 00009 42421 298D0/ DATA D(12) /+0.00000 00000 25281 237D0/ DATA D(13) /-0.00000 00000 00577 740D0/ DATA D(14) /+0.00000 00000 00011 386D0/ DATA D(15) /-0.00000 00000 00000 196D0/ DATA D(16) /+0.00000 00000 00000 003D0/ DATA E( 0) /-0.04017 29465 44414 076D0/ DATA E( 1) /-0.44444 71476 30558 063D0/ DATA E( 2) /-0.02271 92444 28417 736D0/ DATA E( 3) /+0.20664 45410 17490 520D0/ DATA E( 4) /-0.08667 16970 56948 524D0/ DATA E( 5) /+0.01763 67030 03163 134D0/ DATA E( 6) /-0.00223 56192 94485 095D0/ DATA E( 7) /+0.00019 70623 02701 541D0/ DATA E( 8) /-0.00001 28858 53299 241D0/ DATA E( 9) /+0.00000 06528 47952 359D0/ DATA E(10) /-0.00000 00264 50737 175D0/ DATA E(11) /+0.00000 00008 78030 117D0/ DATA E(12) /-0.00000 00000 24343 279D0/ DATA E(13) /+0.00000 00000 00572 612D0/ DATA E(14) /-0.00000 00000 00011 578D0/ DATA E(15) /+0.00000 00000 00000 203D0/ DATA E(16) /-0.00000 00000 00000 003D0/ #if defined(CERNLIB_DOUBLE) DATA + F( 0)/ (+1.00170 22348 53820 996D0, +0.03726 17150 00537 654D0)/, 1 F( 1)/ (+0.00225 55728 46561 180D0, +0.03714 53224 79807 690D0)/, 2 F( 2)/ (+0.00054 32164 87508 013D0, -0.00013 72632 38201 907D0)/, 3 F( 3)/ (-0.00001 11794 61895 408D0, -0.00001 98512 94687 597D0)/, 4 F( 4)/ (-0.00000 09469 01382 392D0, +0.00000 10700 14057 386D0)/, 5 F( 5)/ (+0.00000 01110 32677 121D0, +0.00000 00383 05261 714D0)/, 6 F( 6)/ (-0.00000 00012 94398 927D0, -0.00000 00116 28723 277D0)/, 7 F( 7)/ (-0.00000 00011 14905 944D0, +0.00000 00007 59733 092D0)/, 8 F( 8)/ (+0.00000 00001 57637 232D0, +0.00000 00000 75476 075D0)/, 9 F( 9)/ (-0.00000 00000 02830 457D0, -0.00000 00000 24752 781D0)/ DATA * F(10)/ (-0.00000 00000 02932 169D0, +0.00000 00000 02493 893D0)/, A F(11)/ (+0.00000 00000 00617 809D0, +0.00000 00000 00156 198D0)/, B F(12)/ (-0.00000 00000 00043 162D0, -0.00000 00000 00103 385D0)/, C F(13)/ (-0.00000 00000 00010 133D0, +0.00000 00000 00018 129D0)/, D F(14)/ (+0.00000 00000 00003 973D0, -0.00000 00000 00000 709D0)/, E F(15)/ (-0.00000 00000 00000 632D0, -0.00000 00000 00000 520D0)/, F F(16)/ (+0.00000 00000 00000 006D0, +0.00000 00000 00000 172D0)/, G F(17)/ (+0.00000 00000 00000 027D0, -0.00000 00000 00000 026D0)/, H F(18)/ (-0.00000 00000 00000 008D0, -0.00000 00000 00000 000D0)/, I F(19)/ (+0.00000 00000 00000 001D0, +0.00000 00000 00000 001D0)/ #endif #if !defined(CERNLIB_DOUBLE) DATA + F( 0)/ (+1.00170 22348 53820 996E0, +0.03726 17150 00537 654E0)/, 1 F( 1)/ (+0.00225 55728 46561 180E0, +0.03714 53224 79807 690E0)/, 2 F( 2)/ (+0.00054 32164 87508 013E0, -0.00013 72632 38201 907E0)/, 3 F( 3)/ (-0.00001 11794 61895 408E0, -0.00001 98512 94687 597E0)/, 4 F( 4)/ (-0.00000 09469 01382 392E0, +0.00000 10700 14057 386E0)/, 5 F( 5)/ (+0.00000 01110 32677 121E0, +0.00000 00383 05261 714E0)/, 6 F( 6)/ (-0.00000 00012 94398 927E0, -0.00000 00116 28723 277E0)/, 7 F( 7)/ (-0.00000 00011 14905 944E0, +0.00000 00007 59733 092E0)/, 8 F( 8)/ (+0.00000 00001 57637 232E0, +0.00000 00000 75476 075E0)/, 9 F( 9)/ (-0.00000 00000 02830 457E0, -0.00000 00000 24752 781E0)/ DATA * F(10)/ (-0.00000 00000 02932 169E0, +0.00000 00000 02493 893E0)/, A F(11)/ (+0.00000 00000 00617 809E0, +0.00000 00000 00156 198E0)/, B F(12)/ (-0.00000 00000 00043 162E0, -0.00000 00000 00103 385E0)/, C F(13)/ (-0.00000 00000 00010 133E0, +0.00000 00000 00018 129E0)/, D F(14)/ (+0.00000 00000 00003 973E0, -0.00000 00000 00000 709E0)/, E F(15)/ (-0.00000 00000 00000 632E0, -0.00000 00000 00000 520E0)/, F F(16)/ (+0.00000 00000 00000 006E0, +0.00000 00000 00000 172E0)/, G F(17)/ (+0.00000 00000 00000 027E0, -0.00000 00000 00000 026E0)/, H F(18)/ (-0.00000 00000 00000 008E0, -0.00000 00000 00000 000E0)/, I F(19)/ (+0.00000 00000 00000 001E0, +0.00000 00000 00000 001E0)/ #endif LJ0=.TRUE. LY0=.FALSE. GO TO 11 #if !defined(CERNLIB_DOUBLE) ENTRY BESY0(X) #endif #if defined(CERNLIB_DOUBLE) ENTRY DBESY0(X) #endif LJ0=.FALSE. LY0=.TRUE. IF(X .LE. 0) THEN P=0 WRITE(ERRTXT,101) X CALL MTLPRT(NAME0,'C312.1',ERRTXT) GO TO 9 END IF 11 V=ABS(X) IF(V .LT. 8) THEN H=R32*V**2-1 ALFA=H+H B1=0 B2=0 DO 1 IT = 16,0,-1 B0=A(IT)+ALFA*B1-B2 B2=B1 1 B1=B0 P=B0-H*B2 IF(LY0) THEN B1=0 B2=0 DO 2 IT = 16,0,-1 B0=B(IT)+ALFA*B1-B2 B2=B1 2 B1=B0 P=PI1*(CE+LOG(HF*X))*P+B0-H*B2 ENDIF ELSE R=1/V H=10*R-1 ALFA=H+H CB1=0 CB2=0 DO 3 IT = 19,0,-1 CB0=C(IT)+ALFA*CB1-CB2 CB2=CB1 3 CB1=CB0 CB0=SQRT(PI1*R)*EXP(I*(V-PI4))*(CB0-H*CB2) IF(LJ0) P=CB0 IF(LY0) P=-I*CB0 ENDIF GO TO 9 #if !defined(CERNLIB_DOUBLE) ENTRY BESJ1(X) #endif #if defined(CERNLIB_DOUBLE) ENTRY DBESJ1(X) #endif LJ1=.TRUE. LY1=.FALSE. GO TO 12 #if !defined(CERNLIB_DOUBLE) ENTRY BESY1(X) #endif #if defined(CERNLIB_DOUBLE) ENTRY DBESY1(X) #endif LJ1=.FALSE. LY1=.TRUE. IF(X .LE. 0) THEN P=0 WRITE(ERRTXT,101) X CALL MTLPRT(NAME1,'C312.1',ERRTXT) GO TO 9 END IF 12 V=ABS(X) IF(V .LT. 8) THEN Y=R8*V H=2*Y**2-1 ALFA=H+H B1=0 B2=0 DO 4 IT = 16,0,-1 B0=D(IT)+ALFA*B1-B2 B2=B1 4 B1=B0 P=Y*(B0-H*B2) IF(LY1) THEN B1=0 B2=0 DO 5 IT = 16,0,-1 B0=E(IT)+ALFA*B1-B2 B2=B1 5 B1=B0 P=PI1*((CE+LOG(HF*X))*P-1/X)+Y*(B0-B2) ENDIF ELSE R=1/V H=10*R-1 ALFA=H+H CB1=0 CB2=0 DO 6 IT = 19,0,-1 CB0=F(IT)+ALFA*CB1-CB2 CB2=CB1 6 CB1=CB0 CB0=SQRT(PI1*R)*EXP(I*(V-PI3))*(CB0-H*CB2) IF(LJ1) P=CB0 IF(LY1) P=-I*CB0 ENDIF IF(X .LT. 0) P=-P 9 CONTINUE #if !defined(CERNLIB_DOUBLE) BESJ0=P #endif #if defined(CERNLIB_DOUBLE) DBESJ0=P #endif RETURN 101 FORMAT('NON-POSITIVE ARGUMENT X = ',1P,E15.6) END