Télécharger la plaquette Cast3M


fr en

Télécharger envspe.eso

Retour à la liste

Numérotation des lignes : 

envspe

  1. C ENVSPE    SOURCE    CB215821  16/04/15    21:15:20     8907
  2.       SUBROUTINE ENVSPE
  3. ************************************************************************
  4. *
  5. *                             E N V S P E
  6. *                             -----------
  7. *
  8. *     SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ENVELOPPE"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     CREER LE SPECTRE ENVELOPPE D'UNE SERIE DE SPECTRES D'OSCILLATEURS.
  14. *
  15. *     CET OPERATEUR EST TRES ATTACHE A LA NOTION DE SPECTRE CAR IL
  16. *     UTILISE L'INTERPOLATION LINEAIRE OU LOGARITHMIQUE DE FACON BIEN
  17. *     SPECIFIQUE.
  18. *
  19. * PHRASE D'APPEL (EN GIBIANE):
  20. * ----------------------------
  21. *
  22. *     ENVLOP  =  'ENVELOPPE'  LIST_SPO  ;
  23. *
  24. * OPERANDES ET RESULTATS:
  25. * -----------------------
  26. *
  27. *     LIST_SPO  (TABLE)     CONTIENT LES DIFFERENTS SPECTRES
  28. *     --------              D'OSCILLATEUR (PAS FORCEMENT DEFINIS AUX
  29. *                           MEMES FREQUENCES, NI POUR LES MEMES
  30. *                           AMORTISSEMENTS):
  31. *       LIST_SPO I 'SPECTRE        = OBJET "EVOLUTIO" REPRESENTANT LE
  32. *                                    I-EME "SPO".
  33. *       LIST_SPO I 'AMORTISSEMENT' = OBJET "LISTREEL" DONNANT LES
  34. *                                    AMORTISSEMENTS POUR CHAQUE COURBE
  35. *                                    DE L'OBJET "EVOLUTIO" NUMERO "I".
  36. *
  37. *     ENVLOP    (TABLE)     CONTIENT LE SPECTRE ENVELOPPE:
  38. *     ------
  39. *       LIST_SPO 'SPECTRE'         = OBJET "EVOLUTIO" REPRESENTANT LE
  40. *                                    SPECTRE.
  41. *       LIST_SPO 'AMORTISSEMENT'   = OBJET "LISTREEL" DONNANT LES
  42. *                                    AMORTISSEMENTS POUR CHAQUE COURBE
  43. *                                    DE L'OBJET "EVOLUTIO".
  44. *
  45. * MODULES UTILISES:
  46. * -----------------
  47. *
  48.       IMPLICIT INTEGER(I-N)
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC SMTABLE
  53. *
  54. * VARIABLES:
  55. * ----------
  56. *
  57. *     IPEVOL = SPECTRES D'OSCILLATEUR (OBJETS "EVOLUTIO").
  58. *              EN DERNIERE POSITION, ENVELOPPE.
  59. *     IPAMOR = VALEURS DES AMORTISSEMENTS DE CHAQUE SPECTRE (OBJETS
  60. *              "LISTREEL").
  61. *
  62.       REAL*8 X,XVALRE
  63.       CHARACTER*1 C
  64.       CHARACTER*8 TYPOBJ,CHARRE
  65.       LOGICAL L,LOGIN,LOGRE
  66.       SEGMENT,MSPECT
  67.          INTEGER IPEVOL(NBSPEC+1),IPAMOR(NBSPEC+1)
  68.       ENDSEGMENT
  69. *
  70. * AUTEUR, DATE DE CREATION:
  71. * -------------------------
  72. *
  73. *     PASCAL MANIGOT     13 SEPTEMBRE 1988
  74. *
  75. * LANGAGE:
  76. * --------
  77. *
  78. *     ESOPE + FORTRAN77 + EXTENSION: DECLARATION "REAL*8".
  79. *
  80. ************************************************************************
  81. *
  82.       I=0
  83.       X=0.D0
  84.       L=.FALSE.
  85.  
  86.       CALL LIROBJ ('TABLE   ',ISPEC,1,IRETOU)
  87.       IF (IERR .NE. 0) RETURN
  88. *
  89. *     NOMBRE DE SPECTRES D'OSCILLATEURS FOURNI:
  90.       CALL DIMEN7 (ISPEC,  NBSPEC)
  91.       IF (NBSPEC .LE. 0) THEN
  92.          CALL ERREUR (215)
  93.          RETURN
  94.       END IF
  95. *
  96. *     LA TABLE EST SUPPOSEE ETRE INDICEE PAR DES ENTIERS, A PARTIR DE 1.
  97. *     ... CE QUE L'ON VA VERIFIER TOUT DE SUITE, EN MEME TEMPS QUE L'ON
  98. *     RANGE LES SPECTRES SOUS UNE FORME INFORMATIQUEMENT PLUS PRATIQUE.
  99. *
  100.       SEGINI,MSPECT
  101. *
  102.       DO 100 IB=1,NBSPEC
  103.          TYPOBJ = 'TABLE   '
  104.          CALL ACCTAB(ISPEC,'ENTIER  ',IB,0.D0,C,LOGIN ,0,TYPOBJ,
  105.      C    IVALRE,XVALRE,CHARRE,LOGRE,ICOUR)
  106.          IF (TYPOBJ.NE.'TABLE   ') THEN
  107.            MOTERR(1:8)=TYPOBJ(1:8)
  108.            CALL ERREUR(39)
  109.          ENDIF
  110.          IF (IERR .NE. 0) RETURN
  111.          TYPOBJ = 'EVOLUTIO'
  112.          CALL ACCTAB(ICOUR,'MOT     ',0,0.D0,'SPECTRE',LOGIN ,0,TYPOBJ,
  113.      C    IVALRE,XVALRE,CHARRE,LOGRE,IPTR)
  114.          IF (TYPOBJ.NE.'EVOLUTIO') THEN
  115.            MOTERR(1:8)=TYPOBJ(1:8)
  116.            CALL ERREUR(39)
  117.          ENDIF
  118.          IF (IERR .NE. 0) RETURN
  119.          IPEVOL(IB) = IPTR
  120.          TYPOBJ = 'LISTREEL'
  121.          CALL ACCTAB(ICOUR,'MOT     ',0,0.D0,'AMORTISSEMENT',LOGIN ,0,
  122.      C    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPTR)
  123.          IF (TYPOBJ.NE.'LISTREEL') THEN
  124.            MOTERR(1:8)=TYPOBJ(1:8)
  125.            CALL ERREUR(39)
  126.          ENDIF
  127.          IF (IERR .NE. 0) RETURN
  128.          IPAMOR(IB) = IPTR
  129.   100    CONTINUE
  130. *     END DO
  131. *
  132. *     CREATION DU SPECTRE ENVELOPPE:
  133.       CALL ENVSP1 (MSPECT)
  134.       IF (IERR .NE. 0) RETURN
  135. *
  136.       CALL CRTABL(MTABLE)
  137.       SEGACT,MSPECT
  138.       IPEV0L = IPEVOL(NBSPEC+1)
  139.       CALL ECCTAB (MTABLE,'MOT     ',I,X,'SPECTRE',L,I,
  140.      &                    'EVOLUTIO',I,X,C,L,IPEV0L)
  141.       IPAM0R = IPAMOR(NBSPEC+1)
  142.       CALL ECCTAB (MTABLE,'MOT     ',I,X,'AMORTISSEMENT',L,I,
  143.      &                    'LISTREEL',I,X,C,L,IPAM0R)
  144. *
  145.       SEGSUP,MSPECT
  146.       SEGDES,MTABLE
  147. *
  148. *     ECRITURE DU SPECTRE ENVELOPPE:
  149.       CALL ECROBJ ('TABLE   ',MTABLE)
  150. *
  151.       END
  152.  
  153.  
  154.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales