[u/mrichter/AliRoot.git] / HERWIG / jimmy / cernmisc / jmdbsir3.F

*
* $Id$
*
* $Log$
* Revision 1.1  2005/07/29 16:15:46  jmb
* Include the various CERNLIB functions jimmy needs
*
* Revision 1.1.1.1  1996/04/01 15:02:07  mclareni
* Mathlib gen
*
*
      FUNCTION JMDBSIR3(X,NU)
      IMPLICIT DOUBLE PRECISION (A-H,J,O-Z)
      SAVE
      CHARACTER*80 ERRTXT
      CHARACTER NAMEI*(*),NAMEK*(*),NAMEIE*(*),NAMEKE*(*)
      PARAMETER (NAMEI = 'JMBSIR3/JMDBSIR3', NAMEIE =
     $     'JMEBSIR3/JMDEBIR3')
      PARAMETER(NAMEK = 'JMBSKR3/DBSKR3', NAMEKE = 'JMEBSKR3/JMDEBKR3')

      LOGICAL LEX

      DIMENSION BC(0:23,2),CC(0:15,2),PP(-2:2),GG(-2:2)

      PARAMETER (EPS = 1D-15)
      PARAMETER (Z1 = 1, HF = Z1/2)
      PARAMETER (PI = 3.14159 26535 89793 24D0)
      PARAMETER (W3 = 1.73205 08075 68877 29D0)
      PARAMETER (G1 = 2.67893 85347 07747 63D0)
      PARAMETER (G2 = 1.35411 79394 26400 42D0)
      PARAMETER (PIH = PI/2, RPIH = 2/PI, RPI2 = 1/(2*PI))
      PARAMETER (C1 = 2*PI/(3*W3))
      PARAMETER (GM = 3*(1/G2-3/G1)/2, GP = (3/G1+1/G2)/2)

      DATA PP(-2) /-0.66666 66666 66666 67D0/
      DATA PP(-1) /-0.33333 33333 33333 33D0/
      DATA PP( 1) / 0.33333 33333 33333 33D0/
      DATA PP( 2) / 0.66666 66666 66666 67D0/

      DATA GG(-2) / 0.37328 21739 07395 23D0/
      DATA GG(-1) / 0.73848 81116 21648 31D0/
      DATA GG( 1) / 1.11984 65217 22185 68D0/
      DATA GG( 2) / 1.10773 21674 32472 47D0/

      DATA BC( 0,1) / 1.00458 61710 93207 35D0/
      DATA BC( 1,1) / 0.00467 34791 99873 60D0/
      DATA BC( 2,1) / 0.00009 08034 04815 04D0/
      DATA BC( 3,1) / 0.00000 37262 16110 59D0/
      DATA BC( 4,1) / 0.00000 02520 73237 90D0/
      DATA BC( 5,1) / 0.00000 00227 82110 77D0/
      DATA BC( 6,1) / 0.00000 00012 91332 28D0/
      DATA BC( 7,1) /-0.00000 00006 11915 16D0/
      DATA BC( 8,1) /-0.00000 00003 75616 85D0/
      DATA BC( 9,1) /-0.00000 00001 16415 46D0/
      DATA BC(10,1) /-0.00000 00000 14443 25D0/
      DATA BC(11,1) / 0.00000 00000 05373 69D0/
      DATA BC(12,1) / 0.00000 00000 03074 27D0/
      DATA BC(13,1) / 0.00000 00000 00297 66D0/
      DATA BC(14,1) /-0.00000 00000 00265 20D0/
      DATA BC(15,1) /-0.00000 00000 00091 37D0/
      DATA BC(16,1) / 0.00000 00000 00015 52D0/
      DATA BC(17,1) / 0.00000 00000 00014 12D0/
      DATA BC(18,1) /-0.00000 00000 00000 23D0/
      DATA BC(19,1) /-0.00000 00000 00001 98D0/
      DATA BC(20,1) /-0.00000 00000 00000 13D0/
      DATA BC(21,1) / 0.00000 00000 00000 29D0/
      DATA BC(22,1) / 0.00000 00000 00000 03D0/
      DATA BC(23,1) /-0.00000 00000 00000 05D0/

      DATA BC( 0,2) / 0.99363 49867 16925 14D0/
      DATA BC( 1,2) /-0.00646 71526 00616 03D0/
      DATA BC( 2,2) /-0.00010 60188 22351 55D0/
      DATA BC( 3,2) /-0.00000 41406 57716 24D0/
      DATA BC( 4,2) /-0.00000 02916 95418 21D0/
      DATA BC( 5,2) /-0.00000 00365 71574 33D0/
      DATA BC( 6,2) /-0.00000 00075 81590 37D0/
      DATA BC( 7,2) /-0.00000 00019 23008 52D0/
      DATA BC( 8,2) /-0.00000 00004 20438 80D0/
      DATA BC( 9,2) /-0.00000 00000 39372 04D0/
      DATA BC(10,2) / 0.00000 00000 19007 44D0/
      DATA BC(11,2) / 0.00000 00000 10137 64D0/
      DATA BC(12,2) / 0.00000 00000 01331 30D0/
      DATA BC(13,2) /-0.00000 00000 00676 92D0/
      DATA BC(14,2) /-0.00000 00000 00311 72D0/
      DATA BC(15,2) / 0.00000 00000 00011 87D0/
      DATA BC(16,2) / 0.00000 00000 00040 21D0/
      DATA BC(17,2) / 0.00000 00000 00004 78D0/
      DATA BC(18,2) /-0.00000 00000 00004 74D0/
      DATA BC(19,2) /-0.00000 00000 00001 16D0/
      DATA BC(20,2) / 0.00000 00000 00000 59D0/
      DATA BC(21,2) / 0.00000 00000 00000 21D0/
      DATA BC(22,2) /-0.00000 00000 00000 08D0/
      DATA BC(23,2) /-0.00000 00000 00000 03D0/

      DATA CC( 0,1) / 0.99353 64122 76093 39D0/
      DATA CC( 1,1) /-0.00631 44392 60798 63D0/
      DATA CC( 2,1) / 0.00014 30095 80961 13D0/
      DATA CC( 3,1) /-0.00000 57870 60592 03D0/
      DATA CC( 4,1) / 0.00000 03265 50333 20D0/
      DATA CC( 5,1) /-0.00000 00231 23231 95D0/
      DATA CC( 6,1) / 0.00000 00019 39555 14D0/
      DATA CC( 7,1) /-0.00000 00001 85897 89D0/
      DATA CC( 8,1) / 0.00000 00000 19868 42D0/
      DATA CC( 9,1) /-0.00000 00000 02326 79D0/
      DATA CC(10,1) / 0.00000 00000 00294 68D0/
      DATA CC(11,1) /-0.00000 00000 00039 95D0/
      DATA CC(12,1) / 0.00000 00000 00005 75D0/
      DATA CC(13,1) /-0.00000 00000 00000 87D0/
      DATA CC(14,1) / 0.00000 00000 00000 14D0/
      DATA CC(15,1) /-0.00000 00000 00000 02D0/

      DATA CC( 0,2) / 1.00914 95380 72789 40D0/
      DATA CC( 1,2) / 0.00897 12068 42483 60D0/
      DATA CC( 2,2) /-0.00017 13895 98261 54D0/
      DATA CC( 3,2) / 0.00000 65547 92549 82D0/
      DATA CC( 4,2) /-0.00000 03595 19190 49D0/
      DATA CC( 5,2) / 0.00000 00250 24412 19D0/
      DATA CC( 6,2) /-0.00000 00020 74924 13D0/
      DATA CC( 7,2) / 0.00000 00001 97223 67D0/
      DATA CC( 8,2) /-0.00000 00000 20946 47D0/
      DATA CC( 9,2) / 0.00000 00000 02440 93D0/
      DATA CC(10,2) /-0.00000 00000 00307 91D0/
      DATA CC(11,2) / 0.00000 00000 00041 61D0/
      DATA CC(12,2) /-0.00000 00000 00005 97D0/
      DATA CC(13,2) / 0.00000 00000 00000 91D0/
      DATA CC(14,2) /-0.00000 00000 00000 14D0/
      DATA CC(15,2) / 0.00000 00000 00000 02D0/

      LEX=.FALSE.
      GO TO 8

      ENTRY JMDEBIR3(X,NU)

      LEX=.TRUE.

    8 MU=ABS(NU)
      IF(MU .NE. 1 .AND. MU .NE. 2 .OR. NU .LT. 0 .AND. X .LE. 0
     1   .OR. NU .GT. 0 .AND. X .LT. 0) THEN
       S=0
       WRITE(ERRTXT,101) X,NU
       IF(.NOT.LEX) CALL JMMLPT(NAMEI ,'C340.1',ERRTXT)
       IF(     LEX) CALL JMMLPT(NAMEIE,'C340.1',ERRTXT)
      ELSEIF(X .EQ. 0) THEN
       S=0
      ELSEIF(X .LT. 8) THEN
       Y=(HF*X)**2
       XN=PP(NU)
       XL=XN+2
       A0=1
       A1=1+2*Y/((XL+1)*(XN+1))
       A2=1+Y*(4+3*Y/((XL+2)*(XN+2)))/((XL+3)*(XN+1))
       B0=1
       B1=1-Y/(XL+1)
       B2=1-Y*(1-Y/(2*(XL+2)))/(XL+3)
       T1=3+XL
       V1=3-XL
       V3=XL-1
       V2=V3+V3
       C=0
       DO 33 N = 3,30
       C0=C
       T1=T1+2
       T2=T1-1
       T3=T2-1
       T4=T3-1
       T5=T4-1
       T6=T5-1
       V1=V1+1
       V2=V2+1
       V3=V3+1
       U1=N*T4
       E=V3/(U1*T3)
       U2=E*Y
       F1=1+Y*V1/(U1*T1)
       F2=(1+Y*V2/(V3*T2*T5))*U2
       F3=-Y*Y*U2/(T4*T5*T5*T6)
       A=F1*A2+F2*A1+F3*A0
       B=F1*B2+F2*B1+F3*B0
       C=A/B
       IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 34
       A0=A1
       A1=A2
       A2=A
       B0=B1
       B1=B2
       B2=B
   33  CONTINUE
   34  S=GG(NU)*(HF*X)**PP(NU)*C
       IF(LEX) S=EXP(-X)*S
      ELSE
       R=1/X
       W=SQRT(RPI2*R)
       H=16*R-1
       ALFA=H+H
       B1=0
       B2=0
       DO 2 I = 23,0,-1
       B0=BC(I,MU)+ALFA*B1-B2
       B2=B1
    2  B1=B0
       S=W*(B0-H*B2)
       IF(.NOT.LEX) S=EXP(X)*S
       T=0
       IF(NU .LT. 0) THEN
        H=10*R-1
        ALFA=H+H
        B1=0
        B2=0
        DO 3 I = 15,0,-1
        B0=CC(I,MU)+ALFA*B1-B2
        B2=B1
    3   B1=B0
        R=EXP(-X)
        T=W3*W*R*(B0-H*B2)
        IF(LEX) T=R*T
       END IF
       S=S+T
      END IF
      GO TO 99

      ENTRY JMDBSKR3(X,NU)

      LEX=.FALSE.
      GO TO 9

      ENTRY JMDEBKR3(X,NU)

      LEX=.TRUE.

    9 MU=ABS(NU)
      IF(MU .NE. 1 .AND. MU .NE. 2 .OR. X .LE. 0) THEN
       S=0
       WRITE(ERRTXT,101) X,NU
       IF(.NOT.LEX) CALL JMMLPT(NAMEK ,'C340.1',ERRTXT)
       IF(     LEX) CALL JMMLPT(NAMEKE,'C340.1',ERRTXT)
      ELSEIF(X .LE. 1) THEN
       A0=PP(-1)
       B=HF*X
       D=-LOG(B)
       F=A0*D
       E=EXP(F)
       G=(GM*A0+GP)*E
       BK=C1*(HF*GM*(E+1/E)+GP*D*SINH(F)/F)
       F=BK
       E=A0**2
       P=HF*C1*G
       Q=HF/G
       C=1
       D=B**2
       BK1=P
       DO 11 N = 1,15
       FN=N
       F=(FN*F+P+Q)/(FN**2-E)
       C=C*D/FN
       P=P/(FN-A0)
       Q=Q/(FN+A0)
       G=C*(P-FN*F)
       H=C*F
       BK=BK+H
       BK1=BK1+G
       IF(H*BK1+ABS(G)*BK .LE. EPS*BK*BK1) GO TO 12
   11  CONTINUE
   12  S=BK
       IF(MU .EQ. 2) S=BK1/B
       IF(LEX) S=EXP(X)*S
      ELSEIF(X .LE. 5) THEN
       XN=4*PP(MU)**2
       A=9-XN
       B=25-XN
       C=768*X**2
       C0=48*X
       A0=1
       A1=(16*X+7+XN)/A
       A2=(C+C0*(XN+23)+XN*(XN+62)+129)/(A*B)
       B0=1
       B1=(16*X+9-XN)/A
       B2=(C+C0*B)/(A*B)+1
       C=0
       DO 24 N = 3,30
       C0=C
       FN=N
       FN2=FN+FN
       FN1=FN2-1
       FN3=FN1/(FN2-3)
       FN4=12*FN**2-(1-XN)
       FN5=16*FN1*X
       RAN=1/((FN2+1)**2-XN)
       F1=FN3*(FN4-20*FN)+FN5
       F2=28*FN-FN4-8+FN5
       F3=FN3*((FN2-5)**2-XN)
       A=(F1*A2+F2*A1+F3*A0)*RAN
       B=(F1*B2+F2*B1+F3*B0)*RAN
       C=A/B
       IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 25
       A0=A1
       A1=A2
       A2=A
       B0=B1
       B1=B2
       B2=B
   24  CONTINUE
   25  S=C/SQRT(RPIH*X)
       IF(.NOT.LEX) S=EXP(-X)*S
      ELSE
       R=1/X
       H=10*R-1
       ALFA=H+H
       B1=0
       B2=0
       DO 13 I = 15,0,-1
       B0=CC(I,MU)+ALFA*B1-B2
       B2=B1
   13  B1=B0
       S=SQRT(PIH*R)*(B0-H*B2)
       IF(.NOT.LEX) S=EXP(-X)*S
      END IF

   99 JMDBSIR3=S

      RETURN
  101 FORMAT('INCORRECT ARGUMENT OR INDEX, X = ',1P,E15.6,' NU = ',I5)
      END
