subroutine rootlf (rtab,dist,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.05 - V 2.0 c*VER 03.01.06 - V 2.1 c* c*AUT spec. CNES - JC KOSIK - juin 1995 c*AUT port. CISI c* c*ROL Theme : Calculs de geophysique c*ROL Calcul de la distance minimum d'un point a une ligne c*ROL dipolaire. c* c*PAR rtab (I) : tableau (dim = 3) representant : xl, r1 et thet1r c* c*PAR dist (O) : distance c* c*PAR ier (O) : code de retour c* c*NOT rtab : rtab(1) = parametre de la ligne dipolaire c*NOT rtab : rtab(2) = distance geocentrique du satellite c*NOT rtab : (rayons terrestres) c*NOT rtab : rtab(3) = colatitude du satellite (radians) c* c*NOT ier : sans objet c* c*NOT common : util c* c*INF utilise : nuraci, rfonc c* c*HST version 1.0 - 99.03.31 - creation de la maglib au CDPP c*HST version 2.0 - 01.06.05 - 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 rtab(3) double precision dist 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 fonctions externes c ---------------------------------- c double precision rfonc external rfonc c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer nbr c double precision xl,r1,thet1r double precision ra,rb c*LOC ra,rb : bornes de l'intervalle c double precision rh double precision repsi double precision x double precision sx,sx2,sx4 double precision cdthet,dthet,dist2 c*LOC Variables de travail intermediaires 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 xl = rtab(1) r1 = rtab(2) thet1r = rtab(3) c ra = 0.d0 rb = pid c if (thet1r .gt. pid) then ra = pid rb = pi endif c rh = 0.d0 repsi = 1.d-10 c call nuraci(rfonc,rtab,ra,rb,rh,repsi,x,nbr,ier) c sx = sin(x) sx2= sx * sx sx4= sx2 * sx2 c dthet = x - thet1r cdthet = cos(dthet) c dist2 = r1**2 + (xl**2) * sx4 - 2.d0 * xl * r1 * sx2 * cdthet c dist = sqrt(dist2) c c **************** c Fin de programme c **************** c return end