subroutine chapel (tgls,xls,ichapp,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 : Frontieres et regions c*ROL Calcul de l'appartenance d'un satellite a la plasmasphere c*ROL definie par Chappell. c* c*PAR tgls (I) : temps geomagnetique local du satellite c*PAR : (heures fractionnaires) c* c*PAR xls (I) : L de Mac Ilwain du satellite c* c*PAR ichapp (O) : indice d'appartenance du satellite a la plasmasphere c* c*PAR ier (O) : code de retour c* c*NOT Pour un tgl donne l doit etre inferieur a une valeur c*NOT definie dans un tableau. ici l= xls, ichapp =1 si le satellite c*NOT appartient a la plasmasphere de Chappell sinon 0. c* c*NOT ichapp : 0 = non appartenance c*NOT ichapp : 1 = appartenance 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 double precision tgls double precision xls integer ichapp integer ier c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer i c*LOC i : indice de boucle c double precision xl(25) c*LOC xl : coordonnees de la plasmaphere de Chappell c double precision tg(25),deltal,xllim 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*FON Affectation des constantes c -------------------------- c data (xl(i),i = 1,25)/ > 4.1d0, 4.1d0, 4.2d0, 4.2d0, 4.1d0, > 4.d0, 4.d0, 4.d0, 4.d0, 4.d0, > 4.15d0, 4.3d0, 4.5d0, 4.6d0, 4.8d0, > 5.2d0, 6.1d0, 6.7d0, 6.8d0, 6.6d0, > 6.d0, 5.4d0, 4.8d0, 4.4d0, 4.1d0/ c c ****************** c Debut de programme c ****************** c ier = 0 ichapp = 0 c c ----------------------------------------- c*FON Determination de la position du satellite c ----------------------------------------- c if (xls .le. 6.8d0) then c do 10 i = 1, 24 c tg(i) = dble(i-1) tg(i+1) = dble(i) c if (tgls .ge. tg(i) .and. tgls .le. tg(i+1)) then c deltal = xl(i+1) - xl(i) xllim = xl(i) + (tgls-tg(i)) * deltal c if (xls .le. xllim) then c ichapp = 1 c endif c endif c 10 continue c endif c c **************** c Fin de programme c **************** c return end