Commit	Line	Data
ef94df36	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1 2005/07/29 16:15:46 jmb
	6	* Include the various CERNLIB functions jimmy needs
	7	*
	8	* Revision 1.1.1.1 1996/04/01 15:02:07 mclareni
	9	* Mathlib gen
	10	*
	11	*
	12	FUNCTION JMDBSIR3(X,NU)
	13	IMPLICIT DOUBLE PRECISION (A-H,J,O-Z)
	14	SAVE
	15	CHARACTER*80 ERRTXT
	16	CHARACTER NAMEI(),NAMEK(),NAMEIE(),NAMEKE()
	17	PARAMETER (NAMEI = 'JMBSIR3/JMDBSIR3', NAMEIE =
	18	$ 'JMEBSIR3/JMDEBIR3')
	19	PARAMETER(NAMEK = 'JMBSKR3/DBSKR3', NAMEKE = 'JMEBSKR3/JMDEBKR3')
	20
	21	LOGICAL LEX
	22
	23	DIMENSION BC(0:23,2),CC(0:15,2),PP(-2:2),GG(-2:2)
	24
	25	PARAMETER (EPS = 1D-15)
	26	PARAMETER (Z1 = 1, HF = Z1/2)
	27	PARAMETER (PI = 3.14159 26535 89793 24D0)
	28	PARAMETER (W3 = 1.73205 08075 68877 29D0)
	29	PARAMETER (G1 = 2.67893 85347 07747 63D0)
	30	PARAMETER (G2 = 1.35411 79394 26400 42D0)
	31	PARAMETER (PIH = PI/2, RPIH = 2/PI, RPI2 = 1/(2*PI))
	32	PARAMETER (C1 = 2PI/(3W3))
	33	PARAMETER (GM = 3*(1/G2-3/G1)/2, GP = (3/G1+1/G2)/2)
	34
	35	DATA PP(-2) /-0.66666 66666 66666 67D0/
	36	DATA PP(-1) /-0.33333 33333 33333 33D0/
	37	DATA PP( 1) / 0.33333 33333 33333 33D0/
	38	DATA PP( 2) / 0.66666 66666 66666 67D0/
	39
	40	DATA GG(-2) / 0.37328 21739 07395 23D0/
	41	DATA GG(-1) / 0.73848 81116 21648 31D0/
	42	DATA GG( 1) / 1.11984 65217 22185 68D0/
	43	DATA GG( 2) / 1.10773 21674 32472 47D0/
	44
	45	DATA BC( 0,1) / 1.00458 61710 93207 35D0/
	46	DATA BC( 1,1) / 0.00467 34791 99873 60D0/
	47	DATA BC( 2,1) / 0.00009 08034 04815 04D0/
	48	DATA BC( 3,1) / 0.00000 37262 16110 59D0/
	49	DATA BC( 4,1) / 0.00000 02520 73237 90D0/
	50	DATA BC( 5,1) / 0.00000 00227 82110 77D0/
	51	DATA BC( 6,1) / 0.00000 00012 91332 28D0/
	52	DATA BC( 7,1) /-0.00000 00006 11915 16D0/
	53	DATA BC( 8,1) /-0.00000 00003 75616 85D0/
	54	DATA BC( 9,1) /-0.00000 00001 16415 46D0/
	55	DATA BC(10,1) /-0.00000 00000 14443 25D0/
	56	DATA BC(11,1) / 0.00000 00000 05373 69D0/
	57	DATA BC(12,1) / 0.00000 00000 03074 27D0/
	58	DATA BC(13,1) / 0.00000 00000 00297 66D0/
	59	DATA BC(14,1) /-0.00000 00000 00265 20D0/
	60	DATA BC(15,1) /-0.00000 00000 00091 37D0/
	61	DATA BC(16,1) / 0.00000 00000 00015 52D0/
	62	DATA BC(17,1) / 0.00000 00000 00014 12D0/
	63	DATA BC(18,1) /-0.00000 00000 00000 23D0/
	64	DATA BC(19,1) /-0.00000 00000 00001 98D0/
