Télécharger la plaquette Cast3M


fr en

Télécharger respowsp.procedur

Retour à la liste

Numérotation des lignes : 

  1. * RESPOWSP  PROCEDUR  PICA      92/07/03    21:34:39     619            
  2. *********************************************************************
  3. *                                             DATE     06/04/90
  4. *    Procedure RESPOWSP
  5. *
  6. *    PSPE = RESPOWSP RSPE TE AMOR (OPTION);
  7. *********************************************************************
  8. *    objet :
  9. *
  10. *    Calcul du spectre de puissance (objet de type EVOLUTION
  11. *    comportant une unique courbe) d'un signal de duree TE (REEL)
  12. *    associe a N spectres de reponse RSPE (objet de type EVOLUTION
  13. *    comportant N courbes) correspondant aux N amortissements AMOR
  14. *    (objet de type LISTREEL).
  15. *
  16. *    Pour stabiliser le processus de convergence, les premieres
  17. *    iteration s'effectuent en utilant le filtre de Hanning (HANN).
  18. *********************************************************************
  19. *    options :
  20. *
  21. *    Les options sont contenues dans OPTION (objet de type TABLE).
  22. *
  23. *    OPTION.'GPRP'= objet de type MOT representant la grandeur 
  24. *                   physique de reponse : ACCE(leration), VITE(sse)
  25. *                   ou DEPL(acement relatif). Le defaut est ACCE.
  26. *
  27. *    OPTION.'GPAB'= objet de type MOT representant la grandeur
  28. *                   physique en abscisse de la reponse: PERI(ode)
  29. *                   ou FREQ(uence). Le defaut est PERI.
  30. *
  31. *    OPTION.'FRCO'= objet de type FLOTTANT indiquant la frequence
  32. *                   de coupure du signal. le defaut est 25 hz.
  33. *                  
  34. *    OPTION.'FFPS'= objet de type LISTREEL donnant le reticule de
  35. *                   calcul en frequence du spectre de puissance. Le
  36. *                   defaut est une progression geometrique entre
  37. *                   1/TE et la frequence de coupure dont la raison
  38. *                   est (1+2*KSI), ou KSI=MIN AMOR. 
  39. *
  40. *    OPTION.'TTRS'= objet de type LISTREEL donnant le reticule de
  41. *                   calcul en periode du spectre de reponse. Le 
  42. *                   defaut est celui de l'operateur PSRS.
  43. *
  44. *    OPTION.'DIST'= objet de type MOT representant le type de 
  45. *                   distribution choisi pour evaluer le lieu des 
  46. *                   maxima du spectre de reponse: CRAM(er) ou
  47. *                   NEWG(umg).  Le defaut est CRAM.
  48. *
  49. *    OPTION.'JMAX'= objet de type ENTIER representant le nombre
  50. *                   maximum d'iteration autorise. Le defaut est 15.
  51. *
  52. *    OPTION.'JHAN'= objet de type ENTIER representant le nombre
  53. *                   d'iteration comportant le filtrage de Hanning.
  54. *                   le defaut est JMAX.
  55. *
  56. *    OPTION.'EMAX'= objet de type FLOTTANT representant la limite de
  57. *                   convergence de l'erreur. Le defaut est 1.E-2.
  58. *
  59. *    OPTION.'LIST'= objet de type LOGIQUE indiquant la possibilite
  60. *                   d'affichage du processus de convergence. Le
  61. *                   defaut est FAUX.
  62. *
  63. *********************************************************************
  64. 'DEBPROC' RESPOWSP RSPE*'EVOLUTION' TE*'FLOTTANT' AMOR*'LISTREEL'
  65.                    OPTION/'TABLE';
  66. *
  67. ******* INITIALISATION **********************************************
  68. *
  69. *
  70. *------ Reprise de la table d'entre et/ou introduction des defauts
  71. *
  72. 'SI' ('NON' ('EXISTE' OPTION));
  73.   LOPTION=FAUX;
  74. 'SINON';
  75.   LOPTION=VRAI;
  76. 'FINSI';
  77. *
  78. LOK=VRAI;
  79. *
  80. GPRP='ACCE';GPAB='PERI';DIST='CRAM';
  81. FRCO=25.D0;
  82. LFFPS=FAUX;LTTRS=FAUX;
  83. JMAX=15;JHAN=JMAX;EMAX=1.E-2;
  84. LLIST=FAUX;
  85. 'SI' LOPTION;
  86.   'SI' ('EXISTE' OPTION 'GPRP'); GPRP=OPTION.'GPRP'; 'FINSI';
  87.   'SI' ('EXISTE' OPTION 'GPAB'); GPAB=OPTION.'GPAB'; 'FINSI';
  88.   'SI' ('EXISTE' OPTION 'DIST'); DIST=OPTION.'DIST'; 'FINSI';
  89.   'SI' ('EXISTE' OPTION 'FRCO'); FRCO=OPTION.'FRCO'; 'FINSI';
  90.   'SI' ('EXISTE' OPTION 'FFPS');
  91.      LFFPS=VRAI;
  92.      FFPS=OPTION.'FFPS';
  93.      DFFPS='DIMENSION' FFPS;
  94.   'FINSI';
  95.   'SI' ('EXISTE' OPTION 'TTRS');
  96.      LTTRS=VRAI;
  97.      TTRS=OPTION.'TTRS';
  98.   'FINSI';
  99.   'SI' ('EXISTE' OPTION 'JMAX'); JMAX=OPTION.'JMAX';
  100.                                  JHAN=JMAX;          'FINSI';
  101.   'SI' ('EXISTE' OPTION 'EMAX'); EMAX=OPTION.'EMAX'; 'FINSI';
  102.   'SI' ('EXISTE' OPTION 'JHAN'); JHAN=OPTION.'JHAN'; 'FINSI';
  103.   'SI' ('EXISTE' OPTION 'LIST'); LLIST=OPTION.'LIST'; 'FINSI';
  104. 'FINSI';
  105. *'MESSAGE' 'Fin de la reprise';
  106. *
  107. *------ Verification de la grille du RS (donnee)
  108. *
  109. FRMIN=1/TE;
  110. 'SI' (LTTRS);
  111.    TTMIN='EXTRAIRE' TTRS 1;
  112.    NBTTRS='DIMENSION' TTRS;TTMAX='EXTRAIRE' TTRS NBTTRS;
  113.    'SI' ( (1/TTMAX) '>EG' (FRMIN + 1.D-6) );
  114.        LOK=FAUX;
  115.        'MESSAGE' 'LA PERIODE MAXI DE RSPS EST TROP PETITE (TE)';
  116.    'FINSI';
  117.    'SI' ( (1/TTMIN) '<EG' (FRCO - 1.D-6) );
  118.        LOK=FAUX;
  119.        'MESSAGE' 'LA PERIODE MINI DE RSPS EST TROP GRANDE (1/25Hz)';
  120.    'FINSI';
  121. 'FINSI';
  122. 'SI' ('NON' LOK);
  123.    'MESSAGE' '----> PB AVEC IPOL';
  124. 'FINSI';
  125. *'MESSAGE' 'Fin verification de la grille du RS
  126. *
  127. *------ Constante relative a la phase de Hanning
  128. NHANN=3; 
  129. *
  130. *------ Generation de la grille des frequence du PS
  131. *------ ou verification de la grille par defaut
  132. *
  133. 'SI' LOK;
  134.   'SI' ('NON' LFFPS);
  135.      FXXX= 1. / TE;
  136.      FFPS= 'PROG' FXXX ;
  137.      AMOMIN='MINI' AMOR;
  138.      UNPXI=1. + (2. * AMOMIN);
  139.      J=1;
  140.      'REPETER' LAB1;
  141.        FXXX=FXXX * UNPXI;
  142.        'SI' ( FXXX '>EG' FRCO );
  143.          'QUITTER' LAB1;
  144.        'FINSI';
  145.        J=J+1;
  146.       FFPS= 'INSERER' FFPS J FXXX;
  147.      'FIN' LAB1;
  148.      DFFPS=J+1;
  149.     FFPS ='INSERER' FFPS DFFPS FRCO;
  150. *'MESSAGE' 'Fin de la generation de FFPS';
  151.   'FINSI';
  152. *------ On duplique FFPS (pour mieux detruire l'objet interpole)
  153.   FFRS= 'COPIER' FFPS;
  154. *------ On corrige eventuellement FFRS
  155.   FRMINB='EXTRAIRE' FFRS 1;
  156.   'SI' ( ('ABS' (FRMINB-FRMIN)) '>EG' 1.E-5);
  157.       'SI' (FRMINB '<' FRMIN);
  158.         LOK=FAUX;
  159.         'MESSAGE' 'LA FREQUENCE MINI DE FFPS EST TROP PETITE (1/TE)';
  160.       'FINSI';
  161.   'SINON';
  162.       'REMPLACER' FFRS 1 (FRMIN + 1.D-6);
  163.   'FINSI';
  164.   FRCOB='EXTRAIRE' FFRS DFFPS;
  165.   'SI' ( ('ABS' (FRCOB-FRCO)) '>EG' 1.E-5);
  166.       'SI' (FRCOB '>' FRCO);
  167.         LOK=FAUX;
  168.         'MESSAGE' 'LA FREQUENCE MAX DE FFPS EST INCOHERENTE (25Hz)';
  169.       'FINSI';
  170.   'SINON';
  171.       'REMPLACER' FFRS DFFPS (FRCO - 1.D-6);
  172.   'FINSI';
  173. *------ On detruit FFRS et eventuellement FFPS en cas d'erreur
  174.   'SI' ('NON' LOK);
  175.      'MESSAGE' '----> PB AVEC IPOL';
  176.   'FINSI';
  177. 'FINSI';
  178. *
  179. *------ Creation de l'objet evolution contenant le RS
  180. *------          interpole sur la grille FFPS       
  181. *------ Calcul des references d'erreur
  182. *
  183. 'SI' LOK;
  184. *------ Si le RS est donne en periode on interpole sur une grille
  185. *------ de periode
  186.   'SI' ( 'EGA' GPAB 'PERI' );
  187.     FFPE='PROG';
  188.     JT=0;JF=DFFPS+1;
  189.     'REPETER' LAB2 DFFPS;
  190.       JF=JF-1; FXXX='EXTRAIRE' FFRS JF;
  191.       TXXX= 1. / FXXX;
  192.       JT=JT+1;FFPE= 'INSERER' FFPE JT TXXX;
  193.     'FIN' LAB2;
  194.     GRITER=FFPE;
  195.   'SINON';
  196.     GRITER=FFRS;
  197.   'FINSI';
  198. *'MESSAGE' 'Fin de generation/recuperation de GRITER';
  199. *------ Min/Max de GRITER
  200.   XMIGR='EXTRAIRE' GRITER 1;
  201.   XMAGR='EXTRAIRE' GRITER DFFPS;
  202. *------ On initialise les references d'erreur
  203.   ERRN='PROG';
  204. *------ Boucle sur les courbes
  205.   DAMOR= 'DIMENSION' AMOR;
  206.   J=0;
  207.   'REPETER' LAB4 DAMOR;
  208.     J=J+1;
  209. *'MESSAGE' 'Interpolation du resp numero' J;
  210. *------ Extraction des courbes
  211.     ABSI= 'EXTRAIRE' RSPE 'ABSC' J;
  212.     ORDI= 'EXTRAIRE' RSPE 'ORDO' J;
  213. *'MESSAGE' '  fin extraction';
  214. *------ Interpolation (on blinde pour que GRITER soit tjs dedans
  215. *------                ABSI)
  216.     INTERN=VRAI;
  217.     DABSI= 'DIMENSION' ABSI;
  218.     XMAAB= 'EXTRAIRE' ABSI DABSI; LMAX = XMAAB '<' XMAGR; 
  219.     XMIAB= 'EXTRAIRE' ABSI 1;     LMIN = XMIAB '>' XMIGR;
  220.     'SI' ( LMAX 'OU' LMIN );
  221.       INTERN=FAUX;
  222.       AABSI='COPIER' ABSI;
  223.       OORDI='COPIER' ORDI;
  224.       'SI' LMAX;
  225.        AABSI='INSERER' AABSI (DABSI+1) (1.00001*XMAGR);
  226.         XXORD='EXTRAIRE' OORDI DABSI;
  227.        OORDI= 'INSERER' OORDI (DABSI+1) XXORD;
  228.       'FINSI';
  229.       'SI' LMIN;
  230.        AABSI= 'INSERER' AABSI 1 (.99999*XMIGR);
  231.         XXORD='EXTRAIRE' OORDI 1;
  232.        OORDI= 'INSERER' OORDI 1 XXORD;
  233.       'FINSI';
  234.     'FINSI';
  235.     'SI' INTERN;
  236.       RSTER= 'IPOL' GRITER ABSI ORDI;
  237.     'SINON';
  238.       RSTER= 'IPOL' GRITER AABSI OORDI;
  239.     'FINSI';
  240. *'MESSAGE' '  fin interpolation';
  241. *------ Si le RS est donne en periode on le restitue en frequence
  242.     'SI' ( 'EGA' GPAB 'PERI' );
  243.       RSTERB=PROG;
  244.       JF=0;JT=DFFPS+1;
  245.       'REPETER' LAB3 DFFPS;
  246.         JT=JT-1; RS='EXTRAIRE' RSTER JT;
  247.         JF=JF+1;RSTERB = 'INSERER' RSTERB JF RS;
  248.       'FIN' LAB3;
  249.       RSTER=RSTERB;
  250. *'MESSAGE' '  fin restitution en frequence';
  251.     'FINSI';
  252. *------ On calcul la reference d'erreur
  253.     ERRRN='MAXI' RSTER;
  254.    ERRN= 'INSERER' ERRN J ERRRN;
  255. *------ On genere la courbe RS interpole
  256.     COURBE='EVOL' 'MANU' 'Freq' FFRS 'RSinter' RSTER;
  257.     'SI' (J 'EGA' 1);
  258.       RSINTERF=COURBE;
  259.     'SINON';
  260.       RSINTERF=RSINTERF 'ET' COURBE;
  261.     'FINSI';
  262. *'MESSAGE' '  fin concatenation dans RSINTERF';
  263.   'FIN' LAB4;
  264. *
  265. *------ On initialise le PS
  266. *
  267.   J=0;
  268.   PS=PROG;
  269.   'REPETER' LAB5 DFFPS; 
  270.     J=J+1;
  271.    PS= 'INSERER' PS J (1.);
  272.   'FIN' LAB5;
  273.   PSPE='EVOL' 'MANU' 'Freq' FFPS 'Power Spect.' PS;
  274. *'MESSAGE' 'fin initialisation PS';
  275. *
  276.   'SI' LLIST;
  277.     'MESSAGE' 'procedure RESPOWSP avec ' DAMOR ' spectres de reponse';
  278.   'FINSI';
  279. *
  280. ******* CALCUL ******************************************************
  281. *
  282.   LHANN=VRAI;
  283.   ERRP=0.;
  284.   JCALC=0;
  285.   EXPOS=2. / DAMOR;
  286.   'REPETER' CALCUL;
  287.     JCALC=JCALC+1;
  288. *'MESSAGE' 'Boucle de calcul: Iteration ' JCALC;
  289. *
  290. *------ On calcul le RS (en frequence) associer au PS
  291. *
  292.     'SI' LTTRS;
  293.       RSPEC= 'PSRS' PSPE TE AMOR TTRS GPRP DIST 'FREQ';
  294.     'SINON';
  295.       RSPEC= 'PSRS' PSPE TE AMOR      GPRP DIST 'FREQ';
  296.     'FINSI';
  297. *'MESSAGE' '  Fin du calcul du RS';
  298. *
  299. *------ On interpole le RS sur la grille du PS
  300. *
  301.     ERRA='PROG';
  302.     J=0;
  303.     'REPETER' LAB10 DAMOR;
  304.       J=J+1;
  305. *'MESSAGE' '  Boucle d"interpolation du RS' J ; 
  306. *------ Extraction des abscisses/ordonnees
  307.       ABSI= 'EXTRAIRE' RSPEC 'ABSC' J;
  308.       ORDI= 'EXTRAIRE' RSPEC 'ORDO' J;
  309. *'MESSAGE' '    Fin extraction RS Calcule'; 
  310. *------ Interpolation
  311.       RSCJ= 'IPOL' FFRS ABSI ORDI;
  312. *'MESSAGE' '    Fin interpolation'; 
  313. *------ Extraction du RS de consigne
  314.       RSJ  = 'EXTRAIRE' RSINTERF 'ORDO' J;
  315. *'MESSAGE' '    Fin extraction RS Consigne'; 
  316. *------ Calcul du rapport du calcul a la consigne
  317.       RAPJ = RSJ / RSCJ;
  318. *'MESSAGE' '    Fin calcul amplification RAPJ'; 
  319. *------ Determination de l'erreur absolue;
  320.       ERRRA1 = RSJ - RSCJ;
  321.       ERRRA2 = 'ABS' ERRRA1;
  322.       ERRRA  = 'MAXI' ERRRA2; 
  323.      ERRA='INSERER' ERRA J ERRRA;
  324. *------ Cumul des rapport....
  325.       'SI' (J 'EGA' 1);
  326.         RAP = RAPJ;
  327.       'SINON';
  328.         RRAP = RAP * RAPJ;
  329. *------ ... et premieres destructions
  330.         RAP=RRAP;
  331.       'FINSI';
  332. *'MESSAGE' '    Fin cumul amplification RAP'; 
  333.     'FIN' LAB10;
  334. *'MESSAGE' '  Fin calcul amplification RAP'; 
  335. *------ calcul des coefficients
  336.     COEF = RAP ** EXPOS;
  337. *'MESSAGE' '  Fin calcul amplification reelle COEF'; 
  338. *------ calcul d'erreur
  339.     ERRR = ERRA / ERRN;
  340.     ERR  = 'MAXI' ERRR;
  341. *'MESSAGE' '  Fin calcul mesure scalaire d"erreur'; 
  342.     'SI' LLIST;
  343.       'MESSAGE' 'step' JCALC ' ---> mesure d"erreur=' ERR;
  344.     'FINSI';
  345. *------ nouveau PS;
  346.     PSO  = 'EXTRAIRE' PSPE 'ORDO' 1;
  347.     PS   = COEF * PSO;
  348.     PSPE='EVOL' 'MANU' 'Freq' FFPS 'Power Spect.' PS;
  349. *'MESSAGE' '  Fin calcul nouveau PS'; 
  350. *------ fin du calcul???
  351.     XCONV1=ERR;XCONV2=(ABS (ERRP - ERR))/ERR;
  352.     'SI' (XCONV1 '>' XCONV2);
  353.       XCONV=XCONV2;
  354.     'SINON';
  355.       XCONV=XCONV1;
  356.     'FINSI';
  357.     'SI' (XCONV '<' EMAX);
  358.        'QUITTER' CALCUL;
  359.     'FINSI';
  360.     ERRP=ERR;
  361. *'MESSAGE' '  Fin test d"erreur'; 
  362. *------ fin du calcul en erreur ???
  363.     'SI' (JCALC '>EG' JMAX); 'QUITTER' CALCUL; 'FINSI';
  364. *------ filtrage
  365.     'SI' (JCALC '>EG' JHAN); LHANN=FAUX; 'FINSI';
  366.     'SI' LHANN;
  367.       PSPB= 'HANN' PSPE NHANN;
  368.       PSPE=PSPB; 
  369. *'MESSAGE' '  Fin filtrage'; 
  370.     'FINSI';
  371.   'FIN' CALCUL;
  372. *'MESSAGE' '  Fin boucle de calcul';
  373. *
  374. ******* SORTIE ******************************************************
  375. *
  376. 'FINSI';
  377. 'FINPROC' PSPE;
  378.  

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