lxsd / fvn

Download as
Browse Code ยป

Commit e1aefab23388470bc445506e2c9ccf682803f108

Authored by daniau
1 parent f26a262db0
Exists in master and in 3 other branches geevx, geevx_2020, multi

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

Showing 10 changed files with 577 additions and 1 deletions Inline Diff

1 1
include $(BTREE)/Make.inc 2 2 include $(BTREE)/Make.inc
3 3
library = libfvn_fnlib.a 4 4 library = libfvn_fnlib.a
5 5
objects = acosh.o aide.o aid.o aie.o \ 6 6 objects = acosh.o aide.o aid.o aie.o \
ai.o albeta.o algams.o ali.o \ 7 7 ai.o albeta.o algams.o ali.o \
alngam.o alnrel.o asinh.o atanh.o \ 8 8 alngam.o alnrel.o asinh.o atanh.o \
besi0e.o besi0.o besi1e.o besi1.o \ 9 9 besi0e.o besi0.o besi1e.o besi1.o \
besj0.o besj1.o besk0e.o besk0.o \ 10 10 besj0.o besj1.o besk0e.o besk0.o \
besk1e.o besk1.o beskes.o besks.o \ 11 11 besk1e.o besk1.o beskes.o besks.o \
besy0.o besy1.o betai.o beta.o \ 12 12 besy0.o besy1.o betai.o beta.o \
bide.o bid.o bie.o binom.o \ 13 13 bide.o bid.o bie.o binom.o \
bi.o c0lgmc.o c8lgmc.o c9lgmc.o \ 14 14 bi.o c0lgmc.o c8lgmc.o c9lgmc.o \
c9ln2r.o cacosh.o cacos.o carg.o \ 15 15 c9ln2r.o cacosh.o cacos.o carg.o \
casinh.o casin.o catan2.o catanh.o \ 16 16 casinh.o casin.o catan2.o catanh.o \
catan.o cbeta.o cbrt.o ccbrt.o \ 17 17 catan.o cbeta.o cbrt.o ccbrt.o \
ccosh.o ccot.o cexprl.o cgamma.o \ 18 18 ccosh.o ccot.o cexprl.o cgamma.o \
cgamr.o chi.o chu.o cinh.o \ 19 19 cgamr.o chi.o chu.o cinh.o \
cin.o ci.o clbeta.o clngam.o \ 20 20 cin.o ci.o clbeta.o clngam.o \
clnrel.o clog10.o comp1.o comp2.o \ 21 21 clnrel.o clog10.o comp1.o comp2.o \
comp3.o cosdg.o cot.o cpsi.o \ 22 22 comp3.o cosdg.o cot.o cpsi.o \
csevl.o csinh.o ctanh.o ctan.o \ 23 23 csevl.o csinh.o ctanh.o ctan.o \
d1mach.o d9admp.o d9aimp.o d9atn1.o \ 24 24 d1mach.o d9admp.o d9aimp.o d9atn1.o \
d9b0mp.o d9b1mp.o d9chm.o d9chu.o \ 25 25 d9b0mp.o d9b1mp.o d9chm.o d9chu.o \
d9gaml.o d9gmic.o d9gmit.o d9knus.o \ 26 26 d9gaml.o d9gmic.o d9gmit.o d9knus.o \
d9lgic.o d9lgit.o d9lgmc.o d9ln2r.o \ 27 27 d9lgic.o d9lgit.o d9lgmc.o d9ln2r.o \
d9pak.o d9sifg.o d9upak.o dacosh.o \ 28 28 d9pak.o d9sifg.o d9upak.o dacosh.o \
daide.o daid.o daie.o dai.o \ 29 29 daide.o daid.o daie.o dai.o \
dasinh.o datanh.o daws.o dbesi0.o \ 30 30 dasinh.o datanh.o daws.o dbesi0.o \
dbesi1.o dbesj0.o dbesj1.o dbesk0.o \ 31 31 dbesi1.o dbesj0.o dbesj1.o dbesk0.o \
dbesk1.o dbesks.o dbesy0.o dbesy1.o \ 32 32 dbesk1.o dbesks.o dbesy0.o dbesy1.o \
dbetai.o dbeta.o dbide.o dbid.o \ 33 33 dbetai.o dbeta.o dbide.o dbid.o \
dbie.o dbinom.o dbi.o dbsi0e.o \ 34 34 dbie.o dbinom.o dbi.o dbsi0e.o \
dbsi1e.o dbsk0e.o dbsk1e.o dbskes.o \ 35 35 dbsi1e.o dbsk0e.o dbsk1e.o dbskes.o \
dcbrt.o dchi.o dchu.o dcinh.o \ 36 36 dcbrt.o dchi.o dchu.o dcinh.o \
dcin.o dci.o dcosdg.o dcot.o \ 37 37 dcin.o dci.o dcosdg.o dcot.o \
dcsevl.o ddaws.o de1.o dei.o \ 38 38 dcsevl.o ddaws.o de1.o dei.o \
derfc.o derf.o dexprl.o dfac.o \ 39 39 derfc.o derf.o dexprl.o dfac.o \
dgamic.o dgami.o dgamit.o dgamma.o \ 40 40 dgamic.o dgami.o dgamit.o dgamma.o \
dgamr.o dlbeta.o dlgams.o dli.o \ 41 41 dgamr.o dlbeta.o dlgams.o dli.o \
dlngam.o dlnrel.o dpoch1.o dpoch.o \ 42 42 dlngam.o dlnrel.o dpoch1.o dpoch.o \
dpsi.o dshi.o dsindg.o dsi.o \ 43 43 dpsi.o dshi.o dsindg.o dsi.o \
dspenc.o e1.o e9rint.o ei.o \ 44 44 dspenc.o e1.o e9rint.o ei.o \
entsrc.o eprint.o erfc.o erf.o \ 45 45 entsrc.o eprint.o erfc.o erf.o \
erroff.o exprel.o fac.o fdump.o \ 46 46 erroff.o exprel.o fac.o fdump.o \
fvn_fnlib.o gamic.o gami.o gamit.o \ 47 47 fvn_fnlib.o gamic.o gami.o gamit.o \
gamma.o gamr.o i1mach.o i8save.o \ 48 48 gamma.o gamr.o i1mach.o i8save.o \
initds.o inits.o nerror.o poch1.o \ 49 49 initds.o inits.o nerror.o poch1.o \
poch.o psi.o r1mach.o r9admp.o \ 50 50 poch.o psi.o r1mach.o r9admp.o \
r9aimp.o r9atn1.o r9chm.o r9chu.o \ 51 51 r9aimp.o r9atn1.o r9chm.o r9chu.o \
r9gaml.o r9gmic.o r9gmit.o r9knus.o \ 52 52 r9gaml.o r9gmic.o r9gmit.o r9knus.o \
r9lgic.o r9lgit.o r9lgmc.o r9ln2r.o \ 53 53 r9lgic.o r9lgit.o r9lgmc.o r9ln2r.o \
r9pak.o r9sifg.o r9upak.o randgs.o \ 54 54 r9pak.o r9sifg.o r9upak.o randgs.o \
rand.o random.o ranf.o retsrc.o \ 55 55 rand.o random.o ranf.o retsrc.o \
s88fmt.o s9comp.o seterr.o seteru.o \ 56 56 s88fmt.o s9comp.o seterr.o seteru.o \
shi.o sindg.o si.o spenc.o \ 57 57 shi.o sindg.o si.o spenc.o \
z0lgmc.o z8lgmc.o z9lgmc.o z9ln2r.o \ 58 58 z0lgmc.o z8lgmc.o z9lgmc.o z9ln2r.o \
zacosh.o zacos.o zarg.o zasinh.o \ 59 59 zacosh.o zacos.o zarg.o zasinh.o \
zasin.o zatan2.o zatanh.o zatan.o \ 60 60 zasin.o zatan2.o zatanh.o zatan.o \
zbeta.o zcbrt.o zcosh.o zcot.o \ 61 61 zbeta.o zcbrt.o zcosh.o zcot.o \
zexprl.o zgamma.o zgamr.o zlbeta.o \ 62 62 zexprl.o zgamma.o zgamr.o zlbeta.o \
zlngam.o zlnrel.o zlog10.o zpsi.o \ 63 63 zlngam.o zlnrel.o zlog10.o zpsi.o \
zsinh.o ztanh.o ztan.o 64 64 zsinh.o ztanh.o ztan.o besyn.o \
65 besjn.o dbesyn.o dbesjn.o beskn.o \
66 besin.o dbeskn.o dbesin.o
65 67
lib:$(library) 66 68 lib:$(library)
67 69
$(library): $(objects) 68 70 $(library): $(objects)
$(AR) rcu $@ $(objects) 69 71 $(AR) rcu $@ $(objects)
$(AR) s $@ 70 72 $(AR) s $@
71 73
install: 72 74 install:
cp fvn_fnlib.mod $(BTREE)/modules 73 75 cp fvn_fnlib.mod $(BTREE)/modules
cp libfvn_fnlib.a $(BTREE)/lib 74 76 cp libfvn_fnlib.a $(BTREE)/lib
75 77
File was created 1 real(4) function besin(n,x,factor,big)
2 implicit none
3 ! This function compute the rank n Bessel J function
4 ! using recurrence relation :
5 ! In+1(x)=-2n/x * In(x) + In-1(x)
6 !
7 ! Two optional parameters :
8 ! factor : an integer that is used in Miller's algorithm to determine the
9 ! starting point of iteration. Default value is 40, an increase of this value
10 ! will increase accuracy. Starting point ~ nearest even integer of sqrt(factor*n)
11 ! big : a real that determine the threshold for taking anti overflow counter measure
12 ! default value is 1e10
13 !
14 integer :: n
15 real(4) :: x
16 integer, optional :: factor
17 real(4), optional :: big
18
19 integer :: tfactor
20 real(4) :: tbig,tsmall
21 real(4) :: two_on_x,binm1,bin,binp1,absx
22 integer :: i,start
23 real(4), external :: besi0,besi1
24
25 ! Initialization of optional parameters
26 tfactor=40
27 if(present(factor)) tfactor=factor
28 tbig=1e10
29 if(present(big)) tbig=big
30 tsmall=1./tbig
31
32 if (n==0) then
33 besin=besi0(x)
34 return
35 end if
36 if (n==1) then
37 besin=besi1(x)
38 return
39 end if
40 if (n < 0) then
41 write(*,*) "Error in besin, n must be >= 0"
42 stop
43 end if
44
45 absx=abs(x)
46 if (absx == 0.) then
47 besin=0.
48 else
49 ! We use Miller's Algorithm
50 ! as upward reccurence is unstable.
51 ! This is adapted from Numerical Recipes
52 ! Principle : use of downward recurrence from an arbitrary
53 ! higher than n value with an arbitrary seed,
54 ! and then use the normalization formula :
55 ! 1=I0-2I2+2I4-2I6+.... however it is easier to use a
56 ! call to besi0
57 two_on_x=2./absx
58 start=2*((n+int(sqrt(float(n*tfactor))))/2) ! even start
59 binp1=0.
60 bin=1.
61 do i=start,1,-1
62 ! begin downward rec
63 binm1=two_on_x*bin*i+binp1
64 binp1=bin
65 bin=binm1
66 ! Action to prevent overflow
67 if (abs(bin) > tbig) then
68 bin=bin*tsmall
69 binp1=binp1*tsmall
70 besin=besin*tsmall
71 end if
72 if (i==n) besin=binp1
73 end do
74 besin=besin*besi0(x)/bin
File was created 1 real(4) function besjn(n,x,factor,big)
2 implicit none
3 ! This function compute the rank n Bessel J function
4 ! using recurrence relation :
5 ! Jn+1(x)=2n/x * Jn(x) - Jn-1(x)
6 !
7 ! Two optional parameters :
8 ! factor : an integer that is used in Miller's algorithm to determine the
9 ! starting point of iteration. Default value is 40, an increase of this value
10 ! will increase accuracy. Starting point ~ nearest even integer of sqrt(factor*n)
11 ! big : a real that determine the threshold for taking anti overflow counter measure
12 ! default value is 1e10
13 !
14 integer :: n
15 real(4) :: x
16 integer, optional :: factor
17 real(4), optional :: big
18
19 integer :: tfactor
20 real(4) :: tbig,tsmall,som
21 real(4),external :: besj0,besj1
22 real(4) :: two_on_x,bjnm1,bjn,bjnp1,absx
23 integer :: i,start
24 logical :: iseven
25
26 ! Initialization of optional parameters
27 tfactor=40
28 if(present(factor)) tfactor=factor
29 tbig=1e10
30 if(present(big)) tbig=big
31 tsmall=1./tbig
32
33 if (n==0) then
34 besjn=besj0(x)
35 return
36 end if
37 if (n==1) then
38 besjn=besj1(x)
39 return
40 end if
41 if (n < 0) then
42 write(*,*) "Error in besjn, n must be >= 0"
43 stop
44 end if
45
46 absx=abs(x)
47 if (absx == 0.) then
48 besjn=0.
49 else if (absx > float(n)) then
50 ! For x > n upward reccurence is stable
51 two_on_x=2./absx
52 bjnm1=besj0(absx)
53 bjn=besj1(absx)
54 do i=1,n-1
55 bjnp1=two_on_x*bjn*i-bjnm1
56 bjnm1=bjn
57 bjn=bjnp1
58 end do
59 besjn=bjnp1
60 else
61 ! For x <= n we use Miller's Algorithm
62 ! as upward reccurence is unstable.
63 ! This is adapted from Numerical Recipes
64 ! Principle : use of downward recurrence from an arbitrary
65 ! higher than n value with an arbitrary seed,
66 ! and then use the normalization formula :
67 ! 1=J0+2J2+2J4+2J6+....
68 two_on_x=2./absx
69 start=2*((n+int(sqrt(float(n*tfactor))))/2) ! even start
70 som=0.
71 iseven=.false.
72 bjnp1=0.
73 bjn=1.
74 do i=start,1,-1
75 ! begin downward rec
76 bjnm1=two_on_x*bjn*i-bjnp1
77 bjnp1=bjn
78 bjn=bjnm1
79 ! Action to prevent overflow
80 if (abs(bjn) > tbig) then
81 bjn=bjn*tsmall
82 bjnp1=bjnp1*tsmall
83 besjn=besjn*tsmall
84 som=som*tsmall
85 end if
86 if (iseven) then
87 som=som+bjn
88 end if
89 iseven= .not. iseven
90 if (i==n) besjn=bjnp1
91 end do
92 som=2.*som-bjn
93 besjn=besjn/som
File was created 1 real(4) function beskn(n,x)
2 implicit none
3 ! This function compute the rank n Bessel Y function
4 ! using recurrence relation :
5 ! Kn+1(x)=2n/x * Kn(x) + Kn-1(x)
6 !
7 integer :: n
8 real(4) :: x
9
10 real(4),external :: besk0,besk1
11 real(4) :: two_on_x,bknm1,bkn,bktmp
12 integer :: i
13
14 if (n==0) then
15 beskn=besk0(x)
16 return
17 end if
18 if (n==1) then
19 beskn=besk1(x)
20 return
21 end if
22
23 if (n < 0) then
24 write(*,*) "Error in beskn, n must be >= 0"
25 stop
26 end if
27 if (x <= 0.) then
28 write(*,*) "Error in beskn, x must be strictly positive"
29 end if
30
31 two_on_x=2./x
32 bknm1=besk0(x)
33 bkn=besk1(x)
34
35 do i=1,n-1
36 bktmp=two_on_x*bkn*i+bknm1
File was created 1 real(4) function besyn(n,x)
2 implicit none
3 ! This function compute the rank n Bessel Y function
4 ! using recurrence relation :
5 ! Yn+1(x)=2n/x * Yn(x) - Yn-1(x)
6 !
7 integer :: n
8 real(4) :: x
9
10 real(4),external :: besy0,besy1
11 real(4) :: two_on_x,bynm1,byn,bytmp
12 integer :: i
13
14 if (n==0) then
15 besyn=besy0(x)
16 return
17 end if
18 if (n==1) then
19 besyn=besy1(x)
20 return
21 end if
22
23 if (n < 0) then
24 write(*,*) "Error in besyn, n must be >= 0"
25 stop
26 end if
27 if (x <= 0.) then
28 write(*,*) "Error in besyn, x must be strictly positive"
29 end if
30
31 two_on_x=2./x
32 bynm1=besy0(x)
33 byn=besy1(x)
34
35 do i=1,n-1
36 bytmp=two_on_x*byn*i-bynm1
fvn_fnlib/dbesin.f90
Diff comments   View file @ e1aefab
File was created 1 real(8) function dbesin(n,x,factor,big)
2 implicit none
3 ! This function compute the rank n Bessel J function
4 ! using recurrence relation :
5 ! In+1(x)=-2n/x * In(x) + In-1(x)
6 !
7 ! Two optional parameters :
8 ! factor : an integer that is used in Miller's algorithm to determine the
9 ! starting point of iteration. Default value is 40, an increase of this value
10 ! will increase accuracy. Starting point ~ nearest even integer of sqrt(factor*n)
11 ! big : a real that determine the threshold for taking anti overflow counter measure
12 ! default value is 1e10
13 !
14 integer :: n
15 real(8) :: x
16 integer, optional :: factor
17 real(8), optional :: big
18
19 integer :: tfactor
20 real(8) :: tbig,tsmall
21 real(8) :: two_on_x,binm1,bin,binp1,absx
22 integer :: i,start
23 real(8), external :: dbesi0,dbesi1
24
25 ! Initialization of optional parameters
26 tfactor=40
27 if(present(factor)) tfactor=factor
28 tbig=1e10
29 if(present(big)) tbig=big
30 tsmall=1./tbig
31
32 if (n==0) then
33 dbesin=dbesi0(x)
34 return
35 end if
36 if (n==1) then
37 dbesin=dbesi1(x)
38 return
39 end if
40
41 if (n < 0) then
42 write(*,*) "Error in dbesin, n must be >= 0"
43 stop
44 end if
45
46 absx=abs(x)
47 if (absx == 0.) then
48 dbesin=0.
49 else
50 ! We use Miller's Algorithm
51 ! as upward reccurence is unstable.
52 ! This is adapted from Numerical Recipes
53 ! Principle : use of downward recurrence from an arbitrary
54 ! higher than n value with an arbitrary seed,
55 ! and then use the normalization formula :
56 ! 1=I0-2I2+2I4-2I6+.... however it is easier to use a
57 ! call to besi0
58 two_on_x=2./absx
59 start=2*((n+int(sqrt(float(n*tfactor))))/2) ! even start
60 binp1=0.
61 bin=1.
62 do i=start,1,-1
63 ! begin downward rec
64 binm1=two_on_x*bin*i+binp1
65 binp1=bin
66 bin=binm1
67 ! Action to prevent overflow
68 if (abs(bin) > tbig) then
69 bin=bin*tsmall
70 binp1=binp1*tsmall
71 dbesin=dbesin*tsmall
72 end if
73 if (i==n) dbesin=binp1
74 end do
fvn_fnlib/dbesjn.f90
Diff comments   View file @ e1aefab
File was created 1 real(8) function dbesjn(n,x,factor,big)
2 implicit none
3 ! This function compute the rank n Bessel J function
4 ! using recurrence relation :
5 ! Jn+1(x)=2n/x * Jn(x) - Jn-1(x)
6 !
7 ! Two optional parameters :
8 ! factor : an integer that is used in Miller's algorithm to determine the
9 ! starting point of iteration. Default value is 40, an increase of this value
10 ! will increase accuracy. Starting point ~ nearest even integer of sqrt(factor*n)
11 ! big : a real that determine the threshold for taking anti overflow counter measure
12 ! default value is 1e10
13 !
14 integer :: n
15 real(8) :: x
16 integer, optional :: factor
17 real(8), optional :: big
18
19 integer :: tfactor
20 real(8) :: tbig,tsmall,som
21 real(8),external :: dbesj0,dbesj1
22 real(8) :: two_on_x,bjnm1,bjn,bjnp1,absx
23 integer :: i,start
24 logical :: iseven
25
26 ! Initialization of optional parameters
27 tfactor=40
28 if(present(factor)) tfactor=factor
29 tbig=1d10
30 if(present(big)) tbig=big
31 tsmall=1./tbig
32
33 if (n==0) then
34 dbesjn=dbesj0(x)
35 return
36 end if
37 if (n==1) then
38 dbesjn=dbesj1(x)
39 return
40 end if
41 if (n < 0) then
42 write(*,*) "Error in dbesjn, n must be >= 0"
43 stop
44 end if
45
46 absx=abs(x)
47 if (absx == 0.) then
48 dbesjn=0.
49 else if (absx > float(n)) then
50 ! For x > n upward reccurence is stable
51 two_on_x=2./absx
52 bjnm1=dbesj0(absx)
53 bjn=dbesj1(absx)
54 do i=1,n-1
55 bjnp1=two_on_x*bjn*i-bjnm1
56 bjnm1=bjn
57 bjn=bjnp1
58 end do
59 dbesjn=bjnp1
60 else
61 ! For x <= n we use Miller's Algorithm
62 ! as upward reccurence is unstable.
63 ! This is adapted from Numerical Recipes
64 ! Principle : use of downward recurrence from an arbitrary
65 ! higher than n value with an arbitrary seed,
66 ! and then use the normalization formula :
67 ! 1=J0+2J2+2J4+2J6+....
68 two_on_x=2./absx
69 start=2*((n+int(sqrt(float(n*tfactor))))/2) ! even start
70 som=0.
71 iseven=.false.
72 bjnp1=0.
73 bjn=1.
74 do i=start,1,-1
75 ! begin downward rec
76 bjnm1=two_on_x*bjn*i-bjnp1
77 bjnp1=bjn
78 bjn=bjnm1
79 ! Action to prevent overflow
80 if (abs(bjn) > tbig) then
81 bjn=bjn*tsmall
82 bjnp1=bjnp1*tsmall
83 dbesjn=dbesjn*tsmall
84 som=som*tsmall
85 end if
86 if (iseven) then
87 som=som+bjn
88 end if
89 iseven= .not. iseven
90 if (i==n) dbesjn=bjnp1
91 end do
92 som=2.*som-bjn
93 dbesjn=dbesjn/som
fvn_fnlib/dbeskn.f90
Diff comments   View file @ e1aefab
File was created 1 real(8) function dbeskn(n,x)
2 implicit none
3 ! This function compute the rank n Bessel Y function
4 ! using recurrence relation :
5 ! Kn+1(x)=2n/x * Kn(x) + Kn-1(x)
6 !
7 integer :: n
8 real(8) :: x
9
10 real(8),external :: dbesk0,dbesk1
11 real(8) :: two_on_x,bknm1,bkn,bktmp
12 integer :: i
13
14 if (n==0) then
15 dbeskn=dbesk0(x)
16 return
17 end if
18 if (n==1) then
19 dbeskn=dbesk1(x)
20 return
21 end if
22
23 if (n < 0) then
24 write(*,*) "Error in dbeskn, n must be >= 0"
25 stop
26 end if
27 if (x <= 0.) then
28 write(*,*) "Error in dbeskn, x must be strictly positive"
29 end if
30
31 two_on_x=2./x
32 bknm1=dbesk0(x)
33 bkn=dbesk1(x)
34
35 do i=1,n-1
36 bktmp=two_on_x*bkn*i+bknm1
fvn_fnlib/dbesyn.f90
Diff comments   View file @ e1aefab
File was created 1 real(8) function dbesyn(n,x)
2 implicit none
3 ! This function compute the rank n Bessel Y function
4 ! using recurrence relation :
5 ! Yn+1(x)=2n/x * Yn(x) - Yn-1(x)
6 !
7 integer :: n
8 real(8) :: x
9
10 real(8),external :: dbesy0,dbesy1
11 real(8) :: two_on_x,bynm1,byn,bytmp
12 integer :: i
13
14 if (n==0) then
15 dbesyn=dbesy0(x)
16 return
17 end if
18 if (n==1) then
19 dbesyn=dbesy1(x)
20 return
21 end if
22 if (n < 0) then
23 write(*,*) "Error in dbesyn, n must be >= 0"
24 stop
25 end if
26 if (x <= 0.) then
27 write(*,*) "Error in dbesyn, x must be strictly positive"
28 end if
29
30 two_on_x=2./x
31 bynm1=dbesy0(x)
32 byn=dbesy1(x)
33
34 do i=1,n-1
35 bytmp=two_on_x*byn*i-bynm1
36 bynm1=byn
fvn_fnlib/fvn_fnlib.f90
Diff comments   View file @ e1aefab
module fvn_fnlib 1 1 module fvn_fnlib
2 2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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(4) function carg(z) 14 14 real(4) function carg(z)
complex(4) :: z 15 15 complex(4) :: z
end function carg 16 16 end function carg
real(8) function zarg(z) 17 17 real(8) function zarg(z)
complex(8) :: z 18 18 complex(8) :: 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(4) function cbrt(x) 24 24 real(4) function cbrt(x)
real(4) :: x 25 25 real(4) :: x
end function cbrt 26 26 end function cbrt
real(8) function dcbrt(x) 27 27 real(8) function dcbrt(x)
real(8) :: x 28 28 real(8) :: x
end function dcbrt 29 29 end function dcbrt
complex(4) function ccbrt(z) 30 30 complex(4) function ccbrt(z)
complex(4) :: z 31 31 complex(4) :: z
end function ccbrt 32 32 end function ccbrt
complex(8) function zcbrt(z) 33 33 complex(8) function zcbrt(z)
complex(8) :: z 34 34 complex(8) :: 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(4) function exprel(x) 40 40 real(4) function exprel(x)
real(4) :: x 41 41 real(4) :: x
end function exprel 42 42 end function exprel
real(8) function dexprl(x) 43 43 real(8) function dexprl(x)
real(8) :: x 44 44 real(8) :: x
end function dexprl 45 45 end function dexprl
complex(4) function cexprl(z) 46 46 complex(4) function cexprl(z)
complex(4) :: z 47 47 complex(4) :: z
end function cexprl 48 48 end function cexprl
complex(8) function zexprl(z) 49 49 complex(8) function zexprl(z)
complex(8) :: z 50 50 complex(8) :: 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(4) function clog10(z) 56 56 complex(4) function clog10(z)
complex(4) :: z 57 57 complex(4) :: z
end function clog10 58 58 end function clog10
complex(8) function zlog10(z) 59 59 complex(8) function zlog10(z)
complex(8) :: z 60 60 complex(8) :: 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(4) function alnrel(x) 66 66 real(4) function alnrel(x)
real(4) :: x 67 67 real(4) :: x
end function alnrel 68 68 end function alnrel
real(8) function dlnrel(x) 69 69 real(8) function dlnrel(x)
real(8) :: x 70 70 real(8) :: x
end function dlnrel 71 71 end function dlnrel
complex(4) function clnrel(z) 72 72 complex(4) function clnrel(z)
complex(4) :: z 73 73 complex(4) :: z
end function clnrel 74 74 end function clnrel
complex(8) function zlnrel(z) 75 75 complex(8) function zlnrel(z)
complex(8) :: z 76 76 complex(8) :: 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(4) function ctan(z) 91 91 complex(4) function ctan(z)
complex(4) :: z 92 92 complex(4) :: z
end function ctan 93 93 end function ctan
complex(8) function ztan(z) 94 94 complex(8) function ztan(z)
complex(8) :: z 95 95 complex(8) :: 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(4) function cot(x) 101 101 real(4) function cot(x)
real(4) :: x 102 102 real(4) :: x
end function cot 103 103 end function cot
real(8) function dcot(x) 104 104 real(8) function dcot(x)
real(8) :: x 105 105 real(8) :: x
end function dcot 106 106 end function dcot
complex(4) function ccot(z) 107 107 complex(4) function ccot(z)
complex(4) :: z 108 108 complex(4) :: z
end function ccot 109 109 end function ccot
complex(8) function zcot(z) 110 110 complex(8) function zcot(z)
complex(8) :: z 111 111 complex(8) :: 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(4) function sindg(x) 117 117 real(4) function sindg(x)
real(4) :: x 118 118 real(4) :: x
end function sindg 119 119 end function sindg
real(8) function dsindg(x) 120 120 real(8) function dsindg(x)
real(8) :: x 121 121 real(8) :: 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(4) function cosdg(x) 127 127 real(4) function cosdg(x)
real(4) :: x 128 128 real(4) :: x
end function cosdg 129 129 end function cosdg
real(8) function dcosdg(x) 130 130 real(8) function dcosdg(x)
real(8) :: x 131 131 real(8) :: 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(4) function casin(z) 138 138 complex(4) function casin(z)
complex(4) :: z 139 139 complex(4) :: z
end function casin 140 140 end function casin
complex(8) function zasin(z) 141 141 complex(8) function zasin(z)
complex(8) :: z 142 142 complex(8) :: 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(4) function cacos(z) 148 148 complex(4) function cacos(z)
complex(4) :: z 149 149 complex(4) :: z
end function cacos 150 150 end function cacos
complex(8) function zacos(z) 151 151 complex(8) function zacos(z)
complex(8) :: z 152 152 complex(8) :: 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(4) function catan(z) 158 158 complex(4) function catan(z)
complex(4) :: z 159 159 complex(4) :: z
end function catan 160 160 end function catan
complex(8) function zatan(z) 161 161 complex(8) function zatan(z)
complex(8) :: z 162 162 complex(8) :: 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(4) function catan2(csn,ccs) 168 168 complex(4) function catan2(csn,ccs)
complex(4) :: csn,ccs 169 169 complex(4) :: csn,ccs
end function catan2 170 170 end function catan2
complex(8) function zatan2(csn,ccs) 171 171 complex(8) function zatan2(csn,ccs)
complex(8) :: csn,ccs 172 172 complex(8) :: 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(4) function csinh(z) 182 182 complex(4) function csinh(z)
complex(4) :: z 183 183 complex(4) :: z
end function csinh 184 184 end function csinh
complex(8) function zsinh(z) 185 185 complex(8) function zsinh(z)
complex(8) :: z 186 186 complex(8) :: 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(4) function ccosh(z) 192 192 complex(4) function ccosh(z)
complex(4) :: z 193 193 complex(4) :: z
end function ccosh 194 194 end function ccosh
complex(8) function zcosh(z) 195 195 complex(8) function zcosh(z)
complex(8) :: z 196 196 complex(8) :: 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(4) function ctanh(z) 202 202 complex(4) function ctanh(z)
complex(4) :: z 203 203 complex(4) :: z
end function ctanh 204 204 end function ctanh
complex(8) function ztanh(z) 205 205 complex(8) function ztanh(z)
complex(8) :: z 206 206 complex(8) :: 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(4) function asinh(x) 212 212 real(4) function asinh(x)
real(4) :: x 213 213 real(4) :: x
end function asinh 214 214 end function asinh
real(8) function dasinh(x) 215 215 real(8) function dasinh(x)
real(8) :: x 216 216 real(8) :: x
end function dasinh 217 217 end function dasinh
complex(4) function casinh(z) 218 218 complex(4) function casinh(z)
complex(4) :: z 219 219 complex(4) :: z
end function casinh 220 220 end function casinh
complex(8) function zasinh(z) 221 221 complex(8) function zasinh(z)
complex(8) :: z 222 222 complex(8) :: 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(4) function acosh(x) 228 228 real(4) function acosh(x)
real(4) :: x 229 229 real(4) :: x
end function acosh 230 230 end function acosh
real(8) function dacosh(x) 231 231 real(8) function dacosh(x)
real(8) :: x 232 232 real(8) :: x
end function dacosh 233 233 end function dacosh
complex(4) function cacosh(z) 234 234 complex(4) function cacosh(z)
complex(4) :: z 235 235 complex(4) :: z
end function cacosh 236 236 end function cacosh
complex(8) function zacosh(z) 237 237 complex(8) function zacosh(z)
complex(8) :: z 238 238 complex(8) :: 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(4) function atanh(x) 244 244 real(4) function atanh(x)
real(4) :: x 245 245 real(4) :: x
end function atanh 246 246 end function atanh
real(8) function datanh(x) 247 247 real(8) function datanh(x)
real(8) :: x 248 248 real(8) :: x
end function datanh 249 249 end function datanh
complex(4) function catanh(z) 250 250 complex(4) function catanh(z)
complex(4) :: z 251 251 complex(4) :: z
end function catanh 252 252 end function catanh
complex(8) function zatanh(z) 253 253 complex(8) function zatanh(z)
complex(8) :: z 254 254 complex(8) :: 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(4) function ei(x) 269 269 real(4) function ei(x)
real(4) :: x 270 270 real(4) :: x
end function ei 271 271 end function ei
real(8) function dei(x) 272 272 real(8) function dei(x)
real(8) :: x 273 273 real(8) :: 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(4) function e1(x) 279 279 real(4) function e1(x)
real(4) :: x 280 280 real(4) :: x
end function e1 281 281 end function e1
real(8) function de1(x) 282 282 real(8) function de1(x)
real(8) :: x 283 283 real(8) :: x
end function de1 284 284 end function de1
end interface e1 285 285 end interface e1
286 286
!!!!!!!!!!!!!!! 287 287 !!!!!!!!!!!!!!!
! MISSING ENE 288 288 ! MISSING ENE
!!!!!!!!!!!!!!! 289 289 !!!!!!!!!!!!!!!
290 290
! Logarithm integral 291 291 ! Logarithm integral
interface ali 292 292 interface ali
real(4) function ali(x) 293 293 real(4) function ali(x)
real(4) :: x 294 294 real(4) :: x
end function ali 295 295 end function ali
real(8) function dli(x) 296 296 real(8) function dli(x)
real(8) :: x 297 297 real(8) :: x
end function dli 298 298 end function dli
end interface ali 299 299 end interface ali
300 300
! Sine integral 301 301 ! Sine integral
interface si 302 302 interface si
real(4) function si(x) 303 303 real(4) function si(x)
real(4) :: x 304 304 real(4) :: x
end function si 305 305 end function si
real(8) function dsi(x) 306 306 real(8) function dsi(x)
real(8) :: x 307 307 real(8) :: x
end function dsi 308 308 end function dsi
end interface si 309 309 end interface si
310 310
! Cosine integral 311 311 ! Cosine integral
interface ci 312 312 interface ci
real(4) function ci(x) 313 313 real(4) function ci(x)
real(4) :: x 314 314 real(4) :: x
end function ci 315 315 end function ci
real(8) function dci(x) 316 316 real(8) function dci(x)
real(8) :: x 317 317 real(8) :: x
end function dci 318 318 end function dci
end interface ci 319 319 end interface ci
320 320
! Cosine integral alternate definition 321 321 ! Cosine integral alternate definition
interface cin 322 322 interface cin
real(4) function cin(x) 323 323 real(4) function cin(x)
real(4) :: x 324 324 real(4) :: x
end function cin 325 325 end function cin
real(8) function dcin(x) 326 326 real(8) function dcin(x)
real(8) :: x 327 327 real(8) :: x
end function dcin 328 328 end function dcin
end interface cin 329 329 end interface cin
330 330
! Hyperbolic sine integral 331 331 ! Hyperbolic sine integral
interface shi 332 332 interface shi
real(4) function shi(x) 333 333 real(4) function shi(x)
real(4) :: x 334 334 real(4) :: x
end function shi 335 335 end function shi
real(8) function dshi(x) 336 336 real(8) function dshi(x)
real(8) :: x 337 337 real(8) :: x
end function dshi 338 338 end function dshi
end interface shi 339 339 end interface shi
340 340
! Hyperbolic cosine integral 341 341 ! Hyperbolic cosine integral
interface chi 342 342 interface chi
real(4) function chi(x) 343 343 real(4) function chi(x)
real(4) :: x 344 344 real(4) :: x
end function chi 345 345 end function chi
real(8) function dchi(x) 346 346 real(8) function dchi(x)
real(8) :: x 347 347 real(8) :: x
end function dchi 348 348 end function dchi
end interface chi 349 349 end interface chi
350 350
! Hyperbolic cosine integral alternate definition 351 351 ! Hyperbolic cosine integral alternate definition
interface cinh 352 352 interface cinh
real(4) function cinh(x) 353 353 real(4) function cinh(x)
real(4) :: x 354 354 real(4) :: x
end function cinh 355 355 end function cinh
real(8) function dcinh(x) 356 356 real(8) function dcinh(x)
real(8) :: x 357 357 real(8) :: x
end function dcinh 358 358 end function dcinh
end interface cinh 359 359 end interface cinh
360 360
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 361 361 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Exponential integral and related 362 362 ! END Exponential integral and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 363 363 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
364 364
365 365
366 366
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 367 367 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Gamma family 368 368 ! Gamma family
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 369 369 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
370 370
! No generic interface for fac and binom but we still 371 371 ! No generic interface for fac and binom but we still
! define their prototypes 372 372 ! define their prototypes
! Factorial 373 373 ! Factorial
interface 374 374 interface
real(4) function fac(n) 375 375 real(4) function fac(n)
integer(4) :: n 376 376 integer(4) :: n
end function fac 377 377 end function fac
real(8) function dfac(n) 378 378 real(8) function dfac(n)
integer(4) :: n 379 379 integer(4) :: n
end function dfac 380 380 end function dfac
! Binomial coefficient 381 381 ! Binomial coefficient
real(4) function binom(n,m) 382 382 real(4) function binom(n,m)
integer(4) :: n,m 383 383 integer(4) :: n,m
end function binom 384 384 end function binom
real(8) function dbinom(n,m) 385 385 real(8) function dbinom(n,m)
integer(4) :: n,m 386 386 integer(4) :: n,m
end function dbinom 387 387 end function dbinom
end interface 388 388 end interface
389 389
! Gamma function 390 390 ! Gamma function
interface gamma 391 391 interface gamma
real(4) function gamma(x) 392 392 real(4) function gamma(x)
real(4) :: x 393 393 real(4) :: x
end function gamma 394 394 end function gamma
real(8) function dgamma(x) 395 395 real(8) function dgamma(x)
real(8) :: x 396 396 real(8) :: x
end function dgamma 397 397 end function dgamma
complex(4) function cgamma(z) 398 398 complex(4) function cgamma(z)
complex(4) :: z 399 399 complex(4) :: z
end function cgamma 400 400 end function cgamma
complex(8) function zgamma(z) 401 401 complex(8) function zgamma(z)
complex(8) :: z 402 402 complex(8) :: z
end function zgamma 403 403 end function zgamma
end interface gamma 404 404 end interface gamma
405 405
! Reciprocal of gamma function 406 406 ! Reciprocal of gamma function
interface gamr 407 407 interface gamr
real(4) function gamr(x) 408 408 real(4) function gamr(x)
real(4) :: x 409 409 real(4) :: x
end function gamr 410 410 end function gamr
real(8) function dgamr(x) 411 411 real(8) function dgamr(x)
real(8) :: x 412 412 real(8) :: x
end function dgamr 413 413 end function dgamr
complex(4) function cgamr(z) 414 414 complex(4) function cgamr(z)
complex(4) :: z 415 415 complex(4) :: z
end function cgamr 416 416 end function cgamr
complex(8) function zgamr(z) 417 417 complex(8) function zgamr(z)
complex(8) :: z 418 418 complex(8) :: z
end function zgamr 419 419 end function zgamr
end interface gamr 420 420 end interface gamr
421 421
! natural log of abs(gamma) 422 422 ! natural log of abs(gamma)
interface alngam 423 423 interface alngam
real(4) function alngam(x) 424 424 real(4) function alngam(x)
real(4) :: x 425 425 real(4) :: x
end function alngam 426 426 end function alngam
real(8) function dlngam(x) 427 427 real(8) function dlngam(x)
real(8) :: x 428 428 real(8) :: x
end function dlngam 429 429 end function dlngam
complex(4) function clngam(z) 430 430 complex(4) function clngam(z)
complex(4) :: z 431 431 complex(4) :: z
end function clngam 432 432 end function clngam
complex(8) function zlngam(z) 433 433 complex(8) function zlngam(z)
complex(8) :: z 434 434 complex(8) :: z
end function zlngam 435 435 end function zlngam
end interface alngam 436 436 end interface alngam
437 437
! log abs gamma and sign 438 438 ! log abs gamma and sign
interface algams 439 439 interface algams
subroutine algams(x,algam,sgngam) 440 440 subroutine algams(x,algam,sgngam)
real(4) :: x 441 441 real(4) :: x
end subroutine algams 442 442 end subroutine algams
subroutine dlgams(x,algam,sgngam) 443 443 subroutine dlgams(x,algam,sgngam)
real(8) :: x 444 444 real(8) :: x
end subroutine dlgams 445 445 end subroutine dlgams
end interface algams 446 446 end interface algams
447 447
! Incomplete gamma function 448 448 ! Incomplete gamma function
interface gami 449 449 interface gami
real(4) function gami(a,x) 450 450 real(4) function gami(a,x)
real(4) :: a,x 451 451 real(4) :: a,x
end function gami 452 452 end function gami
real(8) function dgami(a,x) 453 453 real(8) function dgami(a,x)
real(8) :: a,x 454 454 real(8) :: a,x
end function dgami 455 455 end function dgami
end interface gami 456 456 end interface gami
457 457
! Complementary incomplete gamma function 458 458 ! Complementary incomplete gamma function
interface gamic 459 459 interface gamic
real(4) function gamic(a,x) 460 460 real(4) function gamic(a,x)
real(4) :: a,x 461 461 real(4) :: a,x
end function gamic 462 462 end function gamic
real(8) function dgamic(a,x) 463 463 real(8) function dgamic(a,x)
real(8) :: a,x 464 464 real(8) :: a,x
end function dgamic 465 465 end function dgamic
end interface gamic 466 466 end interface gamic
467 467
! Tricomi's incomplete gamma function 468 468 ! Tricomi's incomplete gamma function
interface gamit 469 469 interface gamit
real(4) function gamit(a,x) 470 470 real(4) function gamit(a,x)
real(4) :: a,x 471 471 real(4) :: a,x
end function gamit 472 472 end function gamit
real(8) function dgamit(a,x) 473 473 real(8) function dgamit(a,x)
real(8) :: a,x 474 474 real(8) :: a,x
end function dgamit 475 475 end function dgamit
end interface gamit 476 476 end interface gamit
477 477
! Psi function 478 478 ! Psi function
interface psi 479 479 interface psi
real(4) function psi(x) 480 480 real(4) function psi(x)
real(4) :: x 481 481 real(4) :: x
end function psi 482 482 end function psi
real(8) function dpsi(x) 483 483 real(8) function dpsi(x)
real(8) :: x 484 484 real(8) :: x
end function dpsi 485 485 end function dpsi
complex(4) function cpsi(z) 486 486 complex(4) function cpsi(z)
complex(4) :: z 487 487 complex(4) :: z
end function cpsi 488 488 end function cpsi
complex(8) function zpsi(z) 489 489 complex(8) function zpsi(z)
complex(8) :: z 490 490 complex(8) :: z
end function zpsi 491 491 end function zpsi
end interface psi 492 492 end interface psi
493 493
! Pochhammer 494 494 ! Pochhammer
interface poch 495 495 interface poch
real(4) function poch(a,x) 496 496 real(4) function poch(a,x)
real(4) :: a,x 497 497 real(4) :: a,x
end function poch 498 498 end function poch
real(8) function dpoch(a,x) 499 499 real(8) function dpoch(a,x)
real(8) :: a,x 500 500 real(8) :: a,x
end function dpoch 501 501 end function dpoch
end interface poch 502 502 end interface poch
503 503
! Pochhammer first order 504 504 ! Pochhammer first order
interface poch1 505 505 interface poch1
real(4) function poch1(a,x) 506 506 real(4) function poch1(a,x)
real(4) :: a,x 507 507 real(4) :: a,x
end function poch1 508 508 end function poch1
real(8) function dpoch1(a,x) 509 509 real(8) function dpoch1(a,x)
real(8) :: a,x 510 510 real(8) :: a,x
end function dpoch1 511 511 end function dpoch1
end interface poch1 512 512 end interface poch1
513 513
! Beta function 514 514 ! Beta function
interface beta 515 515 interface beta
real(4) function beta(a,b) 516 516 real(4) function beta(a,b)
real(4) :: a,b 517 517 real(4) :: a,b
end function beta 518 518 end function beta
real(8) function dbeta(a,b) 519 519 real(8) function dbeta(a,b)
real(8) :: a,b 520 520 real(8) :: a,b
end function dbeta 521 521 end function dbeta
complex(4) function cbeta(a,b) 522 522 complex(4) function cbeta(a,b)
complex(4) :: a,b 523 523 complex(4) :: a,b
end function cbeta 524 524 end function cbeta
complex(8) function zbeta(a,b) 525 525 complex(8) function zbeta(a,b)
complex(8) :: a,b 526 526 complex(8) :: a,b
end function zbeta 527 527 end function zbeta
end interface beta 528 528 end interface beta
529 529
! natural log of beta 530 530 ! natural log of beta
interface albeta 531 531 interface albeta
real(4) function albeta(a,b) 532 532 real(4) function albeta(a,b)
real(4) :: a,b 533 533 real(4) :: a,b
end function albeta 534 534 end function albeta
real(8) function dlbeta(a,b) 535 535 real(8) function dlbeta(a,b)
real(8) :: a,b 536 536 real(8) :: a,b
end function dlbeta 537 537 end function dlbeta
complex(4) function clbeta(a,b) 538 538 complex(4) function clbeta(a,b)
complex(4) :: a,b 539 539 complex(4) :: a,b
end function clbeta 540 540 end function clbeta
complex(8) function zlbeta(a,b) 541 541 complex(8) function zlbeta(a,b)
complex(8) :: a,b 542 542 complex(8) :: a,b
end function zlbeta 543 543 end function zlbeta
end interface albeta 544 544 end interface albeta
545 545
! Incomplete beta function 546 546 ! Incomplete beta function
interface betai 547 547 interface betai
real(4) function betai(x,pin,qin) 548 548 real(4) function betai(x,pin,qin)
real(4) :: x,pin,qin 549 549 real(4) :: x,pin,qin
end function betai 550 550 end function betai
real(8) function dbetai(x,pin,qin) 551 551 real(8) function dbetai(x,pin,qin)
real(8) :: x,pin,qin 552 552 real(8) :: x,pin,qin
end function dbetai 553 553 end function dbetai
end interface betai 554 554 end interface betai
555 555
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 556 556 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Gamma family 557 557 ! END Gamma family
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 558 558 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
559 559
560 560
561 561
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 562 562 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Error function and related 563 563 ! Error function and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 564 564 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
565 565
! Error function 566 566 ! Error function
interface erf 567 567 interface erf
real(4) function erf(x) 568 568 real(4) function erf(x)
real(4) :: x 569 569 real(4) :: x
end function erf 570 570 end function erf
real(8) function derf(x) 571 571 real(8) function derf(x)
real(8) :: x 572 572 real(8) :: x
end function derf 573 573 end function derf
end interface erf 574 574 end interface erf
575 575
! Complementary error function 576 576 ! Complementary error function
interface erfc 577 577 interface erfc
real(4) function erfc(x) 578 578 real(4) function erfc(x)
real(4) :: x 579 579 real(4) :: x
end function erfc 580 580 end function erfc
real(8) function derfc(x) 581 581 real(8) function derfc(x)
real(8) :: x 582 582 real(8) :: x
end function derfc 583 583 end function derfc
end interface erfc 584 584 end interface erfc
585 585
!!!!!!!!!!! 586 586 !!!!!!!!!!!
! MISSING ERFCE 587 587 ! MISSING ERFCE
! MISSING CERFI 588 588 ! MISSING CERFI
! MISSING ERFI 589 589 ! MISSING ERFI
! MISSING ERFCI 590 590 ! MISSING ERFCI
!!!!!!!!!!!!!! 591 591 !!!!!!!!!!!!!!
592 592
! Dawson's function 593 593 ! Dawson's function
interface daws 594 594 interface daws
real(4) function daws(x) 595 595 real(4) function daws(x)
real(4) :: x 596 596 real(4) :: x
end function daws 597 597 end function daws
real(8) function ddaws(x) 598 598 real(8) function ddaws(x)
real(8) :: x 599 599 real(8) :: x
end function ddaws 600 600 end function ddaws
end interface daws 601 601 end interface daws
602 602
!!!!!!!!!!!!!!!!! 603 603 !!!!!!!!!!!!!!!!!
! MISSING FRESC 604 604 ! MISSING FRESC
! MISSING FRESS 605 605 ! MISSING FRESS
!!!!!!!!!!!!!!!!! 606 606 !!!!!!!!!!!!!!!!!
607 607
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 608 608 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Error function and related 609 609 ! END Error function and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 610 610 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
611 611
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 612 612 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Bessel functions and related 613 613 ! Bessel functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 614 614 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
615 615
!J0(x) 616 616 !J0(x)
interface bsj0 617 617 interface bsj0
real(4) function besj0(x) 618 618 real(4) function besj0(x)
real(4) :: x 619 619 real(4) :: x
end function besj0 620 620 end function besj0
real(8) function dbesj0(x) 621 621 real(8) function dbesj0(x)
real(8) :: x 622 622 real(8) :: x
end function dbesj0 623 623 end function dbesj0
end interface bsj0 624 624 end interface bsj0
625 625
!J1(x) 626 626 !J1(x)
interface bsj1 627 627 interface bsj1
real(4) function besj1(x) 628 628 real(4) function besj1(x)
real(4) :: x 629 629 real(4) :: x
end function besj1 630 630 end function besj1
real(8) function dbesj1(x) 631 631 real(8) function dbesj1(x)
real(8) :: x 632 632 real(8) :: x
end function dbesj1 633 633 end function dbesj1
end interface bsj1 634 634 end interface bsj1
635 635
!Y0(x) 636 636 !Y0(x)
interface bsy0 637 637 interface bsy0
real(4) function besy0(x) 638 638 real(4) function besy0(x)
real(4) :: x 639 639 real(4) :: x
end function besy0 640 640 end function besy0
real(8) function dbesy0(x) 641 641 real(8) function dbesy0(x)
real(8) x 642 642 real(8) x
end function dbesy0 643 643 end function dbesy0
end interface bsy0 644 644 end interface bsy0
645 645
!Y1(x) 646 646 !Y1(x)
interface bsy1 647 647 interface bsy1
real(4) function besy1(x) 648 648 real(4) function besy1(x)
real(4) :: x 649 649 real(4) :: x
end function besy1 650 650 end function besy1
real(8) function dbesy1(x) 651 651 real(8) function dbesy1(x)
real(8) x 652 652 real(8) x
end function dbesy1 653 653 end function dbesy1
end interface bsy1 654 654 end interface bsy1
655 655
!I0(x) 656 656 !I0(x)
interface bsi0 657 657 interface bsi0
real(4) function besi0(x) 658 658 real(4) function besi0(x)
real(4) :: x 659 659 real(4) :: x
end function besi0 660 660 end function besi0
real(8) function dbesi0(x) 661 661 real(8) function dbesi0(x)
real(8) x 662 662 real(8) x
end function dbesi0 663 663 end function dbesi0
end interface bsi0 664 664 end interface bsi0
665 665
!I1(x) 666 666 !I1(x)
interface bsi1 667 667 interface bsi1
real(4) function besi1(x) 668 668 real(4) function besi1(x)
real(4) :: x 669 669 real(4) :: x
end function besi1 670 670 end function besi1
real(8) function dbesi1(x) 671 671 real(8) function dbesi1(x)
real(8) x 672 672 real(8) x
end function dbesi1 673 673 end function dbesi1
end interface bsi1 674 674 end interface bsi1
675 675
!K0(x) 676 676 !K0(x)
interface bsk0 677 677 interface bsk0
real(4) function besk0(x) 678 678 real(4) function besk0(x)
real(4) :: x 679 679 real(4) :: x
end function besk0 680 680 end function besk0
real(8) function dbesk0(x) 681 681 real(8) function dbesk0(x)
real(8) x 682 682 real(8) x
end function dbesk0 683 683 end function dbesk0
end interface bsk0 684 684 end interface bsk0
685 685
!K1(x) 686 686 !K1(x)
interface bsk1 687 687 interface bsk1
real(4) function besk1(x) 688 688 real(4) function besk1(x)
real(4) :: x 689 689 real(4) :: x
end function besk1 690 690 end function besk1
real(8) function dbesk1(x) 691 691 real(8) function dbesk1(x)
real(8) x 692 692 real(8) x
end function dbesk1 693 693 end function dbesk1
end interface bsk1 694 694 end interface bsk1
695 695
! Exponentially scaled I0 696 696 ! Exponentially scaled I0
interface bsi0e 697 697 interface bsi0e
real(4) function besi0e(x) 698 698 real(4) function besi0e(x)
real(4) :: x 699 699 real(4) :: x
end function besi0e 700 700 end function besi0e
real(8) function dbsi0e(x) 701 701 real(8) function dbsi0e(x)
real(8) :: x 702 702 real(8) :: x
end function dbsi0e 703 703 end function dbsi0e
end interface bsi0e 704 704 end interface bsi0e
705 705
! Exponentially scaled I1 706 706 ! Exponentially scaled I1
interface bsi1e 707 707 interface bsi1e
real(4) function besi1e(x) 708 708 real(4) function besi1e(x)
real(4) :: x 709 709 real(4) :: x
end function besi1e 710 710 end function besi1e
real(8) function dbsi1e(x) 711 711 real(8) function dbsi1e(x)
real(8) :: x 712 712 real(8) :: x
end function dbsi1e 713 713 end function dbsi1e
end interface bsi1e 714 714 end interface bsi1e
715 715
! Exponentially scaled K0 716 716 ! Exponentially scaled K0
interface bsk0e 717 717 interface bsk0e
real(4) function besk0e(x) 718 718 real(4) function besk0e(x)
real(4) :: x 719 719 real(4) :: x
end function besk0e 720 720 end function besk0e
real(8) function dbsk0e(x) 721 721 real(8) function dbsk0e(x)
real(8) :: x 722 722 real(8) :: x
end function dbsk0e 723 723 end function dbsk0e
end interface bsk0e 724 724 end interface bsk0e
725 725
! Exponentially scaled K1 726 726 ! Exponentially scaled K1
interface bsk1e 727 727 interface bsk1e
real(4) function besk1e(x) 728 728 real(4) function besk1e(x)
real(4) :: x 729 729 real(4) :: x
end function besk1e 730 730 end function besk1e
real(8) function dbsk1e(x) 731 731 real(8) function dbsk1e(x)
real(8) :: x 732 732 real(8) :: x
end function dbsk1e 733 733 end function dbsk1e
end interface bsk1e 734 734 end interface bsk1e
735 735
736 ! nth order J
737 interface bsjn
738 real(4) function besjn(n,x,factor,big)
739 integer(4) :: n
740 real(4) :: x
741 integer(4), optional :: factor
742 real(4), optional :: big
743 end function besjn
744 real(8) function dbesjn(n,x,factor,big)
745 integer(4) :: n
746 real(8) :: x
747 integer(4), optional :: factor
748 real(8), optional :: big
749 end function dbesjn
750 end interface bsjn
751
752 ! nth order Y
753 interface bsyn
754 real(4) function besyn(n,x)
755 integer(4) :: n
756 real(4) :: x
757 end function besyn
758 real(8) function dbesyn(n,x)
759 integer(4) :: n
760 real(8) :: x
761 end function dbesyn
762 end interface bsyn
763
764 ! nth order I
765 interface bsin
766 real(4) function besin(n,x,factor,big)
767 integer(4) :: n
768 real(4) :: x
769 integer(4), optional :: factor
770 real(4), optional :: big
771 end function besin
772 real(8) function dbesin(n,x,factor,big)
773 integer(4) :: n
774 real(8) :: x
775 integer(4), optional :: factor
776 real(8), optional :: big
777 end function dbesin
778 end interface bsin
779
780 ! nth order K
781 interface bskn
782 real(4) function beskn(n,x)
783 integer(4) :: n
784 real(4) :: x
785 end function beskn
786 real(8) function dbeskn(n,x)
787 integer(4) :: n
788 real(8) :: x
789 end function dbeskn
790 end interface bskn
791
!!!!!!!!!!!!!!!!!!!!! 736 792 !!!!!!!!!!!!!!!!!!!!!
! MISSING BSJNS 737 793 ! MISSING BSJNS
! MISSING BSINS 738 794 ! MISSING BSINS
! MISSING BSJS 739 795 ! MISSING BSJS
! MISSING BSYS 740 796 ! MISSING BSYS
! MISSING BSIS 741 797 ! MISSING BSIS
! MISSING BSIES 742 798 ! MISSING BSIES
!!!!!!!!!!!!!!!!!!!!! 743 799 !!!!!!!!!!!!!!!!!!!!!
744 800
! K nu + k 745 801 ! K nu + k
interface bsks 746 802 interface bsks
subroutine besks(xnu,x,nin,bk) 747 803 subroutine besks(xnu,x,nin,bk)
real(4) :: xnu,x 748 804 real(4) :: xnu,x
integer :: nin 749 805 integer :: nin
real(4), dimension(nin) :: bk 750 806 real(4), dimension(nin) :: bk
end subroutine besks 751 807 end subroutine besks
subroutine dbesks(xnu,x,nin,bk) 752 808 subroutine dbesks(xnu,x,nin,bk)
real(8) :: xnu,x 753 809 real(8) :: xnu,x
integer :: nin 754 810 integer :: nin
real(8), dimension(nin) :: bk 755 811 real(8), dimension(nin) :: bk
end subroutine dbesks 756 812 end subroutine dbesks
end interface bsks 757 813 end interface bsks
758 814
! Exponentially scaled K nu + k 759 815 ! Exponentially scaled K nu + k
interface bskes 760 816 interface bskes
subroutine beskes(xnu,x,nin,bke) 761 817 subroutine beskes(xnu,x,nin,bke)
real(4) :: xnu,x 762 818 real(4) :: xnu,x
integer :: nin 763 819 integer :: nin
real(4),dimension(nin) :: bke 764 820 real(4),dimension(nin) :: bke
end subroutine beskes 765 821 end subroutine beskes
subroutine dbskes(xnu,x,nin,bke) 766 822 subroutine dbskes(xnu,x,nin,bke)
real(8) :: xnu,x 767 823 real(8) :: xnu,x
integer :: nin 768 824 integer :: nin
real(8),dimension(nin) :: bke 769 825 real(8),dimension(nin) :: bke
end subroutine dbskes 770 826 end subroutine dbskes
end interface bskes 771 827 end interface bskes
772 828
!!!!!!!!!!!!!!!!!! 773 829 !!!!!!!!!!!!!!!!!!
! MISSING CBJS 774 830 ! MISSING CBJS
! MISSING CBYS 775 831 ! MISSING CBYS
! MISSING CBIS 776 832 ! MISSING CBIS
!!!!!!!!!!!!!!!!!! 777 833 !!!!!!!!!!!!!!!!!!
778 834
779 835
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 780 836 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END Bessel functions and related 781 837 ! END Bessel functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 782 838 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
783 839
784 840
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 785 841 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Airy functions and related 786 842 ! Airy functions and related
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 787 843 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
788 844
!ai(x) 789 845 !ai(x)
interface ai 790 846 interface ai
real(4) function ai(x) 791 847 real(4) function ai(x)
real(4) :: x 792 848 real(4) :: x
end function ai 793 849 end function ai
real(8) function dai(x) 794 850 real(8) function dai(x)
real(8) :: x 795 851 real(8) :: x
end function dai 796 852 end function dai
end interface ai 797 853 end interface ai
798 854
!bi(x) 799 855 !bi(x)
interface bi 800 856 interface bi
real(4) function bi(x) 801 857 real(4) function bi(x)
real(4) :: x 802 858 real(4) :: x
end function bi 803 859 end function bi
real(8) function dbi(x) 804 860 real(8) function dbi(x)
real(8) :: x 805 861 real(8) :: x
end function dbi 806 862 end function dbi
end interface bi 807 863 end interface bi
808 864
!ai'(x) 809 865 !ai'(x)
interface aid 810 866 interface aid
real(4) function aid(x) 811 867 real(4) function aid(x)
real(4) :: x 812 868 real(4) :: x
end function aid 813 869 end function aid
real(8) function daid(x) 814 870 real(8) function daid(x)
real(8) :: x 815 871 real(8) :: x
end function daid 816 872 end function daid
end interface aid 817 873 end interface aid
818 874
!bi'(x) 819 875 !bi'(x)
interface bid 820 876 interface bid
real(4) function bid(x) 821 877 real(4) function bid(x)
real(4) :: x 822 878 real(4) :: x