subroutine gussen (tgls,xinvla,iguss,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 - janvier 1991 c*AUT port. CISI c* c*ROL Theme : Frontieres et regions c*ROL Calcul de la presence d'un satellite dans la zone diffuse. c*ROL Calcul de la frontiere sud de la zone aurorale diffuse c*ROL d'apres le modele de Gussenhoven pour l'activite c*ROL magnetique Kp = 3. c* c*PAR tgls (I) : temps geomagnetique local (heures fractionnaires) c* c*PAR xinvla (I) : latitude invariante (radians) c* c*PAR iguss (O) : indicateur de presence dans la zone diffuse c* c*PAR ier (O) : code de retour c* c*NOT iguss : 1 = le satellite est dans la zone diffuse c*NOT iguss : 0 = le satellite est en dehors 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.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 tgls double precision xinvla integer iguss 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 i,k c*LOC i,k : indices de boucles c double precision txinv(24),a1s(2),a2s(2),a3s(2),tthets(2) double precision t,alfas,xinvli,xoval,xthets,xinvm,tginf,tgsup 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 c* Donnees de latitude invariante pour Kp=3 c data (txinv(i),i=1,24)/ > 60.13d0, 60.45d0, 61.39d0, 62.33d0, 63.26d0, 62.19d0, > 62.50d0, 63.17d0, 63.69d0, 64.43d0, 65.27d0, 66.35d0, > 66.88d0, 67.41d0, 67.94d0, 68.47d0, 67.76d0, 67.17d0, > 65.98d0, 64.91d0, 63.73d0, 63.02d0, 62.56d0, 61.59d0/ c c* Donnees de la frontiere sud de l'oval auroral c data (a1s(i),i=1,2) /17.36d0, 23.18d0/ data (a2s(i),i=1,2) / 3.03d0, 4.85d0/ data (a3s(i),i=1,2) / 3.3d0, 3.3d0/ c c ****************** c Debut de programme c ****************** c ier = 0 c c ---------------------------------------------------------- c*FON Calcul de la latitude geom.frontiere sud de l oval auroral c ---------------------------------------------------------- c t = tgls * 15.d0 t = mod(t,360.d0) c do 10 k = 1, 2 alfas = t + a3s(k) tthets(k) = a1s(k) + a2s(k) * cos(alfas * rad) 10 continue c xthets = (tthets(1) + tthets(2)) * rad / 2.d0 xoval = pid - xthets c c ------------------------------------------ c*FON Calcul de l appartenance a la zone diffuse c ------------------------------------------ c iguss = 0 c xinvm = 60.13d0 * rad if (xinvla .ge. xinvm) then c do 15 i = 1, 24 c tginf = dble(i - 1) tgsup = dble(i) c if (tgls .ge. tginf .and. tgls .le. tgsup) then c xinvli = txinv(i) * rad c if (xinvla .gt. xinvli .and. xinvla .lt. xoval) then iguss = 1 endif c endif c 15 continue c endif c c **************** c Fin de programme c **************** c return end