subroutine calcds (np,tr,tthet,tphi,flength,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 spec. CNES - JC KOSIK - janvier 1991 c*AUT port. CISI c* c*ROL Theme : Calculs de geophysique c*ROL Calcul de la longueur de la ligne de champ. c* c*PAR np (I) : nombre de points calcules c* c*PAR tr (I) : tableau des distances geocentriques des point de la c*PAR : ligne de champ c*PAR tthet (I) : tableau des colatitudes des points calcules de la c*PAR : ligne de champ c*PAR tphi (I) : tableau des longitudes des points calcules de la c*PAR : ligne de champ c* c*PAR flength (O) : longueur de la ligne de champ c* c*PAR ier (O) : code de retour c* c*NOT ier : sans objet 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 integer np double precision tr(500), tthet(500), tphi(500) double precision flength integer ier c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer n c*LOC n : indice de boucle c integer npfin c*LOC npfin : nombre d'elements du calcul courant C double precision rp,thetp,phip double precision rre,thete,phie c*LOC coordonnees spheriques intermediaires c double precision x,y,z,xp,yp,zp c*LOC x,y,z,xp,yp,zp : coordonnees cartesiennes intermediaires c double precision ds2,dseff c*LOC ds2,dseff : 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 flength = 0.d0 c c ------------------------------ c*FON Calculs pour les points 1 et 4 c ------------------------------ c do 10 n = 1, 4, 3 c rp = tr(n) thetp = tthet(n) phip = tphi(n) rre = tr(n+3) thete = tthet(n+3) phie = tphi(n+3) c xp = rp * sin(thetp) * cos(phip) yp = rp * sin(thetp) * sin(phip) zp = rp * cos(thetp) c x = rre * sin(thete) * cos(phie) y = rre * sin(thete) * sin(phie) z = rre * cos(thete) c ds2 = (x - xp)**2 + (y - yp)**2 + (z - zp)**2 dseff = sqrt(ds2) flength = flength + dseff 10 continue c npfin = np - 2 c c ---------------------------------- c*FON Calculs pour les points 7 a np - 2 c ---------------------------------- c do 20 n = 7, npfin rp = tr(n) thetp = tthet(n) phip = tphi(n) rre = tr(n+1) thete = tthet(n+1) phie = tphi(n+1) c xp = rp * sin(thetp) * cos(phip) yp = rp * sin(thetp) * sin(phip) zp = rp * cos(thetp) c x = rre * sin(thete) * cos(phie) y = rre * sin(thete) * sin(phie) z = rre * cos(thete) c ds2 = (x - xp)**2 + (y-yp)**2 + (z - zp)**2 dseff = sqrt(ds2) flength = flength + dseff c 20 continue c c **************** c Fin de programme c **************** c return end