This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / dbska64.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1996/04/01 15:02:08 mclareni
6* Mathlib gen
7*
8*
9#include "gen/pilot.h"
10#if defined(CERNLIB_DOUBLE)
11 SUBROUTINE DBSKA(X,IA,JA,NL,B)
12 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
13#endif
14#if !defined(CERNLIB_DOUBLE)
15 SUBROUTINE BSKA(X,IA,JA,NL,B)
16#include "gen/imp64.inc"
17#endif
18 LOGICAL LEX
19
20 CHARACTER NAME*(*),ENAM*(*)
21 CHARACTER*80 ERRTXT
22 PARAMETER (NAME = 'BSKA/DBSKA', ENAM = 'EBSKA/DEBKA')
23
24 PARAMETER (Z1 = 1, Z2 = 2, Z3 = 3, Z4 = 4)
25 PARAMETER (Z12 = Z1/Z2, Z13 = Z1/Z3, Z14 = Z1/Z4, Z23 = Z2/Z3)
26 PARAMETER (Z34 = Z3/Z4)
27
28 DIMENSION B(0:*)
29
30 PARAMETER (PI = 3.14159 26535 89793D0, PIV = PI/4)
31
32 LEX=.FALSE.
33 GO TO 9
34
35#if defined(CERNLIB_DOUBLE)
36 ENTRY DEBKA(X,IA,JA,NL,B)
37#endif
38#if !defined(CERNLIB_DOUBLE)
39 ENTRY EBKA(X,IA,JA,NL,B)
40#endif
41 LEX=.TRUE.
42
43 9 MODE=10*IA+JA
44 N=NL-1
45 U=2/X
46 IF(LEX) THEN
47 IF(X .LE. 0) THEN
48 N=0
49 WRITE(ERRTXT,101) X
50 CALL MTLPRT(ENAM,'C341.1',ERRTXT)
51 ELSEIF(NL .LT. 0 .OR. NL .GT. 100) THEN
52 N=0
53 WRITE(ERRTXT,103) NL
54 CALL MTLPRT(ENAM,'C341.3',ERRTXT)
55 ELSEIF(IA .EQ. 0) THEN
56 A=0
57 B(0)=DEBSK0(X)
58 B(1)=DEBSK1(X)
59 ELSEIF(MODE .EQ. 12) THEN
60 A=Z12
61 B(0)=SQRT(PIV*U)
62 B(1)=B(0)*(1+A*U)
63 ELSEIF(MODE .EQ. 13) THEN
64 A=Z13
65 B(0)=DEBKR3(X,1)
66 B(1)=DEBKR3(X,2)+A*U*B(0)
67 ELSEIF(MODE .EQ. 14) THEN
68 A=Z14
69 B(0)=DEBKR4(X,1)
70 B(1)=DEBKR4(X,3)+A*U*B(0)
71 ELSEIF(MODE .EQ. 23) THEN
72 A=Z23
73 B(0)=DEBKR3(X,2)
74 B(1)=DEBKR3(X,1)+A*U*B(0)
75 ELSEIF(MODE .EQ. 34) THEN
76 A=Z34
77 B(0)=DEBKR4(X,3)
78 B(1)=DEBKR4(X,1)+A*U*B(0)
79 ELSE
80 N=0
81 WRITE(ERRTXT,102) IA,JA
82 CALL MTLPRT(ENAM,'C341.2',ERRTXT)
83 ENDIF
84 ELSE
85 IF(X .LE. 0) THEN
86 N=0
87 WRITE(ERRTXT,101) X
88 CALL MTLPRT(NAME,'C341.1',ERRTXT)
89 ELSEIF(NL .LT. 0 .OR. NL .GT. 100) THEN
90 N=0
91 WRITE(ERRTXT,103) NL
92 CALL MTLPRT(NAME,'C341.3',ERRTXT)
93 ELSEIF(IA .EQ. 0) THEN
94 A=0
95 B(0)=DBESK0(X)
96 B(1)=DBESK1(X)
97 ELSEIF(MODE .EQ. 12) THEN
98 A=Z12
99 B(0)=EXP(-X)*SQRT(PIV*U)
100 B(1)=B(0)*(1+A*U)
101 ELSEIF(MODE .EQ. 13) THEN
102 A=Z13
103 B(0)=DBSKR3(X,1)
104 B(1)=DBSKR3(X,2)+A*U*B(0)
105 ELSEIF(MODE .EQ. 14) THEN
106 A=Z14
107 B(0)=DBSKR4(X,1)
108 B(1)=DBSKR4(X,3)+A*U*B(0)
109 ELSEIF(MODE .EQ. 23) THEN
110 A=Z23
111 B(0)=DBSKR3(X,2)
112 B(1)=DBSKR3(X,1)+A*U*B(0)
113 ELSEIF(MODE .EQ. 34) THEN
114 A=Z34
115 B(0)=DBSKR4(X,3)
116 B(1)=DBSKR4(X,1)+A*U*B(0)
117 ELSE
118 N=0
119 WRITE(ERRTXT,102) IA,JA
120 CALL MTLPRT(NAME,'C341.2',ERRTXT)
121 ENDIF
122 ENDIF
123 DO 1 J = 1,N
124 A=A+1
125 1 B(J+1)=B(J-1)+A*U*B(J)
126 RETURN
127 101 FORMAT('NON-POSITIVE ARGUMENT X = ',E15.6)
128 102 FORMAT('PAIR (IA,JA) = (',I5,I5,') ILLEGAL')
129 103 FORMAT('ILLEGAL NL =',I5)
130 END