lxsd / fvn

Download as
Browse Code ยป

Commit d55dcfb5ae31249d42c99c6af1da476b7e14d14e

Authored by wdaniau
1 parent e80b2ec787
Exists in master and in 3 other branches geevx, geevx_2020, multi

1) Added single precision versions of besri and besrj 

2) Modification of corresponding interface in fvn_fnlib.f90

git-svn-id: https://lxsd.femto-st.fr/svn/fvn@61 b657c933-2333-4658-acf2-d3c7c2708721

Showing 5 changed files with 438 additions and 6 deletions Inline Diff

1 1
include $(BTREE)/Make.inc 2 2 include $(BTREE)/Make.inc
3 3
objects = acosh.o aide.o aid.o aie.o \ 4 4 objects = acosh.o aide.o aid.o aie.o \
ai.o albeta.o algams.o ali.o \ 5 5 ai.o albeta.o algams.o ali.o \
alngam.o alnrel.o asinh.o atanh.o \ 6 6 alngam.o alnrel.o asinh.o atanh.o \
besi0e.o besi0.o besi1e.o besi1.o \ 7 7 besi0e.o besi0.o besi1e.o besi1.o \
besj0.o besj1.o besk0e.o besk0.o \ 8 8 besj0.o besj1.o besk0e.o besk0.o \
besk1e.o besk1.o beskes.o besks.o \ 9 9 besk1e.o besk1.o beskes.o besks.o \
besy0.o besy1.o betai.o beta.o \ 10 10 besy0.o besy1.o betai.o beta.o \
bide.o bid.o bie.o binom.o \ 11 11 bide.o bid.o bie.o binom.o \
bi.o c0lgmc.o c8lgmc.o c9lgmc.o \ 12 12 bi.o c0lgmc.o c8lgmc.o c9lgmc.o \
c9ln2r.o cacosh.o cacos.o carg.o \ 13 13 c9ln2r.o cacosh.o cacos.o carg.o \
casinh.o casin.o catan2.o catanh.o \ 14 14 casinh.o casin.o catan2.o catanh.o \
catan.o cbeta.o cbrt.o ccbrt.o \ 15 15 catan.o cbeta.o cbrt.o ccbrt.o \
ccosh.o ccot.o cexprl.o cgamma.o \ 16 16 ccosh.o ccot.o cexprl.o cgamma.o \
cgamr.o chi.o chu.o cinh.o \ 17 17 cgamr.o chi.o chu.o cinh.o \
cin.o ci.o clbeta.o clngam.o \ 18 18 cin.o ci.o clbeta.o clngam.o \
clnrel.o clog10.o comp1.o comp2.o \ 19 19 clnrel.o clog10.o comp1.o comp2.o \
comp3.o cosdg.o cot.o cpsi.o \ 20 20 comp3.o cosdg.o cot.o cpsi.o \
csevl.o csinh.o ctanh.o ctan.o \ 21 21 csevl.o csinh.o ctanh.o ctan.o \
d9admp.o d9aimp.o d9atn1.o \ 22 22 d9admp.o d9aimp.o d9atn1.o \
d9b0mp.o d9b1mp.o d9chm.o d9chu.o \ 23 23 d9b0mp.o d9b1mp.o d9chm.o d9chu.o \
d9gaml.o d9gmic.o d9gmit.o d9knus.o \ 24 24 d9gaml.o d9gmic.o d9gmit.o d9knus.o \
d9lgic.o d9lgit.o d9lgmc.o d9ln2r.o \ 25 25 d9lgic.o d9lgit.o d9lgmc.o d9ln2r.o \
d9pak.o d9sifg.o d9upak.o dacosh.o \ 26 26 d9pak.o d9sifg.o d9upak.o dacosh.o \
daide.o daid.o daie.o dai.o \ 27 27 daide.o daid.o daie.o dai.o \
dasinh.o datanh.o daws.o dbesi0.o \ 28 28 dasinh.o datanh.o daws.o dbesi0.o \
dbesi1.o dbesj0.o dbesj1.o dbesk0.o \ 29 29 dbesi1.o dbesj0.o dbesj1.o dbesk0.o \
dbesk1.o dbesks.o dbesy0.o dbesy1.o \ 30 30 dbesk1.o dbesks.o dbesy0.o dbesy1.o \
dbetai.o dbeta.o dbide.o dbid.o \ 31 31 dbetai.o dbeta.o dbide.o dbid.o \
dbie.o dbinom.o dbi.o dbsi0e.o \ 32 32 dbie.o dbinom.o dbi.o dbsi0e.o \
dbsi1e.o dbsk0e.o dbsk1e.o dbskes.o \ 33 33 dbsi1e.o dbsk0e.o dbsk1e.o dbskes.o \
db1slr.o dbesri.o dbesrj.o \ 34 34 db1slr.o dbesri.o dbesrj.o \
35 b1slr.o besri.o besrj.o \
dcbrt.o dchi.o dchu.o dcinh.o \ 35 36 dcbrt.o dchi.o dchu.o dcinh.o \
dcin.o dci.o dcosdg.o dcot.o \ 36 37 dcin.o dci.o dcosdg.o dcot.o \
dcsevl.o ddaws.o de1.o dei.o \ 37 38 dcsevl.o ddaws.o de1.o dei.o \
derfc.o derf.o dexprl.o dfac.o \ 38 39 derfc.o derf.o dexprl.o dfac.o \
dgamic.o dgami.o dgamit.o dgamma.o \ 39 40 dgamic.o dgami.o dgamit.o dgamma.o \
dgamr.o dlbeta.o dlgams.o dli.o \ 40 41 dgamr.o dlbeta.o dlgams.o dli.o \
dlngam.o dlnrel.o dpoch1.o dpoch.o \ 41 42 dlngam.o dlnrel.o dpoch1.o dpoch.o \
dpsi.o dshi.o dsindg.o dsi.o \ 42 43 dpsi.o dshi.o dsindg.o dsi.o \
dspenc.o e1.o e9rint.o ei.o \ 43 44 dspenc.o e1.o e9rint.o ei.o \
entsrc.o eprint.o erfc.o erf.o \ 44 45 entsrc.o eprint.o erfc.o erf.o \
erroff.o exprel.o fac.o fdump.o \ 45 46 erroff.o exprel.o fac.o fdump.o \
fvn_fnlib.o gamic.o gami.o gamit.o \ 46 47 fvn_fnlib.o gamic.o gami.o gamit.o \
gamma.o gamr.o i1mach.o i8save.o \ 47 48 gamma.o gamr.o i1mach.o i8save.o \
initds.o inits.o nerror.o poch1.o \ 48 49 initds.o inits.o nerror.o poch1.o \
poch.o psi.o r9admp.o \ 49 50 poch.o psi.o r9admp.o \
r9aimp.o r9atn1.o r9chm.o r9chu.o \ 50 51 r9aimp.o r9atn1.o r9chm.o r9chu.o \
r9gaml.o r9gmic.o r9gmit.o r9knus.o \ 51 52 r9gaml.o r9gmic.o r9gmit.o r9knus.o \
r9lgic.o r9lgit.o r9lgmc.o r9ln2r.o \ 52 53 r9lgic.o r9lgit.o r9lgmc.o r9ln2r.o \
r9pak.o r9sifg.o r9upak.o randgs.o \ 53 54 r9pak.o r9sifg.o r9upak.o randgs.o \
rand.o random.o ranf.o retsrc.o \ 54 55 rand.o random.o ranf.o retsrc.o \
s88fmt.o s9comp.o seterr.o seteru.o \ 55 56 s88fmt.o s9comp.o seterr.o seteru.o \
shi.o sindg.o si.o spenc.o \ 56 57 shi.o sindg.o si.o spenc.o \
z0lgmc.o z8lgmc.o z9lgmc.o z9ln2r.o \ 57 58 z0lgmc.o z8lgmc.o z9lgmc.o z9ln2r.o \
zacosh.o zacos.o zarg.o zasinh.o \ 58 59 zacosh.o zacos.o zarg.o zasinh.o \
zasin.o zatan2.o zatanh.o zatan.o \ 59 60 zasin.o zatan2.o zatanh.o zatan.o \
zbeta.o zcbrt.o zcosh.o zcot.o \ 60 61 zbeta.o zcbrt.o zcosh.o zcot.o \
zexprl.o zgamma.o zgamr.o zlbeta.o \ 61 62 zexprl.o zgamma.o zgamr.o zlbeta.o \
zlngam.o zlnrel.o zlog10.o zpsi.o \ 62 63 zlngam.o zlnrel.o zlog10.o zpsi.o \
zsinh.o ztanh.o ztan.o besyn.o \ 63 64 zsinh.o ztanh.o ztan.o besyn.o \
besjn.o dbesyn.o dbesjn.o beskn.o \ 64 65 besjn.o dbesyn.o dbesjn.o beskn.o \
besin.o dbeskn.o dbesin.o ze1.o 65 66 besin.o dbeskn.o dbesin.o ze1.o
66 67
lib:$(objects) 67 68 lib:$(objects)
68 69
install: 69 70 install:
cp fvn_fnlib.mod $(BTREE)/modules 70 71 cp fvn_fnlib.mod $(BTREE)/modules
71 72
clean: 72 73 clean:
File was created 1 SUBROUTINE B1SLR(X,NB,IZE,B,NCALC)
2 C THIS ROUTINE CALCULATES BESSEL FUNCTIONS I AND J OF REAL
3 C ARGUMENT AND INTEGER ORDER.
4 C
5 C
6 C EXPLANATION OF VARIABLES IN THE CALLING SEQUENCE
7 C
8 C X REAL ARGUMENT FOR WHICH I*S OR J*S
9 C ARE TO BE CALCULATED. IF I*S ARE TO BE CALCULATED,
10 C ABS(X) MUST BE LESS THAN EXPARG (WHICH SEE BELOW).
11 C NB INTEGER TYPE. 1 + HIGHEST ORDER TO BE CALCULATED.
12 C IT MUST BE POSITIVE.
13 C IZE INTEGER TYPE. ZERO IF J*S ARE TO BE CALCULATED, 1
14 C IF I*S ARE TO BE CALCULATED.
15 C B REAL VECTOR OF LENGTH NB, NEED NOT BE
16 C INITIALIZED BY USER. IF THE ROUTINE TERMINATES
17 C NORMALLY (NCALC=NB), IT RETURNS J(OR I)-SUB-ZERO
18 C THROUGH J(OR I)-SUB-NB-MINUS-ONE OF X IN THIS
19 C VECTOR.
20 C NCALC INTEGER TYPE, NEED NOT BE INITIALIZED BY USER.
21 C BEFORE USING THE RESULTS, THE USER SHOULD CHECK THAT
22 C NCALC=NB, I.E. ALL ORDERS HAVE BEEN CALCULATED TO
23 C THE DESIRED ACCURACY. SEE ERROR RETURNS BELOW.
24 C
25 C
26 C EXPLANATION OF MACHINE-DEPENDENT CONSTANTS
27 C
28 C NSIG DECIMAL SIGNIFICANCE DESIRED. SHOULD BE SET TO
29 C IFIX(ALOG10(2)*NBIT+1), WHERE NBIT IS THE NUMBER OF
30 C BITS IN THE MANTISSA OF A REAL VARIABLE.
31 C SETTING NSIG LOWER WILL RESULT IN DECREASED ACCURACY
32 C WHILE SETTING NSIG HIGHER WILL INCREASE CPU TIME
33 C WITHOUT INCREASING ACCURACY. THE TRUNCATION ERROR
34 C IS LIMITED TO T=.5*10**-NSIG FOR J*S OF ORDER LESS
35 C THAN ARGUMENT, AND TO A RELATIVE ERROR OF T FOR
36 C I*S AND THE OTHER J*S.
37 C NTEN LARGEST INTEGER K SUCH THAT 10**K IS MACHINE-
38 C REPRESENTABLE IN SINGLE PRECISION.
39 C LARGEX UPPER LIMIT ON THE MAGNITUDE OF X. BEAR IN MIND
40 C THAT IF ABS(X)=N, THEN AT LEAST N ITERATIONS OF THE
41 C BACKWARD RECURSION WILL BE EXECUTED.
42 C EXPARG LARGEST REAL ARGUMENT THAT THE LIBRARY
43 C EXP ROUTINE CAN HANDLE.
44 C
45 C PORT NOTE, SEPTEMBER 8,1976 -
46 C THE LARGEX AND EXPARG TESTS ARE MADE IN THE OUTER ROUTINES -
47 C BESRJ AND BESRI, WHICH CALL B1SLR.
48 C
49 C
50 C ERROR RETURNS
51 C
52 C PORT NOTE, SEPTEMBER 8, 1976 -
53 C THE NOTES BELOW ARE KEPT IN FOR THE RECORD, BUT, AS ABOVE,
54 C THE ACTUAL TESTS ARE NOW IN THE OUTER CALLING ROUTINES.
55 C
56 C LET G DENOTE EITHER I OR J.
57 C IN CASE OF AN ERROR, NCALC.NE.NB, AND NOT ALL G*S
58 C ARE CALCULATED TO THE DESIRED ACCURACY.
59 C IF NCALC.LT.0, AN ARGUMENT IS OUT OF RANGE. NB.LE.0
60 C OR IZE IS NEITHER 0 NOR 1 OR IZE=1 AND ABS(X).GE.EXPARG.
61 C IN THIS CASE, THE B-VECTOR IS NOT CALCULATED, AND NCALC
62 C IS SET TO MIN0(NB,0)-1 SO NCALC.NE.NB.
63 C NB.GT.NCALC.GT.0 WILL OCCUR IF NB.GT.MAGX AND ABS(G-
64 C SUB-NB-OF-X/G-SUB-MAGX+NP-OF-X).LT.10.**(NTEN/2), I.E. NB
65 C IS MUCH GREATER THAN MAGX. IN THIS CASE, B(N) IS CALCU-
66 C LATED TO THE DESIRED ACCURACY FOR N.LE.NCALC, BUT FOR
67 C NCALC.LT.N.LE.NB, PRECISION IS LOST. IF N.GT.NCALC AND
68 C ABS(B(NCALC)/B(N)).EQ.10**-K, THEN THE LAST K SIGNIFICANT
69 C FIGURES OF B(N) ARE ERRONEOUS. IF THE USER WISHES TO
70 C CALCULATE B(N) TO HIGHER ACCURACY, HE SHOULD USE AN
71 C ASYMPTOTIC FORMULA FOR LARGE ORDER.
72 C
73 REAL
74 1 X,B,P,TEST,TEMPA,TEMPB,TEMPC,SIGN,SUM,TOVER,
75 2 PLAST,POLD,PSAVE,PSAVEL,R1MACH
76 DIMENSION B(NB)
77 DATA NSIG/0/, NTEN/0/
78 IF(NSIG .NE. 0) GO TO 1
79 NSIG = IFIX(-ALOG10(R1MACH(3))+1.)
80 NTEN = ALOG10(R1MACH(2))
81 1 TEMPA=ABS(X)
82 MAGX=IFIX((TEMPA))
83 C
84 SIGN=FLOAT(1-2*IZE)
85 NCALC=NB
86 C USE 2-TERM ASCENDING SERIES FOR SMALL X
87 IF(TEMPA**4.LT..1E0**NSIG) GO TO 30
88 C INITIALIZE THE CALCULATION OF P*S
89 NBMX=NB-MAGX
90 N=MAGX+1
91 PLAST=1.E0
92 P=FLOAT(2*N)/TEMPA
93 C CALCULATE GENERAL SIGNIFICANCE TEST
94 TEST=2.E0*1.E1**NSIG
95 IF(IZE.EQ.1.AND.2*MAGX.GT.5*NSIG) TEST=SQRT(TEST*P)
96 IF(IZE.EQ.1.AND.2*MAGX.LE.5*NSIG) TEST=TEST/1.585**MAGX
97 M=0
98 IF(NBMX.LT.3) GO TO 4
99 C CALCULATE P*S UNTIL N=NB-1. CHECK FOR POSSIBLE OVERFLOW.
100 TOVER=1.E1**(NTEN-NSIG)
101 NSTART=MAGX+2
102 NEND=NB-1
103 DO 3 N=NSTART,NEND
104 POLD=PLAST
105 PLAST=P
106 P=FLOAT(2*N)*PLAST/TEMPA-SIGN*POLD
107 IF(P-TOVER) 3,3,5
108 3 CONTINUE
109 C CALCULATE SPECIAL SIGNIFICANCE TEST FOR NBMX.GT.2.
110 TEST=AMAX1(TEST,SQRT(PLAST*1.E1**NSIG)*SQRT(2.E0*P))
111 C CALCULATE P*S UNTIL SIGNIFICANCE TEST PASSES
112 4 N=N+1
113 POLD=PLAST
114 PLAST=P
115 P=FLOAT(2*N)*PLAST/TEMPA-SIGN*POLD
116 IF(P.LT.TEST) GO TO 4
117 IF(IZE.EQ.1.OR.M.EQ.1) GO TO 12
118 C FOR J*S, A STRONG VARIANT OF THE TEST IS NECESSARY.
119 C CALCULATE IT, AND CALCULATE P*S UNTIL THIS TEST IS PASSED.
120 M=1
121 TEMPB=P/PLAST
122 TEMPC=FLOAT(N+1)/TEMPA
123 IF(TEMPB+1.E0/TEMPB.GT.2.E0*TEMPC)TEMPB=TEMPC+SQRT(TEMPC**2-1.E0)
124 TEST=TEST/SQRT(TEMPB-1.E0/TEMPB)
125 IF(P-TEST) 4,12,12
126 C TO AVOID OVERFLOW, DIVIDE P*S BY TOVER. CALCULATE P*S
127 C UNTIL ABS(P).GT.1.
128 5 TOVER=1.E1**NTEN
129 P=P/TOVER
130 PLAST=PLAST/TOVER
131 PSAVE=P
132 PSAVEL=PLAST
133 NSTART=N+1
134 6 N=N+1
135 POLD=PLAST
136 PLAST=P
137 P=FLOAT(2*N)*PLAST/TEMPA-SIGN*POLD
138 IF(P.LE.1.E0) GO TO 6
139 TEMPB=FLOAT(2*N)/TEMPA
140 IF(IZE.EQ.1) GO TO 8
141 TEMPC=.5E0*TEMPB
142 TEMPB=PLAST/POLD
143 IF(TEMPB+1.E0/TEMPB.GT.2.E0*TEMPC)TEMPB=TEMPC+SQRT(TEMPC**2-1.E0)
144 C CALCULATE BACKWARD TEST, AND FIND NCALC, THE HIGHEST N
145 C SUCH THAT THE TEST IS PASSED.
146 8 TEST=.5E0*POLD*PLAST*(1.E0-1.E0/TEMPB**2)/1.E1**NSIG
147 P=PLAST*TOVER
148 N=N-1
149 NEND=MIN0(NB,N)
150 DO 9 NCALC=NSTART,NEND
151 POLD=PSAVEL
152 PSAVEL=PSAVE
153 PSAVE=FLOAT(2*N)*PSAVEL/TEMPA-SIGN*POLD
154 IF(PSAVE*PSAVEL-TEST) 9,9,10
155 9 CONTINUE
156 NCALC=NEND+1
157 10 NCALC=NCALC-1
158 C THE SUM B(1)+2B(3)+2B(5)... IS USED TO NORMALIZE. M, THE
159 C COEFFICIENT OF B(N), IS INITIALIZED TO 2 OR 0.
160 12 N=N+1
161 M=2*N-4*(N/2)
162 C INITIALIZE THE BACKWARD RECURSION AND THE NORMALIZATION
163 C SUM
164 TEMPB=0.E0
165 TEMPA=1.E0/P
166 SUM=FLOAT(M)*TEMPA
167 NEND=N-NB
168 IF(NEND) 17,15,13
169 C RECUR BACKWARD VIA DIFFERENCE EQUATION, CALCULATING (BUT
170 C NOT STORING) B(N), UNTIL N=NB.
171 13 DO 14 L=1,NEND
172 N=N-1
173 TEMPC=TEMPB
174 TEMPB=TEMPA
175 TEMPA=FLOAT(2*N)*TEMPB/X-SIGN*TEMPC
176 M=2-M
177 14 SUM=SUM+FLOAT(M)*TEMPA
178 C STORE B(NB)
179 15 B(N)=TEMPA
180 IF(NB.GT.1) GO TO 16
181 C NB=1. SINCE 2*TEMPA WAS ADDED TO THE SUM, TEMPA MUST BE
182 C SUBTRACTED
183 SUM=SUM-TEMPA
184 GO TO 23
185 C CALCULATE AND STORE B(NB-1)
186 16 N=N-1
187 B(N) =FLOAT(2*N)*TEMPA/X-SIGN*TEMPB
188 IF(N.EQ.1) GO TO 22
189 M=2-M
190 SUM=SUM+FLOAT(M)*B(N)
191 GO TO 19
192 C N.LT.NB, SO STORE B(N) AND SET HIGHER ORDERS TO ZERO
193 17 B(N)=TEMPA
194 NEND=-NEND
195 DO 18 L=1,NEND
196 K=N+L
197 18 B(K)=0.E0
198 19 NEND=N-2
199 IF(NEND.EQ.0) GO TO 21
200 C CALCULATE VIA DIFFERENCE EQUATION AND STORE B(N),
201 C UNTIL N=2
202 DO 20 L=1,NEND
203 N=N-1
204 B(N)=(FLOAT(2*N)*B(N+1))/X-SIGN*B(N+2)
205 M=2-M
206 20 SUM=SUM+FLOAT(M)*B(N)
207 C CALCULATE B(1)
208 21 B(1)=2.E0*B(2)/X-SIGN*B(3)
209 22 SUM=SUM+B(1)
210 C NORMALIZE--IF IZE=1, DIVIDE SUM BY COSH(X). DIVIDE ALL
211 C B(N) BY SUM.
212 23 IF(IZE.EQ.0) GO TO 25
213 TEMPA=EXP(ABS(X))
214 SUM=2.E0*SUM/(TEMPA+1.E0/TEMPA)
215 25 DO 26 N=1,NB
216 26 B(N)=B(N)/SUM
217 RETURN
218 C
219 C TWO-TERM ASCENDING SERIES FOR SMALL X
220 30 TEMPA=1.E0
221 TEMPB=-.25E0*X*X*SIGN
222 B(1)=1.E0+TEMPB
223 IF(NB.EQ.1) GO TO 32
224 DO 31 N=2,NB
225 TEMPA=TEMPA*X/FLOAT(2*N-2)
226 31 B(N)=TEMPA*(1.E0+TEMPB/FLOAT(N))
227 32 RETURN
228 END
File was created 1 SUBROUTINE BESRI(X, NB, B)
2 C
3 C THIS ROUTINE CALCULATES MODIFIED BESSEL FUNCTIONS I OF REAL
4 C ARGUMENT AND INTEGER ORDER.
5 C
6 C EXPLANATION OF VARIABLES IN THE CALLING SEQUENCE -
7 C
8 C X - REAL ARGUMENT FOR WHICH THE I*S
9 C ARE TO BE CALCULATED.
10 C
11 C NB - INTEGER TYPE. 1 + HIGHEST ORDER TO BE CALCULATED.
12 C IT MUST BE POSITIVE.
13 C
14 C B - REAL VECTOR OF LENGTH NB, NEED NOT BE
15 C INITIALIZED BY USER. IF THE ROUTINE TERMINATES
16 C NORMALLY IT RETURNS I-SUB-ZERO
17 C THROUGH I-SUB-NB-MINUS-ONE OF X IN THIS
18 C VECTOR.
19 C
20 C ACCURACY OF THE COMPUTED VALUES -
21 C
22 C IN CASE OF AN ERROR, NOT ALL I*S
23 C ARE CALCULATED TO THE DESIRED ACCURACY.
24 C
25 C THE SUBPROGRAM CALLED BY BESRI, B1SLR,
26 C RETURNS IN THE VARIABLE, NCALC, THE NUMBER CALCULATED CORRECTLY.
27 C
28 C LET NTEN BE THE LARGEST INTEGER K SUCH THAT 10**K IS MACHINE-
29 C REPRESENTABLE IN REAL.
30 C THEN NB.GT.NCALC.GT.0 WILL OCCUR IF NB.GT.MAGX AND ABS(I-
31 C SUB-NB-OF-X/I-SUB-MAGX+NP-OF-X).LT.10.**(NTEN/2), I.E. NB
32 C IS MUCH GREATER THAN MAGX. IN THIS CASE, B(N) IS CALCU-
33 C LATED TO THE DESIRED ACCURACY FOR N.LE.NCALC, BUT FOR
34 C NCALC.LT.N.LE.NB, PRECISION IS LOST. IF N.GT.NCALC AND
35 C ABS(B(NCALC)/B(N)).EQ.10**-K, THEN THE LAST K SIGNIFICANT
36 C FIGURES OF B(N) ARE ERRONEOUS. IF THE USER WISHES TO
37 C CALCULATE B(N) TO HIGHER ACCURACY, HE SHOULD USE AN
38 C ASYMPTOTIC FORMULA FOR LARGE ORDER.
39 C
40 REAL X,B(NB),R1MACH
41 C
42 C CHECK INPUT VALUES
43 C
44 C AN UPPER LIMIT OF 10000 IS SET ON THE MAGNITUDE OF X.
45 C BEAR IN MIND THAT IF ABS(X)=N, THEN AT LEAST N ITERATIONS
46 C OF THE BACKWARD RECURSION WILL BE EXECUTED.
47 C
48 MAGX = ABS(X)
49 MEXP = ALOG(R1MACH(2))
50 C
51 C/6S
52 C IF (MAGX .GT. 10000 .OR. MAGX .GT. MEXP) CALL SETERR(
53 C 1 33H BESRI - X IS TOO BIG (MAGNITUDE),33,1,2)
54 C/7S
55 IF (MAGX .GT. 10000 .OR. MAGX .GT. MEXP) CALL SETERR(
56 1 ' BESRI - X IS TOO BIG (MAGNITUDE)',33,1,2)
57 C/
58 C
59 C/6S
60 C IF (NB .LT. 1) CALL SETERR(
61 C 1 28H BESRI - NB SHOULD = ORDER+1,28,2,2)
62 C/7S
63 IF (NB .LT. 1) CALL SETERR(
64 1 ' BESRI - NB SHOULD = ORDER+1',28,2,2)
65 C/
66 C
67 C BESRJ CALLS ON THE SUBPROGRAM,B1SLR,
68 C WHICH IS SOOKNES ORIGINAL BESLRI.
69 C
70 C THE ADDITIONAL INPUT ARGUMENTS REQUIRED FOR IT ARE -
71 C
72 C IZE INTEGER TYPE. ZERO IF J*S ARE TO BE CALCULATED, 1
73 C IF I*S ARE TO BE CALCULATED.(THIRD ARGUMENT BELOW)
74 C
75 C NCALC INTEGER TYPE, NEED NOT BE INITIALIZED BY USER.
76 C BEFORE USING THE RESULTS, IT SHOULD BE CHECKED THAT
77 C NCALC=NB, I.E. ALL ORDERS HAVE BEEN CALCULATED TO
78 C THE DESIRED ACCURACY.
79 C
80 CALL B1SLR (X, NB, 1, B, NCALC)
81 C
82 C TEST IF ALL GOT COMPUTED OK
83 C (SINCE SOME VALUES MAY BE OK, THIS IS A RECOVERABLE ERROR.)
84 C
85 IF (NB .EQ. NCALC) RETURN
86 C
87 NCALC = NCALC+10
88 C/6S
89 C CALL SETERR(
90 C 1 38H BESRI - ONLY THIS MANY ANSWERS ARE OK,38,NCALC,1)
91 C/7S
92 CALL SETERR(
93 1 ' BESRI - ONLY THIS MANY ANSWERS ARE OK',38,NCALC,1)
94 C/
95 C
96 RETURN
97 END
File was created 1 SUBROUTINE BESRJ(X, NB, B)
2 C
3 C THIS ROUTINE CALCULATES BESSEL FUNCTIONS J OF REAL
4 C ARGUMENT AND INTEGER ORDER.
5 C
6 C EXPLANATION OF VARIABLES IN THE CALLING SEQUENCE -
7 C
8 C X - REAL ARGUMENT FOR WHICH THE J*S
9 C ARE TO BE CALCULATED.
10 C
11 C NB - INTEGER TYPE. 1 + HIGHEST ORDER TO BE CALCULATED.
12 C IT MUST BE POSITIVE.
13 C
14 C B - REAL VECTOR OF LENGTH NB, NEED NOT BE
15 C INITIALIZED BY USER. IF THE ROUTINE TERMINATES
16 C NORMALLY IT RETURNS J(OR I)-SUB-ZERO
17 C THROUGH J(OR I)-SUB-NB-MINUS-ONE OF X IN THIS
18 C VECTOR.
19 C
20 C ACCURACY OF THE COMPUTED VALUES -
21 C
22 C IN CASE OF AN ERROR, NOT ALL J*S
23 C ARE CALCULATED TO THE DESIRED ACCURACY.
24 C
25 C THE SUBPROGRAM CALLED BY BESRJ, B1SLR,
26 C RETURNS IN THE VARIABLE, NCALC, THE NUMBER CALCULATED CORRECTLY.
27 C
28 C LET NTEN BE THE LARGEST INTEGER K SUCH THAT 10**K IS MACHINE-
29 C REPRESENTABLE IN SINGLE PRECISION.
30 C THEN NB.GT.NCALC.GT.0 WILL OCCUR IF NB.GT.MAGX AND ABS(J-
31 C SUB-NB-OF-X/J-SUB-MAGX+NP-OF-X).LT.10.**(NTEN/2), I.E. NB
32 C IS MUCH GREATER THAN MAGX. IN THIS CASE, B(N) IS CALCU-
33 C LATED TO THE DESIRED ACCURACY FOR N.LE.NCALC, BUT FOR
34 C NCALC.LT.N.LE.NB, PRECISION IS LOST. IF N.GT.NCALC AND
35 C ABS(B(NCALC)/B(N)).EQ.10**-K, THEN THE LAST K SIGNIFICANT
36 C FIGURES OF B(N) ARE ERRONEOUS. IF THE USER WISHES TO
37 C CALCULATE B(N) TO HIGHER ACCURACY, HE SHOULD USE AN
38 C ASYMPTOTIC FORMULA FOR LARGE ORDER.
39 C
40 REAL X,B(NB)
41 C
42 C CHECK INPUT VALUES
43 C
44 C AN UPPER LIMIT OF 10000 IS SET ON THE MAGNITUDE OF X.
45 C BEAR IN MIND THAT IF ABS(X)=N, THEN AT LEAST N ITERATIONS
46 C OF THE BACKWARD RECURSION WILL BE EXECUTED.
47 C
48 MAGX = ABS(X)
49 C
50 C/6S
51 C IF (MAGX .GT. 10000) CALL SETERR(
52 C 1 33H BESRJ - X IS TOO BIG (MAGNITUDE),33,1,2)
53 C/7S
54 IF (MAGX .GT. 10000) CALL SETERR(
55 1 ' BESRJ - X IS TOO BIG (MAGNITUDE)',33,1,2)
56 C/
57 C
58 C/6S
59 C IF (NB .LT. 1) CALL SETERR(
60 C 1 28H BESRJ - NB SHOULD = ORDER+1,28,2,2)
61 C/7S
62 IF (NB .LT. 1) CALL SETERR(
63 1 ' BESRJ - NB SHOULD = ORDER+1',28,2,2)
64 C/
65 C
66 C BESRJ CALLS ON THE SUBPROGRAM,B1SLR,
67 C WHICH IS SOOKNES ORIGINAL BESLRI.
68 C
69 C THE ADDITIONAL INPUT ARGUMENTS REQUIRED FOR IT ARE -
70 C
71 C IZE INTEGER TYPE. ZERO IF J*S ARE TO BE CALCULATED, 1
72 C IF I*S ARE TO BE CALCULATED.(THIRD ARGUMENT BELOW)
73 C
74 C NCALC INTEGER TYPE, NEED NOT BE INITIALIZED BY USER.
75 C BEFORE USING THE RESULTS, IT SHOULD BE CHECKED THAT
76 C NCALC=NB, I.E. ALL ORDERS HAVE BEEN CALCULATED TO
77 C THE DESIRED ACCURACY.
78 C
79 CALL B1SLR (X, NB, 0, B, NCALC)
80 C
81 C TEST IF ALL GOT COMPUTED OK
82 C (SINCE SOME VALUES MAY BE OK, THIS IS A RECOVERABLE ERROR.)
83 C
84 IF (NB .EQ. NCALC) RETURN
85 C
86 NCALC = NCALC+10
87 C/6S
88 C CALL SETERR(
89 C 1 38H BESRJ - ONLY THIS MANY ANSWERS ARE OK,38,NCALC,1)
90 C/7S
91 CALL SETERR(
92 1 ' BESRJ - ONLY THIS MANY ANSWERS ARE OK',38,NCALC,1)
93 C/
94 C
95 RETURN
96 END
fvn_fnlib/fvn_fnlib.f90
Diff comments   View file @ d55dcfb
module fvn_fnlib 1 1 module fvn_fnlib
use fvn_common 2 2 use fvn_common
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3 3 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! This module is a generic interface for fn library 4 4 ! This module is a generic interface for fn library
! http://www.netlib.org/fn 5 5 ! http://www.netlib.org/fn
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 6 6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7 7
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 8 8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Elementary Functions 9 9 ! Elementary Functions
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 10 10 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
11 11
! Argument 12 12 ! Argument
interface carg 13 13 interface carg
real function carg(z) 14 14 real function carg(z)
complex :: z 15 15 complex :: z
end function carg 16 16 end function carg
real(kind(1.d0)) function zarg(z) 17 17 real(kind(1.d0)) function zarg(z)
complex(kind(1.d0)) :: z 18 18 complex(kind(1.d0)) :: z
end function zarg 19 19 end function zarg
end interface carg 20 20 end interface carg
21 21
! Cubic root 22 22 ! Cubic root
interface cbrt 23 23 interface cbrt
real function cbrt(x) 24 24 real function cbrt(x)
real :: x 25 25 real :: x
end function cbrt 26 26 end function cbrt
real(kind(1.d0)) function dcbrt(x) 27 27 real(kind(1.d0)) function dcbrt(x)
real(kind(1.d0)) :: x 28 28 real(kind(1.d0)) :: x
end function dcbrt 29 29 end function dcbrt
complex function ccbrt(z) 30 30 complex function ccbrt(z)
complex :: z 31 31 complex :: z
end function ccbrt 32 32 end function ccbrt
complex(kind(1.d0)) function zcbrt(z) 33 33 complex(kind(1.d0)) function zcbrt(z)
complex(kind(1.d0)) :: z 34 34 complex(kind(1.d0)) :: z
end function zcbrt 35 35 end function zcbrt
end interface cbrt 36 36 end interface cbrt
37 37
! (exp(x) -1)/x 38 38 ! (exp(x) -1)/x
interface exprl 39 39 interface exprl
real function exprel(x) 40 40 real function exprel(x)
real :: x 41 41 real :: x
end function exprel 42 42 end function exprel
real(kind(1.d0)) function dexprl(x) 43 43 real(kind(1.d0)) function dexprl(x)
real(kind(1.d0)) :: x 44 44 real(kind(1.d0)) :: x
end function dexprl 45 45 end function dexprl
complex function cexprl(z) 46 46 complex function cexprl(z)
complex :: z 47 47 complex :: z
end function cexprl 48 48 end function cexprl
complex(kind(1.d0)) function zexprl(z) 49 49 complex(kind(1.d0)) function zexprl(z)
complex(kind(1.d0)) :: z 50 50 complex(kind(1.d0)) :: z
end function zexprl 51 51 end function zexprl
end interface exprl 52 52 end interface exprl
53 53
! log10 extension to complex arguments 54 54 ! log10 extension to complex arguments
interface log10 55 55 interface log10
complex function clog10(z) 56 56 complex function clog10(z)
complex :: z 57 57 complex :: z
end function clog10 58 58 end function clog10
complex(kind(1.d0)) function zlog10(z) 59 59 complex(kind(1.d0)) function zlog10(z)
complex(kind(1.d0)) :: z 60 60 complex(kind(1.d0)) :: z
end function zlog10 61 61 end function zlog10
end interface log10 62 62 end interface log10
63 63
! ln(x+1) 64 64 ! ln(x+1)
interface alnrel 65 65 interface alnrel
real function alnrel(x) 66 66 real function alnrel(x)
real :: x 67 67 real :: x
end function alnrel 68 68 end function alnrel
real(kind(1.d0)) function dlnrel(x) 69 69 real(kind(1.d0)) function dlnrel(x)
real(kind(1.d0)) :: x 70 70 real(kind(1.d0)) :: x
end function dlnrel 71 71 end function dlnrel
complex function clnrel(z) 72 72 complex function clnrel(z)
complex :: z 73 73 complex :: z
end function clnrel 74 74 end function clnrel
complex(kind(1.d0)) function zlnrel(z) 75 75 complex(kind(1.d0)) function zlnrel(z)
complex(kind(1.d0)) :: z 76 76 complex(kind(1.d0)) :: z
end function zlnrel 77 77 end function zlnrel
end interface alnrel 78 78 end interface alnrel
79 79
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 80 80 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Elementary Functions 81 81 ! END Elementary Functions
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 82 82 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
83 83
84 84
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 85 85 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Trigonometry 86 86 ! Trigonometry
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 87 87 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
88 88
! Extension de la tangente aux arguments complexes 89 89 ! Extension de la tangente aux arguments complexes
interface tan 90 90 interface tan
complex function ctan(z) 91 91 complex function ctan(z)
complex :: z 92 92 complex :: z
end function ctan 93 93 end function ctan
complex(kind(1.d0)) function ztan(z) 94 94 complex(kind(1.d0)) function ztan(z)
complex(kind(1.d0)) :: z 95 95 complex(kind(1.d0)) :: z
end function ztan 96 96 end function ztan
end interface tan 97 97 end interface tan
98 98
! Cotangente 99 99 ! Cotangente
interface cot 100 100 interface cot
real function cot(x) 101 101 real function cot(x)
real :: x 102 102 real :: x
end function cot 103 103 end function cot
real(kind(1.d0)) function dcot(x) 104 104 real(kind(1.d0)) function dcot(x)
real(kind(1.d0)) :: x 105 105 real(kind(1.d0)) :: x
end function dcot 106 106 end function dcot
complex function ccot(z) 107 107 complex function ccot(z)
complex :: z 108 108 complex :: z
end function ccot 109 109 end function ccot
complex(kind(1.d0)) function zcot(z) 110 110 complex(kind(1.d0)) function zcot(z)
complex(kind(1.d0)) :: z 111 111 complex(kind(1.d0)) :: z
end function zcot 112 112 end function zcot
end interface cot 113 113 end interface cot
114 114
! Sinus in degree 115 115 ! Sinus in degree
interface sindg 116 116 interface sindg
real function sindg(x) 117 117 real function sindg(x)
real :: x 118 118 real :: x
end function sindg 119 119 end function sindg
real(kind(1.d0)) function dsindg(x) 120 120 real(kind(1.d0)) function dsindg(x)
real(kind(1.d0)) :: x 121 121 real(kind(1.d0)) :: x
end function dsindg 122 122 end function dsindg
end interface sindg 123 123 end interface sindg
124 124
! Cosinus in degree 125 125 ! Cosinus in degree
interface cosdg 126 126 interface cosdg
real function cosdg(x) 127 127 real function cosdg(x)
real :: x 128 128 real :: x
end function cosdg 129 129 end function cosdg
real(kind(1.d0)) function dcosdg(x) 130 130 real(kind(1.d0)) function dcosdg(x)
real(kind(1.d0)) :: x 131 131 real(kind(1.d0)) :: x
end function dcosdg 132 132 end function dcosdg
end interface cosdg 133 133 end interface cosdg
134 134
135 135
! Extension de l'arcsinus aux arguments complexes 136 136 ! Extension de l'arcsinus aux arguments complexes
interface asin 137 137 interface asin
complex function casin(z) 138 138 complex function casin(z)
complex :: z 139 139 complex :: z
end function casin 140 140 end function casin
complex(kind(1.d0)) function zasin(z) 141 141 complex(kind(1.d0)) function zasin(z)
complex(kind(1.d0)) :: z 142 142 complex(kind(1.d0)) :: z
end function zasin 143 143 end function zasin
end interface asin 144 144 end interface asin
145 145
! Extension de l'arccosinus aux arguments complexes 146 146 ! Extension de l'arccosinus aux arguments complexes
interface acos 147 147 interface acos
complex function cacos(z) 148 148 complex function cacos(z)
complex :: z 149 149 complex :: z
end function cacos 150 150 end function cacos
complex(kind(1.d0)) function zacos(z) 151 151 complex(kind(1.d0)) function zacos(z)
complex(kind(1.d0)) :: z 152 152 complex(kind(1.d0)) :: z
end function zacos 153 153 end function zacos
end interface acos 154 154 end interface acos
155 155
! Extension de l'arctangente aux arguments complexes 156 156 ! Extension de l'arctangente aux arguments complexes
interface atan 157 157 interface atan
complex function catan(z) 158 158 complex function catan(z)
complex :: z 159 159 complex :: z
end function catan 160 160 end function catan
complex(kind(1.d0)) function zatan(z) 161 161 complex(kind(1.d0)) function zatan(z)
complex(kind(1.d0)) :: z 162 162 complex(kind(1.d0)) :: z
end function zatan 163 163 end function zatan
end interface atan 164 164 end interface atan
165 165
! Extension de atan2 aux arguments complexes 166 166 ! Extension de atan2 aux arguments complexes
interface atan2 167 167 interface atan2
complex function catan2(csn,ccs) 168 168 complex function catan2(csn,ccs)
complex :: csn,ccs 169 169 complex :: csn,ccs
end function catan2 170 170 end function catan2
complex(kind(1.d0)) function zatan2(csn,ccs) 171 171 complex(kind(1.d0)) function zatan2(csn,ccs)
complex(kind(1.d0)) :: csn,ccs 172 172 complex(kind(1.d0)) :: csn,ccs
end function zatan2 173 173 end function zatan2
end interface atan2 174 174 end interface atan2
175 175
176 176
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 177 177 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Hyperbolic Trigonometry 178 178 ! Hyperbolic Trigonometry
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 179 179 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Extension du Sinus hyperbolique aux arguments complexes 180 180 ! Extension du Sinus hyperbolique aux arguments complexes
interface sinh 181 181 interface sinh
complex function csinh(z) 182 182 complex function csinh(z)
complex :: z 183 183 complex :: z
end function csinh 184 184 end function csinh
complex(kind(1.d0)) function zsinh(z) 185 185 complex(kind(1.d0)) function zsinh(z)
complex(kind(1.d0)) :: z 186 186 complex(kind(1.d0)) :: z
end function zsinh 187 187 end function zsinh
end interface sinh 188 188 end interface sinh
189 189
! Extension du Cosinus hyperbolique aux arguments complexes 190 190 ! Extension du Cosinus hyperbolique aux arguments complexes
interface cosh 191 191 interface cosh
complex function ccosh(z) 192 192 complex function ccosh(z)
complex :: z 193 193 complex :: z
end function ccosh 194 194 end function ccosh
complex(kind(1.d0)) function zcosh(z) 195 195 complex(kind(1.d0)) function zcosh(z)
complex(kind(1.d0)) :: z 196 196 complex(kind(1.d0)) :: z
end function zcosh 197 197 end function zcosh
end interface cosh 198 198 end interface cosh
199 199
! Extension de la tangente hyperbolique aux arguments complexes 200 200 ! Extension de la tangente hyperbolique aux arguments complexes
interface tanh 201 201 interface tanh
complex function ctanh(z) 202 202 complex function ctanh(z)
complex :: z 203 203 complex :: z
end function ctanh 204 204 end function ctanh
complex(kind(1.d0)) function ztanh(z) 205 205 complex(kind(1.d0)) function ztanh(z)
complex(kind(1.d0)) :: z 206 206 complex(kind(1.d0)) :: z
end function ztanh 207 207 end function ztanh
end interface tanh 208 208 end interface tanh
209 209
! Arc sinus hyperbolique 210 210 ! Arc sinus hyperbolique
interface asinh 211 211 interface asinh
real function asinh(x) 212 212 real function asinh(x)
real :: x 213 213 real :: x
end function asinh 214 214 end function asinh
real(kind(1.d0)) function dasinh(x) 215 215 real(kind(1.d0)) function dasinh(x)
real(kind(1.d0)) :: x 216 216 real(kind(1.d0)) :: x
end function dasinh 217 217 end function dasinh
complex function casinh(z) 218 218 complex function casinh(z)
complex :: z 219 219 complex :: z
end function casinh 220 220 end function casinh
complex(kind(1.d0)) function zasinh(z) 221 221 complex(kind(1.d0)) function zasinh(z)
complex(kind(1.d0)) :: z 222 222 complex(kind(1.d0)) :: z
end function zasinh 223 223 end function zasinh
end interface asinh 224 224 end interface asinh
225 225
! Arc cosinus hyperbolique 226 226 ! Arc cosinus hyperbolique
interface acosh 227 227 interface acosh
real function acosh(x) 228 228 real function acosh(x)
real :: x 229 229 real :: x
end function acosh 230 230 end function acosh
real(kind(1.d0)) function dacosh(x) 231 231 real(kind(1.d0)) function dacosh(x)
real(kind(1.d0)) :: x 232 232 real(kind(1.d0)) :: x
end function dacosh 233 233 end function dacosh
complex function cacosh(z) 234 234 complex function cacosh(z)
complex :: z 235 235 complex :: z
end function cacosh 236 236 end function cacosh
complex(kind(1.d0)) function zacosh(z) 237 237 complex(kind(1.d0)) function zacosh(z)
complex(kind(1.d0)) :: z 238 238 complex(kind(1.d0)) :: z
end function zacosh 239 239 end function zacosh
end interface acosh 240 240 end interface acosh
241 241
! Arc tangente hyperbolique 242 242 ! Arc tangente hyperbolique
interface atanh 243 243 interface atanh
real function atanh(x) 244 244 real function atanh(x)
real :: x 245 245 real :: x
end function atanh 246 246 end function atanh
real(kind(1.d0)) function datanh(x) 247 247 real(kind(1.d0)) function datanh(x)
real(kind(1.d0)) :: x 248 248 real(kind(1.d0)) :: x
end function datanh 249 249 end function datanh
complex function catanh(z) 250 250 complex function catanh(z)
complex :: z 251 251 complex :: z
end function catanh 252 252 end function catanh
complex(kind(1.d0)) function zatanh(z) 253 253 complex(kind(1.d0)) function zatanh(z)
complex(kind(1.d0)) :: z 254 254 complex(kind(1.d0)) :: z
end function zatanh 255 255 end function zatanh
end interface atanh 256 256 end interface atanh
257 257
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 258 258 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Trigonometry 259 259 ! END Trigonometry
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 260 260 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
261 261
262 262
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 263 263 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Exponential integral and related 264 264 ! Exponential integral and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 265 265 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
266 266
! Exponential integral ei(x) 267 267 ! Exponential integral ei(x)
interface ei 268 268 interface ei
real function ei(x) 269 269 real function ei(x)
real :: x 270 270 real :: x
end function ei 271 271 end function ei
real(kind(1.d0)) function dei(x) 272 272 real(kind(1.d0)) function dei(x)
real(kind(1.d0)) :: x 273 273 real(kind(1.d0)) :: x
end function dei 274 274 end function dei
end interface ei 275 275 end interface ei
276 276
! Exponential integral e1(x) 277 277 ! Exponential integral e1(x)
interface e1 278 278 interface e1
real function e1(x) 279 279 real function e1(x)
real :: x 280 280 real :: x
end function e1 281 281 end function e1
real(kind(1.d0)) function de1(x) 282 282 real(kind(1.d0)) function de1(x)
real(kind(1.d0)) :: x 283 283 real(kind(1.d0)) :: x
end function de1 284 284 end function de1
complex(kind(1.d0)) function ze1(x) 285 285 complex(kind(1.d0)) function ze1(x)
complex(kind(1.d0)) :: x 286 286 complex(kind(1.d0)) :: x
end function 287 287 end function
end interface e1 288 288 end interface e1
289 289
!!!!!!!!!!!!!!! 290 290 !!!!!!!!!!!!!!!
! MISSING ENE 291 291 ! MISSING ENE
!!!!!!!!!!!!!!! 292 292 !!!!!!!!!!!!!!!
293 293
! Logarithm integral 294 294 ! Logarithm integral
interface ali 295 295 interface ali
real function ali(x) 296 296 real function ali(x)
real :: x 297 297 real :: x
end function ali 298 298 end function ali
real(kind(1.d0)) function dli(x) 299 299 real(kind(1.d0)) function dli(x)
real(kind(1.d0)) :: x 300 300 real(kind(1.d0)) :: x
end function dli 301 301 end function dli
end interface ali 302 302 end interface ali
303 303
! Sine integral 304 304 ! Sine integral
interface si 305 305 interface si
real function si(x) 306 306 real function si(x)
real :: x 307 307 real :: x
end function si 308 308 end function si
real(kind(1.d0)) function dsi(x) 309 309 real(kind(1.d0)) function dsi(x)
real(kind(1.d0)) :: x 310 310 real(kind(1.d0)) :: x
end function dsi 311 311 end function dsi
end interface si 312 312 end interface si
313 313
! Cosine integral 314 314 ! Cosine integral
interface ci 315 315 interface ci
real function ci(x) 316 316 real function ci(x)
real :: x 317 317 real :: x
end function ci 318 318 end function ci
real(kind(1.d0)) function dci(x) 319 319 real(kind(1.d0)) function dci(x)
real(kind(1.d0)) :: x 320 320 real(kind(1.d0)) :: x
end function dci 321 321 end function dci
end interface ci 322 322 end interface ci
323 323
! Cosine integral alternate definition 324 324 ! Cosine integral alternate definition
interface cin 325 325 interface cin
real function cin(x) 326 326 real function cin(x)
real :: x 327 327 real :: x
end function cin 328 328 end function cin
real(kind(1.d0)) function dcin(x) 329 329 real(kind(1.d0)) function dcin(x)
real(kind(1.d0)) :: x 330 330 real(kind(1.d0)) :: x
end function dcin 331 331 end function dcin
end interface cin 332 332 end interface cin
333 333
! Hyperbolic sine integral 334 334 ! Hyperbolic sine integral
interface shi 335 335 interface shi
real function shi(x) 336 336 real function shi(x)
real :: x 337 337 real :: x
end function shi 338 338 end function shi
real(kind(1.d0)) function dshi(x) 339 339 real(kind(1.d0)) function dshi(x)
real(kind(1.d0)) :: x 340 340 real(kind(1.d0)) :: x
end function dshi 341 341 end function dshi
end interface shi 342 342 end interface shi
343 343
! Hyperbolic cosine integral 344 344 ! Hyperbolic cosine integral
interface chi 345 345 interface chi
real function chi(x) 346 346 real function chi(x)
real :: x 347 347 real :: x
end function chi 348 348 end function chi
real(kind(1.d0)) function dchi(x) 349 349 real(kind(1.d0)) function dchi(x)
real(kind(1.d0)) :: x 350 350 real(kind(1.d0)) :: x
end function dchi 351 351 end function dchi
end interface chi 352 352 end interface chi
353 353
! Hyperbolic cosine integral alternate definition 354 354 ! Hyperbolic cosine integral alternate definition
interface cinh 355 355 interface cinh
real function cinh(x) 356 356 real function cinh(x)
real :: x 357 357 real :: x
end function cinh 358 358 end function cinh
real(kind(1.d0)) function dcinh(x) 359 359 real(kind(1.d0)) function dcinh(x)
real(kind(1.d0)) :: x 360 360 real(kind(1.d0)) :: x
end function dcinh 361 361 end function dcinh
end interface cinh 362 362 end interface cinh
363 363
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 364 364 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Exponential integral and related 365 365 ! END Exponential integral and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 366 366 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
367 367
368 368
369 369
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 370 370 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Gamma family 371 371 ! Gamma family
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 372 372 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
373 373
! No generic interface for fac and binom but we still 374 374 ! No generic interface for fac and binom but we still
! define their prototypes 375 375 ! define their prototypes
! Factorial 376 376 ! Factorial
interface 377 377 interface
real function fac(n) 378 378 real function fac(n)
integer :: n 379 379 integer :: n
end function fac 380 380 end function fac
real(kind(1.d0)) function dfac(n) 381 381 real(kind(1.d0)) function dfac(n)
integer :: n 382 382 integer :: n
end function dfac 383 383 end function dfac
! Binomial coefficient 384 384 ! Binomial coefficient
real function binom(n,m) 385 385 real function binom(n,m)
integer :: n,m 386 386 integer :: n,m
end function binom 387 387 end function binom
real(kind(1.d0)) function dbinom(n,m) 388 388 real(kind(1.d0)) function dbinom(n,m)
integer :: n,m 389 389 integer :: n,m
end function dbinom 390 390 end function dbinom
end interface 391 391 end interface
392 392
! Gamma function 393 393 ! Gamma function
interface gamma 394 394 interface gamma
real function gamma(x) 395 395 real function gamma(x)
real :: x 396 396 real :: x
end function gamma 397 397 end function gamma
real(kind(1.d0)) function dgamma(x) 398 398 real(kind(1.d0)) function dgamma(x)
real(kind(1.d0)) :: x 399 399 real(kind(1.d0)) :: x
end function dgamma 400 400 end function dgamma
complex function cgamma(z) 401 401 complex function cgamma(z)
complex :: z 402 402 complex :: z
end function cgamma 403 403 end function cgamma
complex(kind(1.d0)) function zgamma(z) 404 404 complex(kind(1.d0)) function zgamma(z)
complex(kind(1.d0)) :: z 405 405 complex(kind(1.d0)) :: z
end function zgamma 406 406 end function zgamma
end interface gamma 407 407 end interface gamma
408 408
! Reciprocal of gamma function 409 409 ! Reciprocal of gamma function
interface gamr 410 410 interface gamr
real function gamr(x) 411 411 real function gamr(x)
real :: x 412 412 real :: x
end function gamr 413 413 end function gamr
real(kind(1.d0)) function dgamr(x) 414 414 real(kind(1.d0)) function dgamr(x)
real(kind(1.d0)) :: x 415 415 real(kind(1.d0)) :: x
end function dgamr 416 416 end function dgamr
complex function cgamr(z) 417 417 complex function cgamr(z)
complex :: z 418 418 complex :: z
end function cgamr 419 419 end function cgamr
complex(kind(1.d0)) function zgamr(z) 420 420 complex(kind(1.d0)) function zgamr(z)
complex(kind(1.d0)) :: z 421 421 complex(kind(1.d0)) :: z
end function zgamr 422 422 end function zgamr
end interface gamr 423 423 end interface gamr
424 424
! natural log of abs(gamma) 425 425 ! natural log of abs(gamma)
interface alngam 426 426 interface alngam
real function alngam(x) 427 427 real function alngam(x)
real :: x 428 428 real :: x
end function alngam 429 429 end function alngam
real(kind(1.d0)) function dlngam(x) 430 430 real(kind(1.d0)) function dlngam(x)
real(kind(1.d0)) :: x 431 431 real(kind(1.d0)) :: x
end function dlngam 432 432 end function dlngam
complex function clngam(z) 433 433 complex function clngam(z)
complex :: z 434 434 complex :: z
end function clngam 435 435 end function clngam
complex(kind(1.d0)) function zlngam(z) 436 436 complex(kind(1.d0)) function zlngam(z)
complex(kind(1.d0)) :: z 437 437 complex(kind(1.d0)) :: z
end function zlngam 438 438 end function zlngam
end interface alngam 439 439 end interface alngam
440 440
! log abs gamma and sign 441 441 ! log abs gamma and sign
interface algams 442 442 interface algams
subroutine algams(x,algam,sgngam) 443 443 subroutine algams(x,algam,sgngam)
real :: x 444 444 real :: x
end subroutine algams 445 445 end subroutine algams
subroutine dlgams(x,algam,sgngam) 446 446 subroutine dlgams(x,algam,sgngam)
real(kind(1.d0)) :: x 447 447 real(kind(1.d0)) :: x
end subroutine dlgams 448 448 end subroutine dlgams
end interface algams 449 449 end interface algams
450 450
! Incomplete gamma function 451 451 ! Incomplete gamma function
interface gami 452 452 interface gami
real function gami(a,x) 453 453 real function gami(a,x)
real :: a,x 454 454 real :: a,x
end function gami 455 455 end function gami
real(kind(1.d0)) function dgami(a,x) 456 456 real(kind(1.d0)) function dgami(a,x)
real(kind(1.d0)) :: a,x 457 457 real(kind(1.d0)) :: a,x
end function dgami 458 458 end function dgami
end interface gami 459 459 end interface gami
460 460
! Complementary incomplete gamma function 461 461 ! Complementary incomplete gamma function
interface gamic 462 462 interface gamic
real function gamic(a,x) 463 463 real function gamic(a,x)
real :: a,x 464 464 real :: a,x
end function gamic 465 465 end function gamic
real(kind(1.d0)) function dgamic(a,x) 466 466 real(kind(1.d0)) function dgamic(a,x)
real(kind(1.d0)) :: a,x 467 467 real(kind(1.d0)) :: a,x
end function dgamic 468 468 end function dgamic
end interface gamic 469 469 end interface gamic
470 470
! Tricomi's incomplete gamma function 471 471 ! Tricomi's incomplete gamma function
interface gamit 472 472 interface gamit
real function gamit(a,x) 473 473 real function gamit(a,x)
real :: a,x 474 474 real :: a,x
end function gamit 475 475 end function gamit
real(kind(1.d0)) function dgamit(a,x) 476 476 real(kind(1.d0)) function dgamit(a,x)
real(kind(1.d0)) :: a,x 477 477 real(kind(1.d0)) :: a,x
end function dgamit 478 478 end function dgamit
end interface gamit 479 479 end interface gamit
480 480
! Psi function 481 481 ! Psi function
interface psi 482 482 interface psi
real function psi(x) 483 483 real function psi(x)
real :: x 484 484 real :: x
end function psi 485 485 end function psi
real(kind(1.d0)) function dpsi(x) 486 486 real(kind(1.d0)) function dpsi(x)
real(kind(1.d0)) :: x 487 487 real(kind(1.d0)) :: x
end function dpsi 488 488 end function dpsi
complex function cpsi(z) 489 489 complex function cpsi(z)
complex :: z 490 490 complex :: z
end function cpsi 491 491 end function cpsi
complex(kind(1.d0)) function zpsi(z) 492 492 complex(kind(1.d0)) function zpsi(z)
complex(kind(1.d0)) :: z 493 493 complex(kind(1.d0)) :: z
end function zpsi 494 494 end function zpsi
end interface psi 495 495 end interface psi
496 496
! Pochhammer 497 497 ! Pochhammer
interface poch 498 498 interface poch
real function poch(a,x) 499 499 real function poch(a,x)
real :: a,x 500 500 real :: a,x
end function poch 501 501 end function poch
real(kind(1.d0)) function dpoch(a,x) 502 502 real(kind(1.d0)) function dpoch(a,x)
real(kind(1.d0)) :: a,x 503 503 real(kind(1.d0)) :: a,x
end function dpoch 504 504 end function dpoch
end interface poch 505 505 end interface poch
506 506
! Pochhammer first order 507 507 ! Pochhammer first order
interface poch1 508 508 interface poch1
real function poch1(a,x) 509 509 real function poch1(a,x)
real :: a,x 510 510 real :: a,x
end function poch1 511 511 end function poch1
real(kind(1.d0)) function dpoch1(a,x) 512 512 real(kind(1.d0)) function dpoch1(a,x)
real(kind(1.d0)) :: a,x 513 513 real(kind(1.d0)) :: a,x
end function dpoch1 514 514 end function dpoch1
end interface poch1 515 515 end interface poch1
516 516
! Beta function 517 517 ! Beta function
interface beta 518 518 interface beta
real function beta(a,b) 519 519 real function beta(a,b)
real :: a,b 520 520 real :: a,b
end function beta 521 521 end function beta
real(kind(1.d0)) function dbeta(a,b) 522 522 real(kind(1.d0)) function dbeta(a,b)
real(kind(1.d0)) :: a,b 523 523 real(kind(1.d0)) :: a,b
end function dbeta 524 524 end function dbeta
complex function cbeta(a,b) 525 525 complex function cbeta(a,b)
complex :: a,b 526 526 complex :: a,b
end function cbeta 527 527 end function cbeta
complex(kind(1.d0)) function zbeta(a,b) 528 528 complex(kind(1.d0)) function zbeta(a,b)
complex(kind(1.d0)) :: a,b 529 529 complex(kind(1.d0)) :: a,b
end function zbeta 530 530 end function zbeta
end interface beta 531 531 end interface beta
532 532
! natural log of beta 533 533 ! natural log of beta
interface albeta 534 534 interface albeta
real function albeta(a,b) 535 535 real function albeta(a,b)
real :: a,b 536 536 real :: a,b
end function albeta 537 537 end function albeta
real(kind(1.d0)) function dlbeta(a,b) 538 538 real(kind(1.d0)) function dlbeta(a,b)
real(kind(1.d0)) :: a,b 539 539 real(kind(1.d0)) :: a,b
end function dlbeta 540 540 end function dlbeta
complex function clbeta(a,b) 541 541 complex function clbeta(a,b)
complex :: a,b 542 542 complex :: a,b
end function clbeta 543 543 end function clbeta
complex(kind(1.d0)) function zlbeta(a,b) 544 544 complex(kind(1.d0)) function zlbeta(a,b)
complex(kind(1.d0)) :: a,b 545 545 complex(kind(1.d0)) :: a,b
end function zlbeta 546 546 end function zlbeta
end interface albeta 547 547 end interface albeta
548 548
! Incomplete beta function 549 549 ! Incomplete beta function
interface betai 550 550 interface betai
real function betai(x,pin,qin) 551 551 real function betai(x,pin,qin)
real :: x,pin,qin 552 552 real :: x,pin,qin
end function betai 553 553 end function betai
real(kind(1.d0)) function dbetai(x,pin,qin) 554 554 real(kind(1.d0)) function dbetai(x,pin,qin)
real(kind(1.d0)) :: x,pin,qin 555 555 real(kind(1.d0)) :: x,pin,qin
end function dbetai 556 556 end function dbetai
end interface betai 557 557 end interface betai
558 558
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 559 559 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Gamma family 560 560 ! END Gamma family
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 561 561 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
562 562
563 563
564 564
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 565 565 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Error function and related 566 566 ! Error function and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 567 567 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
568 568
! Error function 569 569 ! Error function
interface erf 570 570 interface erf
real function erf(x) 571 571 real function erf(x)
real :: x 572 572 real :: x
end function erf 573 573 end function erf
real(kind(1.d0)) function derf(x) 574 574 real(kind(1.d0)) function derf(x)
real(kind(1.d0)) :: x 575 575 real(kind(1.d0)) :: x
end function derf 576 576 end function derf
end interface erf 577 577 end interface erf
578 578
! Complementary error function 579 579 ! Complementary error function
interface erfc 580 580 interface erfc
real function erfc(x) 581 581 real function erfc(x)
real :: x 582 582 real :: x
end function erfc 583 583 end function erfc
real(kind(1.d0)) function derfc(x) 584 584 real(kind(1.d0)) function derfc(x)
real(kind(1.d0)) :: x 585 585 real(kind(1.d0)) :: x
end function derfc 586 586 end function derfc
end interface erfc 587 587 end interface erfc
588 588
!!!!!!!!!!! 589 589 !!!!!!!!!!!
! MISSING ERFCE 590 590 ! MISSING ERFCE
! MISSING CERFI 591 591 ! MISSING CERFI
! MISSING ERFI 592 592 ! MISSING ERFI
! MISSING ERFCI 593 593 ! MISSING ERFCI
!!!!!!!!!!!!!! 594 594 !!!!!!!!!!!!!!
595 595
! Dawson's function 596 596 ! Dawson's function
interface daws 597 597 interface daws
real function daws(x) 598 598 real function daws(x)
real :: x 599 599 real :: x
end function daws 600 600 end function daws
real(kind(1.d0)) function ddaws(x) 601 601 real(kind(1.d0)) function ddaws(x)
real(kind(1.d0)) :: x 602 602 real(kind(1.d0)) :: x
end function ddaws 603 603 end function ddaws
end interface daws 604 604 end interface daws
605 605
!!!!!!!!!!!!!!!!! 606 606 !!!!!!!!!!!!!!!!!
! MISSING FRESC 607 607 ! MISSING FRESC
! MISSING FRESS 608 608 ! MISSING FRESS
!!!!!!!!!!!!!!!!! 609 609 !!!!!!!!!!!!!!!!!
610 610
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 611 611 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Error function and related 612 612 ! END Error function and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 613 613 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
614 614
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 615 615 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bessel functions and related 616 616 ! Bessel functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 617 617 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
618 618
!J0(x) 619 619 !J0(x)
interface bsj0 620 620 interface bsj0
real function besj0(x) 621 621 real function besj0(x)
real :: x 622 622 real :: x
end function besj0 623 623 end function besj0
real(kind(1.d0)) function dbesj0(x) 624 624 real(kind(1.d0)) function dbesj0(x)
real(kind(1.d0)) :: x 625 625 real(kind(1.d0)) :: x
end function dbesj0 626 626 end function dbesj0
end interface bsj0 627 627 end interface bsj0
628 628
!J1(x) 629 629 !J1(x)
interface bsj1 630 630 interface bsj1
real function besj1(x) 631 631 real function besj1(x)
real :: x 632 632 real :: x
end function besj1 633 633 end function besj1
real(kind(1.d0)) function dbesj1(x) 634 634 real(kind(1.d0)) function dbesj1(x)
real(kind(1.d0)) :: x 635 635 real(kind(1.d0)) :: x
end function dbesj1 636 636 end function dbesj1
end interface bsj1 637 637 end interface bsj1
638 638
!Y0(x) 639 639 !Y0(x)
interface bsy0 640 640 interface bsy0
real function besy0(x) 641 641 real function besy0(x)
real :: x 642 642 real :: x
end function besy0 643 643 end function besy0
real(kind(1.d0)) function dbesy0(x) 644 644 real(kind(1.d0)) function dbesy0(x)
real(kind(1.d0)) x 645 645 real(kind(1.d0)) x
end function dbesy0 646 646 end function dbesy0
end interface bsy0 647 647 end interface bsy0
648 648
!Y1(x) 649 649 !Y1(x)
interface bsy1 650 650 interface bsy1
real function besy1(x) 651 651 real function besy1(x)
real :: x 652 652 real :: x
end function besy1 653 653 end function besy1
real(kind(1.d0)) function dbesy1(x) 654 654 real(kind(1.d0)) function dbesy1(x)
real(kind(1.d0)) x 655 655 real(kind(1.d0)) x
end function dbesy1 656 656 end function dbesy1
end interface bsy1 657 657 end interface bsy1
658 658
!I0(x) 659 659 !I0(x)
interface bsi0 660 660 interface bsi0
real function besi0(x) 661 661 real function besi0(x)
real :: x 662 662 real :: x
end function besi0 663 663 end function besi0
real(kind(1.d0)) function dbesi0(x) 664 664 real(kind(1.d0)) function dbesi0(x)
real(kind(1.d0)) x 665 665 real(kind(1.d0)) x
end function dbesi0 666 666 end function dbesi0
end interface bsi0 667 667 end interface bsi0
668 668
!I1(x) 669 669 !I1(x)
interface bsi1 670 670 interface bsi1
real function besi1(x) 671 671 real function besi1(x)
real :: x 672 672 real :: x
end function besi1 673 673 end function besi1
real(kind(1.d0)) function dbesi1(x) 674 674 real(kind(1.d0)) function dbesi1(x)
real(kind(1.d0)) x 675 675 real(kind(1.d0)) x
end function dbesi1 676 676 end function dbesi1
end interface bsi1 677 677 end interface bsi1
678 678
!K0(x) 679 679 !K0(x)
interface bsk0 680 680 interface bsk0
real function besk0(x) 681 681 real function besk0(x)
real :: x 682 682 real :: x
end function besk0 683 683 end function besk0
real(kind(1.d0)) function dbesk0(x) 684 684 real(kind(1.d0)) function dbesk0(x)
real(kind(1.d0)) x 685 685 real(kind(1.d0)) x
end function dbesk0 686 686 end function dbesk0
end interface bsk0 687 687 end interface bsk0
688 688
!K1(x) 689 689 !K1(x)
interface bsk1 690 690 interface bsk1
real function besk1(x) 691 691 real function besk1(x)
real :: x 692 692 real :: x
end function besk1 693 693 end function besk1
real(kind(1.d0)) function dbesk1(x) 694 694 real(kind(1.d0)) function dbesk1(x)
real(kind(1.d0)) x 695 695 real(kind(1.d0)) x
end function dbesk1 696 696 end function dbesk1
end interface bsk1 697 697 end interface bsk1
698 698
! Exponentially scaled I0 699 699 ! Exponentially scaled I0
interface bsi0e 700 700 interface bsi0e
real function besi0e(x) 701 701 real function besi0e(x)
real :: x 702 702 real :: x
end function besi0e 703 703 end function besi0e
real(kind(1.d0)) function dbsi0e(x) 704 704 real(kind(1.d0)) function dbsi0e(x)
real(kind(1.d0)) :: x 705 705 real(kind(1.d0)) :: x
end function dbsi0e 706 706 end function dbsi0e
end interface bsi0e 707 707 end interface bsi0e
708 708
! Exponentially scaled I1 709 709 ! Exponentially scaled I1
interface bsi1e 710 710 interface bsi1e
real function besi1e(x) 711 711 real function besi1e(x)
real :: x 712 712 real :: x
end function besi1e 713 713 end function besi1e
real(kind(1.d0)) function dbsi1e(x) 714 714 real(kind(1.d0)) function dbsi1e(x)
real(kind(1.d0)) :: x 715 715 real(kind(1.d0)) :: x
end function dbsi1e 716 716 end function dbsi1e
end interface bsi1e 717 717 end interface bsi1e
718 718
! Exponentially scaled K0 719 719 ! Exponentially scaled K0
interface bsk0e 720 720 interface bsk0e
real function besk0e(x) 721 721 real function besk0e(x)
real :: x 722 722 real :: x
end function besk0e 723 723 end function besk0e
real(kind(1.d0)) function dbsk0e(x) 724 724 real(kind(1.d0)) function dbsk0e(x)
real(kind(1.d0)) :: x 725 725 real(kind(1.d0)) :: x
end function dbsk0e 726 726 end function dbsk0e
end interface bsk0e 727 727 end interface bsk0e
728 728
! Exponentially scaled K1 729 729 ! Exponentially scaled K1
interface bsk1e 730 730 interface bsk1e
real function besk1e(x) 731 731 real function besk1e(x)
real :: x 732 732 real :: x
end function besk1e 733 733 end function besk1e
real(kind(1.d0)) function dbsk1e(x) 734 734 real(kind(1.d0)) function dbsk1e(x)
real(kind(1.d0)) :: x 735 735 real(kind(1.d0)) :: x
end function dbsk1e 736 736 end function dbsk1e
end interface bsk1e 737 737 end interface bsk1e
738 738
! nth order J 739 739 ! nth order J
interface bsjn 740 740 interface bsjn
real function besjn(n,x,factor,big) 741 741 real function besjn(n,x,factor,big)
integer :: n 742 742 integer :: n
real :: x 743 743 real :: x
integer, optional :: factor 744 744 integer, optional :: factor
real, optional :: big 745 745 real, optional :: big
end function besjn 746 746 end function besjn
real(kind(1.d0)) function dbesjn(n,x,factor,big) 747 747 real(kind(1.d0)) function dbesjn(n,x,factor,big)
integer :: n 748 748 integer :: n
real(kind(1.d0)) :: x 749 749 real(kind(1.d0)) :: x
integer, optional :: factor 750 750 integer, optional :: factor
real(kind(1.d0)), optional :: big 751 751 real(kind(1.d0)), optional :: big
end function dbesjn 752 752 end function dbesjn
end interface bsjn 753 753 end interface bsjn
754 754
! nth order Y 755 755 ! nth order Y
interface bsyn 756 756 interface bsyn
real function besyn(n,x) 757 757 real function besyn(n,x)
integer :: n 758 758 integer :: n
real :: x 759 759 real :: x
end function besyn 760 760 end function besyn
real(kind(1.d0)) function dbesyn(n,x) 761 761 real(kind(1.d0)) function dbesyn(n,x)
integer :: n 762 762 integer :: n
real(kind(1.d0)) :: x 763 763 real(kind(1.d0)) :: x
end function dbesyn 764 764 end function dbesyn
end interface bsyn 765 765 end interface bsyn
766 766
! nth order I 767 767 ! nth order I
interface bsin 768 768 interface bsin
real function besin(n,x,factor,big) 769 769 real function besin(n,x,factor,big)
integer :: n 770 770 integer :: n
real :: x 771 771 real :: x
integer, optional :: factor 772 772 integer, optional :: factor
real, optional :: big 773 773 real, optional :: big
end function besin 774 774 end function besin
real(kind(1.d0)) function dbesin(n,x,factor,big) 775 775 real(kind(1.d0)) function dbesin(n,x,factor,big)
integer :: n 776 776 integer :: n
real(kind(1.d0)) :: x 777 777 real(kind(1.d0)) :: x
integer, optional :: factor 778 778 integer, optional :: factor
real(kind(1.d0)), optional :: big 779 779 real(kind(1.d0)), optional :: big
end function dbesin 780 780 end function dbesin
end interface bsin 781 781 end interface bsin
782 782
! nth order K 783 783 ! nth order K
interface bskn 784 784 interface bskn
real function beskn(n,x) 785 785 real function beskn(n,x)
integer :: n 786 786 integer :: n
real :: x 787 787 real :: x
end function beskn 788 788 end function beskn
real(kind(1.d0)) function dbeskn(n,x) 789 789 real(kind(1.d0)) function dbeskn(n,x)
integer :: n 790 790 integer :: n
real(kind(1.d0)) :: x 791 791 real(kind(1.d0)) :: x
end function dbeskn 792 792 end function dbeskn
end interface bskn 793 793 end interface bskn
794 794
!!!!!!!!!!!!!!!!!!!!! 795 795 !!!!!!!!!!!!!!!!!!!!!
! MISSING BSJNS, replaced by dbesrj (ChW 11/2009) 796 796 ! MISSING BSJNS, replaced by dbesrj (ChW 11/2009)
! MISSING BSINS, replaced by dbesri (ChW 11/2009) 797 797 ! MISSING BSINS, replaced by dbesri (ChW 11/2009)
! MISSING BSJS 798 798 ! MISSING BSJS
! MISSING BSYS 799 799 ! MISSING BSYS
! MISSING BSIS 800 800 ! MISSING BSIS
! MISSING BSIES 801 801 ! MISSING BSIES
!!!!!!!!!!!!!!!!!!!!! 802 802 !!!!!!!!!!!!!!!!!!!!!
! vector b of Bessel J values of x from order 0 to order (n-1) 803 803 ! vector b of Bessel J values of x from order 0 to order (n-1)
interface besrj 804 804 interface besrj
805 subroutine besrj(x,n,b)
806 real(kind(1.e0)), intent(in) :: x
807 integer, intent(in) :: n
808 real(kind(1.e0)), intent(out) :: b(n)
809 end subroutine besrj
subroutine dbesrj(x,n,b) 805 810 subroutine dbesrj(x,n,b)
real(kind(1.d0)) :: x 806 811 real(kind(1.d0)), intent(in) :: x
integer :: n 807 812 integer, intent(in) :: n
real(kind(1.d0)) :: b(n) 808 813 real(kind(1.d0)), intent(out) :: b(n)
end subroutine dbesrj 809 814 end subroutine dbesrj
end interface besrj 810 815 end interface besrj
811 816
! vector b of Bessel I values of x from order 0 to order (n-1) 812 817 ! vector b of Bessel I values of x from order 0 to order (n-1)
interface besri 813 818 interface besri
819 subroutine besri(x,n,b)
820 real(kind(1.e0)), intent(in) :: x
821 integer, intent(in) :: n
822 real(kind(1.e0)), intent(out) :: b(n)
823 end subroutine besri
subroutine dbesri(x,n,b) 814 824 subroutine dbesri(x,n,b)
real(kind(1.d0)) :: x 815 825 real(kind(1.d0)), intent(in) :: x
integer :: n 816 826 integer, intent(in) :: n
real(kind(1.d0)) :: b(n) 817 827 real(kind(1.d0)), intent(out) :: b(n)
end subroutine dbesri 818 828 end subroutine dbesri
end interface besri 819 829 end interface besri
820 830
! K nu + k 821 831 ! K nu + k
interface bsks 822 832 interface bsks
subroutine besks(xnu,x,nin,bk) 823 833 subroutine besks(xnu,x,nin,bk)
real :: xnu,x 824 834 real :: xnu,x
integer :: nin 825 835 integer :: nin
real, dimension(nin) :: bk 826 836 real, dimension(nin) :: bk
end subroutine besks 827 837 end subroutine besks
subroutine dbesks(xnu,x,nin,bk) 828 838 subroutine dbesks(xnu,x,nin,bk)
real(kind(1.d0)) :: xnu,x 829 839 real(kind(1.d0)) :: xnu,x
integer :: nin 830 840 integer :: nin
real(kind(1.d0)), dimension(nin) :: bk 831 841 real(kind(1.d0)), dimension(nin) :: bk
end subroutine dbesks 832 842 end subroutine dbesks
end interface bsks 833 843 end interface bsks
834 844
! Exponentially scaled K nu + k 835 845 ! Exponentially scaled K nu + k
interface bskes 836 846 interface bskes
subroutine beskes(xnu,x,nin,bke) 837 847 subroutine beskes(xnu,x,nin,bke)
real :: xnu,x 838 848 real :: xnu,x
integer :: nin 839 849 integer :: nin
real,dimension(nin) :: bke 840 850 real,dimension(nin) :: bke
end subroutine beskes 841 851 end subroutine beskes
subroutine dbskes(xnu,x,nin,bke) 842 852 subroutine dbskes(xnu,x,nin,bke)
real(kind(1.d0)) :: xnu,x 843 853 real(kind(1.d0)) :: xnu,x
integer :: nin 844 854 integer :: nin
real(kind(1.d0)),dimension(nin) :: bke 845 855 real(kind(1.d0)),dimension(nin) :: bke
end subroutine dbskes 846 856 end subroutine dbskes
end interface bskes 847 857 end interface bskes
848 858
!!!!!!!!!!!!!!!!!! 849 859 !!!!!!!!!!!!!!!!!!
! MISSING CBJS 850 860 ! MISSING CBJS
! MISSING CBYS 851 861 ! MISSING CBYS
! MISSING CBIS 852 862 ! MISSING CBIS
!!!!!!!!!!!!!!!!!! 853 863 !!!!!!!!!!!!!!!!!!
854 864
855 865
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 856 866 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Bessel functions and related 857 867 ! END Bessel functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 858 868 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
859 869
860 870
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 861 871 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Airy functions and related 862 872 ! Airy functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 863 873 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
864 874
!ai(x) 865 875 !ai(x)
interface ai 866 876 interface ai
real function ai(x) 867 877 real function ai(x)
real :: x 868 878 real :: x
end function ai 869 879 end function ai
real(kind(1.d0)) function dai(x) 870 880 real(kind(1.d0)) function dai(x)
real(kind(1.d0)) :: x 871 881 real(kind(1.d0)) :: x
end function dai 872 882 end function dai
end interface ai 873 883 end interface ai
874 884
!bi(x) 875 885 !bi(x)
interface bi 876 886 interface bi
real function bi(x) 877 887 real function bi(x)
real :: x 878 888 real :: x
end function bi 879 889 end function bi
real(kind(1.d0)) function dbi(x) 880 890 real(kind(1.d0)) function dbi(x)
real(kind(1.d0)) :: x 881 891 real(kind(1.d0)) :: x
end function dbi 882 892 end function dbi
end interface bi 883 893 end interface bi
884 894
!ai'(x) 885 895 !ai'(x)
interface aid 886 896 interface aid
real function aid(x) 887 897 real function aid(x)
real :: x 888 898 real :: x
end function aid 889 899 end function aid
real(kind(1.d0)) function daid(x) 890 900 real(kind(1.d0)) function daid(x)
real(kind(1.d0)) :: x 891 901 real(kind(1.d0)) :: x
end function daid 892 902 end function daid
end interface aid 893 903 end interface aid
894 904
!bi'(x) 895 905 !bi'(x)
interface bid 896 906 interface bid
real function bid(x) 897 907 real function bid(x)
real :: x 898 908 real :: x
end function bid 899 909 end function bid
real(kind(1.d0)) function dbid(x) 900 910 real(kind(1.d0)) function dbid(x)