calphi.f 4.71 KB
      subroutine calphi (xgse,ygse,zgse,rgsa,thetd,phid,
     >                   ival,phi1,phi2,ier)
c*
c***********************************************************************
c*
c*      "Copyright [c] CNES 98 - tous droits reserves"
c*      **********************************************
c*
c*PRO MAGLIB
c*
c*VER 01.10.23 - V 2.0
c*VER 03.01.06 - V 2.1
c*
c*AUT spec. CNES - JC KOSIK - octobre 2001
c*AUT port. CISI
c*
c*ROL Theme : Astronomie et calculs d'orbite
c*ROL       Recherche des deux fuseaux qui encadrent le point donne.
c*ROL       Ces fuseaux sont donnes par les angles phi1 et phi2
c*ROL       comptes a partir de l'axe ygsa.
c*
c*PAR xgse  (I) : composante solaire ecliptque en x (degres)
c*PAR ygse  (I) : composante solaire ecliptque en y (degres)
c*PAR zgse  (I) : composante solaire ecliptque en z (degres)
c*
c*PAR rgsa  (I) : composante solaire corrigee 
c
c*PAR thetd (I) : colatitude geocentrique du dipole (degres)
c*PAR phidp (I) : longitude geocentrique du dipole (degres)

c*PAR ival  (I) : numero du fuseau
c*PAR phi1  (O) : angle phi1 du premier meridien (degres)
c*PAR phi2  (O) : angle phi2 du second meridien (degres)
c*
c*PAR ier   (O) : code retour
c*
c*NOT ier      : 0 = OK
c*NOT ier      : 1 = thetd superieur a 165 degres
c*
c*NOT common   : util
c*
c*INF utilise  : aberrm
c*
c*HST version 2.0 - 01.10.23 - Enrichissement de la maglib au CDPP
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 ival, ier
      double precision xgse,ygse,zgse,rgsa,thetd,phid,phi1,phi2
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
      double precision thetmax
c*LOC thetmax : valeur maximale de l'angle theta
c
      double precision phiinf, phisup
c*LOC phiinf, phisup : bornes inferieure et superieure de l'angle phi
c
      double precision xgsa,ygsa,zgsa
c*LOC xgsa,ygsa,zgsa : composantes solaires ecliptiques corrigees
c
      integer i
c*LOC i :indice de boucles
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 thetmax/165.d0/
c
c     ******************
c     Debut de programme
c     ******************
c
      ier = 0
c
c     ------------------------------------------------------
c*FON Calcul des coordonnees dans le systeme du vent solaire
c*FON i.e. avec aberration
c     ------------------------------------------------------
c
      call aberrm (xgse,ygse,zgse,xgsa,ygsa,zgsa,ier)
c
c     ---------------------------------------------------------------
c*FON Calcul des coordonnees thet phi du systeme Olson
c*FON thet est compte en degres depuis l'axe xgsa, phi est
c*FON compte positivementdepuis l'axe ygsa de 0 a 90 vers
c*FON l'axe zgsa positif et negativement vers l'axe zgsa
c*FON negatif. Pour ygsa negatif on fait ygsa = -ygsa
c*FON (symetrie par rapport a l'axe zgsa)
c     ---------------------------------------------------------------
c
c     changement de signe de ygsa si ygsa est negatif
c
      if (ygsa .lt. 0.d0) then
         ygsa = - ygsa
      endif
c
      rgsa = dsqrt(xgsa*xgsa + ygsa*ygsa + zgsa*zgsa)
c
      thetd = dacos(xgsa / rgsa) * deg
c
      phid  = datan(zgsa / ygsa) * deg
c
      if (thetd .le. thetmax) then
c
         ier = 1
c
         do 20  i = 1, 12

            phiinf = -90.d0  + dble(i-1) * 15.d0
            phisup = -90.d0  + dble(i)   * 15.d0

            if (phid .ge. phiinf .and. phid .le. phisup) then
c
               ival  = i
               ier   = 0
               phi1  = phiinf
               phi2  = phisup
c
            endif
c
20       continue
      endif
c
c     ****************
c     Fin de programme
c     ****************
c

      return
      end