Télécharger la plaquette Cast3M


fr en

Télécharger filtre.eso

Retour à la liste

Numérotation des lignes : 

filtre

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

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