Télécharger filtre.eso

Retour à la liste

Numérotation des lignes :

  1. C FILTRE SOURCE BP208322 16/11/18 21:17:15 9177
  2. SUBROUTINE FILTRE
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C=======================================================================
  7. C = CALCUL DE FILTRES PASSE-HAUT, PASSE-BAS,EN I*OMEGA
  8. C =
  9. C = SYNTAXE :
  10. C =
  11. C = FILTRE = FILT NN TYPE 'PHAU' FC (SORT 'REIM') DFRQ DF
  12. C = 'PBAS' FC 'MOPH'
  13. C = 'OMEG' NP
  14. C =
  15. C = NN EXPOSANT TEL QUE NPOINT=2**NN
  16. C =
  17. C = TYPE MOT-CLE
  18. C =
  19. C = SUIVI DU MOT HAUT : POUR UN FILTRE PASSE-HAUT
  20. C = BAS : POUR UN FILTRE PASSE-BAS
  21. C = OMEG : POUR UN FILTRE EN OMEGA
  22. C =
  23. C = FC FREQUENCE DE COUPURE DU FILTRE
  24. C =
  25. C = NP PUISSANCE DU FILTRE
  26. C =
  27. C = SORT MOT-CLE FACULTATIF : PAR DEFAUT MOPH
  28. C =
  29. C = SUIVI DU MOT REIM : PARTIES REELLES ET IMAGINAIRES
  30. C = MOPH : MODULE ET PHASE
  31. C =
  32. C =
  33. C = DFRQ MOT-CLE
  34. C =
  35. C = SUIVI DE LA VALEUR DU PAS EN FREQUENCE EN HZ
  36. C =
  37. C = CREATION : 16/04/88, F.ROULLIER
  38. C =
  39. C=======================================================================
  40. C
  41. CHARACTER*4 ISORT(2),MOCLE(3),ITYPE(3)
  42. CHARACTER*4 IBLAN
  43. SEGMENT TEMPP
  44. IMPLIED AA(NP),BB(NP),XX(NP),OMEG(NP)
  45. ENDSEGMENT
  46. C
  47. -INC CCGEOME
  48. -INC CCOPTIO
  49. -INC CCREEL
  50. -INC SMEVOLL
  51. -INC SMLREEL
  52. C
  53. DATA IBLAN
  54. 1/' '/
  55. DATA ISORT/'REIM','MOPH'/
  56. DATA ITYPE/'PHAU','PBAS','OMEG'/
  57. DATA MOCLE/'TYPE','SORT','DFRQ'/
  58. ISOR=2
  59. DEGRES=180.D0/XPI
  60. XPI2=XPI*2.D0
  61. ITYP=0
  62. C
  63. C LECTURE DE L'EXPOSANT NN
  64. C
  65. CALL LIRENT(NN,1,IRETOU)
  66. IF(IRETOU.EQ.0) GOTO 666
  67. C
  68. 10 CALL LIRMOT(MOCLE,3,IRETOU,0)
  69. C
  70. IF (IRETOU.EQ.0) GO TO 30
  71. GO TO (11,12,13) IRETOU
  72. GO TO 30
  73. C
  74. 11 CONTINUE
  75. C LECTURE DU TYPE DE FILTRE
  76. CALL LIRMOT(ITYPE,3,ITYP,1)
  77. C
  78. GO TO (21,21,23) ITYP
  79. C
  80. 21 CONTINUE
  81. C LECTURE DE LA FREQUENCE DE COUPURE
  82. CALL LIRREE(FC,1,IRETOU)
  83. C
  84. IF(IRETOU.EQ.0) GOTO 666
  85. GO TO 10
  86. C
  87. 23 CONTINUE
  88. C LECTURE DE LA PUISSANCE DE LA FREQ
  89. CALL LIRENT(NPUIS,1,IRETOU)
  90. C
  91. IF(IRETOU.EQ.0) GOTO 666
  92. GO TO 10
  93.  
  94. 12 CONTINUE
  95. C LECTURE DU TYPE DE SORTIE
  96. CALL LIRMOT(ISORT,2,ISOR,0)
  97. IF(ISOR.EQ.0) ISOR=2
  98. C
  99. GO TO 10
  100. C
  101. 13 CONTINUE
  102. C LECTURE DU PAS EN FREQUENCE
  103. CALL LIRREE(DF,1,IRETOU)
  104. C
  105. IF(IRETOU.EQ.0) GOTO 666
  106. GO TO 10
  107. C
  108. 30 CONTINUE
  109. IF(ITYP.EQ.0) THEN
  110. MOTERR(1:4)= MOCLE(1)
  111. CALL ERREUR ( 396 )
  112. RETURN
  113. ENDIF
  114. C
  115. NPOINT=2**NN
  116. NPT2=NPOINT/2
  117. NP=NPT2+1
  118. C
  119. C CREATION DES FREQUENCES ET DU FILTRE
  120. C
  121. SEGINI TEMPP
  122. IF (ITYP.EQ.3) GO TO 100
  123. C
  124. C
  125. IF(ISOR.EQ.1) THEN
  126. C
  127. C SORTIE EN PARTIE REELLE & IMAGINAIRE
  128. C
  129. I=1
  130. XX(I)=0.
  131. IF (ITYP.EQ.1) THEN
  132. AA(I)=0.
  133. ELSE
  134. AA(I)=1.
  135. ENDIF
  136. BB(I)=0.
  137. DO 40 K=1,NPT2
  138. I=I+1
  139. FRQ=DBLE(I-1)*DF
  140. IF (ITYP.EQ.1) THEN
  141. RAP=FC/FRQ
  142. ELSE
  143. RAP=-FRQ/FC
  144. ENDIF
  145. DENOM=1./(1.+RAP*RAP)
  146. XX(I)=FRQ
  147. AA(I)=DENOM
  148. BB(I)=RAP*DENOM
  149. 40 CONTINUE
  150. C
  151. ELSE
  152. C
  153. C SORTIE EN MODULE & PHASE
  154. C
  155. I=1
  156. XX(I)=0.
  157. IF (ITYP.EQ.1) THEN
  158. AA(I)=0.
  159. BB(I)=90.
  160. ELSE
  161. AA(I)=1.
  162. BB(I)=0.
  163. ENDIF
  164. DO 50 K=1,NPT2
  165. I=I+1
  166. FRQ=DBLE(I-1)*DF
  167. IF (ITYP.EQ.1) THEN
  168. RAP=FC/FRQ
  169. ELSE
  170. RAP=FRQ/FC
  171. ENDIF
  172. DENOM=1./(1.+RAP*RAP)
  173. XX(I)=FRQ
  174. AA(I)=SQRT(DENOM)
  175. IF (ITYP.EQ.1) THEN
  176. BB(I)=ATAN(RAP)*DEGRES
  177. ELSE
  178. BB(I)=-ATAN(RAP)*DEGRES
  179. ENDIF
  180. 50 CONTINUE
  181. ENDIF
  182. C
  183. JG=NP
  184. SEGINI MLREE1,MLREE2,MLREE3
  185. C
  186. DO 60 I=1,NP
  187. MLREE1.PROG(I)=XX(I)
  188. MLREE2.PROG(I)=AA(I)
  189. MLREE3.PROG(I)=BB(I)
  190. 60 CONTINUE
  191. C
  192. GO TO 200
  193. 100 CONTINUE
  194. C
  195. IMULT = 1
  196. IF(NPUIS.LT.0) IMULT = -1
  197. C
  198. C
  199. MDPUIS = MOD ( (IMULT*NPUIS),4)
  200. IF(IMULT.EQ.-1) THEN
  201. MDPUI1 = MDPUIS
  202. IF(MDPUI1.EQ.1) MDPUIS = 3
  203. IF(MDPUI1.EQ.3) MDPUIS = 1
  204. ENDIF
  205. C
  206. IF (ISOR.EQ.1) THEN
  207. I=1
  208. XX(I)=0.
  209. AA(I)=0.
  210. BB(I)=0.
  211. OMEG(I)=0.
  212. DO 70 K=1,NPT2
  213. I=I+1
  214. FRQ=DBLE(I-1)*DF
  215. XX(I)=FRQ
  216. OMEG(I)=FRQ*XPI2
  217. 70 CONTINUE
  218. C
  219. C
  220. C
  221. IF (MDPUIS.EQ.0) THEN
  222. DO 71 K=2,NP
  223. AA(K)=OMEG(K)**NPUIS
  224. BB(K)=0.
  225. 71 CONTINUE
  226. ELSEIF (MDPUIS.EQ.1) THEN
  227. DO 72 K=2,NP
  228. AA(K)=0.
  229. BB(K)=(OMEG(K)**NPUIS)
  230. 72 CONTINUE
  231. ELSEIF (MDPUIS.EQ.2) THEN
  232. DO 73 K=2,NP
  233. AA(K)=-1.0*(OMEG(K)**NPUIS)
  234. BB(K)=0.
  235. 73 CONTINUE
  236. ELSEIF (MDPUIS.EQ.3) THEN
  237. DO 74 K=2,NP
  238. AA(K)=0.
  239. BB(K)=-1.0*(OMEG(K)**NPUIS)
  240. 74 CONTINUE
  241. ENDIF
  242. C
  243. ELSE
  244. I=1
  245. XX(I)=0.
  246. AA(I)=0.
  247. OMEG(I)=0.
  248. DO 75 K=1,NPT2
  249. I=I+1
  250. FRQ=DBLE(I-1)*DF
  251. XX(I)=FRQ
  252. OMEG(I)=FRQ*XPI2
  253. 75 CONTINUE
  254. C
  255. DO 81 K=2,NP
  256. AA(K)=OMEG(K)**NPUIS
  257. 81 CONTINUE
  258. IF (MDPUIS.EQ.1) THEN
  259. DO 76 K=1,NP
  260. BB(K)=90.
  261. 76 CONTINUE
  262. ELSEIF (MDPUIS.EQ.2) THEN
  263. DO 77 K=1,NP
  264. BB(K)=180.
  265. 77 CONTINUE
  266. ELSEIF (MDPUIS.EQ.3) THEN
  267. DO 78 K=1,NP
  268. BB(K)=-90.
  269. 78 CONTINUE
  270. ELSEIF (MDPUIS.EQ.0) THEN
  271. DO 79 K=1,NP
  272. BB(K)=0.
  273. 79 CONTINUE
  274. ENDIF
  275. C
  276. ENDIF
  277. C
  278. JG=NP
  279. SEGINI MLREE1,MLREE2,MLREE3
  280. C
  281. DO 80 I=1,NP
  282. MLREE1.PROG(I)=XX(I)
  283. MLREE2.PROG(I)=AA(I)
  284. MLREE3.PROG(I)=BB(I)
  285. 80 CONTINUE
  286. 200 CONTINUE
  287. SEGSUP TEMPP
  288. SEGDES MLREE1,MLREE2,MLREE3
  289. C
  290. C CREATION DE L'OBJET EVOLUTIO FILTRE
  291. C
  292. N=2
  293. SEGINI MEVOLL
  294. IPEVOL=MEVOLL
  295. C
  296. IEVTEX=TITREE
  297. ITYEVO='COMPLEXE'
  298. C
  299. C MODULE (OU PARTIE REELLE)
  300. C
  301. SEGINI KEVOL1
  302. KEVOL1.TYPX='LISTREEL'
  303. KEVOL1.TYPY='LISTREEL'
  304. IEVOLL(1)=KEVOL1
  305. C
  306. c KEVOL1.KEVTEX=TITREE
  307. KEVOL1.NUMEVX=IDCOUL
  308. KEVOL1.NOMEVX='FREQUENCES '
  309. IF(ISOR.EQ.1) THEN
  310. KEVOL1.NUMEVY='PREE'
  311. KEVOL1.NOMEVY='P. REELLE '
  312. KEVOL1.KEVTEX='Re'
  313. ELSE
  314. KEVOL1.NUMEVY='MODU'
  315. KEVOL1.NOMEVY='MODULE '
  316. KEVOL1.KEVTEX='Amp'
  317. ENDIF
  318. KEVOL1.IPROGX=MLREE1
  319. KEVOL1.IPROGY=MLREE2
  320. KEVOL1.NUMEVX=IDCOUL
  321. SEGDES KEVOL1
  322. C
  323. C PHASE (OU PARTIE IMAGINAIRE)
  324. C
  325. SEGINI KEVOL2
  326. KEVOL2.TYPX='LISTREEL'
  327. KEVOL2.TYPY='LISTREEL'
  328. IEVOLL(2)=KEVOL2
  329. C
  330. c KEVOL2.KEVTEX=TITREE
  331. KEVOL2.NUMEVX=IDCOUL
  332. KEVOL2.NOMEVX='FREQUENCES '
  333. IF(ISOR.EQ.1) THEN
  334. KEVOL2.NUMEVY='PIMA'
  335. KEVOL2.NOMEVY='P.IMAGINAIRE'
  336. KEVOL2.KEVTEX='Im'
  337. ELSE
  338. KEVOL2.NUMEVY='PHAS'
  339. KEVOL2.NOMEVY='PHASE '
  340. KEVOL2.KEVTEX='\j'
  341. ENDIF
  342. KEVOL2.IPROGX=MLREE1
  343. KEVOL2.IPROGY=MLREE3
  344. KEVOL2.NUMEVX=IDCOUL
  345. SEGDES KEVOL2
  346. C
  347. C
  348. SEGDES MEVOLL
  349. CALL ECROBJ('EVOLUTIO',IPEVOL)
  350. 666 CONTINUE
  351. RETURN
  352. END
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  

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