module fvn_fnlib use fvn_common !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! This module is a generic interface for fn library ! http://www.netlib.org/fn !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Elementary Functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Argument interface carg real function carg(z) complex :: z end function carg real(kind(1.d0)) function zarg(z) complex(kind(1.d0)) :: z end function zarg end interface carg ! Cubic root interface cbrt real function cbrt(x) real :: x end function cbrt real(kind(1.d0)) function dcbrt(x) real(kind(1.d0)) :: x end function dcbrt complex function ccbrt(z) complex :: z end function ccbrt complex(kind(1.d0)) function zcbrt(z) complex(kind(1.d0)) :: z end function zcbrt end interface cbrt ! (exp(x) -1)/x interface exprl real function exprel(x) real :: x end function exprel real(kind(1.d0)) function dexprl(x) real(kind(1.d0)) :: x end function dexprl complex function cexprl(z) complex :: z end function cexprl complex(kind(1.d0)) function zexprl(z) complex(kind(1.d0)) :: z end function zexprl end interface exprl ! log10 extension to complex arguments interface log10 complex function clog10(z) complex :: z end function clog10 complex(kind(1.d0)) function zlog10(z) complex(kind(1.d0)) :: z end function zlog10 end interface log10 ! ln(x+1) interface alnrel real function alnrel(x) real :: x end function alnrel real(kind(1.d0)) function dlnrel(x) real(kind(1.d0)) :: x end function dlnrel complex function clnrel(z) complex :: z end function clnrel complex(kind(1.d0)) function zlnrel(z) complex(kind(1.d0)) :: z end function zlnrel end interface alnrel !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Elementary Functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Trigonometry !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Extension de la tangente aux arguments complexes interface tan complex function ctan(z) complex :: z end function ctan complex(kind(1.d0)) function ztan(z) complex(kind(1.d0)) :: z end function ztan end interface tan ! Cotangente interface cot real function cot(x) real :: x end function cot real(kind(1.d0)) function dcot(x) real(kind(1.d0)) :: x end function dcot complex function ccot(z) complex :: z end function ccot complex(kind(1.d0)) function zcot(z) complex(kind(1.d0)) :: z end function zcot end interface cot ! Sinus in degree interface sindg real function sindg(x) real :: x end function sindg real(kind(1.d0)) function dsindg(x) real(kind(1.d0)) :: x end function dsindg end interface sindg ! Cosinus in degree interface cosdg real function cosdg(x) real :: x end function cosdg real(kind(1.d0)) function dcosdg(x) real(kind(1.d0)) :: x end function dcosdg end interface cosdg ! Extension de l'arcsinus aux arguments complexes interface asin complex function casin(z) complex :: z end function casin complex(kind(1.d0)) function zasin(z) complex(kind(1.d0)) :: z end function zasin end interface asin ! Extension de l'arccosinus aux arguments complexes interface acos complex function cacos(z) complex :: z end function cacos complex(kind(1.d0)) function zacos(z) complex(kind(1.d0)) :: z end function zacos end interface acos ! Extension de l'arctangente aux arguments complexes interface atan complex function catan(z) complex :: z end function catan complex(kind(1.d0)) function zatan(z) complex(kind(1.d0)) :: z end function zatan end interface atan ! Extension de atan2 aux arguments complexes interface atan2 complex function catan2(csn,ccs) complex :: csn,ccs end function catan2 complex(kind(1.d0)) function zatan2(csn,ccs) complex(kind(1.d0)) :: csn,ccs end function zatan2 end interface atan2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Hyperbolic Trigonometry !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Extension du Sinus hyperbolique aux arguments complexes interface sinh complex function csinh(z) complex :: z end function csinh complex(kind(1.d0)) function zsinh(z) complex(kind(1.d0)) :: z end function zsinh end interface sinh ! Extension du Cosinus hyperbolique aux arguments complexes interface cosh complex function ccosh(z) complex :: z end function ccosh complex(kind(1.d0)) function zcosh(z) complex(kind(1.d0)) :: z end function zcosh end interface cosh ! Extension de la tangente hyperbolique aux arguments complexes interface tanh complex function ctanh(z) complex :: z end function ctanh complex(kind(1.d0)) function ztanh(z) complex(kind(1.d0)) :: z end function ztanh end interface tanh ! Arc sinus hyperbolique interface asinh real function asinh(x) real :: x end function asinh real(kind(1.d0)) function dasinh(x) real(kind(1.d0)) :: x end function dasinh complex function casinh(z) complex :: z end function casinh complex(kind(1.d0)) function zasinh(z) complex(kind(1.d0)) :: z end function zasinh end interface asinh ! Arc cosinus hyperbolique interface acosh real function acosh(x) real :: x end function acosh real(kind(1.d0)) function dacosh(x) real(kind(1.d0)) :: x end function dacosh complex function cacosh(z) complex :: z end function cacosh complex(kind(1.d0)) function zacosh(z) complex(kind(1.d0)) :: z end function zacosh end interface acosh ! Arc tangente hyperbolique interface atanh real function atanh(x) real :: x end function atanh real(kind(1.d0)) function datanh(x) real(kind(1.d0)) :: x end function datanh complex function catanh(z) complex :: z end function catanh complex(kind(1.d0)) function zatanh(z) complex(kind(1.d0)) :: z end function zatanh end interface atanh !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Trigonometry !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Exponential integral and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Exponential integral ei(x) interface ei real function ei(x) real :: x end function ei real(kind(1.d0)) function dei(x) real(kind(1.d0)) :: x end function dei end interface ei ! Exponential integral e1(x) interface e1 real function e1(x) real :: x end function e1 real(kind(1.d0)) function de1(x) real(kind(1.d0)) :: x end function de1 complex(kind(1.d0)) function ze1(x) complex(kind(1.d0)) :: x end function end interface e1 !!!!!!!!!!!!!!! ! MISSING ENE !!!!!!!!!!!!!!! ! Logarithm integral interface ali real function ali(x) real :: x end function ali real(kind(1.d0)) function dli(x) real(kind(1.d0)) :: x end function dli end interface ali ! Sine integral interface si real function si(x) real :: x end function si real(kind(1.d0)) function dsi(x) real(kind(1.d0)) :: x end function dsi end interface si ! Cosine integral interface ci real function ci(x) real :: x end function ci real(kind(1.d0)) function dci(x) real(kind(1.d0)) :: x end function dci end interface ci ! Cosine integral alternate definition interface cin real function cin(x) real :: x end function cin real(kind(1.d0)) function dcin(x) real(kind(1.d0)) :: x end function dcin end interface cin ! Hyperbolic sine integral interface shi real function shi(x) real :: x end function shi real(kind(1.d0)) function dshi(x) real(kind(1.d0)) :: x end function dshi end interface shi ! Hyperbolic cosine integral interface chi real function chi(x) real :: x end function chi real(kind(1.d0)) function dchi(x) real(kind(1.d0)) :: x end function dchi end interface chi ! Hyperbolic cosine integral alternate definition interface cinh real function cinh(x) real :: x end function cinh real(kind(1.d0)) function dcinh(x) real(kind(1.d0)) :: x end function dcinh end interface cinh !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Exponential integral and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Gamma family !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! No generic interface for fac and binom but we still ! define their prototypes ! Factorial interface real function fac(n) integer :: n end function fac real(kind(1.d0)) function dfac(n) integer :: n end function dfac ! Binomial coefficient real function binom(n,m) integer :: n,m end function binom real(kind(1.d0)) function dbinom(n,m) integer :: n,m end function dbinom end interface ! Gamma function interface gamma real function gamma(x) real :: x end function gamma real(kind(1.d0)) function dgamma(x) real(kind(1.d0)) :: x end function dgamma complex function cgamma(z) complex :: z end function cgamma complex(kind(1.d0)) function zgamma(z) complex(kind(1.d0)) :: z end function zgamma end interface gamma ! Reciprocal of gamma function interface gamr real function gamr(x) real :: x end function gamr real(kind(1.d0)) function dgamr(x) real(kind(1.d0)) :: x end function dgamr complex function cgamr(z) complex :: z end function cgamr complex(kind(1.d0)) function zgamr(z) complex(kind(1.d0)) :: z end function zgamr end interface gamr ! natural log of abs(gamma) interface alngam real function alngam(x) real :: x end function alngam real(kind(1.d0)) function dlngam(x) real(kind(1.d0)) :: x end function dlngam complex function clngam(z) complex :: z end function clngam complex(kind(1.d0)) function zlngam(z) complex(kind(1.d0)) :: z end function zlngam end interface alngam ! log abs gamma and sign interface algams subroutine algams(x,algam,sgngam) real :: x end subroutine algams subroutine dlgams(x,algam,sgngam) real(kind(1.d0)) :: x end subroutine dlgams end interface algams ! Incomplete gamma function interface gami real function gami(a,x) real :: a,x end function gami real(kind(1.d0)) function dgami(a,x) real(kind(1.d0)) :: a,x end function dgami end interface gami ! Complementary incomplete gamma function interface gamic real function gamic(a,x) real :: a,x end function gamic real(kind(1.d0)) function dgamic(a,x) real(kind(1.d0)) :: a,x end function dgamic end interface gamic ! Tricomi's incomplete gamma function interface gamit real function gamit(a,x) real :: a,x end function gamit real(kind(1.d0)) function dgamit(a,x) real(kind(1.d0)) :: a,x end function dgamit end interface gamit ! Psi function interface psi real function psi(x) real :: x end function psi real(kind(1.d0)) function dpsi(x) real(kind(1.d0)) :: x end function dpsi complex function cpsi(z) complex :: z end function cpsi complex(kind(1.d0)) function zpsi(z) complex(kind(1.d0)) :: z end function zpsi end interface psi ! Pochhammer interface poch real function poch(a,x) real :: a,x end function poch real(kind(1.d0)) function dpoch(a,x) real(kind(1.d0)) :: a,x end function dpoch end interface poch ! Pochhammer first order interface poch1 real function poch1(a,x) real :: a,x end function poch1 real(kind(1.d0)) function dpoch1(a,x) real(kind(1.d0)) :: a,x end function dpoch1 end interface poch1 ! Beta function interface beta real function beta(a,b) real :: a,b end function beta real(kind(1.d0)) function dbeta(a,b) real(kind(1.d0)) :: a,b end function dbeta complex function cbeta(a,b) complex :: a,b end function cbeta complex(kind(1.d0)) function zbeta(a,b) complex(kind(1.d0)) :: a,b end function zbeta end interface beta ! natural log of beta interface albeta real function albeta(a,b) real :: a,b end function albeta real(kind(1.d0)) function dlbeta(a,b) real(kind(1.d0)) :: a,b end function dlbeta complex function clbeta(a,b) complex :: a,b end function clbeta complex(kind(1.d0)) function zlbeta(a,b) complex(kind(1.d0)) :: a,b end function zlbeta end interface albeta ! Incomplete beta function interface betai real function betai(x,pin,qin) real :: x,pin,qin end function betai real(kind(1.d0)) function dbetai(x,pin,qin) real(kind(1.d0)) :: x,pin,qin end function dbetai end interface betai !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Gamma family !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Error function and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Error function interface erf real function erf(x) real :: x end function erf real(kind(1.d0)) function derf(x) real(kind(1.d0)) :: x end function derf end interface erf ! Complementary error function interface erfc real function erfc(x) real :: x end function erfc real(kind(1.d0)) function derfc(x) real(kind(1.d0)) :: x end function derfc end interface erfc !!!!!!!!!!! ! MISSING ERFCE ! MISSING CERFI ! MISSING ERFI ! MISSING ERFCI !!!!!!!!!!!!!! ! Dawson's function interface daws real function daws(x) real :: x end function daws real(kind(1.d0)) function ddaws(x) real(kind(1.d0)) :: x end function ddaws end interface daws !!!!!!!!!!!!!!!!! ! MISSING FRESC ! MISSING FRESS !!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Error function and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Bessel functions and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !J0(x) interface bsj0 real function besj0(x) real :: x end function besj0 real(kind(1.d0)) function dbesj0(x) real(kind(1.d0)) :: x end function dbesj0 end interface bsj0 !J1(x) interface bsj1 real function besj1(x) real :: x end function besj1 real(kind(1.d0)) function dbesj1(x) real(kind(1.d0)) :: x end function dbesj1 end interface bsj1 !Y0(x) interface bsy0 real function besy0(x) real :: x end function besy0 real(kind(1.d0)) function dbesy0(x) real(kind(1.d0)) x end function dbesy0 end interface bsy0 !Y1(x) interface bsy1 real function besy1(x) real :: x end function besy1 real(kind(1.d0)) function dbesy1(x) real(kind(1.d0)) x end function dbesy1 end interface bsy1 !I0(x) interface bsi0 real function besi0(x) real :: x end function besi0 real(kind(1.d0)) function dbesi0(x) real(kind(1.d0)) x end function dbesi0 end interface bsi0 !I1(x) interface bsi1 real function besi1(x) real :: x end function besi1 real(kind(1.d0)) function dbesi1(x) real(kind(1.d0)) x end function dbesi1 end interface bsi1 !K0(x) interface bsk0 real function besk0(x) real :: x end function besk0 real(kind(1.d0)) function dbesk0(x) real(kind(1.d0)) x end function dbesk0 end interface bsk0 !K1(x) interface bsk1 real function besk1(x) real :: x end function besk1 real(kind(1.d0)) function dbesk1(x) real(kind(1.d0)) x end function dbesk1 end interface bsk1 ! Exponentially scaled I0 interface bsi0e real function besi0e(x) real :: x end function besi0e real(kind(1.d0)) function dbsi0e(x) real(kind(1.d0)) :: x end function dbsi0e end interface bsi0e ! Exponentially scaled I1 interface bsi1e real function besi1e(x) real :: x end function besi1e real(kind(1.d0)) function dbsi1e(x) real(kind(1.d0)) :: x end function dbsi1e end interface bsi1e ! Exponentially scaled K0 interface bsk0e real function besk0e(x) real :: x end function besk0e real(kind(1.d0)) function dbsk0e(x) real(kind(1.d0)) :: x end function dbsk0e end interface bsk0e ! Exponentially scaled K1 interface bsk1e real function besk1e(x) real :: x end function besk1e real(kind(1.d0)) function dbsk1e(x) real(kind(1.d0)) :: x end function dbsk1e end interface bsk1e ! nth order J interface bsjn real function besjn(n,x,factor,big) integer :: n real :: x integer, optional :: factor real, optional :: big end function besjn real(kind(1.d0)) function dbesjn(n,x,factor,big) integer :: n real(kind(1.d0)) :: x integer, optional :: factor real(kind(1.d0)), optional :: big end function dbesjn end interface bsjn ! nth order Y interface bsyn real function besyn(n,x) integer :: n real :: x end function besyn real(kind(1.d0)) function dbesyn(n,x) integer :: n real(kind(1.d0)) :: x end function dbesyn end interface bsyn ! nth order I interface bsin real function besin(n,x,factor,big) integer :: n real :: x integer, optional :: factor real, optional :: big end function besin real(kind(1.d0)) function dbesin(n,x,factor,big) integer :: n real(kind(1.d0)) :: x integer, optional :: factor real(kind(1.d0)), optional :: big end function dbesin end interface bsin ! nth order K interface bskn real function beskn(n,x) integer :: n real :: x end function beskn real(kind(1.d0)) function dbeskn(n,x) integer :: n real(kind(1.d0)) :: x end function dbeskn end interface bskn !!!!!!!!!!!!!!!!!!!!! ! MISSING BSJNS, replaced by dbesrj (ChW 11/2009) ! MISSING BSINS, replaced by dbesri (ChW 11/2009) ! MISSING BSJS ! MISSING BSYS ! MISSING BSIS ! MISSING BSIES !!!!!!!!!!!!!!!!!!!!! ! vector b of Bessel J values of x from order 0 to order (n-1) interface besrj subroutine besrj(x,n,b) real(kind(1.e0)), intent(in) :: x integer, intent(in) :: n real(kind(1.e0)), intent(out) :: b(n) end subroutine besrj subroutine dbesrj(x,n,b) real(kind(1.d0)), intent(in) :: x integer, intent(in) :: n real(kind(1.d0)), intent(out) :: b(n) end subroutine dbesrj end interface besrj ! vector b of Bessel I values of x from order 0 to order (n-1) interface besri subroutine besri(x,n,b) real(kind(1.e0)), intent(in) :: x integer, intent(in) :: n real(kind(1.e0)), intent(out) :: b(n) end subroutine besri subroutine dbesri(x,n,b) real(kind(1.d0)), intent(in) :: x integer, intent(in) :: n real(kind(1.d0)), intent(out) :: b(n) end subroutine dbesri end interface besri ! K nu + k interface bsks subroutine besks(xnu,x,nin,bk) real :: xnu,x integer :: nin real, dimension(nin) :: bk end subroutine besks subroutine dbesks(xnu,x,nin,bk) real(kind(1.d0)) :: xnu,x integer :: nin real(kind(1.d0)), dimension(nin) :: bk end subroutine dbesks end interface bsks ! Exponentially scaled K nu + k interface bskes subroutine beskes(xnu,x,nin,bke) real :: xnu,x integer :: nin real,dimension(nin) :: bke end subroutine beskes subroutine dbskes(xnu,x,nin,bke) real(kind(1.d0)) :: xnu,x integer :: nin real(kind(1.d0)),dimension(nin) :: bke end subroutine dbskes end interface bskes !!!!!!!!!!!!!!!!!! ! MISSING CBJS ! MISSING CBYS ! MISSING CBIS !!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Bessel functions and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Airy functions and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !ai(x) interface ai real function ai(x) real :: x end function ai real(kind(1.d0)) function dai(x) real(kind(1.d0)) :: x end function dai end interface ai !bi(x) interface bi real function bi(x) real :: x end function bi real(kind(1.d0)) function dbi(x) real(kind(1.d0)) :: x end function dbi end interface bi !ai'(x) interface aid real function aid(x) real :: x end function aid real(kind(1.d0)) function daid(x) real(kind(1.d0)) :: x end function daid end interface aid !bi'(x) interface bid real function bid(x) real :: x end function bid real(kind(1.d0)) function dbid(x) real(kind(1.d0)) :: x end function dbid end interface bid ! Exponentially scaled Ai interface aie real function aie(x) real :: x end function aie real(kind(1.d0)) function daie(x) real(kind(1.d0)) :: x end function daie end interface aie ! Exponentially scaled Bi interface bie real function bie(x) real :: x end function bie real(kind(1.d0)) function dbie(x) real(kind(1.d0)) :: x end function dbie end interface bie ! Exponentially scaled Ai'(x) interface aide real function aide(x) real :: x end function aide real(kind(1.d0)) function daide(x) real(kind(1.d0)) :: x end function daide end interface aide ! Exponentially scaled Bi'(x) interface bide real function bide(x) real :: x end function bide real(kind(1.d0)) function dbide(x) real(kind(1.d0)) :: x end function dbide end interface bide !!!!!!!!!!!!!!!!!!!!!!! ! MISSING CAI ! MISSING CBI ! MISSING CAID ! MISSING CBID !!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Airy functions and related !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Miscellanous functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Spence dilogarithm interface spenc real function spenc(x) real :: x end function spenc real(kind(1.d0)) function dspenc(x) real(kind(1.d0)) :: x end function dspenc end interface spenc ! Initialize a Chebyshev series interface inits integer function inits(os,nos,eta) real,dimension(nos) :: os integer :: nos real :: eta end function inits integer function initds(dos,nos,eta) real(kind(1.d0)),dimension(nos) :: dos integer :: nos real :: eta end function initds end interface inits ! Evaluate a Chebyshev series interface csevl real function csevl(x,cs,n) real :: x real,dimension(n) :: cs integer :: n end function csevl real(kind(1.d0)) function dcsevl(x,a,n) real(kind(1.d0)) :: x real(kind(1.d0)), dimension(n) :: a integer :: n end function dcsevl end interface csevl !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! END Miscellanous functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module fvn_fnlib