This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / c / dbska64.F
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