geophys.f 9.94 KB
      subroutine geophys (ignloc,isw,rre,thetr,phir,year,tilt,
     >      rgsm,rggsm,rgsmg,rgse,dismp,br,bt,bp,bb,
     >      bxsm,bysm,bzsm,btsm,bxgsm,bygsm,bzgsm,
     >      btgsm,bxse,byse,bzse,btse,
     >      fl,xlamb,rmagc,thetc,phic,tgmlc,ier)
c*
c***********************************************************************
c*
c*          "Copyright [c] CNES 98 - tous droits reserves"
c*          **********************************************
c*
c*PRO MAGLIB
c*
c*VER 01.10.98 - V 1.0
c*VER 01.06.05 - V 2.0
c*VER 13.10.10 - V 3.0
c*VER 2017.02.23 - V 4.0
c*
c*AUT spec. CNES - JC KOSIK - juillet 1998
c*AUT port. CISI
c*AUT adapt. AKKA
c*
c*ROL Theme : Calculs de geophysique
c*ROL         Calcul des quantites geophysiques.
c*ROL         Calcul des parametres geophysiques non locaux :
c*ROL         br,bt,bp,bb composantes du champ et champ total 
c*ROL         dans le repere geographique,
c*ROL         bxsm,bysm,bzsm composantes dans le repere SM,
c*ROL         bxgsm,bygsm,bzgsm composantes dans le repere GSM,
c*ROL         bxse,byse,bzse composantes dans le repere SE,
c*ROL         fl parametre L de Galperin,
c*ROL         xlamb latitude invariante,
c*ROL         rmagc,thetc,phic, tgmlc position geographique et temps 
c*ROL         geomagnetique local du point conjugue.
c*ROL         On bloque le choix de l'activite geomagnetique sur le choix
c*ROL         de l'activite solaire. on part avec un indice indval = isw + 1
c*
c*PAR ignloc (I) : indicateur de calculs non locaux
c*
c*PAR isw    (I) : valeur de l'indice de variabilite du vent solaire
c*
c*PAR rre    (I) : distance radiale geocentrique (rayons terrestres)
c*PAR thetr  (I) : colatitude geocentrique (radians)
c*PAR phir   (I) : longitude geocentrique (radians)
c*
c*PAR year   (I) : annee fractionnaire > 2015
c*
c*PAR tilt   (I) : angle de tilt (radians)
c*
c*PAR rgsm   (I) : matrice de passage du repere geocentrique au repere
c*PAR            : solaire magnetique
c*PAR rggsm  (I) : matrice de passage du repere geocentrique
c*PAR            : au repere magnetospherique
c*PAR rgsmg  (I) : matrice de passage du repere solaire
c*PAR            : magnetospherique au repere geocentrique
c*PAR rgse   (I) : matrice de passage du repere geocentrique
c*PAR            : au repere solaire ecliptique
c*
c*PAR dismp  (O) : distance a la magnetopause (rayons terrestres)
c*
c*PAR br    (O) : composante radiale du champ magnetique le long du
c*              : meridien positive vers l'exterieur (gauss)
c*PAR bt    (O) : composante tangentielle du champ magnetique le long
c*PAR           : du meridien positive vers le sud (gauss)
c*PAR bp    (O) : composante azimuthale du champ magnetique, positive
c*PAR           : vers l'est (gauss)
c*
c*PAR bb     (O) : module du champ magnetique (gauss)
c*
c*PAR bxsm   (O) : composante x du champ magnetique dans le repere SM
c*PAR bysm   (O) : composante y du champ magnetique dans le repere SM
c*PAR bzsm   (O) : composante z du champ magnetique dans le repere SM
c*
c*PAR btsm   (O) : module du champ magnetique dans le repere SM
c*
c*PAR bxgsm  (O) : composante suivant xgsm du champ magnetique (gauss)
c*PAR bygsm  (O) : composante suivant ygsm du champ magnetique (gauss)
c*PAR bzgsm  (O) : composante suivant zgsm du champ magnetique (gauss)
c*
c*PAR btgsm  (O) : module du champ magnetique dans le repere GSM
c*
c*PAR bxse   (O) : composante suivant xse du champ magnetique (gauss)
c*PAR byse   (O) : composante suivant yse du champ magnetique (gauss)
c*PAR bzse   (O) : composante suivant zse du champ magnetique (gauss)
c*
c*PAR btse   (O) : module du champ magnetique dans le repere SE
c*
c*PAR fl     (O) : parametre L de Galperin
c*
c*PAR xlamb  (O) : latitude invariante (radians)
c*
c*PAR rmagc  (O) : distance radiale du point conjugue (rayons terrestres)
c*PAR thetc  (O) : colatitude geocentrique du point conjugue (radians)
c*PAR phic   (O) : longitude geocentrique du point conjugue (radians)
c*
c*PAR tgmlc  (O) : temps geomagnetique local du point conjugue
c*               : (heures fractionnaires)
c*
c*PAR ier    (O) : code de retour
c*
c*NOT ignloc     : 0 = pas de calcul des parametres locaux
c*NOT ignloc     : 1 = calcul des parametres locaux
c*
c*NOT isw        : 1 a 5
c*NOT isw        : 1 : distance subsolaire = 12.6 rayons terrestres
c*NOT isw        : 2 : distance subsolaire = 11.7 rayons terrestres
c*NOT isw        : 3 : distance subsolaire = 11.  rayons terrestres
c*NOT isw        : 4 : distance subsolaire = 10.  rayons terrestres
c*NOT isw        : 5 : distance subsolaire = 8.8  rayons terrestres
c*
c*NOT ier        : 0 = OK
c*NOT ier        : 1 = dismp < 0
c*
c*INF utilise    : magtot, vspvcar, geogsm, geose, geosm, dlgalp
c*INF            : tgml
c*
c*HST version 1.0 - 01.10.98 - 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*HST version 3.0 - 13.10.10 - Mise a jour du modele de champ interne
c*HST                          (IGRF10, magin=4)
c*HST version 4.0 - 2017.02.23 - Mise a jour du modele de champ interne
c*HST                            (IGRF15, magin=5)
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 ignloc,isw
      double precision rre,thetr,phir
      double precision year,tilt
      double precision rgsm(3,3),rggsm(3,3),rgse(3,3),rgsmg(3,3)
      double precision dismp,br,bt,bp,bb,bxsm,bysm,bzsm
      double precision btsm,bxgsm,bygsm,bzgsm,btgsm
      double precision bxse,byse,bzse,btse
      double precision fl,xlamb,rmagc,thetc,phic,tgmlc
      integer ier
