iterat.f 5.27 KB
      subroutine iterat (l,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.05.31 - 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 : Calculs de geophysique
c*ROL         Integration d'une ligne de force.
c*
c*PAR l   (I) : indicateur de traitement (nombre de pas)
c*
c*PAR ier (O) : code de retour
c*
c*NOT Integration d'une ligne de forces, similaire a la version FAP de
c*NOT "gl aide share pgm no. 413"). Utilise au depart une procedure
c*NOT "bootstrap", puis la formule Adams, avec lct = 1 au depart, 
c*NOT puis incrementation de lct de 1 chaque fois que phi contient les
c*NOT cooerdonnees initiales - distance geocentrique, latitude and l
c*NOT en radians. br, etc, sont les composants du champs a phi. 
c*NOT st = sin(theta) latitude a phi. Chaque pas genere un nouveau phi 
c*NOT et conserve le point phip precedant.
c*NOT Si sgn = +1, l'integration se deroule dans le sens direct
c*NOT c'est a dire , du nord vers le sud dans le champ terrestres.
c*NOT Si sgn = -1 la direction est inversee.
c*NOT d = valeur du pas le long de la ligne de forces r et dont la
c*NOT meme unite. 3 pas ont lieu en 7 iterations, puis 1 pas pour chaque  
c*NOT iteration supplentaire, yp(3,4) different de phi et 3 points 
c*NOT precedants.
c
c*NOT ier     : sans objet
c*
c*NOT common  : iter
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.05.31 - 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
      integer l
      integer ier
c
c     ----------------------------------
c*FON Declaration des variables communes
c     ----------------------------------
c
      double precision y(3),yold(3)
      double precision br,bt,bp,b,st,sgn,ds
c*COM y        : composantes spheriques
c*COM yold     : composantes spheriques precedantes
c*COM br,bt,bp : composantes radiale, tangentielle et azimuthale du champ
c*COM b        : module du champ
c*COM st       : sinus theta
c*COM sgn      : sens du calcul (+1, -1)
c*COM ds       : intervalle d'integration le long de la ligne de champ
c
      common/iter/y,yold,br,bt,bp,b,st,sgn,ds
c
c     ---------------------------------
c*FON Declaration des variables locales
c     ---------------------------------
c
      double precision yp(3,4)
      double precision d12,d2,d24,d6,fac
      integer i,j
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
c
      if (l .eq. 269) go to 200
      yp(1,4) = sgn * br / b
      fac     = sgn / (b * y(1))
      yp(2,4) = bt * fac
      yp(3,4) = bp * fac / st
c
      if (l .gt. 7) go to 90
c
c     --------------------------------------------------------
c*FON Bootstrapping pour les 7 premieres iterations, sur 3 pas
c     --------------------------------------------------------
c
      do 80 i = 1, 3
c
         go to (10,20,30,40,50,60,70),l
c
10       continue
c
         d2      = ds / 2.d0
         d6      = ds / 6.d0
         d12     = ds / 12.d0
         d24     = ds / 24.d0
         yp(i,1) = yp(i,4)
         yold(i) = y(i)
         y(i)    = yold(i) + ds * yp(i,1)
         go to 80
c
20       continue
c
         yp(i,2) = yp(i,4)
         y(i)    = yold(i) + d2 * (yp(i,2) + yp(i,1))
         go to 80
c
30       continue
c
         y(i) = yold(i) + d6 * 
     >          (2.d0 * yp(i,4) + yp(i,2) + 3.d0 * yp(i,1))
         go to 80
c
40       continue
c
         yp(i,2) = yp(i,4)
         yold(i) = y(i)
         y(i)    = yold(i) + d2 * (3.d0 * yp(i,2) - yp(i,1))
         go to 80
c
50       continue
c
         y(i) = yold(i) + d12 * 
     >          (5.d0 * yp(i,4) + 8.d0 * yp(i,2) - yp(i,1))
         go to 80
c
60       continue
c
         yp(i,3) = yp(i,4)
         yold(I) = y(i)
         y(I)    = yold(i) + d12 * (23.d0 * yp(i,3) - 16.d0 * yp(i,2)
     +             + 5.d0 * yp(i,1))
         go to 80
c
70       continue
c
         y(i) = yold(i) + d24 * (9.d0 * yp(i,4) + 19.d0 * yp(i,3)
     +          - 5.d0 * yp(i,2) + yp(i,1))
c
80    continue
      go to 200
c
c     ----------------------------------------------
c*FON 8eme iteration et apres -formule Adams 4-point 
c     ----------------------------------------------
c
90    continue
c
      do 100 i = 1, 3
c
         yold(i) = y(i)
         y(i)    = yold(i) + d24 * (55.d0 * yp(i,4) - 59.d0 * yp(i,3)
     +             + 37.d0 * yp(i,2) - 9.d0 * yp(i,1))
c
         do 110 j = 1, 3
c
            yp(i,j) = yp(i,j+1)
c
110      continue
c
100   continue
c
c     ****************
c     Fin de programme
c     ****************
c
200   continue
      return
      end