subroutine bessel (x,kk,bess,ier) c* c*********************************************************************** c* c* "Copyright [c] CNES 98 - tous droits reserves" c* ********************************************** c* c*PRO MAGLIB c* c*VER 99.03.31 - V 1.0 c*VER 01.06.01 - V 2.0 c*VER 03.01.06 - V 2.1 c* c*AUT J.C. Kosik adapted from reference: c*AUT Nelson M.Blachman, S.Hossein Mousavineshad, IEEE Transactions c*AUT on Aerospace and Electronic Systems, Vol. AES-22, No 1, Jan 1986 c*AUT port. CISI c* c*ROL Theme : Calculs mathematiques c*ROL Calcul des fonctions de Bessel d'ordre quelconque. c*ROL x compris entre 0 et 10, kk entre 1 et 6 soit c*ROL J0, J1, J2, J3, J4, J5. c* c*PAR x (I) : coordonnee radiale c* c*PAR kk (I) : ordre de la fonction c* c*PAR bess (O) : resultat de la fonction c* c*PAR ier (O) : code de retour c* c*NOT ier : sans objet c* c*NOT common : util c* c*INF utilise : sans objet c* c*HST version 1.0 - 99.03.31 - creation de la maglib au CDPP c*HST version 2.0 - 01.06.01 - correction de commentaires de code c*HST version 2.1 - 03.01.06 - corrections en compilation avec g77 c* c*********************************************************************** c* implicit none c c --------------------------------- c*FON Declaration identificateur rcs_id c --------------------------------- c character rcs_id*100 c c -------------------------- c*FON Declaration des parametres c -------------------------- c double precision x integer kk double precision bess integer ier c c ---------------------------------- c*FON Declaration des variables communes c ---------------------------------- c double precision pi,dpi,rad,deg,pid,xmu,rayt c c*COM pi : constante pi (obtenue a partir de acos(-1.)) c*COM dpi : constante 2 * pi c*COM pid : constante pi / 2 c*COM rad : facteur de conversion degres ----> radians c*COM deg : facteur de conversion radians ----> degres c*COM xmu : constante de gravitation terrestre (km**3/sec**2) c*COM rayt : rayon equatorial terrestre (km) c common/util/pi,dpi,rad,deg,pid,xmu,rayt c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer k c*LOC k : indice de boucles c double precision a1, a2, a3, a4, a5 c*LOC a1, a2, a3, a4, a5 : constantes c double precision bessj(6) c*LOC bessj : contient le resultat des calculs c SAVE c c --------------------------------- c*FON Affectation identificateur rcs_id c --------------------------------- c data rcs_id /" >$Id$"/ c c ****************** c Debut de programme c ****************** c ier = 0 c c --------------- c*FON Initialisations c --------------- c a1 = 1.d0 / 7.d0 a2 = 2.d0 / 7.d0 a3 = dsin(2.d0 * pi / 7.d0) a4 = dsin(4.d0 * pi / 7.d0) a5 = dsin(6.d0 * pi / 7.d0) c c --------------------------------------- c*FON Calcul des fonctions de Bessel J0 et J1 c --------------------------------------- c bessj(1) = a1 + a2 * (dcos(a3 * x) + dcos(a4 * x) > + dcos(a5 * x)) c bessj(2) = a2 * (a3 * dsin(a3 * x) + a4 *dsin(a4 * x) > + a5 * dsin(a5 * x)) c c -------------------------------------------------------- c*FON Calcul des fonctions de Bessel J2, J3, J4, J5 pour x > 0 c -------------------------------------------------------- c if (kk .gt. 2 .and. kk .le. 6 .and. x .gt. 0.d0) then c do 10 k = 3, kk c bessj(k) = 2.d0 * dble(k - 2) * bessj(k-1) / x > - bessj(k-2) c 10 continue c endif c c ---------------------------------------------------------------- c*FON Calcul des fonctions de Bessel J0, J1, J2, J3, J4, J5 pour x = 0 c ---------------------------------------------------------------- c if (x .eq. 0.d0 .and. kk .le. 6) then bessj(1) = 1.d0 bessj(2) = 0.d0 bessj(3) = 0.d0 bessj(4) = 0.d0 bessj(5) = 0.d0 bessj(6) = 0.d0 endif c bess = bessj(kk) c c **************** c Fin de programme c **************** c return end