inigeo1.f 9.14 KB
      subroutine inigeo1 (iyear,imonth,iday,ihour,imin,isec,year,
     >                    djulc,alfag,tetdip,phidip,alfas,deltas,
     >                    obliq,rig,rgi,rgdip,rdipg,rgsm,rsmg,tilt,
     >                    rggsm,rgsmg,rsmgsm,rgsmsm,rgse,rseg,
     >                    rise,rsei,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.10.23 - V 2.0
c*VER 03.01.06 - V 2.1
c*VER 01.01.07 - V 3.0
c*VER 13.10.10 - V 4.0
c*VER 2017.02.24 - V 5.0
c*
c*AUT spec. CNES - JC KOSIK - janvier 1991
c*AUT port. CISI
c*AUT adapt. AKKA
c*
c*ROL Theme : Modules d'initialisation
c*ROL         Initialisation de toutes les matrices de rotation
c*ROL         necessaires aux calculs geophysiques et geomagnetiques
c*ROL         pour CLUSTER, ainsi que l'angle de tilt, l'orientation
c*ROL         de l'axe du dipole, l'ascension droite et la declinaison
c*ROL         du soleil.
c*
c*PAR iyear  (I) : annee (>= 2000)
c*PAR imonth (I) : mois
c*PAR iday   (I) : jour
c*PAR ihour  (I) : heures
c*PAR imin   (I) : minutes
c*PAR isec   (I) : secondes
C*
c*PAR year   (O) : annee fractionnaire (>= 2000.)
c*
c*PAR djulc  (O) : date julienne CNES fractionnaire (depuis le 01/01/1950)
c*
c*PAR alfag  (O) : ascension droite de Greenwich (radians)
c*PAR tetdip (O) : colatitude geocentrique du point ou le dipole
c*PAR            : coupe l'hemisphere nord (radians)
c*PAR phidip (O) : longitude geocentrique du point ou le dipole
c*PAR            : coupe l'hemisphere nord (radians)
c*
c*PAR alfas  (O) : ascension droite du soleil (radians)
c*PAR deltas (O) : declinaison du soleil (radians)
c*
c*PAR obliq  (O) : obliquite de l'ecliptique (radians)
c*
c*PAR rig    (O) : matrice (3,3) de passage du repere inertiel
c*PAR            : au repere geocentrique
c*PAR rgi    (O) : matrice (3,3) de passage du repere geocentrique
c*PAR            : au repere inertiel
c*
c*PAR rgdip  (O) : matrice (3,3) de passage du repere geographique
c*PAR            : au repere dipolaire
c*PAR rdipg  (O) : matrice (3,3) de passage du repere dipolaire
c*PAR            : au repere geocentrique
c*
c*PAR rgsm   (O) : matrice (3,3) de passage du repere geocentrique
c*PAR            : au repere solaire magnetique
c*PAR rsmg   (O) : matrice (3,3) de passage du repere solaire
c*PAR            : magnetique au repere geocentrique
c*
c*PAR tilt   (O) : angle de tilt (radians)
c*
c*PAR rggsm  (O) : matrice (3,3) de passage du repere geocentrique
c*PAR            : au repere solaire magnetospherique
c*PAR rgsmg  (O) : matrice (3,3) de passage du repere solaire
c*PAR            : magnetospherique au repere geocentrique
c*
c*PAR rsmgsm (O) : matrice (3,3) de passage du repere solaire 
c*PAR            : magnetique au repere solaire magnetospherique
c*PAR rgsmsm (O) : matrice (3,3) de passage du repere solaire
c*PAR            : magnetospherique au repere solaire magnetique
c*
c*PAR rgse   (O) : matrice (3,3) de passage du repere geocentrique
c*PAR            : au repere solaire ecliptique
c*PAR rseg   (O) : matrice (3,3) de passage du repere solaire
c*PAR            : ecliptique au repere geocentrique
c*
c*PAR rise   (O) : matrice (3,3) de passage du repere inertiel  
c*PAR rsei   (O) : matrice (3,3) de passage du repere solaire
c*
c*PAR ier    (O) : code de retour
c*
c*NOT ier        : = 1 si iyear < 2000
c*
c*INF utilise    : solter00, solter05, solter10, solter15,
c*INF utilise    : roig, rogdip, rogsm, roggsm, rogse, roise, rosmgs
c*
c*HST version 1.0 - 15.09.98 - creation de la maglib au CDPP
c*HST version 2.0 - 01.10.23 - ajout de soltern
c*HST version 2.1 - 03.01.06 - corrections en compilation avec g77
c*HST version 3.0 - 01.01.07 - adoption des coefficients definitifs
c*HST                          du champ 2000
c*HST version 4.0 - 13.10.10 - Calcule entre 2000 et 2014
c*HST version 5.0 - 2017.02.24 - Calcule entre 2000 et 2019 (ajout du
c*HST                            module solter15).
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 iyear, imonth, iday, ihour, imin, isec
      double precision year, djulc
      double precision alfag
      double precision tetdip, phidip
      double precision alfas, deltas
      double precision obliq
      double precision rig(3,3), rgi(3,3)
      double precision rgdip(3,3), rdipg(3,3)
      double precision rgsm(3,3), rsmg(3,3)
      double precision tilt
      double precision rggsm(3,3), rgsmg(3,3)
      double precision rise(3,3), rsei(3,3)
      double precision rgse(3,3), rseg(3,3)
      double precision rsmgsm(3,3), rgsmsm(3,3)
      integer ier
c
c     ----------------------------------
c*FON Declaration des fonctions externes
c     ----------------------------------
c
      external julg
      integer julg
c
c     ---------------------------------
c*FON Declaration des variables locales
c     ---------------------------------
c
      integer ierjul
c*LOVC ierjul : erreur sur calcul de la date julienne
c
      integer ier1,ier2,ier3,ier4,ier5,ier6,ier7,ier8
c*LOC ier1 a ier8 : codes retour des modules appeles
c
      double precision fjour
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
      ier1 = 0
      ier2 = 0
      ier3 = 0
      ier4 = 0
      ier5 = 0
      ier6 = 0
      ier7 = 0
      ier8 = 0
      ierjul = 0
c
c     --------------------------------------
c*FON Calcul de la date julienne CNES  djulc
c     --------------------------------------
c
      fjour = dble((ihour * 60 + imin) * 60 + isec) / 86400.d0
      djulc = dble(julg (iday,imonth,iyear,ierjul)) + fjour
c
c     ----------------------------------------------------------
c*FON Calcul de la position inertielle de Greenwich et du soleil
c*FON et des angles d'orientation du dipole terrestre suivant
c*FON la periode, 2000-2005 ou 2005-2010 ou 2010-2015 ou 2015-2020
c     ----------------------------------------------------------
c
      if (iyear .ge. 2000 .and. iyear .lt. 2005) then
c
         call solter00(iyear,imonth,iday,ihour,imin,isec,year,alfag,
     >                alfas,deltas,obliq,tetdip,phidip,ier1)
c
      else if (iyear .ge. 2005 .and. iyear .lt. 2010) then
c
         call solter05(iyear,imonth,iday,ihour,imin,isec,year,alfag,
     >                 alfas,deltas,obliq,tetdip,phidip,ier1)
c
      else if (iyear .ge. 2010 .and. iyear .lt. 2015) then
c
         call solter10(iyear,imonth,iday,ihour,imin,isec,year,alfag,
     >                 alfas,deltas,obliq,tetdip,phidip,ier1)
c
      else if (iyear .ge. 2015) then
c
         call solter15(iyear,imonth,iday,ihour,imin,isec,year,alfag,
     >                 alfas,deltas,obliq,tetdip,phidip,ier1)
c
      else
         ier = 1
      endif
c
c     ------------------------------------------------------
c*FON Calcul des matrices de passage du repere inertiel vers
c*FON le repere geographique
c     ------------------------------------------------------
c
      call roig(alfag,rig,rgi,ier2)
c
c     --------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique au
c*FON repere dipolaire
c     --------------------------------------------------------
c
      call rogdip(tetdip,phidip,rgdip,rdipg,ier3)
c
c     ----------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique vers
c*FON le repere solaire-magnetique
c     ----------------------------------------------------------
c
      call rogsm(rgdip,alfag,alfas,deltas,rgsm,rsmg,
     >            tilt,ier4)
c
c     ----------------------------------------------------------
c*FON Calcul des matrices de passage du repere geographique vers
c*FON le repere solaire-magnetospherique
c     ----------------------------------------------------------
c
      call roggsm(tilt,rgsm,rggsm,rgsmg,ier5)
c
c     -----------------------------------------------------------
c*FON Calcul des matrices de passage du repere inertiel au repere
c*FON solaire magnetospherique gsm
c     -----------------------------------------------------------
c
      call rogse(alfag,alfas,deltas,obliq,rgse,rseg,ier6)
c
c     -----------------------------------------------------------
c*FON calcul des matrices de passage du repere inertiel au repere
c*FON solaire ecliptique 
c     -----------------------------------------------------------
c
      call roise(alfas,deltas,obliq,rise,rsei,ier7)
c
c     ------------------------------------------------------------
c*FON calcul des matrices de passage du repere sm au repere gsm et
c*FON inverse
c     ------------------------------------------------------------
c
      call rosmgs(tilt,rsmgsm,rgsmsm,ier8) 
c
c     ****************
c     Fin de programme
c     ****************
c
      return
      end