Télécharger intva1.eso

Retour à la liste

Numérotation des lignes :

  1. C INTVA1 SOURCE CHAT 05/01/13 00:41:42 5004
  2. SUBROUTINE INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ
  3. & ,IPSOLU,LIMAGE,LMULT)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. ************************************************************************
  7. *
  8. * I N T V A 1
  9. * -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. * EFFECTUER LE TRAVAIL ATTRIBUE AU SOUS-PROGRAMME "INTVAL".
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. * CALL INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ,IPSOLU)
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * FREINF REEL DP (E) 1ERE BORNE DE L'INTERVALLE DE FREQUENCES.
  25. * (S) BORNE INFERIEURE DE L'INTERVALLE DE
  26. * FREQUENCES.
  27. * FRESUP REEL DP (E) 2EME BORNE DE L'INTERVALLE DE FREQUENCES.
  28. * (S) BORNE SUPERIEURE DE L'INTERVALLE DE
  29. * FREQUENCES.
  30. * IPRIGI ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'.
  31. * IPMASS ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'.
  32. * MOPTIO ENTIER (E) MOT-CLE INDIQUANT PAR "BASS" OU "HAUT" SI
  33. * LA RECHERCHE DE FREQUENCES DOIT SE FAIRE
  34. * EN COMMENCANT PAR LES PLUS BASSES OU LES
  35. * PLUS HAUTES FREQUENCES PROPRES.
  36. * NBFREQ ENTIER (E) NOMBRE MAXIMUM DE FREQUENCES PROPRES
  37. * DEMANDEES.
  38. * IPSOLU ENTIER (S) POINTEUR SUR L'OBJET 'SOLUTION' REGROUPANT
  39. * LES MODES PROPRES CALCULES.
  40. *
  41. * LEXIQUE: (ORDRE ALPHABETIQUE)
  42. * --------
  43. *
  44. * IPW2 ENTIER VOIR LE SOUS-PROGRAMME "INTVA2".
  45. * IPNUM ENTIER VOIR LE SOUS-PROGRAMME "INTVA2".
  46. * NUMW2A ENTIER VOIR LE SOUS-PROGRAMME "INTVA2".
  47. * NUMW2B ENTIER VOIR LE SOUS-PROGRAMME "INTVA2".
  48. * W2A REEL DP VOIR LE SOUS-PROGRAMME "INTVA2".
  49. * W2B REEL DP VOIR LE SOUS-PROGRAMME "INTVA2".
  50. *
  51. * SOUS-PROGRAMMES APPELES:
  52. * ------------------------
  53. *
  54. * DIAGN1, ERREUR, INTVA2, NBVALP.
  55. *
  56. * MODE DE FONCTIONNEMENT:
  57. * -----------------------
  58. *
  59. * 1) INITIALISATION D'UNE PARTITION DE L'INTERVALLE DE FREQUENCES
  60. * EN SOUS-INTERVALLES: ON CREE 1 SEUL SOUS-INTERVALLE (W2A,W2B) EGAL
  61. * A L'INTERVALLE ENTIER.
  62. * 2) APPEL AU SOUS-PROGRAMME "INTVA2".
  63. *
  64. * REMARQUES:
  65. * ----------
  66. *
  67. * AVEC L'OPTION "BASSE", LES PULSATIONS SONT RANGEES EN ORDRE
  68. * DECROISSANT,
  69. * AVEC L'OPTION "HAUTE", LES PULSATIONS SONT RANGEES EN ORDRE
  70. * CROISSANT,
  71. * POUR UNE PROGRAMMATION PLUS SIMPLE ET UN DEROULEMENT PLUS RAPIDE
  72. * DE LA PROCEDURE.
  73. *
  74. * AUTEUR, DATE DE CREATION:
  75. * -------------------------
  76. *
  77. * PASCAL MANIGOT 24 DECEMBRE 1984
  78. *
  79. * LANGAGE:
  80. * --------
  81. *
  82. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  83. *
  84. ************************************************************************
  85. *
  86. -INC CCREEL
  87. -INC CCOPTIO
  88. -INC SMLENTI
  89. -INC SMLREEL
  90. *
  91. * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  92. COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  93. & NUMW2B ,IUN
  94. *
  95. *
  96. PARAMETER (DEUXPI = (2.D0*XPI))
  97. *
  98. CHARACTER*4 MOPTIO
  99. LOGICAL LIMAGE,LMULT
  100. *
  101. * -- VERIFICATION DES DONNEES --
  102. *
  103. * SI LES BORNES DE L'INTERVALLE SONT DONNEES DANS LE DESORDRE:
  104. IF (FREINF .GT. FRESUP) THEN
  105. X = FREINF
  106. FREINF = FRESUP
  107. FRESUP = X
  108. END IF
  109. *
  110. * SI L'OPTION DONNEE NE FIGURE PAS PARMI CELLES RECONNUES:
  111. IF (MOPTIO .NE. 'BASS'.AND. MOPTIO .NE.'HAUT') THEN
  112. MOTERR(1:4) = MOPTIO
  113. NUMERR = 7
  114. CALL ERREUR (NUMERR)
  115. RETURN
  116. END IF
  117. *
  118. * -- CREATION DE LA SUITE DE PULSATIONS AU CARRE --
  119. *
  120. IF (MOPTIO .EQ. 'BASS') THEN
  121. W2A = (FRESUP * DEUXPI) ** 2
  122. W2B = (FREINF * DEUXPI) ** 2
  123. IF(LIMAGE) THEN
  124. W2A = SIGN(W2A,FRESUP)
  125. W2B = SIGN(W2B,FREINF)
  126. ENDIF
  127. IUN = 1
  128. ELSE
  129. W2A = (FREINF * DEUXPI) ** 2
  130. W2B = (FRESUP * DEUXPI) ** 2
  131. IF(LIMAGE) THEN
  132. W2A = SIGN(W2A,FREINF)
  133. W2B = SIGN(W2B,FRESUP)
  134. ENDIF
  135. IUN = -1
  136. END IF
  137. *
  138. JG=2
  139. SEGINI,MLREEL
  140. IPW2 = MLREEL
  141. PROG(1) = W2A
  142. PROG(2) = W2B
  143. SEGDES,MLREEL
  144. NBW2 = 2
  145. *
  146. CALL NBVALP (IPRIGI,IPMASS,W2A, NUMW2A)
  147. IF (IERR .NE. 0) RETURN
  148. CALL NBVALP (IPRIGI,IPMASS,W2B, NUMW2B)
  149. IF (IERR .NE. 0) RETURN
  150. *
  151. JG=2
  152. SEGINI,MLENTI
  153. IPNUM = MLENTI
  154. LECT(1) = NUMW2A
  155. LECT(2) = NUMW2B
  156. SEGDES,MLENTI
  157. *
  158. * -- ISOLATION ET CALCUL DES PULSATIONS PROPRES --
  159. *
  160. ***************************************************************
  161. ** CALL DIAGN1 (IPRIGI,INF0)
  162. ** IF (IERR .NE. 0) RETURN
  163. ***************************************************************
  164. INF0=0
  165. CALL INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU,LIMAGE,LMULT)
  166. IF (IERR .NE. 0) RETURN
  167. *
  168. MLREEL = IPW2
  169. SEGSUP,MLREEL
  170. MLENTI = IPNUM
  171. SEGSUP,MLENTI
  172. *
  173. END
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  

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