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