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;
© Cast3M 2003 - All rights reserved.
Disclaimer