c
c     ---------------------------------
c*FON Declaration des variables locales
c     ---------------------------------
c
      integer magin
c*LOC magin : type de champ magnetique interne (= 5 : IGRF 2015)
c
      integer magout
c*LOC magout : type de champ magnetique externe (= 1 : Tsyganenko 87)
c
      integer indgm
c*LOC indgm : type d'indice geomagnetique (= 1 : Kp)
c
      integer indval
c*LOC indval : indice geomagnetique : niveau d'amplitude du champ (1 a 6)
c
      integer ier1,ier2,ier3,ier4,ier5,ier6,ier7
c*LOC ier1,ier2,ier3,ier4,ier5,ier6,ier7 : codes retour des modules appeles
c
      double precision bx,by,bz
c*LOC bx,by,bz : coordonnees cartesiennes x, y et z du champ
c
      double precision gaunano
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 gaunano /1.d5/
c
c     ******************
c     Debut de programme
c     ******************
c
      magin  = 5
      magout = 1
      indgm  = 1
      indval = isw + 1
c
      ier  = 0
      ier1 = 0
      ier2 = 0
      ier3 = 0
      ier4 = 0
      ier5 = 0
      ier6 = 0
      ier7 = 0
c
      bxsm  = 999.d0
      bysm  = 999.d0
      bzsm  = 999.d0
      bxse  = 999.d0
      byse  = 999.d0
      bzse  = 999.d0
      bxgsm = 999.d0
      bygsm = 999.d0
      bzgsm = 999.d0
      fl    = 999.d0
      xlamb = 999.d0
      rmagc = 999.d0
      thetc = 999.d0
      phic  = 999.d0
      tgmlc = 999.d0
c
      ier = 1
c
c     ------------------------------------------------------
c*FON Calcul si point en-deca de la magnetopause (dismp = 0)
c     ------------------------------------------------------
c
      if (dismp .lt. 0.d0) then
c
         ier = 0
c
c        -------------------------------------------
c*FON    Calcul du champ total et de ses composantes
c        -------------------------------------------
c
         call magtot(magin,year,magout,indgm,indval,tilt,rggsm,
     +               rgsmg,rre,thetr,phir,br,bt,bp,bb,ier1)
c
c        ----------------------------------------------------------
c*FON    Conversion en nanoteslas en multipliant par gaunano = 1.d5
c        ----------------------------------------------------------
c
         br = br * gaunano
         bt = bt * gaunano
         bp = bp * gaunano
         bb = bb * gaunano
c
c        --------------------------------------------------
c*FON    Calcul des composantes solaires magnetospheriques,
c*FON    solaire-ecliptiques, solaires magnetiques
c        --------------------------------------------------
c
         call vspvcar(thetr,phir,br,bt,bp,bx,by,bz,ier2)
c
         call geogsm(rggsm,bx,by,bz,bxgsm,bygsm,bzgsm,ier3)
         btgsm = dsqrt(bxgsm**2 + bygsm**2 + bzgsm**2)
c
         call geose(rgse,bx,by,bz,bxse,byse,bzse,ier4)
         btse = dsqrt(bxse**2 + byse**2 + bzse**2)
c
         call geosm(rgsm,bx,by,bz,bxsm,bysm,bzsm,ier5)
         btsm = dsqrt(bxsm**2 + bysm**2 + bzsm**2)
c
c        --------------------------------------------------
c*FON    Calculs de geophysique si ignloc = 1 , sinon aucun
c        --------------------------------------------------
c
         if (ignloc .eq. 1) then
c
c           --------------------------------------------------------
c*FON       Calcul du L Galperin et calcul de la latitude invariante
c           --------------------------------------------------------
c
            call dlgalp(magin,magout,year,tilt,rggsm,rgsmg,  
     +                  rre,thetr,phir,fl,xlamb,rmagc,
     +                  thetc,phic,ier6)
c
c           --------------------------------------------------------
c*FON       Calcul du temps geomagnetique local du point conjugue du
c*FON       satellite tgmlc
c           --------------------------------------------------------
c
            if (ier6 .eq. 0) then
c
               call tgml(rgsm,thetc,phic,tgmlc,ier7)
c
            else if (ier6 .eq. 1) then
               ier = 2
            else if (ier6 .eq. 2) then
               ier = 3
            endif
         endif
      endif
c
c     ****************
c     Fin de programme
c     ****************
c
      return
      end