65	DATA BC(20,1) /-0.00000 00000 00000 13D0/
66	DATA BC(21,1) / 0.00000 00000 00000 29D0/
67	DATA BC(22,1) / 0.00000 00000 00000 03D0/
68	DATA BC(23,1) /-0.00000 00000 00000 05D0/
69
70	DATA BC( 0,2) / 0.99363 49867 16925 14D0/
71	DATA BC( 1,2) /-0.00646 71526 00616 03D0/
72	DATA BC( 2,2) /-0.00010 60188 22351 55D0/
73	DATA BC( 3,2) /-0.00000 41406 57716 24D0/
74	DATA BC( 4,2) /-0.00000 02916 95418 21D0/
75	DATA BC( 5,2) /-0.00000 00365 71574 33D0/
76	DATA BC( 6,2) /-0.00000 00075 81590 37D0/
77	DATA BC( 7,2) /-0.00000 00019 23008 52D0/
78	DATA BC( 8,2) /-0.00000 00004 20438 80D0/
79	DATA BC( 9,2) /-0.00000 00000 39372 04D0/
80	DATA BC(10,2) / 0.00000 00000 19007 44D0/
81	DATA BC(11,2) / 0.00000 00000 10137 64D0/
82	DATA BC(12,2) / 0.00000 00000 01331 30D0/
83	DATA BC(13,2) /-0.00000 00000 00676 92D0/
84	DATA BC(14,2) /-0.00000 00000 00311 72D0/
85	DATA BC(15,2) / 0.00000 00000 00011 87D0/
86	DATA BC(16,2) / 0.00000 00000 00040 21D0/
87	DATA BC(17,2) / 0.00000 00000 00004 78D0/
88	DATA BC(18,2) /-0.00000 00000 00004 74D0/
89	DATA BC(19,2) /-0.00000 00000 00001 16D0/
90	DATA BC(20,2) / 0.00000 00000 00000 59D0/
91	DATA BC(21,2) / 0.00000 00000 00000 21D0/
92	DATA BC(22,2) /-0.00000 00000 00000 08D0/
93	DATA BC(23,2) /-0.00000 00000 00000 03D0/
94
95	DATA CC( 0,1) / 0.99353 64122 76093 39D0/
96	DATA CC( 1,1) /-0.00631 44392 60798 63D0/
97	DATA CC( 2,1) / 0.00014 30095 80961 13D0/
98	DATA CC( 3,1) /-0.00000 57870 60592 03D0/
99	DATA CC( 4,1) / 0.00000 03265 50333 20D0/
100	DATA CC( 5,1) /-0.00000 00231 23231 95D0/
101	DATA CC( 6,1) / 0.00000 00019 39555 14D0/
102	DATA CC( 7,1) /-0.00000 00001 85897 89D0/
103	DATA CC( 8,1) / 0.00000 00000 19868 42D0/
104	DATA CC( 9,1) /-0.00000 00000 02326 79D0/
105	DATA CC(10,1) / 0.00000 00000 00294 68D0/
106	DATA CC(11,1) /-0.00000 00000 00039 95D0/
107	DATA CC(12,1) / 0.00000 00000 00005 75D0/
108	DATA CC(13,1) /-0.00000 00000 00000 87D0/
109	DATA CC(14,1) / 0.00000 00000 00000 14D0/
110	DATA CC(15,1) /-0.00000 00000 00000 02D0/
111
112	DATA CC( 0,2) / 1.00914 95380 72789 40D0/
113	DATA CC( 1,2) / 0.00897 12068 42483 60D0/
114	DATA CC( 2,2) /-0.00017 13895 98261 54D0/
115	DATA CC( 3,2) / 0.00000 65547 92549 82D0/
116	DATA CC( 4,2) /-0.00000 03595 19190 49D0/
117	DATA CC( 5,2) / 0.00000 00250 24412 19D0/
118	DATA CC( 6,2) /-0.00000 00020 74924 13D0/
119	DATA CC( 7,2) / 0.00000 00001 97223 67D0/
120	DATA CC( 8,2) /-0.00000 00000 20946 47D0/
121	DATA CC( 9,2) / 0.00000 00000 02440 93D0/
122	DATA CC(10,2) /-0.00000 00000 00307 91D0/
123	DATA CC(11,2) / 0.00000 00000 00041 61D0/
124	DATA CC(12,2) /-0.00000 00000 00005 97D0/
125	DATA CC(13,2) / 0.00000 00000 00000 91D0/
126	DATA CC(14,2) /-0.00000 00000 00000 14D0/
127	DATA CC(15,2) / 0.00000 00000 00000 02D0/
128
129	LEX=.FALSE.
130	GO TO 8
131
132	ENTRY JMDEBIR3(X,NU)
133
134	LEX=.TRUE.
135
136	8 MU=ABS(NU)
137	IF(MU .NE. 1 .AND. MU .NE. 2 .OR. NU .LT. 0 .AND. X .LE. 0
138	1 .OR. NU .GT. 0 .AND. X .LT. 0) THEN
139	S=0
140	WRITE(ERRTXT,101) X,NU
141	IF(.NOT.LEX) CALL JMMLPT(NAMEI ,'C340.1',ERRTXT)
142	IF( LEX) CALL JMMLPT(NAMEIE,'C340.1',ERRTXT)
143	ELSEIF(X .EQ. 0) THEN
144	S=0
145	ELSEIF(X .LT. 8) THEN
146	Y=(HFX)*2
147	XN=PP(NU)
148	XL=XN+2
149	A0=1
150	A1=1+2Y/((XL+1)(XN+1))
151	A2=1+Y(4+3Y/((XL+2)(XN+2)))/((XL+3)(XN+1))
152	B0=1
153	B1=1-Y/(XL+1)
154	B2=1-Y(1-Y/(2(XL+2)))/(XL+3)
155	T1=3+XL
156	V1=3-XL
157	V3=XL-1
158	V2=V3+V3
159	C=0
160	DO 33 N = 3,30
161	C0=C
162	T1=T1+2
163	T2=T1-1
164	T3=T2-1
165	T4=T3-1
166	T5=T4-1
167	T6=T5-1
168	V1=V1+1
169	V2=V2+1
170	V3=V3+1
171	U1=N*T4
172	E=V3/(U1*T3)
173	U2=E*Y
174	F1=1+YV1/(U1T1)
175	F2=(1+YV2/(V3T2T5))U2
176	F3=-YYU2/(T4T5T5*T6)
177	A=F1A2+F2A1+F3*A0
178	B=F1B2+F2B1+F3*B0
179	C=A/B
180	IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 34
181	A0=A1
182	A1=A2
183	A2=A
184	B0=B1
185	B1=B2
186	B2=B
187	33 CONTINUE
188	34 S=GG(NU)(HFX)*PP(NU)C
189	IF(LEX) S=EXP(-X)*S
190	ELSE
191	R=1/X
192	W=SQRT(RPI2*R)
193	H=16*R-1
194	ALFA=H+H
195	B1=0
196	B2=0
197	DO 2 I = 23,0,-1
198	B0=BC(I,MU)+ALFA*B1-B2
199	B2=B1
200	2 B1=B0
201	S=W(B0-HB2)
202	IF(.NOT.LEX) S=EXP(X)*S
203	T=0
204	IF(NU .LT. 0) THEN
205	H=10*R-1
206	ALFA=H+H
207	B1=0
208	B2=0
209	DO 3 I = 15,0,-1
210	B0=CC(I,MU)+ALFA*B1-B2
211	B2=B1
212	3 B1=B0
213	R=EXP(-X)
214	T=W3WR(B0-HB2)
215	IF(LEX) T=R*T
216	END IF
217	S=S+T
218	END IF
219	GO TO 99
220
221	ENTRY JMDBSKR3(X,NU)
222
223	LEX=.FALSE.
224	GO TO 9
225
226	ENTRY JMDEBKR3(X,NU)
227
228	LEX=.TRUE.
229
230	9 MU=ABS(NU)
231	IF(MU .NE. 1 .AND. MU .NE. 2 .OR. X .LE. 0) THEN
232	S=0
233	WRITE(ERRTXT,101) X,NU
234	IF(.NOT.LEX) CALL JMMLPT(NAMEK ,'C340.1',ERRTXT)
235	IF( LEX) CALL JMMLPT(NAMEKE,'C340.1',ERRTXT)
236	ELSEIF(X .LE. 1) THEN
237	A0=PP(-1)
238	B=HF*X
239	D=-LOG(B)
240	F=A0*D
241	E=EXP(F)
242	G=(GMA0+GP)E
243	BK=C1(HFGM(E+1/E)+GPD*SINH(F)/F)
244	F=BK
245	E=A0**2
246	P=HFC1G
247	Q=HF/G
248	C=1
249	D=B**2
250	BK1=P
251	DO 11 N = 1,15
252	FN=N
253	F=(FNF+P+Q)/(FN*2-E)
254	C=C*D/FN
255	P=P/(FN-A0)
256	Q=Q/(FN+A0)
257	G=C(P-FNF)
258	H=C*F
259	BK=BK+H
260	BK1=BK1+G
261	IF(HBK1+ABS(G)BK .LE. EPSBKBK1) GO TO 12
262	11 CONTINUE
263	12 S=BK
264	IF(MU .EQ. 2) S=BK1/B
265	IF(LEX) S=EXP(X)*S
266	ELSEIF(X .LE. 5) THEN
267	XN=4PP(MU)*2
268	A=9-XN
269	B=25-XN
270	C=768X*2
271	C0=48*X
272	A0=1
273	A1=(16*X+7+XN)/A
274	A2=(C+C0(XN+23)+XN(XN+62)+129)/(A*B)
275	B0=1
276	B1=(16*X+9-XN)/A
277	B2=(C+C0B)/(AB)+1
278	C=0
279	DO 24 N = 3,30
280	C0=C
281	FN=N
282	FN2=FN+FN
283	FN1=FN2-1
284	FN3=FN1/(FN2-3)
285	FN4=12FN*2-(1-XN)
286	FN5=16FN1X
287	RAN=1/((FN2+1)**2-XN)
288	F1=FN3(FN4-20FN)+FN5
289	F2=28*FN-FN4-8+FN5
290	F3=FN3((FN2-5)*2-XN)
291	A=(F1A2+F2A1+F3A0)RAN
292	B=(F1B2+F2B1+F3B0)RAN
293	C=A/B
294	IF(ABS(C0-C) .LT. EPS*ABS(C)) GO TO 25
295	A0=A1
296	A1=A2
297	A2=A
298	B0=B1
299	B1=B2
300	B2=B
301	24 CONTINUE
302	25 S=C/SQRT(RPIH*X)
303	IF(.NOT.LEX) S=EXP(-X)*S
304	ELSE
305	R=1/X
306	H=10*R-1
307	ALFA=H+H
308	B1=0
309	B2=0
310	DO 13 I = 15,0,-1
311	B0=CC(I,MU)+ALFA*B1-B2
312	B2=B1
313	13 B1=B0
314	S=SQRT(PIHR)(B0-H*B2)
315	IF(.NOT.LEX) S=EXP(-X)*S
316	END IF
317
318	99 JMDBSIR3=S
319
320	RETURN
321	101 FORMAT('INCORRECT ARGUMENT OR INDEX, X = ',1P,E15.6,' NU = ',I5)
322	END